#!/usr/bin/perl
use Test::WWW::Mechanize::CGIApp;
use Test::Builder::Tester;
use strict;
use warnings;
use DateTime;
use POSIX;
use Test::More tests => 34;
# 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 $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 });
# delete NHS number to force warning:
$dbix->update('patients', { nhs_number => undef }, { id => 1 });
# create guest user:
create_guest_user({ lname => 'guest', fname => 'a' });
do_login();
# screen request #1 as PNH - can auto-authorise:
$mech->get_ok('/screen/do_initial_screen/1?screen_id=2;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',
);
} # 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',
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();
}
# 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 #1:
$mech->get_ok('/report/=/2'); # print_and_exit();
{
my %report = (
status => 'new',
diagnosis_id => 2,
comment => 'comment goes here',
biopsy_site => 'biopsy details here',
specimen_quality => 'adequate',
gross_description => 'gross description goes here',
);
$mech->form_name('reportForm');
$mech->submit_form(fields => \%report);
$mech->submit_form(form_name => 'reportForm'); # print_and_exit();
}
# 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();
}
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();
{
my $date = DateTime->now->strftime('%a %d.%b.%Y'); # warn $mech->text;
$mech->text_like(
qr{reported on a peripheral blood specimen received on $date},
'OK: expected specimen details found',
); # print_and_exit();
$mech->has_tag(
span => 'RAEB',
'OK: primary diagnosis found',
);
$mech->has_tag(
div => '2. CLL',
'OK: secondary diagnosis found',
);
$mech->content_lacks(
'comment goes here',
'OK: comment suppressed by diagnosis',
);
$mech->has_tag(
pre => 'morphology description goes here',
'OK: morphology description found',
);
$mech->has_tag(
pre => '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();
is ($i, 1, 'OK: HMRN link found'); # warn $i;
}
$mech->has_tag(
span => 'PLEASE USE THE NHS NUMBER',
'OK: please use NHS number warning found',
);
} # print_and_exit();
# search for reported record #2:
$mech->get_ok('/search/=/2'); # print_and_exit();
{
my $date = DateTime->now->strftime('%a %d.%b.%Y'); # warn $mech->text;
$mech->text_like(
qr{reported on a biopsy details here specimen received on $date},
'OK: expected specimen 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 comment',
);
$mech->content_contains(
'this is a NEW diagnosis',
'OK: new diagnosis text found',
);
$mech->has_tag(
pre => 'molecular results summary goes here',
'OK: molecular summary found',
);
$mech->has_tag(
pre => 'flow results summary goes here',
'OK: flow summary found',
);
# check links (skip HMRN):
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;
$mech->links_ok( [ grep $_->url !~ 'hmrn', @links ], 'Check main links' );
} # print_and_exit();
