#!/usr/bin/env perl
# cases screened as suspected aml, cytopenia, suspected mds, etc, or a new myeloid
# diagnosis, mails to CC, MS & PE weekly on rollover Thursday/Friday
my $JUST_TESTING = 0; # email to ra.jones only
############ recipients from contacts.lib #######################################
my @recipients = qw( catherine.cargo.secure paul.evans.secure mike.short.secure );
push @recipients, 'raj.secure'; # if $JUST_TESTING; # will be the only recipient
################################################################################
use lib '/home/raj/perl5/lib/perl5';
use Spreadsheet::WriteExcel::Simple;
use Data::Printer;
use Modern::Perl;
use FindBin; # warn $FindBin::Bin;
use lib '/home/raj/apps/HILIS4/lib';
use LIMS::Local::ScriptHelpers;
use LIMS::Local::Utils;
my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);
my $config = $tools->config();
my $dbix = $tools->dbix();
#-------------------------------------------------------------------------------
my $date = $tools->time_now;
my $date_from = $date->clone->subtract(days => 7)->ymd; # warn $date_from; exit;
my $subject = sprintf 'Myeloid screens & diagnoses for NGS [%s - %s]',
$date->clone->subtract(days => 7)->dmy,
$date->clone->subtract(days => 1)->dmy; # warn $subject; exit;
my $filename = 'myeloid_ngs.xls';
#-------------------------------------------------------------------------------
my $xl = Spreadsheet::WriteExcel::Simple->new;
# xl file headers:
my @headers = qw( req_number year reg_date last_name first_name dob age screen
screen_date specimen diagnosis );
my @rows;
my $sql = query(); # say $sql; exit;
my $result = $dbix->query($sql, $date_from);
while (my $row = $result->array) { # p $row; next;
push @rows, $row;
}
my %mail = (
config => $config,
subject => $subject,
);
if (@rows) {
my $xl = Spreadsheet::WriteExcel::Simple->new;
$xl->write_bold_row(\@headers);
$xl->write_row($_) for @rows;
$mail{attachment} = $xl->data;
$mail{filename} = $filename;
$tools->send_mail(\%mail, \@recipients);
}
sub query { # uses sub-select (derived tables) to avoid repeating 'age' calc in where
my $screens = join ',', map qq("$_"), (
'Aplastic anaemia', # .......................................... retired
'Cytopenia',
'Suspected AML 60+',
'Suspected AML under-60',
'Suspected CMML', # ............................................ retired
'Suspected CMML (BM)',
'Suspected CMML (PB)',
'Suspected MDS',
);
# can't use icdo3 for this as many unwanted diagnoses included eg CML's
my $diagnoses = join ',', map qq("$_"), (
'AML arising from transformation of MDS',
'AML arising from transformation of MDS/MPN',
'AML arising from transformation of MPD',
'AML inv(16)(p13;q22)',
'AML NOS',
'AML with t(6;9)(p23;q34); DEK-NUP214',
'AML t(8;21)(q22;q22)',
'AML t(9;11)(p21.3;q23.3); MLLT3-KMT2A',
'AML with adverse cellular features', # ........................ retired
'AML with biallelic mutations of CEBPA',
'AML with MDS-related changes',
'AML with MLL (11q23) rearrangement',
'AML with MLL (KMT2A) (11q23) rearrangement',
'AML with mutated NPM1',
'AML with mutated RUNX1',
'AML with NPM mutation as sole abnormality',
'Aplastic anaemia',
'Atypical chronic myeloid leukaemia',
'Chronic myelomonocytic leukaemia', # .......................... retired
'Chronic myelomonocytic leukaemia - 0',
'Chronic myelomonocytic leukaemia - 1',
'Chronic myelomonocytic leukaemia - 2',
'Chronic myeloproliferative neoplasm with myelofibrosis',
'MDS unclassifiable',
'MDS with excess blasts - 1',
'MDS with excess blasts - 2',
'MDS with high risk features', # ............................... retired
'MDS with isolated del (5q)',
'MDS with multilineage dysplasia',
'MDS with ring sideroblasts and multilineage dysplasia',
'MDS with ring sideroblasts and single lineage dysplasia',
'MDS with single lineage dysplasia',
'MDS/MPN with ring sideroblasts and thrombosis',
'Myelodysplastic syndrome (5q-)',
'Myelodysplastic syndrome, unclassifiable',
'Myelodysplastic/myeloproliferative neoplasm unclassified',
'Myelodysplastic/myeloproliferative neoplasm unclassified',
'Primary myelofibrosis',
'Refractory anaemia with excess blasts', # ..................... retired
'Refractory anaemia with excess blasts and fibrosis', # .........retired
'Refractory anaemia with ring sideroblasts', # ................. retired
'Refractory anaemia with ring sideroblasts and thrombocytosis',# retired
'Refractory cytopenia with multilineage dysplasia', # .......... retired
'Refractory cytopenia with unilineage dysplasia', # ............ retired
);
return qq!
select t1.request_number, t1.year, t1.reg_date, t1.last_name, t1.first_name,
t1.dob, t1.age, t1.screened, t1.screen_date, group_concat(t1.specimen),
t1.diagnosis
from (
select
r.id as 'request_id', r.request_number, r.year, rrd.status,
s.description as 'screened', date(r.created_at) as 'reg_date',
p.last_name, p.first_name, p.dob, date(rsv.time) as 'screen_date',
s2.sample_code as 'specimen', d.name as 'diagnosis',
( date_format(r.created_at,'%Y') - date_format(p.dob,'%Y') )
- ( date_format(r.created_at,'00-%m-%d') < date_format(p.dob,'00-%m-%d') )
as 'age'
from requests r
join ( patient_case pc join patients p on pc.patient_id = p.id )
on r.patient_case_id = pc.id
join request_status_view rsv on ( rsv.request_id = r.id
and rsv.`action` = 'screened' )
join ( request_initial_screen ris join screens s on ris.screen_id = s.id )
on r.id = ris.request_id
join ( request_specimen rs join specimens s2 on rs.specimen_id = s2.id )
on rs.request_id = r.id
left join ( request_report_detail rrd join diagnoses d on
rrd.diagnosis_id = d.id ) on rrd.request_id = r.id
) as t1
where t1.screen_date >= ?
and t1.age >= 18
and (
t1.screened IN ($screens)
or ( t1.status = 'new' and t1.diagnosis in ($diagnoses) )
)
group by t1.request_id
order by t1.reg_date, t1.request_number!;
}
