#!/usr/bin/perl
use Test::WWW::Mechanize::CGIApp;
use strict;
use warnings;
use Test::More;
use constant TESTS => 60;
=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 $@;
my $dbix = get_dbix();
{ # create new HMRN parent:
my %h = (
parent_code => 'RR8',
description => 'LTH',
referral_type_id => 3,
);
$dbix->insert('parent_organisations', \%h) or die $dbix->error;
}
{ # create new HMRN source of new parent:
$dbix->select('parent_organisations', 'id',
{ parent_code => 'RR8' })->into(my $id);
my %h = (
parent_organisation_id => $id,
organisation_code => 'RR813',
referral_type_id => 3,
display_name => 'SJUH',
);
$dbix->insert('referral_sources', \%h) or die $dbix->error;
}
{ # create hmrn permission:
my %h = (
function_name => 'edit_clinical_data',
function_detail =>'view & edit HMRN data',
);
$dbix->insert('user_functions', \%h);
}
{ # update user access permissions:
$dbix->select('user_functions', 'id',
{ function_name => 'edit_clinical_data' })->into(my $id);
$dbix->insert('user_group_function', { group_id => 1, function_id => $id });
}
do_hmrn_data();
do_login();
# register new patient_case + request:
$mech->get_ok('/patient/select_patient/2');
{
$mech->submit_form(
fields => {
unit_number => 2233,
referral_source_id => 5,
},
); # print_and_exit();
$mech->submit_form(
fields => {
request_number => 3,
referrer_code => 'C9999998',
specimen => 'PB',
},
); # print_and_exit();
$mech->has_tag(
h3 => 'New request successful',
);
}
# screen it:
$mech->get_ok('/screen/do_initial_screen/3?screen_id=1;option_id=1');# print_and_exit();
# report it:
$mech->get_ok('/report/=/3'); # print_and_exit();
{
# test missing:
my %report = (
status => 'default',
confirm_outstanding_tests => 1,
clinical_details => 'some details here',
gross_description => 'gross description here',
specimen_quality => 'adequate',
diagnosis_id => 1,
);
$mech->form_name('reportForm');
$mech->submit_form(fields => \%report); # print_and_exit();
$mech->submit_form(form_name =>'reportForm') if is_spell_check_required();
lacks_dfv_errors(); # print_and_exit();
}
# authorise it:
{
# manually change reporter's id:
$dbix->update( 'request_history',
{ user_id => 2 }, { action => 'reported', request_id => 3 },
);
$mech->get_ok('/report/=/3?pre-authorisation-check=1'); # print_and_exit();
$mech->form_name('reportForm');
$mech->field( confirm_outstanding_tests => 1 );
$mech->field( authorise => 1 );
$mech->submit_form(); # print_and_exit();
$mech->submit_form(form_name =>'reportForm') if is_spell_check_required();
lacks_dfv_errors(); # print_and_exit();
}
# add some HMRN data:
my %precursor = (
ecog => 1,
wbc => 6.0,
hb => 120,
plts => 300,
lymphs => 5.0,
haematocrit_vol => 65,
neutrophils => 2.0,
monocytes => 1.0,
);
my %myeloid = ( # excluding fields shared with precursor:
pcv => 60,
epo => 'low',
splenomegaly => 'Y',
hepatomegaly => 'N',
detection_spleen => 'both',
detection_liver => 'both',
);
{
# clear existing 1st:
$dbix->query(q!select patient_id from patient_case pc join requests r on
r.patient_case_id = pc.id where r.id = 3!)->into(my $patient_id);
$dbix->delete('hmrn_test.patient_params', { patient_id => $patient_id });
$mech->get_ok('/hmrn_data/=/3'); # print_and_exit();
$mech->form_name('precursor');
$mech->submit_form(fields => \%precursor); # print_and_exit();
$mech->form_name('myeloid');
$mech->submit_form(fields => \%myeloid); # print_and_exit();
}
{ # check all data present:
# precursor fields:
$mech->form_name('precursor');
my @precursor_params = get_params_for_category('precursor'); # p \@precursor_params;
for my $param(@precursor_params) { # p [ $param, $mech->value($param) ];
my $result = $mech->value($param) ? 1 : 0; # just need existance
is($result, 1, "OK: precursors.$param value loaded");
}
# myeloid fields:
$mech->form_name('myeloid');
for my $param(@precursor_params) { # p [ $param, $mech->value($param) ];
my $result = $mech->value($param) ? 1 : 0; # just need existance
is($result, 1, "OK: myeloid.$param value loaded");
}
my @myeloid_params = keys %myeloid; # p \@myeloid_params;
for my $param(@myeloid_params) { # p [ $param, $mech->value($param) ];
my $result = $mech->value($param) ? 1 : 0; # just need existance
is($result, 1, "OK: myeloid.$param value loaded");
}
}
# attempt to delete 1 dataset:
$mech->get_ok('/hmrn_data/delete_section_data/3/precursor'); # print_and_exit;
{ # warn $mech->text;
$mech->text_contains(
'deleting data items from the PRECURSOR section will also remove them from other sections',
'OK: warning 1 located',
);
$mech->text_contains(
'sections highlighted in red also contain additional (non-shared) data ',
'OK: warning 2 located',
);
}
# provide confirmation:
{
$mech->tick(confirm_delete => 1);
$mech->submit(); # print_and_exit();
my $msg = get_messages('action')->{delete_success};
$mech->has_tag_like(
p => qr(INFO: $msg),
'OK: delete action succeeded',
);
}
{ # check all precursor data gone and non-shared still exists:
# precursor fields:
$mech->form_name('precursor');
my @precursor_params = get_params_for_category('precursor'); # p \@precursor_params;
for my $param(@precursor_params) { # p [ $param, $mech->value($param) ];
my $result = $mech->value($param) ? 1 : 0; # just need existance
is($result, 0, "OK: precursors.$param value deleted");
}
# myeloid fields:
$mech->form_name('myeloid');
for my $param(@precursor_params) { # p [ $param, $mech->value($param) ];
my $result = $mech->value($param) ? 1 : 0; # just need existance
is($result, 0, "OK: myeloid.$param value deleted");
}
my @myeloid_params = keys %myeloid; # p \@myeloid_params; # didn't add all
for my $param(@myeloid_params) { # p [ $param, $mech->value($param) ];
my $result = $mech->value($param) ? 1 : 0; # just need existance
is($result, 1, "OK: myeloid.$param value retained");
}
}
done_testing(TESTS);
sub get_params_for_category {
my $category = shift;
my $sql = q!select param_name from hmrn_test.parameters p join
hmrn_test.category_parameter cp on cp.parameter_id = p.id join
hmrn_test.categories c on cp.category_id = c.id where c.category = ?!;
my @params = $dbix->query($sql, $category)->flat; # \p @params;
return wantarray ? @params : \@params;
}
