#!/usr/bin/env perl =begin ------------------------------------------------------------------------- emails XL list of outreach requests with non-CMP sample type for previous month from Feb 2018 requires xlsx file format -------------------------------------------------------------------------------- =cut use Getopt::Std; getopts('m:tq'); # month, testing, query output our($opt_m,$opt_t,$opt_q); # warn $opt_t; exit; use strict; use warnings; use lib '/home/raj/perl5/lib/perl5'; use Data::Printer; use Excel::Writer::XLSX; use lib '/home/raj/perl-lib'; use Local::DB; my $JUST_TESTING = $opt_t || 0; # email to ra.jones only my $duration = $opt_m || 1; # months ############ recipients from contacts.lib ###################################### my @recipients = map $_ . '.secure', qw( lth.commissioning andy.rawstron raj ); ################################################################################ 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(); $tools->test_only($JUST_TESTING); #------------------------------------------------------------------------------- my $ref_date = $tools->date_subtract( months => $duration ); my $filename = 'HMDS.xlsx'; # new filename requirement my $subject = sprintf 'HMDS Outreach patients [%s %s]', $ref_date->month_name, $ref_date->year; # warn $subject; exit; # xl file headers: my @headers = qw( last_name first_name dob unit_number nhs_number registered location sample ); #------------------------------------------------------------------------------- my $sql_lib = $tools->sql_lib(); my $config = $tools->config(); my $dbix = Local::DB->dbix({ dbname => 'hilis4', dump_query => $opt_q }); my @data = do{ my $args = _query_args(); $dbix->sam_query($args)->arrays; }; # p @data; my %mail = ( config => $config, subject => $subject, ); if (@data) { open my $fh, '>', \my $str or die $!; my $xl = Excel::Writer::XLSX->new($fh); my $worksheet = $xl->add_worksheet('CommissioningData'); my $hdr_format = $xl->add_format(bold => 1); # bg_color => '#e0f8f7' my $row_format = $xl->add_format(align => 'left'); # unit number varies $worksheet->write('A1', \@headers, $hdr_format); # row 0 - headers $worksheet->write('A2', [\@data] , $row_format); # ref to arrayref for write_cols() function $xl->close() or die $!; $mail{attachment} = $str; $mail{filename} = $filename; save_file($str) if $JUST_TESTING; } else { # unlikely !! $mail{message} = "No Outreach patients registered during this period."; } # p %mail; $tools->send_mail(\%mail, \@recipients) unless $opt_q; sub save_file { my $str = shift; open my $fh, '>', join '/', $Bin, $filename or die $!; binmode $fh; print $fh $str; close $fh; } sub _query_args { my @cols = qw( p.last_name p.first_name p.dob pc.unit_number p.nhs_number DATE(r.created_at) rs1.display_name s1.sample_code ); my @rels = ( 'requests|r' => 'r.patient_case_id = pc.id' , 'patient_case|pc' => 'pc.patient_id = p.id' , 'patients|p' => 'pc.referral_source_id = rs1.id' , 'referral_sources|rs1' => 'rs2.request_id = r.id' , 'request_specimen|rs2' => 'rs2.specimen_id = s1.id' , 'specimens|s1' => 'ris.request_id = r.id' , 'request_initial_screen|ris' => 'ris.screen_id = s2.id' , 'screens|s2' ); my %where = ( 's2.description' => { -rlike => 'outreach' }, 's1.sample_code' => { '!=' => 'CMP' }, 'MONTH(r.created_at)' => $ref_date->month, 'YEAR(r.created_at)' => $ref_date->year, ); my $order = 'r.created_at'; return { cols => \@cols, rels => \@rels, where => \%where, sort_by => $order, } }