#!/usr/bin/perl
use Test::WWW::Mechanize::CGIApp;
use Test::Builder::Tester;
use strict;
use warnings;
use Array::Compare;
use Data::Printer;
use DateTime;
use POSIX;
use Test::More;
use constant TESTS => 71;
=begin # tests:
0) check expected tests allocated to screen term
1) load 1st unscreened new request
2) follow 'screen' link
3) submit new screen data
4) check 'screen' link disappeared
5) check 'screened as' text displayed
6) check expected tests requested
7) check direct link to screen generates error
8) create & load 2nd unscreened new request
9) change initial_screen & check tests
10) change initial screen to request a lab-test requiring a sample type not present
11) add required sample type & repeat above
12) check previous request found on same patient id
13) report previous request & check previous diagnosis found
14) inactivate lab test & check it isn't requested at screening
=cut
BEGIN {
require 't/test-lib.pl';
use DateTime;
DateTime->DefaultLocale('en_GB');
}
my $this_yr = DateTime->now->year - 2000; # warn $this_yr;
my $mech = get_mech();
my $dbh;
eval {
$dbh = get_dbh() or die 'no database handle recieved from get_dbh';
};
warn $@ if $@;
my $dbix = get_dbix();
my $spell_check_required = is_spell_check_required(); # warn $spell_check_required;
do_login();
# check tests allocated to screen term:
$mech->get_ok('/admin/screen_test/list/1'); # print_and_exit();
{
$mech->content_like(
qr{<option value="1" selected>(\s*)AML(\s*)</option>},
'OK: expected screen term loaded'
); # print_and_exit();
$mech->has_tag_like(
strong => qr(Flow \[1\]),
'OK: expected number of tests allocated (1)'
);
$mech->has_tag_like(
strong => qr(Molecular \[1\]),
'OK: expected number of tests allocated (2)'
);
# AML, APML:
=begin # horrible hack to deal with line-break, now testing values instead
foreach (2,5) {
$mech->content_like(
qr(value="$_"\s+checked),
'OK: expected test allocated'
);
}
foreach (1,3,4) {
$mech->content_lacks(
q!value="$_" checked!,
'OK: expected test not allocated'
);
}
=cut
# get test_ids of all checkboxes:
$mech->form_name('update_screen_tests');
my @vals = map $_->value, grep defined $_->value, $mech->find_all_inputs(
type => 'checkbox',
name => 'test_id',
); # p @vals;
is( Array::Compare->new->compare(\@vals, [2, 5]), 1, # only 2 & 5 selected
'OK: expected tests allocated' );
$mech->content_contains(
'AML partial panel',
'OK: flow details text loaded'
);
}
# load main summary page for record #1:
$mech->get_ok('/search/=/1'); # print_and_exit();
{
$mech->content_contains(
'» Record Search',
'OK: initial summary page loaded',
);
# follow 'Screen' link:
$mech->follow_link( text => 'Screen', n => 1 ); # print_and_exit();
$mech->content_contains(
'» Initial Screen',
'OK: initial screen page loaded',
);
$mech->submit_form(
form_name => 'initialScreen', # 1st one is patient notes
fields => {
screen_id => 1, # AML
option_id => 1,
}
); # print_and_exit();
$mech->content_lacks(
q!<a href="http://localhost/screen/=/1">Screen</a>!,
'OK: link to initial screen function disabled',
);
$mech->text_contains(
'Screened as AML',
'OK: initial screen function succeeded',
); # print_and_exit();
}
# check expected tests requested:
{
foreach(qw/AML APML/, ) { # 'Flow details' - not displayed on 'view' page anymore
$mech->has_tag_like(
span => qr($_\:),
'OK: expected test requested',
);
}
foreach (qw/CML PNH HIV/) {
test_out( 'not ok 1 - foo' );
test_fail( +1 );
$mech->has_tag_like( span => qr($_\:), 'foo' );
test_test( 'OK: expected lab test not requested' );
}
$mech->has_tag(
span => '[pending]',
'OK: expected test status detected',
); # print_and_exit();
# get history:
$mech->get_ok('/history/=/1'); # print_and_exit();
$mech->has_tag(
td => 'screened',
'OK: expected history found',
);
}
# try to load initial-screen function again:
$mech->get_ok('/screen/load/1'); # print_and_exit();
$mech->content_contains(
q!Record already screened as "AML"!,
'OK: repeat initial_screen function blocked',
); # print_and_exit();
# register another request direct:
{
my %request = (
request_number => 3,
year => DateTime->now->year,
patient_case_id => 1,
referrer_department_id => 1,
created_at => DateTime->now,
);
$dbix->insert('requests', \%request);
my $id = get_last_insert_id('requests');
$dbix->insert('request_specimen', { request_id => $id, specimen_id => 1 });
}
$mech->get_ok('/screen/=/2'); # print_and_exit();
{
$mech->has_tag(
p => 'No previous patient matches found',
'OK: no previous patient matches found'
);
$mech->submit_form(
form_name => 'initialScreen', # 1st one is patient notes
fields => {
screen_id => 2, # PNH
option_id => 1,
}
); # print_and_exit();
# check expected tests requested:
$mech->has_tag_like(
span => qr(PNH\:),
'OK: expected test requested',
);
foreach( qw/AML HIV APML CML/ ) { # 'Flow details' - not displayed anymore
test_out( 'not ok 1 - foo' );
test_fail( +1 );
$mech->has_tag_like( span => qr($_\:), 'foo' );
test_test( 'OK: expected lab test not requested' );
}
}
{ # register linked lab-test Linked-1 to Molecular test APML:
$dbix->insert('lab_tests', {
field_label => 'Linked-1', lab_section_id => 3, test_type => 'test',
has_results => 'no', is_active => 'yes', test_name => 'linked_1',
});
my $linked_test_id = get_last_insert_id('lab_tests');
$dbix->insert( 'linked_lab_test',
{ parent_test_id => 5, linked_test_id => $linked_test_id });
$dbix->insert('lab_test_sample_type',
{ lab_test_id => $linked_test_id, sample_type_id => 1 });
}
# change initial_screen:
$mech->get_ok('/request/edit/2'); # print_and_exit();
{
$mech->follow_link_ok(
{ url_regex => qr(screen/edit/2) },
'OK: followed edit screen link',
); # print_and_exit();
$mech->has_tag(
h3 => 'Change initial screen:',
'OK: expected title found',
);
# $mech->field( screen_id => 1 ); # AML - can't do it - function replaced by j/s
# $mech->submit(); # print_and_exit();
$mech->get_ok('/screen/update/2?screen_id=1'); # print_and_exit();
# expect new AML tests (AML, AMPL, Flow details, Linked-1) + original PNH & not CML or HIV:
foreach(qw/AML APML PNH Linked-1/, ) { # 'Flow details' - not displayed anymore
$mech->has_tag_like(
span => qr($_\:),
'OK: expected test requested',
);
}
foreach(qw/HIV CML/) {
test_out( 'not ok 1 - foo' );
test_fail( +1 );
$mech->has_tag_like( span => qr($_\:), 'foo' );
test_test( 'OK: expected lab test not requested' );
} # print_and_exit();
$mech->get_ok('/history/=/2'); # print_and_exit();
$mech->has_tag(
td => 'updated initial screen entry PNH',
'OK: expected history found',
);
}
# try to change screen to request lab-test which requires sample type we don't have:
{
# register 2 new screen that requests tests for histology section:
$dbix->insert('screens', { category_id => 2, description => 'fixed_tissue_1' } );
$dbix->insert('screens', { category_id => 2, description => 'fixed_tissue_2' } );
$dbix->insert('screen_lab_test', { screen_id => 3, lab_test_id => 8 } ); # Mib1
$dbix->insert('screen_lab_test', { screen_id => 4, lab_test_id => 8 } ); # Mib1
# update screen to request lab-test not supported by sample type(s):
$mech->get_ok('/screen/update/2?screen_id=3'); # print_and_exit();
{
test_out( 'not ok 1 - foo' );
test_fail( +1 );
$mech->has_tag_like( span => qr(Mib1\:), 'foo' );
test_test( 'OK: expected lab test not requested' );
}
$mech->has_tag_like(
dt => qr(skipped lab-tests),
'OK: skipped lab-tests warning displayed',
); # print_and_exit();
{
test_out( 'not ok 1 - foo' );
test_fail( +1 );
$mech->has_tag_like( dt => qr(requested lab-tests), 'foo' );
test_test( 'OK: requested lab-tests info not displayed' );
}
}
# now change screen to request same lab-test which requires sample type we DO have:
{
# add new request_specimen of required type:
$dbix->insert('request_specimen', { request_id => 2, specimen_id => 4 }); # BMAT
# update screen to request lab-test that IS supported by sample type(s):
$mech->get_ok('/screen/update/2?screen_id=4'); # print_and_exit();
$mech->has_tag_like(
span => qr(Mib1\:),
'OK: expected test requested',
);
$mech->has_tag_like(
dt => qr(requested lab-tests),
'OK: requested lab-tests info displayed',
); # print_and_exit();
{
test_out( 'not ok 1 - foo' );
test_fail( +1 );
$mech->has_tag_like( dt => qr(skipped lab-tests), 'foo' );
test_test( 'OK: skipped lab-tests warning not displayed' );
}
}
$mech->get_ok('/screen/=/3'); # print_and_exit();
{ # warn $mech->text;
$mech->text_like(
qr{Other records \[1 \+ 0\]},
'OK: one other record found',
);
$mech->text_like(
qr{H1/$this_yr},
'OK: other record lab number found',
);
$mech->text_like(
qr{PB, BMAT|BMAT, PB}, # depends on load order
'OK: other record specimen found',
); # print_and_exit();
}
# report #1 so screen #3 finds previous record diagnosis (only after authorisation):
$mech->get_ok('/report/=/1'); # print_and_exit();
{
my %h = (
confirm_outstanding_tests => 1,
gross_description => 'gross description',
clinical_details => 'clinical details',
specimen_quality => 'adequate',
diagnosis_id => 1,
status => 'new',
);
$mech->form_name('reportForm');
$mech->submit_form( fields => \%h ); # print_and_exit();
$mech->submit_form(form_name =>'reportForm') if $spell_check_required;
lacks_dfv_errors(); # print_and_exit();
}
# reload #3 screen:
$mech->get_ok('/screen/=/3'); # print_and_exit();
{
$mech->text_contains(
'H1/'.$this_yr,
'OK: other record lab number found',
);
$mech->text_lacks(
'RAEB',
'OK: other record diagnosis not found',
); # print_and_exit();
}
# authorise #3:
{
# change reporter.id on #1 to allow authorisation:
$dbix->update('request_history', # not FK-enabled so no complaints:
{ user_id => 2 }, { request_id => 1, action => 'reported' } );
$mech->get_ok("/report/=/1?pre-authorisation-check=1"); # print_and_exit();
$mech->form_name('reportForm');
$mech->field( authorise => 1 );
$mech->tick('confirm_outstanding_tests', 1, 1);
$mech->submit_form(); # print_and_exit();
$mech->submit_form(form_name => 'reportForm') if $spell_check_required;
# revert reporter.id:
$dbix->update('request_history',
{ user_id => 1 }, { request_id => 1, action => 'reported' } ); # print_and_exit();
}
# reload #3 screen:
$mech->get_ok('/screen/=/3'); # print_and_exit();
{
$mech->text_contains(
'H1/'.$this_yr,
'OK: other record lab number found',
);
$mech->text_contains(
'RAEB',
'OK: other record diagnosis found',
); # print_and_exit();
}
# inactivate APML lab test & check it isn't requested at screening:
{
$dbix->update('lab_tests', { is_active => 'no' }, { test_name => 'apml' });
$mech->get_ok('/screen/=/3'); # print_and_exit();
$mech->submit_form(
form_name => 'initialScreen', # 1st one is patient notes
fields => {
screen_id => 1, # AML
option_id => 1,
}
); # print_and_exit();
$mech->text_contains(
'Screened as AML',
'OK: initial screen function succeeded',
); # print_and_exit();
$mech->content_contains('AML - Flow', 'OK: expected lab test requested' );
$mech->content_lacks('APML - Molecular', 'OK: expected lab test not requested' );
# switch it on again in case we add more tests later:
$dbix->update('lab_tests', { is_active => 'yes' }, { test_name => 'apml' });
}
do_logout();
done_testing(TESTS);
