package Role::Patient;
use Moose::Role;
use Data::Dumper;
# get patient id :
sub get_patient_id {
my $self = shift;
my $vals = shift;
my $dbh = $self->db->{dbix4};
my $log_file = $self->log_file;
my @h4 = qw(last_name first_name middle_name dob);
my @h3 = qw(lname fname mname dob);
# if $vals has an nhs_number:
if ( my $nhs_number = $vals->{nhsno} ) {
# if nhs_number in list of resolved duplicates:
if ( my $new_data = $self->resolved_nhsno_duplicates_map->{$nhs_number} ) {
no warnings 'uninitialized'; # for all print statements:
# return patient_id if already been here:
if (my $patient_id = $self->nhs_number_map->{$nhs_number}) {
my $sql = q!select last_name, first_name, middle_name, dob, gender,
nhs_number from patients where id = ?!;
my $p = $dbh->query($sql, $patient_id)->hash;
if ( (join '', map uc($_), @{$new_data}{@h3}) ne (join '', map uc($_), @{$p}{@h4}) ) {
print $log_file 'have existing resolved nhsno mismatch for ' . $nhs_number . "\n";
print $log_file join ',', map $p->{$_}, @h4; print $log_file "\n";
print $log_file join ',', map $new_data->{$_}, @h3; print $log_file "\n";
}
return $patient_id;
}
elsif ( (join '', map uc($_), @{$new_data}{@h3}) ne (join '', map uc($_), @{$vals}{@h3}) ) {
print $log_file 'have new resolved nhsno mismatch for ' . $nhs_number . "\n";
print $log_file join ',', map $vals->{$_}, @h3; print $log_file "\n";
print $log_file join ',', map $new_data->{$_}, @h3; print $log_file "\n";
}
# set new params:
$vals->{nhsno} = $nhs_number; # not stored as key in map_hashes
while ( my ($param, $val) = each %$new_data ) {
$vals->{$param} = $val;
} # warn Dumper $vals;
}
# first try to update any records with last_name, dob & unit_no match, but
# WITHOUT nhsno (affects <100 of 45K recs):
if ( $vals->{patno} && $vals->{dob} ) {
my $sql = q!select p.id from patients p join patient_case pc on p.id =
pc.patient_id where unit_number = ? and last_name = ? and dob = ?
and nhs_number is null!;
my $patient_id
= $dbh->query( $sql, map $vals->{$_}, qw(patno lname dob) )->list;
# update record (must be only 1) with nhs_number:
if ($patient_id) {
# check nhsno not already used - in which case need to flag for merge:
if ($self->nhs_number_map->{$nhs_number}) {
print $log_file "merge required on $vals->{lname} $vals->{fname}\n";
}
else {
$dbh->update('patients', {nhs_number => $nhs_number}, {id => $patient_id});
print $log_file "updating $patient_id with $nhs_number for $vals->{dbid}\n";
# cache & return it:
$self->nhs_number_map->{$nhs_number} = $patient_id;
}
return $patient_id;
}
}
# update middle name if exists:
if ( my $mname = $vals->{mname} ) { # already checked mname > 1 char
my $sql = q!select p.id from patients p where nhs_number = ? and last_name = ?
and first_name = ? and middle_name is null!;
my $patient_id
= $dbh->query( $sql, map $vals->{$_}, qw(nhsno lname fname) )->list;
if ($patient_id) {
print $log_file "updating $patient_id with $mname for $vals->{dbid}\n";
$dbh->update('patients', {middle_name => $mname}, {id => $patient_id});
}
}
# if not already seen this nhs_no, create new:
if (! $self->nhs_number_map->{$nhs_number}) {
my $patient_id = $self->_create_new_record($vals);
# now cache it:
$self->nhs_number_map->{$nhs_number} = $patient_id;
}
# return patient_id:
return $self->nhs_number_map->{$nhs_number};
}
# else need to find best match or create new record:
else {
my $patient_id = $self->find_or_create_new_patient($vals);
return $patient_id;
}
}
# don't have an nhs_no, so find best match or create new patient & return LAST_INSERT_ID:
sub find_or_create_new_patient {
my $self = shift;
my $vals = shift;
my $dbh = $self->db->{dbix4};
my $log_file = $self->log_file;
my $patient_id = 0;
# ok, no nhs_number, see if we can find exact match on ALL pid params:
if ($vals->{dob} && $vals->{patno}) { # already know we have fname & lname
{ # 1st see if we have a last_name, first_name & unit_no match with null dob:
my $sql = q!select p.id from patients p join patient_case pc on p.id = pc.patient_id
where unit_number = ? and last_name = ? and first_name = ? and dob is null!;
$patient_id = $dbh->query( $sql, map $vals->{$_}, qw(patno lname fname) )->list;
if ($patient_id) { # update dob:
print $log_file "got $patient_id from matching details with null dob for $vals->{dbid}\n";
$dbh->update('patients', { dob => $vals->{dob} }, {id => $patient_id});
return $patient_id;
}
}
my $middle_name =
$vals->{mname} ?
sprintf q!= %s!, $self->_quote_term($vals->{mname})
: 'IS NULL';
my $sql = sprintf q!
SELECT p.id
FROM patients p
join patient_case pc on p.id = pc.patient_id
WHERE
last_name = ? and
first_name = ? and
middle_name %s and
dob = ? and
unit_number = ? and
nhs_number is null!, $middle_name; # warn $pid_sql;
$patient_id
= $dbh->query( $sql, map $vals->{$_}, qw(lname fname dob patno) )->list;
if ($patient_id) {
# print $log_file "got $patient_id from full matching details for $vals->{dbid}\n";
return $patient_id;
}
# next, try to get patient_id from existing combination of last_name,
# dob & unit_no only (ie skip first_name):
{
my $sql = q!
select p.id from patients p join patient_case pc on p.id = pc.patient_id
where unit_number = ? and last_name = ? and dob = ?!;
$patient_id
= $dbh->query( $sql, map $vals->{$_}, qw(patno lname dob) )->list;
if ($patient_id) {
print $log_file "got $patient_id from partial matching details for $vals->{dbid}\n";
return $patient_id;
}
}
}
# some known exceptions before we give up trying to find a match:
if ($vals->{lname} eq 'CYCLACEL') { # cyclacels
$patient_id = $dbh->query( q!select p.id from patients p where last_name =
'cyclacel' and first_name = ? and dob = ?!, $vals->{fname}, $vals->{dob})
->list;
return $patient_id if $patient_id;
}
elsif (grep $vals->{fname} eq $_, qw/LGI PIN/) { # HIV's
$patient_id = $dbh->query( q!select p.id from patients p where last_name = ?
and first_name = ?!, $vals->{lname}, $vals->{fname})->list;
return $patient_id if $patient_id;
}
# exhausted all attempts to match patient, so create new record & retrieve id:
$patient_id = $self->_create_new_record($vals);
# print $log_file "creating new record for $vals->{dbid}\n";
return $patient_id;
}
sub find_or_create_new_patient_case {
my $self = shift;
my $data = shift;
my $dbh = $self->db->{dbix4};
my $case_id;
{
# update any unknown hospital if patient_id & unit_number match:
my $sql = q!SELECT pc.`id` FROM `patient_case` pc join referral_sources rs on
pc.referral_source_id = rs.id WHERE pc.`patient_id` = ? AND
pc.`unit_number` = ? AND rs.`organisation_code` = 'X99999'!; # unknown source
$case_id = $dbh->query( $sql, $data->{patient_id}, $data->{unit_number} )->list;
if ($case_id) {
$dbh->update( 'patient_case', { referral_source_id => $data->{referral_source_id} },
{id => $case_id} );
# print $log_file "updating $case_id with ".$data->{referral_source_id}."\n";
}
return $case_id if $case_id;
}
{
# update any unknown unit_numbers if patient_id & location_id match:
my $sql = q!SELECT `id` FROM `patient_case` WHERE `patient_id` = ? AND
`referral_source_id` = ? AND `unit_number` = 'UNKNOWN'!; # unknown source
$case_id = $dbh->query($sql, $data->{patient_id}, $data->{referral_source_id})->list;
if ($case_id) {
$dbh->update( 'patient_case', { unit_number => $data->{unit_number} },
{id => $case_id} );
# print $log_file "updating $case_id with ".$data->{unit_number}."\n";
}
return $case_id if $case_id;
}
# failed to find matching case_id so create one:
$dbh->insert('patient_case', $data);
$case_id = $dbh->last_insert_id(undef, undef, 'patient_case', 'id');
return $case_id;
}
sub get_case_id {
my $self = shift;
my $data = shift;
my $sql = q!SELECT `id` FROM `patient_case` WHERE `patient_id` = ? AND
`referral_source_id` = ? AND `unit_number` = ?!;
my $case_id = $self->db->{dbix4}->query(
$sql, @{$data}{ qw(patient_id referral_source_id unit_number) }
)->list;
return $case_id;
}
sub _create_new_record {
my $self = shift;
my $vals = shift;
my $dbh = $self->db->{dbix4};
# data for creating new patient (required):
my %data = (
last_name => lc $vals->{lname},
first_name => lc $vals->{fname},
created_at => $vals->{pid_time},
updated_at => $vals->{pid_time}, # or defaults to now()
);
# add data if exists:
$data{middle_name} = lc $vals->{mname} if $vals->{mname};
$data{dob} = $vals->{dob} if $vals->{dob};
$data{gender} = $vals->{sex} if $vals->{sex};
$data{nhs_number} = $vals->{nhsno} if $vals->{nhsno};
$dbh->insert('patients', \%data); # warn Dumper \%data;
my $patient_id = $dbh->last_insert_id(undef, undef, 'patients', 'id');
return $patient_id;
}
sub _quote_term {
my $self = shift;
my $term = shift;
return $self->db->{dbh3}->quote($term);
}
1;
