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