#!/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; }