• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/env perl

=begin -------------------------------------------------------------------------
emails XL list of CML patients on imatinib follow-up not achieving MMR for previous month
=cut ---------------------------------------------------------------------------

use Getopt::Std;
getopts('d:t'); # days, testing
our($opt_d,$opt_t); # warn $opt_d; exit;

my $days = $opt_d || 7;

# emails only 'service_email' addr in config
my $JUST_TESTING = $opt_t || 0;

use strict;
use warnings;

############ recipients from contacts.lib ######################################
my @recipients = qw(
	raj.secure
    paul.evans.secure
    kate.rothwell.secure
);
################################################################################

use lib '/home/raj/perl5/lib/perl5';
use Data::Printer;
use Spreadsheet::WriteExcel::Simple;

use FindBin qw($Bin); # warn $Bin;
use lib $Bin . '/../../../lib';
use LIMS::Local::ScriptHelpers;

# get tools from LIMS::Local::ScriptHelpers:
my $tools = LIMS::Local::ScriptHelpers->new();
my $date  = $tools->time_now;
$tools->test_only($JUST_TESTING);

#-------------------------------------------------------------------------------
my $diagnosis = 'Chronic myeloid leukaemia - major molecular response';
my $filename  = sprintf 'cml_patients_%s.xls', $date->ymd(''); # warn $filename; exit;
my $subject   = 'CML patients not achieving MMR for week ending ' . $date->dmy;
# xl file headers:
my @headers = qw( request_number year last_name first_name dob nhs_number
    location diagnosis auth_date );
#-------------------------------------------------------------------------------

my $config = $tools->config();
my $dbix   = $tools->dbix();
my $sqla   = SQL::Abstract::More->new;

my %mail = (
	config  => $config,
	subject => $subject,
);

if ( my @requests = get_requests() ) { # array of arrayrefs
	my $xl = Spreadsheet::WriteExcel::Simple->new;
	$xl->write_bold_row(\@headers);
	$xl->write_row($_) for @requests;

	$mail{attachment} = $xl->data;
    $mail{filename}   = $filename;
    $xl->save($Bin . '/cml_non_remision.xls') if $JUST_TESTING;
}
else {
	$mail{message} = 'None during this period.';
} # p %mail;

$tools->send_mail(\%mail, \@recipients);

sub get_requests {
	my @cols = qw(
        t1.request_number
        t1.year
        t1.last_name
        t1.first_name
        t1.dob
        t1.nhs_number
        t1.location|source
        t1.diagnosis
        t1.auth_date
    );
    my @rels = (
        'authorised_reports_view|t1'  => 'ris.request_id = t1.id'    ,
        'request_initial_screen|ris'  => 'ris.screen_id = s.id'      ,
        'screens|s'
    );
    my @date_range = ( $date->clone->subtract(days => $days)->ymd, $date->ymd );
	my %where = (
        't1.auth_date'   => { -between => \@date_range },
        't1.diagnosis'   => { '!=' => $diagnosis },
        'last_name'      => { '!=' => 'neqas' },
        's.description'  => 'Follow-up CML (PB)',
        't1.parent_code' => 'RR8',
	);
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => \%where,
        -order_by => 't1.auth_date',
	);
	my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
	    # $dbix->dump_query($sql, @bind); exit;
    my @ref = $dbix->query($sql, @bind)->arrays; # AoH
    return wantarray ? @ref : \@ref;
}