#!/usr/bin/perl
use Test::WWW::Mechanize::CGIApp;
use Test::Builder::Tester;
use Data::Dumper;
use strict;
use warnings;
use Test::More tests => 38;
# use Test::More 'no_plan';
=begin: tests:
=cut
BEGIN {
require 't/test-lib.pl';
}
my $mech = get_mech();
do_login();
my $dbh;
eval {
$dbh = get_dbh() or die 'no database handle recieved from get_dbh';
};
warn $@ if $@;
my $dbix = get_dbix();
$dbix->insert('error_codes', { code => 'd', description => 'record merged',
is_unique => 'no', active => 'yes' });
{ # add new patient/request - name similar to existing, different dob:
$dbix->insert('patients', { last_name => 'green', first_name => 'alan',
middle_name => 'michael', dob => '1940-02-02', created_at => \'NOW()' });
my $patient_id = get_last_insert_id('patients');
$dbix->insert('patient_notes', { patient_id => $patient_id,
detail => "pid \#${patient_id} notes" });
$dbix->insert('patient_demographics', { patient_id => $patient_id,
address => '1 The Drive', post_code => 'AB1 2CD', gp_id => 2,
practice_id => 2, status => 'alive' });
$dbix->insert('patient_case', { patient_id => $patient_id, referral_source_id => 2,
unit_number => 1011 });
my $patient_case_id = get_last_insert_id('patient_case');
$dbix->insert('requests', { request_number => 3, year => DateTime->now->year,
patient_case_id => $patient_case_id, referrer_department_id => 1,
created_at => \'NOW()' });
}
{ # insert new patient with no request (orphaned patient record):
$dbix->insert('patients', { last_name => 'green', first_name => 'alan',
middle_name => 'michael', dob => '1940-02-03', created_at => \'NOW()' });
my $patient_id = get_last_insert_id('patients');
$dbix->insert('patient_case', { patient_id => $patient_id,
referral_source_id => 2, unit_number => 1011 });
}
{ # check record #3 has patient notes, record #1 doesn't:
$mech->get_ok('/result/=/1'); # print_and_exit();
test_out( 'not ok 1 - foo' );
test_fail( +1 );
$mech->has_tag( td => 'pid #3 notes', 'foo' );
test_test( 'OK: patient notes text not found' ); # print_and_exit();
$mech->get_ok('/result/=/3'); # print_and_exit();
$mech->text_contains(
'pid #3 notes',
'OK: patient notes text found',
); # print_and_exit();
}
{ # check how many patients called green (should be 3):
$dbix->select('patients', 'count(id)', { last_name => 'green' })->into(my $i);
is($i, 3, 'OK: expected patient count');
}
$mech->get_ok('/admin/patient_merge/search?last_name=green'); # print_and_exit();
{
$mech->form_name('do_merge');
# merge patient #3 attached to H3 with patient #1 attached to H1, #3 deleted:
$mech->submit_form( fields => { 3 => 'from', 1 => 'to' } );# print_and_exit();
$mech->submit_form(); # print_and_exit();
my $msg = get_messages('patient')->{merge}->{merge_success};
$mech->has_tag_like(
p => qr($msg),
'OK: patient merge successful',
); # print_and_exit();
$mech->has_tag(
td => '01.Feb.1940',
'OK: expected dob found',
);
test_out( 'not ok 1 - foo' );
test_fail( +1 );
$mech->has_tag( td => '02.Feb.1940', 'foo' );
test_test( 'OK: deleted dob not found' ); # print_and_exit();
}
{ # check records #1 & #3 have patient notes:
for (1,3) {
$mech->get_ok('/result/=/'.$_); # print_and_exit();
$mech->text_contains(
'pid #3 notes',
'OK: patient notes text found',
);
} # print_and_exit();
}
{ # can't load page with demographics so check direct:
my $q = 'select count(*) from patient_demographics where patient_id = ?';
is( $dbix->query($q, 1)->list && ! $dbix->query($q, 3)->list, # id = 1 ok, 3 gone
1, 'OK: patient_demographics patient_id transferred');
}
# THIS SHOULD NOT SHOW EDIT HISTORY (WAS DONE ON RECORD #3):
$mech->get_ok('/history/=/1'); # print_and_exit();
{ # warn $mech->text();
my $i = () = $mech->text =~ /record merged/g; # gets instance count
is($i, 4, 'OK: expected record merge history');
} # print_and_exit();
{ # check patient edit direct in patients tables:
$dbix->select('patients', 'count(id)', { last_name => 'green' })->into(my $i);
is($i, 2, 'OK: expected patient count');
# check patient.id #3 deleted:
$dbix->select('patients', 'count(id)', { id => 3 })->into(my $n);
is($n, 0, 'OK: expected patient deleted');
}
$mech->get_ok('/admin/patient_merge/search?last_name=green'); # print_and_exit();
{
$mech->form_name('do_merge');
# merge orphaned patient #4 with patient #1 attached to H1 & H3, #4 deleted:
$mech->submit_form( fields => { 4 => 'from', 1 => 'to' } );# print_and_exit();
$mech->submit_form(); # print_and_exit();
}
{ # check patient edit direct in patients tables:
$dbix->select('patients', 'count(id)', { last_name => 'green' })->into(my $i);
is($i, 1, 'OK: expected patient count');
# check patient.id #4 deleted:
$dbix->select('patients', 'count(id)', { id => 4 })->into(my $n);
is($n, 0, 'OK: expected patient deleted');
# have checked only 1 'gree', retrieve as hash:
my $data = $dbix->select('patients', '*', { last_name => 'green' })->hash;
my %patient = (
first_name => 'alan',
dob => '1940-02-01',
nhs_number => 1111111111,
gender => 'M',
id => 1,
);
for (keys %patient) { # check remaining patient details:
is( $data->{$_}, $patient{$_}, "OK: patient $_ matches" );
}
}
# check orphaned patient did not get recorded in history:
$mech->get_ok('/history/=/1'); # print_and_exit();
{ # warn $mech->text();
my $i = () = $mech->text =~ /record merged/g; # gets instance count
is($i, 4, 'OK: expected record merge history');
} # print_and_exit();
# merge 2 patients, both with patient notes:
{
# add patient notes to 2nd patient:
$dbix->insert('patient_notes', { patient_id => 2, detail => 'pid #2 notes' });
# add new patient/request - name similar to existing:
$dbix->insert('patients', { last_name => 'brown', first_name => 'stan',
dob => '1960-10-01' }); # wrong dob
my $patient_id = get_last_insert_id('patients');
$dbix->insert('patient_notes', { patient_id => $patient_id,
detail => "pid \#${patient_id} notes" });
$dbix->insert('patient_case', { referral_source_id => 2, unit_number => 1011,
patient_id => $patient_id, });
my $patient_case_id = get_last_insert_id('patient_case');
$dbix->insert('requests', { request_number => 4, year => DateTime->now->year,
patient_case_id => $patient_case_id, referrer_department_id => 1,
created_at => \'NOW()' });
}
$mech->get_ok('/admin/patient_merge/search?last_name=brown'); # print_and_exit();
{
$mech->has_tag(
td => '01.Oct.1960',
'OK: expected dob found',
);
$mech->form_name('do_merge');
# merge patient #5 attached to H4 with patient #1 attached to H1, #4 deleted:
$mech->submit_form( fields => { 5 => 'from', 2 => 'to' } );# print_and_exit();
$mech->submit_form(); # print_and_exit();
my $msg = get_messages('patient')->{merge}->{merge_success};
$mech->has_tag_like(
p => qr($msg),
'OK: patient merge successful',
); # print_and_exit();
test_out( 'not ok 1 - foo' );
test_fail( +1 );
$mech->has_tag( td => '01.Oct.1960', 'foo' );
test_test( 'OK: deleted dob not found' ); # print_and_exit();
}
$mech->get_ok('/result/=/4'); # print_and_exit();
$mech->text_contains(
'pid #5 notes; pid #2 notes',
'OK: merged patient notes text found',
);
