#!/usr/bin/perl use Test::WWW::Mechanize::CGIApp; use strict; use warnings; use DateTime; use POSIX; #use Test::More 'no_plan'; use Test::More tests => 104; use Test::Builder::Tester; =begin # tests: 1) retrieve patient & submit valid request 2) select same patient & register new unit number for same location 3) new request - duplicate labno 4) new request - invalid specimen 5) new request - missing referrer_code 6) retrieve request history for new record 7) submit new request for unknown GP 8) submit new request for unknown clinician 9) delete record 10) re-create record - test for original request.id 11) check lab-test automaticaly requested by sample type =cut BEGIN { require 't/test-lib.pl'; } my $mech = get_mech(); my $dbh; eval { $dbh = get_dbh() or die 'no database handle recieved from get_dbh'; }; warn $@ if $@; foreach( qw/requests request_specimen/ ) { drop_and_recreate($_); } #{ # $dbh->do( q!ALTER TABLE `request_specimen` # ADD CONSTRAINT `request_specimen_ibfk_1` FOREIGN KEY (`request_id`) # REFERENCES `requests` (`id`) ON DELETE CASCADE! ); #} do_login(); $mech->get_ok('/register'); # print_and_exit(); my $last_name = 'green'; $mech->submit_form( fields => { name => $last_name, }, ); # print_and_exit(); $mech->follow_link_ok( # {n => 8}, "Logout $_ via eighth link on page", { url_regex => qr/select/i, }, 'select patient using link', ); # print_and_exit(); $mech->follow_link_ok( # {n => 8}, "Logout $_ via eighth link on page", { url_regex => qr/new/i, }, 'select case using link', ); # print_and_exit(); $mech->submit_form( fields => { request_number => 1, specimen => 'pb', referrer_code => 'G1234567', }, ); # print_and_exit(); $mech->content_contains( q!New request successful!, 'OK: new request entered successfully', ); # print_and_exit(); { my $i=0; foreach (qw/PB 1111111111 01.Feb.1940 1011 GREEN/, 'Black DE', 'The Surgery, Newtown, NT1 1NT' ) { $i++; $mech->content_like( qr(), "OK: new request field [$i] detected", ); } } # follow 'next' link to add new record: $mech->follow_link_ok( # {n => 8}, "Logout $_ via eighth link on page", { url_regex => qr(localhost/register)i, }, 'select "next" using link', ); # print_and_exit(); $mech->content_contains( q!Search For Patient Details!, 'OK: new reqest page loaded', ); # select same patient as previous: $mech->submit_form( fields => { name => $last_name, }, ); # print_and_exit(); $mech->follow_link_ok( # {n => 8}, "Logout $_ via eighth link on page", { url_regex => qr/select/i, }, 'select patient using link', ); # print_and_exit(); # register new location / unit number: $mech->submit_form( fields => { unit_number => 123456, referral_source_id => 1, }, ); # print $fh $mech->content; exit; { my $i=0; foreach (qw/1111111111 01.Feb.1940 GREEN 123456/ ) { $i++; $mech->content_contains( qq!$_!, "OK: submitted field [$i] detected", ); } # print_and_exit(); } # submit duplicate labno: $mech->submit_form( fields => { request_number => 1, specimen => 'PB', }, ); # print_and_exit(); has_dfv_errors(); has_duplicate(); # correct duplicate labno, but submit invalid specimen: $mech->submit_form( fields => { request_number => 2, specimen => 'BMTA', }, ); # print_and_exit(); has_dfv_errors(); has_invalid(); has_missing(); # correct invalid specimen & missing referrer_code: $mech->submit_form( fields => { request_number => 2, specimen => 'PB', referrer_code => 'C1234567', external_reference => 'AB/1234', _referrer => 'Brown, CC', # ajax function in form }, ); # print_and_exit(); { my $i=0; my @fields = ( qw/PB 1111111111 01.Feb.1940 GREEN 123456 AB\/1234/, 'Newtown General Infirmary', 'Brown, CC' ); foreach ( @fields ) { $i++; $mech->content_like( qr(), "OK: new request field [$i] detected", ); } } # print_and_exit(); # test history: $mech->get_ok('/search'); # print_and_exit(); $mech->submit_form( fields => { lab_number => 2, }, ); # print_and_exit(); $mech->content_contains( 'Record not screened', 'OK: record loaded & not screened', ); $mech->follow_link_ok( # {n => 8}, "Logout $_ via eighth link on page", { url_regex => qr(history)i, }, 'select "history" link', ); # print_and_exit(); $mech->content_contains( 'Request history', 'OK: request history page loaded', ); $mech->has_tag( td => 'registered', 'OK: action detected', ); # access new request for case_number.id = 1 direct: $mech->get_ok('/request/add_new/1'); # print_and_exit(); $mech->content_contains( '» Request » New', 'OK: new request page loaded', ); $mech->content_contains( 'The Surgery, Newtown', 'OK: expected patient_case data loaded', ); # select unknown GP: $mech->submit_form( fields => { request_number => 3, specimen => 'PB', referrer_code => 'G9999998', }, ); # print_and_exit(); $mech->content_contains( q!value="Unknown"!, 'OK: value "unknown" detected', ); # access new request for case_number.id = 3 direct: $mech->get_ok('/request/add_new/3'); # print_and_exit(); $mech->content_contains( '» Request » New', 'OK: new request page loaded', ); $mech->content_contains( 'Newtown General Infirmary', 'OK: expected patient_case data loaded', ); # select unknown clinician: $mech->submit_form( fields => { request_number => 4, specimen => 'PB', referrer_code => 'C9999998', }, ); # print_and_exit(); # can't verify unknown clinician from request summary, so do search on request no: $mech->get_ok('/search'); # print_and_exit(); { $mech->submit_form( fields => { lab_number => 4, }, ); # print_and_exit(); my $yr = DateTime->now->strftime('%y'); $mech->has_tag( td => 'Newtown General Infirmary', 'OK: expected content returned', ); $mech->has_tag( span => 'Unknown', 'OK: expected content returned', ); $mech->content_like( qr(\w4/$yr), # department prefix = \w 'OK: expected request number returned', ); } # delete record: $mech->get_ok('/search/do_search?lab_number=3'); # print_and_exit(); { # need to setup FK's this test: my $dbh = get_dbh(); my $dbix = get_dbix(); my @non_cascade_tables = qw(history phone_log lab_test_history); my @cascade_tables = qw(audit consent diagnosis_history error_code external_ref initial_screen lab_test_results lab_test_status option report result_summaries specimen trial); foreach(@cascade_tables) { my $table = 'request_' . $_; my $fk = $table . '_ibfk_1'; $dbh->do( qq!ALTER TABLE `$table` ADD CONSTRAINT `$fk` FOREIGN KEY (`request_id`) REFERENCES `requests` (`id`) ON DELETE CASCADE! ); } { # add some data to tables with fk to request.id: $dbix->insert('request_audit', { request_id => 3, audit_request_option_id => 1}); $dbix->insert('request_consent', { request_id => 3, consent_id => 1, status => 'yes'}); $dbix->insert('request_error_code', { request_id => 3, error_code_id => 1}); $dbix->insert('request_external_ref', { request_id => 3, external_reference => 'AB12'}); $dbix->insert('request_initial_screen', { request_id => 3, screen_id => 1}); $dbix->insert('request_lab_test_results', { request_id => 3, lab_test_id => 1, result => 'foo'}); $dbix->insert('request_lab_test_status', { request_id => 3, lab_test_id => 2, status_option_id => 1}); $dbix->insert('request_option', { request_id => 3, option_id => 1}); $dbix->insert('request_report', { request_id => 3, comment => 'foo', clinical_details => 'foo', diagnosis_id => 1}); $dbix->insert('request_diagnosis_history', { request_id => 3, diagnosis_id => 2, option_id => 1, user_id => 1}); $dbix->insert('request_lab_test_history', { request_id => 3, action => 'foo', user_id => 1}); $dbix->insert('request_trial', { request_id => 3, trial_id => 1}); $dbix->insert('request_phone_log', { request_id => 3, user_id => 1, contact => 'foo', status => 'inbound', details => 'foo'}); $dbix->insert('request_result_summaries', { request_id => 3, lab_section_id => 1, results_summary => 'foo'}); } # check data exists: foreach ( sort (@cascade_tables, @non_cascade_tables) ) { my $tbl = 'request_' . $_; is( $dbix->query(qq!select 1 from `$tbl` where `request_id` = ?!, 3)->list, 1, "OK: $tbl contains expected request data" ); } $mech->has_tag_like( td => qr(GREEN, Alan), 'OK: expected record found', ); # test for absence of re-registered record patient (below): test_out( 'not ok 1 - foo' ); test_fail( +1 ); $mech->has_tag_like( td => qr(BROWN, Stan), 'foo' ); test_test( 'OK: expected record found' ); # test for absence of re-registered record specimen type: test_out( 'not ok 1 - foo' ); test_fail( +1 ); $mech->has_tag( td => 'LU', 'foo' ); test_test( 'OK: expected record found' ); $mech->follow_link_ok( # {n => 8}, "Logout $_ via eighth link on page", { url_regex => qr(request/delete_request), }, 'follow delete link', ); # print_and_exit(); my %delete = ( reason => 'inappropriate request', confirm_delete => 1, ); $mech->submit_form(fields => \%delete); # print_and_exit(); lacks_dfv_errors(); # print_and_exit(); $mech->has_tag( p => 'INFO: record deleted', 'OK: delete success message detected' ); # repeat search for lab_number: $mech->get_ok('/search/do_search?lab_number=3'); # print_and_exit(); $mech->has_tag( p => get_messages('search')->{no_records_found}, 'OK: failed to find deleted record', ); # print_and_exit(); # check table status & remove FK's: # data should be deleted from these (coz ON DELETE CASCADE set): foreach my $t(sort @cascade_tables) { my $tbl = 'request_' . $t; my $fk = $tbl . '_ibfk_1'; isnt( $dbix->query(qq!select 1 from `$tbl` where `request_id` = ?!, 3)->list, 1, "OK: expected request data deleted from $tbl" ); $dbh->do( qq!ALTER TABLE `$tbl` DROP FOREIGN KEY `$fk`! ); } # data should still be in these: foreach my $t(sort @non_cascade_tables) { my $tbl = 'request_' . $t; is( $dbix->query(qq!select 1 from `$tbl` where `request_id` = ?!, 3)->list, 1, "OK: $tbl still contains expected request data" ); } } # print_and_exit(); # re-register deleted record: $mech->get_ok('/patient/select_patient/2'); # print_and_exit(); { $mech->has_tag( td => 'BROWN', 'OK: expected record found', ); $mech->follow_link_ok( # {n => 8}, "Logout $_ via eighth link on page", { url_regex => qr(request/add_new/2), }, 'follow delete link', ); # print_and_exit(); $mech->has_tag( td => 'BROWN', 'OK: expected record found', ); $mech->submit_form( fields => { request_number => 3, specimen => 'BMAT', referrer_code => 'G1234567', _referrer => 'Black, DE', # ajax function in form }, # print_and_exit(); ); $mech->get_ok('/search/do_search?lab_number=3'); # print_and_exit(); $mech->has_tag_like( td => qr(BROWN, Stan), 'OK: expected record found', ); # test for absence of original name: test_out( 'not ok 1 - foo' ); test_fail( +1 ); $mech->has_tag_like( td => qr(GREEN, Alan), 'foo' ); test_test( 'OK: expected record found' ); # test for new specimen type: $mech->has_tag( td => 'BMAT', 'OK: expected specimen type found', ); # check 'AUTO' test been automatically requested by specimen code (BMAT): $mech->content_like( qr(AUTO:\s+\[pending\]), 'OK: expected lab test automatically requested', ); # test for absence of original specimen type: test_out( 'not ok 1 - foo' ); test_fail( +1 ); $mech->has_tag_like( td => qr(PB), 'foo' ); # has_tag_like in case PB not deleted test_test( 'OK: expected record found' ); =begin # not reusing original request_id now # prove new request.id is same as old request.id: my $dbix = get_dbix(); my $new_request_id = $dbix->query('select id from requests where request_number = ?',3)->list; is( $new_request_id, 3, 'OK: got expected new request_id' ); # get history: $mech->get_ok('/history/=/3'); # print_and_exit(); $mech->has_tag_like( td => qr{deleted record H3/\d{2} \(id: 3\) \[reason: inappropriate request\]}, 'OK: expected history output found', ); =cut } do_logout();