#!/usr/bin/perl
# requires presence of config/.local/auto_screen.yml file, or skips tests
use Test::WWW::Mechanize::CGIApp;
use Test::Builder::Tester;
use Data::Dumper;
use strict;
use warnings;
use constant TESTS => 31;
use Test::More tests => TESTS;
# use Test::More 'no_plan';
=begin: tests:
=cut
BEGIN {
require 't/test-lib.pl';
}
my $yaml = get_yaml('auto_screen'); # warn Dumper $yaml;
SKIP: {
skip('these tests require config/.local/settings/auto_screen.yml file',TESTS)
unless $yaml;
do_all_tests();
}
sub do_all_tests {
my $CMP = '~CMP'; # auto-screening outreach disabled 03/17, retained as ~CMP for .t
my $mech = get_mech();
do_login();
my $dbh;
eval {
$dbh = get_dbh() or die 'no database handle received from get_dbh';
};
my $dbix = get_dbix();
$dbix->insert('screen_category', {
name => 'miscellaneous', is_active => 'yes',
});
$dbix->insert('lab_tests', {
field_label => 'CML RQ', lab_section_id => 1, test_type => 'test',
has_results => 'no', is_active => 'yes', test_name => 'cml_rq', id => 44,
});
$dbix->insert('lab_tests', {
field_label => 'Outreach', lab_section_id => 1, test_type => 'test',
has_results => 'no', is_active => 'yes', test_name => 'outreach', id => 49,
});
# add linked lab-test:
$dbix->insert('lab_tests', {
field_label => 'Linked-1', lab_section_id => 1, test_type => 'test',
has_results => 'no', is_active => 'yes', test_name => 'linked_1',
});
my $linked_test_id = get_last_insert_id('lab_tests');
# link cml_rq to new lab-test linked_1:
$dbix->insert( 'linked_lab_test',
{ parent_test_id => 44, linked_test_id => $linked_test_id });
{
$dbix->insert('screens', {
description => 'Outreach', category_id => 3, active => 'yes',
});
my $id = get_last_insert_id('screens'); # warn $id;
$dbix->insert('screen_lab_test', { screen_id => $id, lab_test_id => 49 });
}
{ # add inactive 'Outreach CML' - not loaded for manual screen but used for auto-screen:
$dbix->insert('screens', {
description => 'Outreach CML', category_id => 3, active => 'no',
});
my $id = get_last_insert_id('screens'); # warn $id;
$dbix->insert('screen_lab_test', { screen_id => $id, lab_test_id => 44 });
}
$dbix->insert('diagnoses', { # CML is not diagnostic_category_id 1 but OK for this:
name => 'CML', icdo3 => '9875/3', diagnostic_category_id => 1, active => 'yes',
});
{ # lab_test_sample_type:
my $sample_type_ids = $dbix->select('lab_section_sample_type',
['sample_type_id'], { lab_section_id => 1 } )->flat; # warn Dumper $sample_type_ids;
for my $id (44, 49, $linked_test_id) {
$dbix->insert('lab_test_sample_type',
{ lab_test_id => $id, sample_type_id => $_ }) for @$sample_type_ids;
}
}
$dbix->insert('specimens', { # have disabled auto-screening Outreach in March 2017:
sample_code=> $CMP, description => 'Community monitoring' });
# register new:
$mech->get_ok('/request/add_new/2'); # print_and_exit();
{
$mech->submit_form(
fields => {
request_number => 3,
specimen => $CMP,
referrer_code => 'C1234567',
},
); # print_and_exit();
$mech->has_tag(
h3 => 'New request successful',
);
}
# load history:
$mech->get_ok('/history/=/3'); # print_and_exit();
{
$mech->has_tag(
td => 'screened',
);
}
# load summary page:
$mech->get_ok('/search/=/3'); # print_and_exit();
{ # should have no tests requested:
$mech->has_tag_like(
p => 'Lab Tests \[ 0 \]',
'OK: no lab tests requested',
); # print_and_exit();
}
# register new:
$mech->get_ok('/request/add_new/2'); # print_and_exit();
{
$mech->submit_form(
fields => {
request_number => 4,
specimen => "$CMP, PB",
referrer_code => 'C1234567',
},
); # print_and_exit();
$mech->has_tag(
h3 => 'New request successful',
);
}
$mech->get_ok('/search/=/4'); # print_and_exit();
{ # should have outreach requested, but not CML RQ:
$mech->has_tag_like(
span => qr(Outreach\:),
'OK: has Outreach test requested',
);
$mech->has_tag_like(
span => qr([pending]),
'OK: has [pending]',
);
test_out( 'not ok 1 - foo' );
test_fail( +1 );
$mech->has_tag_like( span => qr(CML RQ\:), 'foo' );
test_test( "OK: expected lab test CML RQ not requested" );
} # print_and_exit();
# now report as CML and repeat registration:
{ # direct update request_report_detail table (outreach case so too complex to do thu' app)
my %d = (
request_id => 4,
clinical_details => 'foo',
comment => 'foo',
status => 'new',
diagnosis_id => 3,
created_at => \'NOW()',
updated_at => \'NOW()',
);
$dbix->insert('request_report_detail', \%d);
$dbix->insert('request_specimen_detail',
{ request_id => 4, specimen_quality => 'good', specimen_date => \'NOW()' });
}
$mech->get_ok('/request/add_new/2'); # print_and_exit();
{
$mech->submit_form(
fields => {
request_number => 5,
specimen => $CMP,
referrer_code => 'C1234567',
},
); # print_and_exit();
$mech->has_tag(
h3 => 'New request successful',
);
}
# load summary page:
$mech->get_ok('/search/=/5'); # print_and_exit();
{ # should have no tests requested:
$mech->has_tag_like(
p => 'Lab Tests \[ 0 \]',
'OK: no lab tests requested',
); # print_and_exit();
$mech->has_tag_like(
a => 'Outreach', # not 'Outreach CML'
'OK: expected screen term found',
); # print_and_exit();
test_out( 'not ok 1 - foo' );
test_fail( +1 );
$mech->has_tag_like( a => 'Outreach CML', 'foo' );
test_test( "OK: incorrect screen term not found" ); # print_and_exit();
}
$mech->get_ok('/request/add_new/2'); # print_and_exit();
{
$mech->submit_form(
fields => {
request_number => 6,
specimen => "$CMP, PB",
referrer_code => 'C1234567',
},
); # print_and_exit();
$mech->has_tag(
h3 => 'New request successful',
);
}
$mech->get_ok('/search/=/6'); # print_and_exit();
{ # should have outreach and CML RQ + linked lab-test requested:
for ('Outreach','CML RQ','Linked-1') {
$mech->has_tag_like(
span => qr($_\:),
"OK: has $_ test requested",
);
}
$mech->has_tag_like(
span => qr([pending]),
'OK: has [pending]',
);
} # print_and_exit();
do_logout();
}
