• Files
• Commits
• Log
• Graph
• Stats

#!/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(); # p $query; 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
  return q!
    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 (
                'Suspected AML 60+',
                'Suspected AML under-60',
                'Cytopenia',
                'Suspected MDS',
                'Suspected CMML'
            )
            or ( t1.status = 'new' and t1.diagnosis in (
                'Myelodysplastic syndrome, unclassifiable',
                'Refractory anaemia with excess blasts',
                'Refractory anaemia with excess blasts and fibrosis',
                'Refractory anaemia with ring sideroblasts',
                'Refractory cytopenia with multilineage dysplasia',
                'Refractory cytopenia with unilineage dysplasia',
                'Myelodysplastic syndrome (5q-)',
                '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 t(8;21)(q22;q22)',
                'AML with adverse cellular features',
                'AML with MLL (11q23) rearrangement',
                'AML with NPM mutation as sole abnormality',
                'Chronic myelomonocytic leukaemia',
                'Atypical chronic myeloid leukaemia',
                'Myelodysplastic/myeloproliferative neoplasm unclassified',
                'Refractory anaemia with ring sideroblasts and thrombocytosis'
              )
            )
        )
    group by t1.request_id
    order by t1.reg_date, t1.request_number!;
}