#!/usr/bin/perl use Test::WWW::Mechanize::CGIApp; use strict; use warnings; use DateTime; use POSIX; use Test::More tests => 68; # use Test::More 'no_plan'; =begin # tests: 1) register test patient through Register page 2) add new patient directly (invalid nhs_number) 3) change nhs_number to valid/unique & submit 4) add another new patient directly (duplicate nhs_number) 5) change nhs_number to valid/unique & submit 6) edit test patient - change dob to invalid date 7) change dob to valid & submit with both confirmation fields missing 8) change dob to valid & submit with one confirmation field missing 9) change dob to valid & submit with both confirmation fields supplied 10) edit test patient - supply invalid nhs_number 11) change nhs_number to valid but duplicate 12) change nhs_number to valid & unique 13) edit test patient - first name 14) edit test patient - delete nhs_number 15) add new request for patient with nhs number and try to change single record =cut BEGIN { require 't/test-lib.pl'; use DateTime; DateTime->DefaultLocale('en_GB'); } my $mech = get_mech(); my $dbh; eval { $dbh = get_dbh() or die 'no database handle recieved from get_dbh'; }; warn $@ if $@; drop_and_recreate('patients'); do_login(); $mech->get_ok('/register'); # print_and_exit(); my %test_patient = ( last_name => 'white', first_name => 'alan', day => 20, month => 10, year => 1944, unit_number => 'N123456', gender => 'M', referral_source_id => 1, ); # register test patient: { $mech->submit_form( fields => { name => $test_patient{last_name}, } ); # print_and_exit(); $mech->content_contains( "Found 0 records matching name=$test_patient{last_name}", 'OK: patient not found', ); $mech->submit_form( fields => \%test_patient, ); # print_and_exit(); my $dob = DateTime->new( year => $test_patient{year}, month => $test_patient{month}, day => $test_patient{day}, formatter => get_formatter() ); my $i=0; my $output = 'OK: patient demographics field [%s] detected'; foreach (uc $test_patient{last_name}, $dob, @test_patient{qw(unit_number gender)} ) { $mech->content_contains( "$_", sprintf $output, ++$i, ); } no warnings 'uninitialized'; # no middle_name, but need to check have empty span foreach ( @test_patient{ qw(first_name middle_name) } ) { # warn $_; $mech->content_like( qr($_)i, sprintf $output, ++$i, ); } } # add new patient directly (invalid nhs_number): $mech->get_ok('/patient'); # print_and_exit(); { my %patient = ( last_name => 'green', first_name => 'leslie', day => 12, month => 11, year => 1974, unit_number => 10101101, gender => 'U', referral_source_id => 1, nhs_number => 123456789, ); $mech->submit_form( fields => \%patient, ); # print_and_exit(); # check we have dfv error: has_dfv_errors(); has_invalid(); # make nhs_number valid: $patient{nhs_number} = 1111111111; $mech->submit_form( fields => \%patient, ); # print_and_exit(); $mech->content_contains( '

New request

', 'OK: new patient record accepted', ); # print_and_exit(); $mech->content_contains( "$patient{nhs_number}", 'OK: expected nhs_number detected', ); # print_and_exit(); } # add another new patient directly (duplicate nhs_number): $mech->get_ok('/patient'); # print $fh $mech->content; { my %patient = ( last_name => 'brown', first_name => 'may', day => 17, month => 1, year => 1934, unit_number => 11223344, nhs_number => 1111111111, # duplicate gender => 'F', referral_source_id => 1, ); $mech->submit_form( fields => \%patient, ); # print_and_exit(); # check we have dfv error: has_dfv_errors(); has_duplicate(); # make nhs_number valid & unique: $patient{nhs_number} = 2222222222; $mech->submit_form( fields => \%patient, ); # print_and_exit(); # check we don't have dfv error: lacks_dfv_errors(); # patient_case.id in edit url: $mech->content_contains( 'patient/register_edit_patient/3', "OK: patient.id correct in edit url", ); $mech->content_contains( '3', "OK: correct patient.id detected", ); } # now select test_patient: $mech->get_ok('/register'); # print_and_exit(); { $mech->submit_form( fields => { name => $test_patient{last_name}, } ); # print_and_exit(); $mech->content_contains( "Found 1 record matching name=$test_patient{last_name}", 'OK: found existing patient match', ); # test edit link: $mech->follow_link_ok( # {n => 8}, "Logout $_ via eighth link on page", { url_regex => qr/edit/i, }, 'edit record using link', ); # print_and_exit(); # confirm edit page loaded: $mech->content_contains( 'Patient » Edit Details', 'edit page loaded OK', ); # print_and_exit(); # confirm warning dispalyed: $mech->content_contains( 'WARNING: DO NOT USE FOR CHANGING PATIENT IDENTITY', 'warning message loaded OK', ); # print_and_exit(); } # change dob to invalid: { my $changed_month = 13; $mech->field('month', $changed_month); $mech->submit_form(); # print_and_exit(); # check we have dfv error: has_dfv_errors(); $mech->content_contains( dfv_format('invalid_date'), 'OK: invalid date detected', ); } # change dob to valid: { my $changed_month = 7; $mech->field('month', $changed_month); $mech->submit_form(); # print_and_exit(); # only 1 record so don't need to select scope: $mech->has_tag( span => 'INFO: change affects this record only', 'OK: change affects only 1 record', ); # reason for change missing: has_dfv_errors(); has_missing(); # submit missing error code value: $mech->field('error_code_id', 1); $mech->submit_form(); # print_and_exit(); # check we don't have dfv error: lacks_dfv_errors(); # new dob detected: my $formatted_dob = DateTime->new( year => $test_patient{year}, month => $changed_month, day => $test_patient{day}, formatter => get_formatter() ); # warn $formatted_dob; # just check last_name & dob (others have td modification) $mech->has_tag_like( span => $formatted_dob, "OK: patient demographics dob field detected", ); $mech->has_tag_like( td => uc $test_patient{last_name}, "OK: patient demographics last name field detected", ); # print_and_exit(); } # give test_patient an nhs_number - invalid at 1st: { $mech->follow_link_ok( { url_regex => qr/edit/i, }, 'edit record using link', ); # print_and_exit(); $mech->field('nhs_number', 123456789); $mech->submit_form(); # print_and_exit(); # check we have dfv error: has_dfv_errors(); has_invalid(); } # correct nhs_number to valid, but duplicate: { $mech->field('nhs_number', 1111111111); $mech->field('error_code_id', 1); $mech->submit_form(); # print_and_exit(); # check we still have dfv error: has_dfv_errors(); has_duplicate(); } # correct nhs_number to valid & unique: { my $nhs_number = 3333333333; my $formatted_nhs_number = '333 333 3333'; $mech->field('nhs_number', $nhs_number); $mech->field('error_code_id', 1); $mech->submit_form(); # print_and_exit(); my $i=0; # just check last_name & nhs_number (others have td modification) foreach ( uc $test_patient{last_name}, $formatted_nhs_number ) { $i++; $mech->has_tag( td => $_, "OK: patient demographics field [$i] detected", ); } } # edit first_name: { $mech->follow_link_ok( { url_regex => qr/edit/i, }, 'edit record using link', ); # print_and_exit(); my $first_name = 'arthur'; $mech->field('first_name', $first_name); $mech->field('error_code_id', 1); $mech->submit_form(); # print_and_exit(); # check we don't have dfv error: lacks_dfv_errors(); $mech->has_tag( span => ucfirst $first_name, 'OK: amended field detected', ); } # try to edit nhs_number to invalid: { $mech->follow_link_ok( { url_regex => qr/edit/i, }, 'edit record using link', ); # print_and_exit(); my $invalid_nhs_number = 123456789; $mech->field('nhs_number', $invalid_nhs_number); $mech->field('error_code_id', 1); $mech->submit_form(); # print_and_exit(); # check we have dfv error: has_dfv_errors(); has_invalid(); } # try to edit nhs_number to one already used: { my $used_nhs_number = 2222222222; $mech->field('nhs_number', $used_nhs_number); $mech->field('error_code_id', 1); $mech->submit_form(); # print_and_exit(); # check we have dfv error: has_dfv_errors(); has_duplicate(); } # delete nhs_number: { my $nhs_number = ''; $mech->field('nhs_number', $nhs_number); $mech->field('error_code_id', 1); $mech->submit_form(); # print_and_exit(); # check we don't have dfv error: lacks_dfv_errors(); # should have null value for nhs_number field (but can't test directly): $mech->content_contains( qq![NULL]!, 'OK: null value detected', ); # print_and_exit(); } # add new request to patient with NHS no: $mech->get_ok('/request/add_new/2'); # print_and_exit(); { $mech->has_tag( td => 1111111111, '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->has_tag( h3 => 'New request successful', 'OK: new record created', ); } # check name: $mech->get_ok('/search/=/3'); # print_and_exit(); { $mech->has_tag_like( td => 'GREEN, Leslie', 'OK: expected name found', ); $mech->content_lacks( 'GREEN, Leslie Anne', "OK: patient doesn't have middle name", ); } # select for edit: $mech->get_ok('/patient/edit_patient/2/3'); # print_and_exit(); { # add midle name and select 'this_record_only': $mech->field( middle_name => 'anne' ); $mech->field( this_record_only => 1 ); $mech->field( error_code_id => 1 ); $mech->submit; # print_and_exit(); my $msg = get_messages('request_edit')->{nhs_conflict}; $mech->has_tag_like( p => $msg, 'OK: cannot change record', ); } # remove nhs number & resubmit: $mech->get_ok('/patient/edit_patient/2/3'); # print_and_exit(); { $mech->field( nhs_number => undef ); $mech->field( middle_name => 'anne' ); $mech->field( this_record_only => 1 ); $mech->field( error_code_id => 1 ); $mech->submit; # print_and_exit(); # check we don't have dfv error: lacks_dfv_errors(); } # retrieve request #3 & check details: $mech->get_ok('/search/=/3'); # print_and_exit(); { $mech->has_tag_like( td => 'GREEN, Leslie Anne', 'OK: expected name found', ); $mech->content_lacks( 1111111111, 'OK: original NHS number gone', ); } do_logout();