#!/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
=cut
#===============================================================================
my $duration = 7; # months
my @recipients = qw( paul.evans.secure raj.secure );
my $JUST_TESTING = 1; # uses Local::DB for query display; email to ra.jones only
#===============================================================================
use lib '/home/raj/perl5/lib/perl5';
use Modern::Perl;
use List::Compare;
use SQL::Abstract::More;
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 nhs_numbers of all cml monitoring patients:
my @patients = do {
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' => '=>pd.patient_id = p.id' , # left join
'patient_demographics|pd'
);
my @args = (
-columns => 'distinct(p.nhs_number)',
-from => [ -join => @rels ],
-where => {
's.description' => { like => 'follow-up CML (PB)%' },
'p.nhs_number' => { '!=' => undef },
'pd.status' => { '!=' => 'dead' },
},
); # p @args;
my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
my $ref = $dbix->query($sql, @bind)->flat; # aref
@$ref;
}; # p \@patients;
# get all above with at least 1 ICDO3 or unauthorised request in past 7 months */
my @have_requests = do {
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 => \@patients },
-or => {
'rsv.`action`' => { '!=' => 'authorised' },
icdo3 => { '!=' => undef },
}
},
); # p @args;
my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
my $ref = $dbix->query($sql, @bind)->flat; # aref
@$ref;
}; # p \@have_requests;
# get patient details for notification:
my @notifications = do {
# remove @have_requests nhs_numbers from @patients:
my @no_requests = # get_unique() returns entries in 1st list & not in 2nd (-u = unsorted):
List::Compare->new('-u', \@patients, \@have_requests)->get_unique; # p \@have_no_requests;
my @cols = ( qw/last_name first_name dob nhs_number display_name/,
q!date_format(max(r.created_at), '%Y-%m-%d')! ); # p \@cols;
my @rels = (
'requests|r' => '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'
);
my @args = (
-columns => \@cols,
-from => [ -join => @rels ],
-where => { nhs_number => { -in => \@no_requests } },
-order_by => 'max(r.created_at)',
-group_by => 'p.id',
); # p @args;
my ($sql, @bind) = $sqla->select(@args); # p $sql; p \@bind;
my $ref = $dbix->query($sql, @bind)->arrays; # AoA
@$ref;
};
my @cols = qw/last_name first_name dob nhs_number location last_sample/;
$xl->write_bold_row(\@cols);
$xl->write_row($_) for @notifications;
if ($JUST_TESTING) {
$xl->save($filename);
}
else {
my %mail = (
config => $config,
subject => $subject,
filename => $filename,
attachment => $xl->data,
);
$tools->send_mail(\%mail, \@recipients);
}
#===============================================================================
=begin # don't need these - doing order-by in query
use DateTime::Format::MySQL;
sub by_date { _to_datetime($a->[-1]) cmp _to_datetime($b->[-1]) } # date is last col
sub _to_datetime { DateTime::Format::MySQL->parse_date(@_) }
=cut
__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);
