RSS Git Download  Clone
Raw Blame History
#!/usr/bin/perl

use Test::WWW::Mechanize::CGIApp;
use Test::Builder::Tester;

use Data::Dumper;
use Data::Printer;

use strict;
use warnings;

use constant TESTS => 58;

use Test::More tests => TESTS;
# use Test::More 'no_plan';

=begin: tests:
=cut

BEGIN {
    require 't/test-lib.pl';
}

my $dbh;
eval {
    $dbh = get_dbh() or die 'no database handle received from get_dbh';
};

my $dbix = get_dbix();
my $mech = get_mech();

# need to see if 'require_spell_check' is required:
my $spell_check_required = is_spell_check_required(); # warn $spell_check_required;

# how many diagnoses already:
$dbix->select('diagnoses', 'count(id)')->into(my $n_diagnoses); # warn $n_diagnoses;

# ======== add new data ========================================================
{ # 1st new diagnosis - just request new lab-tests:
    my $diagnosis = 'diagnosis_test_1';
    $dbix->insert('diagnoses', { name => $diagnosis, diagnostic_category_id => 1 });
    my $new_diagnosis_id = get_last_insert_id('diagnoses');

    for my $t ('a','b') {
        my $test = $diagnosis . $t;
        my %h = (
            lab_section_id => 1,
            test_type => 'test',
            test_name => $test,
        );
        my $test_id = _add_lab_tests(\%h);
        $dbix->insert('diagnosis_lab_test',
            { diagnosis_id => $new_diagnosis_id, lab_test_id => $test_id });
    }
}
{ # 2nd new diagnosis - expands panels -> lab-tests:
    my $diagnosis = 'diagnosis_test_2';
    $dbix->insert('diagnoses', { name => $diagnosis, diagnostic_category_id => 1 });
    my $new_diagnosis_id = get_last_insert_id('diagnoses');
    my $panel_test_id = undef; # will be populated by test 'a'

    # register 1 panel & 2 tests for panel expansion:
    for my $t ( qw/a b c/) {
        my $test = $diagnosis . $t;
        my $type = $t eq 'a' ? 'panel' : 'test';

        my %h = (
            lab_section_id => 3,
            test_type => $type,
            test_name => $test,
        );
        my $test_id = _add_lab_tests(\%h);
        if ( $t eq 'a' ) {
            $panel_test_id = $test_id;
            $dbix->insert('diagnosis_lab_test',
                { diagnosis_id => $new_diagnosis_id, lab_test_id => $test_id });
        }
        else {
            $dbix->insert('panel_lab_test',
                { panel_test_id => $panel_test_id, lab_test_id => $test_id });
        }
    }
}

#===============================================================================

do_login();

# register new:
$mech->get_ok('/request/add_new/2');
{
    $mech->submit_form(
        fields => {
            request_number => 3,
            specimen => 'PB',
            referrer_code => 'C1234567',
        },
    );                                                        # print_and_exit();

    $mech->has_tag(
        h3 => 'New request successful',
    );
}

# screen request:
$mech->get_ok('/screen/=/3');                                 # print_and_exit();
{
    $mech->form_name('initialScreen'); # 1st one is patient notes

    $mech->field(screen_id => 2); # PNH
    $mech->field(option_id => 1);
    $mech->submit();                                          # print_and_exit();

    $mech->text_contains(
        'Screened as PNH',
        'OK: expected screen term found',
    );    													  # print_and_exit();
}

# sign out test:
$mech->get_ok('/worklist/display/1?display_format=Data+Entry'); # print_and_exit();
{
    $mech->field(request_lab_test_id => 1);
    $mech->field(status_option_id => 2);
    $mech->submit();                                          # print_and_exit();

    $mech->has_tag_like(
        p => qr(records updated successfully),
        'OK: update success',
    );                                                        # print_and_exit();

    for ( qw/PNH complete/ ) {
        $mech->has_tag(td => $_);
    }														 # print_and_exit();
}

# report - don't auto-request test (to demonstrate no [pending] fields):
$mech->get_ok('/report/=/3');                                # print_and_exit();
{
    my %report = ( # PB so doesn't need biopsy_site or gross_description
        status  => 'default',
        clinical_details => 'some details here',
        morphology => 'morphology here',
        comment => 'comment here',
        specimen_quality => 'adequate',
        diagnosis_id => 2, # doesn't auto-request tests
    );

    $mech->form_name('reportForm');
    $mech->submit_form(fields => \%report);                  # print_and_exit();
    $mech->submit_form(form_name =>'reportForm') if $spell_check_required;
    lacks_dfv_errors();                                      #  print_and_exit();

    $mech->has_tag_like(
        p => qr(record updated successfully),
        'OK: update success',
    );                                                       # print_and_exit();

    # check 'reported by':
    $mech->has_tag_like(
        p => qr(Reported by),
        'OK: reporter information displayed'
    );

	# no pending tests:
    $mech->text_lacks( '[pending]', 'OK: no pending lab-tests' ); # print_and_exit();
}
# change diagnosis to one auto-requesting tests:
$mech->get_ok('/report/=/3');                                 # print_and_exit();
{
    my $n = 1; # 1st new diagnosis

    $mech->form_name('reportForm');
    $mech->field(diagnosis_id => $n_diagnoses + 1); # auto-requests lab-test
    $mech->field(option_id => 1);
    $mech->submit();                                          # print_and_exit();
    $mech->submit_form(form_name =>'reportForm') if $spell_check_required;
    lacks_dfv_errors();                                       # print_and_exit();

    $mech->text_contains(
        'diagnosis_test_'.$n,
        'OK: changed diagnosis found',
    );                                                        # print_and_exit();

    $mech->has_tag_like(
        p => qr(record updated successfully),
        'OK: update success',
    );                                                        # print_and_exit();

	# check have requested test:
    $mech->has_tag_like(
        span => qr(\[pending\]),
        'OK: new requested test'
    );														  # print_and_exit();
}
# check history:
$mech->get_ok('/history/=/3');                                # print_and_exit();
{
    for my $t ('a','b') {
        my $test = uc'diagnosis_test_1' . $t;
        $mech->has_tag_like(
            td => qr(auto-requested $test triggered by diagnosis),
            'OK: expected history entry'
        );
    }                                                        # print_and_exit();
}

# change diagnosis to one requiring additional panel requiring expansion:
$mech->get_ok('/report/=/3');                                # print_and_exit();
{
    my $n = 2; # 1st new diagnosis

    $mech->form_name('reportForm');
    $mech->field(diagnosis_id => $n_diagnoses + $n); # auto-requests panel which auto-expands
    $mech->field(option_id => 1);
    $mech->field(confirm_outstanding_tests => 1);
    $mech->submit();                                          # print_and_exit();
    $mech->submit_form(form_name =>'reportForm') if $spell_check_required;
    lacks_dfv_errors();                                       # print_and_exit();

    $mech->text_contains(
        'diagnosis_test_'.$n,
        'OK: changed diagnosis found',
    );                                                        # print_and_exit();

    for ( 'B','C' ) {
        $mech->text_contains(
            "DIAGNOSIS_TEST_2$_: [pending]",
            "OK: expanded lab test id $_ pending",
        );
    }
    # does NOT have "HTS myeloid" panel:
    $mech->text_lacks(
        'DIAGNOSIS_TEST_2A: [pending]',
        'OK: does not have pre-expansion panel name',
    );                                                        # print_and_exit();
}
$mech->get_ok('/history/=/3');                                # print_and_exit();
for ( 'B','C' ) {
    $mech->has_tag_like(
        td => qr(auto-requested DIAGNOSIS_TEST_2$_ triggered by diagnosis),
        'OK: expected history entry'
    );
}                                                            # print_and_exit();

#===============================================================================
# result summaries:
{
    $dbix->insert('result_summary_options', {
        description => 'result_summary_details', lab_section_id => 1 });
    my $summary_id = get_last_insert_id('result_summary_options');

    for (1..2) {
        my %h = (
            lab_section_id => 1,
            test_type => 'test',
            test_name => 'result_summary_lab_test_'.$_,
        );
        my $test_id = _add_lab_tests(\%h);
        $dbix->insert('result_summary_lab_test',
            { result_summary_id => $summary_id, lab_test_id => $test_id });
    }
    { # for linked_lab_tests:
        my %h = (
            lab_section_id => 1,
            test_type => 'test',
            test_name => 'rs_linked_test_1',
        );
        my $test_id = _add_lab_tests(\%h);
        my $parent_id = get_last_insert_id('lab_tests') - 1; # link to previous lab-test
        $dbix->insert('linked_lab_test',
            { parent_test_id => $parent_id, linked_test_id => $test_id});
    }
}

# register new:
$mech->get_ok('/request/add_new/2');
{
    $mech->submit_form(
        fields => {
            request_number => 4,
            specimen => 'PB',
            referrer_code => 'C1234567',
        },
    );                                                        # print_and_exit();

    $mech->has_tag(
        h3 => 'New request successful',
    );
}

# screen request:
$mech->get_ok('/screen/=/4');                                 # print_and_exit();
{
    $mech->form_name('initialScreen'); # 1st one is patient notes

    $mech->field(screen_id => 2); # PNH
    $mech->field(option_id => 1);
    $mech->submit();                                          # print_and_exit();

    $mech->text_contains(
        'Screened as PNH',
        'OK: expected screen term found',
    );    													  # print_and_exit();
}

# sign out test:
$mech->get_ok('/worklist/display/1?display_format=Data+Entry'); # print_and_exit();
{
    $mech->field(request_lab_test_id => 6);
    $mech->field(status_option_id => 2);
    $mech->submit();                                         #  print_and_exit();

    $mech->has_tag_like(
        p => qr(records updated successfully),
        'OK: update success',
    );                                                        # print_and_exit();

    for ( qw/PNH complete/ ) {
        $mech->has_tag(td => $_);
    }														 # print_and_exit();
}

my @result_summary_lab_tests =
    qw(result_summary_lab_test_1 result_summary_lab_test_2 rs_linked_test_1);

$mech->get_ok('/search/=/4');                                 # print_and_exit();
{
	# no pending tests:
    for ( @result_summary_lab_tests ) {
        $mech->text_lacks( "$_: [pending]", "OK: no pending $_ lab-test" );
	}                                                        # print_and_exit();
}
$mech->get_ok('/result/=/4');                                # print_and_exit();
{
    $mech->form_name('flow_results');
    $mech->field(_results_summary => 'result_summary_details');
    $mech->submit();                                         # print_and_exit();

    $mech->has_tag_like(
        p => qr(results data update successful),
        'OK: update success',
    );                                                        # print_and_exit();
    for ( @result_summary_lab_tests ) {
        my $test = uc $_;
        $mech->has_tag_like(
			span => qr{$test \(new\)},
			"OK: new $_ lab-test",
		);
	}                                                        # print_and_exit();
}
$mech->get_ok('/history/=/4');                               #  print_and_exit();
{
	my $i = 1;
	$mech->has_tag_like(
		td => qr(new Flow result summary),
		"OK: expected history entry [$i] found",
	);
	$i++;
	for ( @result_summary_lab_tests ) {
        my $test = uc $_;
        $mech->has_tag_like(
			td => qq(auto-requested $test triggered by results summary),
			"OK: expected history entry [$i] found",
		);
        $i++;
	}                                                       #  print_and_exit();
}

do_logout();

sub _add_lab_tests {
	my ($data) = shift; # warn Dumper $data;
    $data->{has_results} = 'no';

	# lab_test_sample_type:
	my $sample_type_ids = $dbix->select('lab_section_sample_type',
		['sample_type_id'], { lab_section_id => $data->{lab_section_id} } )->flat;
    # warn Dumper $sample_type_ids;

    $data->{field_label} = uc $data->{test_name};
    $dbix->insert('lab_tests', $data); # p %h;
    my $lab_test_id = get_last_insert_id('lab_tests');
	# lab_test_sample_type:
	$dbix->insert('lab_test_sample_type',
		{ lab_test_id => $lab_test_id, sample_type_id => $_ }) for @$sample_type_ids;
    return $lab_test_id;
}