#!/usr/bin/perl
use Test::WWW::Mechanize::CGIApp;
use Test::Builder::Tester;
use strict;
use warnings;
use DateTime;
use POSIX;
use Test::More tests => 71; # use Test::More 'no_plan';
=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
12) report previous request & check previous diagnosis found
=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:
foreach (2,5) {
$mech->content_like(
qr(value="$_" checked),
'OK: expected test allocated'
);
}
foreach (1,3,4) {
$mech->content_lacks(
q!value="$_" checked!,
'OK: expected test not 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);
}
$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 from 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',
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();
}
do_logout();
