#!/usr/bin/perl use Test::WWW::Mechanize::CGIApp; use Test::Builder::Tester; use strict; use warnings; use DateTime; use POSIX; use Test::More tests => 52; # use Test::More 'no_plan'; =begin # tests: =cut BEGIN { require 't/test-lib.pl'; } my $mech = get_mech(); my $dbh; eval { $dbh = get_dbh() or die 'no database handle received from get_dbh'; }; warn $@ if $@; foreach( qw// ) { drop_and_recreate($_); } my $DATE = DateTime->now; my $dbix = get_dbix(); # switch on section sign-out for all lab sections: $dbix->update('lab_sections', { has_test_sign_out => 'yes'} ); # remove BMAT from request #1 to allow auto-auth: $dbix->delete('request_specimen', { request_id => 1, specimen_id => 4 }); # add PB to request #2 to allow flow lab tests: $dbix->insert('request_specimen', { request_id => 2, specimen_id => 1 }); # add request_external_ref to sample 2: $dbix->insert('request_external_ref', { request_id => 2, external_reference => 'block reference here' }); # HIV screen to suppress comment on report: $dbix->insert('screens', { description => 'HIV', category_id => 1 }); # delete NHS number to force warning: $dbix->update('patients', { nhs_number => undef }, { id => 2 }); # create guest user: create_guest_user({ lname => 'guest', fname => 'a' }); do_login(); # screen request #1 as PNH - can auto-authorise, providing self_authorisable.t exists: ok( get_yaml('self_authorisable') , "require a self_authorisable.yml file" ); # check for required yaml file $mech->get_ok('/screen/do_initial_screen/1?screen_id=3;option_id=1'); # print_and_exit(); # result request #1: $mech->get_ok('/result/=/1'); # print_and_exit(); { $mech->form_name('flow_results'); $mech->field( results_summary => 'flow results summary goes here' ); $mech->tick('complete_all_tests', 1, 1); $mech->submit; $mech->has_tag( p => 'INFO: results data update successful', 'OK: results update success message', )or diag('check the views are loaded in the lims_test database'); } # print_and_exit(); # report request #1: $mech->get_ok('/report/=/1'); # print_and_exit(); { my %report = ( status => 'default', authorise => 1, diagnosis_id => 1, specimen_quality => 'adequate', comment => 'comment goes here', morphology => 'morphology description goes here', clinical_details => 'random guff goes here', gross_description => 'gross description goes here', secondary_diagnosis_id => 2, ); $mech->form_name('reportForm'); $mech->submit_form(fields => \%report); $mech->submit_form(form_name => 'reportForm'); # print_and_exit(); $mech->content_contains( get_messages('action')->{edit_success}, 'OK: new report succeeded', ); # print_and_exit(); } # screen request #2 as AML: $mech->get_ok('/screen/do_initial_screen/2?screen_id=1;option_id=1'); # print_and_exit(); # result request #1: $mech->get_ok('/result/=/2'); # print_and_exit(); for ( qw/flow molecular/ ) { $mech->form_name($_.'_results'); $mech->field( results_summary => $_.' results summary goes here' ); $mech->tick('complete_all_tests', 1, 1); $mech->submit; $mech->has_tag( p => 'INFO: results data update successful', "OK: $_ results update success message", ); } # print_and_exit(); # report request #2: $mech->get_ok('/report/=/2'); # print_and_exit(); { my %report = ( status => 'new', diagnosis_id => 2, comment => 'comment goes here', biopsy_site => 'lymph node', specimen_quality => 'adequate', clinical_details => 'clinical details', gross_description => 'gross description goes here', ); $mech->form_name('reportForm'); $mech->submit_form(fields => \%report); $mech->submit_form(form_name => 'reportForm'); # print_and_exit(); $mech->content_contains( get_messages('action')->{edit_success}, 'OK: new report succeeded', ); } # change user id (to guest, but ok for this purpose) so it can be authorised: $dbix->update('request_history', { user_id => 2 }, { request_id => 2, action => 'reported' }); # authorise - by-pass pre-auth check: $mech->get_ok('/report/=/2?pre-authorisation-check=1'); # print_and_exit(); { $mech->form_name('reportForm'); $mech->submit_form(fields => { authorise => 1 }); $mech->submit_form(form_name => 'reportForm'); # print_and_exit(); $mech->content_contains( get_messages('action')->{edit_success}, 'OK: report authorisation succeeded', ); } do_logout(); # login as guest user: $mech->submit_form( fields => { authen_username => 'a.guest', authen_password => 'guessed' }, ); # print_and_exit(); # search for reported record #1: $mech->get_ok('/search/=/1'); # print_and_exit(); { # warn $mech->text; exit; my $date_format = $DATE->strftime('%a %d.%b.%Y'); $mech->text_contains( 'reported on a peripheral blood specimen', 'OK: expected specimen details found', ) or diag('This can fail if report_template=hmds not in settings'); # print_and_exit(); { my $date_format # clone this or it changes original = $DATE->clone->subtract(days => 1)->strftime('%a %d.%b.%Y'); $mech->text_contains( 'taken ' . $date_format, 'OK: expected specimen taken details found', ); # print_and_exit(); } { my $date_format = $DATE->strftime('%a %d.%b.%Y'); $mech->text_contains( 'received ' . $date_format, 'OK: expected registration details found', ); # print_and_exit(); } $mech->text_contains( '1. RAEB [9983/3]', 'OK: primary diagnosis found', ); $mech->text_contains( '2. CLL [9823/3]', 'OK: secondary diagnosis found', ); $mech->content_lacks( 'comment goes here', 'OK: comment suppressed by screening term', ); $mech->has_tag( div => 'morphology description goes here', 'OK: morphology description found', ); $mech->has_tag( div => 'flow results summary goes here', 'OK: flow summary found', ); # don't want to follow this as it will hit HMRN web-site, just see if it exists: { # warn $_->url for $mech->followable_links(); my $i = grep { $_->url =~ '/hmrn/info' } $mech->followable_links(); # warn $i; is ($i, 2, 'OK: 2 HMRN links found') or diag('This can fail if have_hmrn_info_link=1 not in settings'); # both diagnoses are ICDO3 } } # print_and_exit(); # search for reported record #2: $mech->get_ok('/search/=/2'); # print_and_exit(); { # warn $mech->text; exit; $mech->text_contains( 'reported on a lymph node specimen', 'OK: expected biopsy details found', ); # print_and_exit(); $mech->text_contains( 'block reference here', 'OK: expected block reference details found', ); # print_and_exit(); $mech->text_contains( 'of adequate quality', 'OK: expected specimen quality details found', ); # print_and_exit(); { my $date_format # clone this or it changes original = $DATE->clone->subtract(days => 1)->strftime('%a %d.%b.%Y'); $mech->text_contains( 'taken ' . $date_format, 'OK: expected specimen taken details found', ); # print_and_exit(); } { my $date_format = $DATE->strftime('%a %d.%b.%Y'); $mech->text_contains( 'received ' . $date_format, 'OK: expected registration details found', ); # print_and_exit(); } $mech->has_tag( span => 'CLL', 'OK: primary diagnosis found', ); $mech->has_tag( p => 'comment goes here', 'OK: comment found', ); $mech->content_lacks( # didn't supply it 'morphology description', 'OK: no morphology description', ); $mech->content_contains( 'this is a NEW diagnosis', 'OK: new diagnosis text found', ); $mech->has_tag( div => 'molecular results summary goes here', 'OK: molecular summary found', ); $mech->has_tag( div => 'flow results summary goes here', 'OK: flow summary found', ); $mech->has_tag( span => 'PLEASE USE THE NHS NUMBER', 'OK: please use NHS number warning found', ); } # print_and_exit(); { # check links (skip HMRN) - logout link causes logout so so last: my @links = $mech->find_all_links( url_regex => qr{localhost}); # not a name or css # warn Dumper $_->url for @links; # warn Dumper grep $_->url !~ 'hmrn', @links; # print_record link will throw wkhtmltodpf QPixmap error if no x-server running: $mech->links_ok( [ grep $_->url !~ 'hmrn|print', @links ], 'OK: nav links checked' ); } #=begin # uncomment to generate long phrases for result summary & comment: do_login(); # login as lab user: { # cosmetic views - word-wrapping on long passages: $mech->get_ok('/result/=/2'); # print_and_exit(); # flow result: my $str = q!Lymphoid cells identified with strong CD45 expression and low ! . q!side scatter properties were gated and account for approx. 22% of marrow ! . q!events. The lymphoid comprise 34% T cells (CD2+,CD3+), 5% NK cells ! . q!(CD2+,CD3-,CD56+) and 58% B cells (CD19+,CD20+,CD22+,CD79B+). The B cells ! . q!express CD38 and are Kappa light chain restricted. CD5, CD10, and CD23 ! . qq!antigens are negative.\n\nIn addition, approx. 1-2% of marrow events are ! . q!plasma cells (strong CD38, weak CD45) which lack CD19.!; $mech->form_name('flow_results'); $mech->submit_form(fields => { results_summary => $str }); # print_and_exit(); $mech->has_tag( p => 'INFO: results data update successful', "OK: results update success message", ); # print_and_exit(); } { $mech->get_ok('/report/=/2'); # print_and_exit(); # morphology: my $str = q!Excellent bone marrow aspirate which is mildly hypercellular and ! . qq!shows trilineage haematopoiesis with 22% atypical lymphocytes.\n! . q!Findings suggest bone marrow infiltration with a low grade NHL best in ! . q!keeping with lymphoplasmacytic. Note cohesive islands of cells with ! . q!blastic appearence and blue nucleoli very suggestive of metastatic ! . qq!carcinoma (note history of metastaic prostate carcinoma).!; $mech->form_name('reportForm'); $mech->submit_form(fields => { morphology => $str }); $mech->submit_form(form_name => 'reportForm'); # print_and_exit(); $mech->content_contains( get_messages('action')->{edit_success}, 'OK: report authorisation succeeded', ); } =begin # login as guest user: do_logout(); $mech->submit_form( fields => { authen_username => 'a.guest', authen_password => 'guessed' }, ); # print_and_exit(); { $mech->get_ok('/search/=/2'); print_and_exit(); } =cut