#!/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;
}