#!/usr/bin/env perl
=begin
monthly notification of CML patients on monitoring who have had in past 7 months:
* inadequate sample
* no repeat sample
see __DATA__ section for manual query
TODO: check patient_demographics.timestamp doesn't trigger new report dispatch:
does PDS query for live/dead status and updates patient_demographics table
=cut
my $JUST_TESTING = 0; # uses Local::DB for query display; email to ra.jones only
#===============================================================================
my @recipients = qw( paul.evans.secure raj.secure ); # patient data
my $system_user = 'HMDS-HILIS4-LEEDS';
my $duration = 7; # months
#===============================================================================
#my $addr = '163.160.171.118:1983'; # rie-test
my $addr = '163.160.171.247:1983'; # lthrie
my $proxy = 'http://'.$addr.'/lthspine';
my $urn = 'Leeds-SMS.service';
#===============================================================================
use lib '/home/raj/perl5/lib/perl5';
use SOAP::Lite; # +trace => 'all'; # or switch on after object created
use Modern::Perl;
use SQL::Abstract::More;
use DateTime::Format::MySQL;
use Spreadsheet::WriteExcel::Simple;
use Data::Printer use_prototypes => 0;
use FindBin qw($Bin); # warn $Bin;
use lib ("$Bin/../../../lib", '/home/raj/perl-lib');
use LIMS::Local::ScriptHelpers;
use Local::DB;
my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);
# use Local::DB for query display if just testing:
my $dbix = $JUST_TESTING ? Local::DB->dbix({dbname => 'hilis4'}) : $tools->dbix();
if ($JUST_TESTING) {
$Local::QueryLogger::NO_QUERY_LOGS = 1;
$Local::DBIx::Simple::Result::NO_AUTO_DATE_INFLATION = 1; # for compatibility with $tools->dbix
}
my $ref_date = $tools->date_subtract( months => $duration ); # p $ref_date;
my $subject = 'CML patients with no recent sample';
my $filename = 'cml_patient_notifications.xls';
my $config = $tools->config();
my $sqla = SQL::Abstract::More->new;
my $xl = Spreadsheet::WriteExcel::Simple->new;
#===============================================================================
# get patient, location & last sample date of all cml monitoring patients:
my $cml_patients = do {
my @cols = ( qw/last_name first_name dob nhs_number display_name|location/,
q!date_format(max(r.created_at), '%Y-%m-%d')|last_sample! ); # p \@cols;
my @rels = (
'requests|r' => 'ris.request_id = r.id' ,
'request_initial_screen|ris' => 'ris.screen_id = s.id' ,
'screens|s' => 'r.patient_case_id = pc.id' ,
'patient_case|pc' => 'pc.patient_id = p.id' ,
'patients|p' => 'pc.referral_source_id = rs.id' ,
'referral_sources|rs' => '=>pd.patient_id = p.id' , # left join
'patient_demographics|pd'
);
my @args = (
-columns => \@cols,
-from => [ -join => @rels ],
-where => {
's.description' => { like => 'follow-up CML (PB)%' },
'p.nhs_number' => { '!=' => undef },
'pd.status' => { '!=' => 'dead' },
},
-group_by => 'p.id',
); # p @args;
my ($sql, @bind) = $sqla->select(@args); # p $sql; p \@bind;
$dbix->query($sql, @bind)->map_hashes('nhs_number');
}; # p $cml_patients;
# add nhs_number key to each cml_patients data href (map_hashes doesn't do it):
$cml_patients->{$_}->{nhs_number} = $_ for keys %$cml_patients; # p $cml_patients;
#===============================================================================
# get patients with at least 1 ICDO3 or unauthorised request in past 7 months
my $recent_requests = do {
my @nhs_nums = keys %$cml_patients;
my @rels = (
'requests|r' => '=>arv.id = r.id' , # left join
'authorised_reports_view|arv' => 'rsv.request_id = r.id' ,
'request_status_view|rsv' => 'r.patient_case_id = pc.id' ,
'patient_case|pc' => 'pc.patient_id = p.id' ,
'patients|p'
);
my @args = (
-columns => 'distinct(p.nhs_number)',
-from => [ -join => @rels ],
-where => {
'date(r.created_at)' => { '>=' => $ref_date->ymd },
'p.nhs_number' => { -in => \@nhs_nums },
-or => {
'rsv.`action`' => { '!=' => 'authorised' },
icdo3 => { '!=' => undef },
}
},
); # p @args;
my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
$dbix->query($sql, @bind)->flat; # aref
}; # p $recent_requests;
#===============================================================================
# remove patients with recent request(s) from cml_patients:
delete $cml_patients->{$_} for @$recent_requests;
#===============================================================================
# check PDS live/dead status of remaining patients (will not have dod recorded on HILIS):
{
my $action = 'GetExtendedPatientDetails';
my $soap = SOAP::Lite->new( proxy => $proxy );
# SOAP::Lite->import(+trace => 'all'); # for debug
$soap->on_action( sub { "urn:$urn/$action" }); # .NET format uses '/' not '#'
$soap->autotype(0);
$soap->default_ns("urn:$urn");
PATIENT:
while ( my ($nhs_num, $d) = each %$cml_patients ) { # $d = href
# get aref of SOAP::Data objects suitable for soap call:
my $data = _soap_data_format($nhs_num, $d); # p $data; # aref
# next PATIENT;
my $res = $soap->call($action,
SOAP::Data->name('request')->value( SOAP::Data->value($data) )
);
if ($res->fault) {
# get fault (->faultstring just returns generic 'server error' msg):
my $fault = $res->fault->{detail}->{error}->{text}; # warn $fault;
$d->{pds_status} = $fault; # fault detail
next PATIENT;
}
my $result = $res->result; # p $result; # p $result->{Person}->{DateOfDeath};
if ( my $dod = $result->{Person}->{DateOfDeath} ) {
delete $cml_patients->{$nhs_num};
# convert dod to mysql date:
$dod =~ s/^(\d{4})(\d{2})(\d{2})$/$1-$2-$3/;
# update patient_demographics table:
next PATIENT unless $nhs_num; # "impossible" but JIC otherwise will update thousands!!
# $dbix->update('patient_demographics', # check timestamp doesn't trigger new report
# { dod => $dod }, { nhs_number => $nhs_num });
}
else { # add pds error-code value:
$d->{pds_status} = $result->{ErrorCode};
}
}
}
#===============================================================================
# save remaining patients to excel file, sorted by date of last sample:
my @cols = qw/last_name first_name dob nhs_number location last_sample pds_status/;
$xl->write_bold_row(\@cols);
# sort by last sample date:
my @nhs_nums = sort by_date keys %$cml_patients; # p \@nhs_nums; exit;
# p [ @{ $cml_patients->{$_} }{@cols} ] for @nhs_nums; exit;
$xl->write_row([ @{ $cml_patients->{$_} }{@cols} ]) for @nhs_nums;
#===============================================================================
if ($JUST_TESTING) {
$xl->save($filename);
}
else {
my %mail = (
config => $config,
subject => $subject,
filename => $filename,
attachment => $xl->data,
);
$tools->send_mail(\%mail, \@recipients);
}
#===============================================================================
sub _soap_data_format {
my ($nhs_num, $d) = @_;
my $last_name = $d->{last_name};
my $dob = $d->{dob};
$dob =~ s/-//g; # requires 8-digit string
my %h = (
DateOfBirth => $dob,
FamilyName => $last_name,
NHSNumber => $nhs_num,
UserID => $system_user,
);
my @data = map { SOAP::Data->name($_)->value($h{$_}) } keys %h;
return \@data;
}
sub by_date { # p $cml_patients->{$a}; p $cml_patients->{$b};
_to_datetime($cml_patients->{$a}->{last_sample}) cmp
_to_datetime($cml_patients->{$b}->{last_sample})
}
sub _to_datetime { DateTime::Format::MySQL->parse_date(@_) }
__DATA__
drop table if exists tmp1; /* all cml monitoring patients */
create temporary table tmp1(nhs_number char(10));
insert into tmp1(nhs_number)
select distinct(p.nhs_number)
from requests as r
join request_initial_screen as ris on ( ris.request_id = r.id )
join screens as s on ( ris.screen_id = s.id )
join patient_case as pc on ( r.patient_case_id = pc.id )
join patients as p on ( pc.patient_id = p.id )
left join patient_demographics pd on ( pd.patient_id = p.id )
where p.nhs_number is not null
and s.description like 'follow-up cml (pb)%'
and pd.`status` <> 'dead';
select * from tmp1;
drop table if exists tmp2; /* all above with at least 1 ICDO3 or unauthorised request in past 7 months */
create temporary table tmp2(nhs_number char(10));
insert into tmp2(nhs_number)
select distinct(p.nhs_number)
from requests as r
left join authorised_reports_view arv on ( arv.id = r.id )
join request_status_view as rsv on ( rsv.request_id = r.id )
join patient_case as pc on ( r.patient_case_id = pc.id )
join patients as p on ( pc.patient_id = p.id )
join tmp1 t on ( p.nhs_number = t.nhs_number )
where date(r.created_at) >= date_sub(current_date, interval 7 month)
and ( rsv.`action` !='authorised' or arv.icdo3 is not null );
select * from tmp2;
/* all cml monitoring patients with no ICDO3 or unauthorised requests in past 7 months */
select p.last_name, p.first_name, p.dob, p.nhs_number, rs.display_name,
date_format(max(r.created_at), '%Y-%m-%d') as 'last_date'
from requests as r
join patient_case as pc on ( r.patient_case_id = pc.id )
join patients as p on ( pc.patient_id = p.id )
join referral_sources rs on ( pc.referral_source_id = rs.id )
join tmp1 t1 on ( t1.nhs_number = p.nhs_number )
left join tmp2 t2 on ( t1.nhs_number = t2.nhs_number )
where t2.nhs_number is null
group by p.id
order by max(r.created_at);
