#!/usr/bin/perl =begin ------------------------------------------------------------------------- emails list of lab-section error codes (ME, FC & HE), every 3 months can supply duration as -m option, but only calculates date range correctly if start & end months in same year (eg can pass -m 4 in Feb, but not -m 4 in March) =cut --------------------------------------------------------------------------- use Getopt::Std; getopts('qtm:'); # dump query, test only, months our($opt_m,$opt_q,$opt_t); # warn $opt_m; exit; ############ usernames from users table (not sending patient info) ############ my @recipients = qw(detute mistry wilkinson evans oconnor kuzmicki raj); ################################################################################ my $JUST_TESTING = $opt_t || 0; # email to ra.jones only use strict; use warnings; use lib '/home/raj/perl5/lib/perl5'; use Data::Printer; use FindBin qw($Bin); # warn $Bin; use Spreadsheet::WriteExcel::Simple; 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 $date = $tools->time_now(); # uncomment to force specific date: # DateTime->new(year => 2018, month => 3, day => 1); #------------------------------------------------------------------------------- my $duration = $opt_m || 3; # months ago # get ref-date $duration months ago: my $ref_date = $date->clone->subtract( months => $duration ); my $filename = sprintf 'sectional_errors_%s.xls', $date->ymd(''); my $subject = sprintf 'Section error codes for %s-%s %s', $ref_date->month_abbr, $ref_date->clone->add(months => 2)->month_abbr, $ref_date->year; # warn $subject; # exit; my @headers = qw( request_number year error details datetime ); my @months = ( $ref_date->month .. $ref_date->month + 2 ); # p @months; #------------------------------------------------------------------------------- my $sql_lib = $tools->sql_lib(); my $config = $tools->config(); my $dbix = $tools->dbix(); my ($sql, @bind) = _get_query(); my @data = $dbix->query( $sql, @bind )->arrays; # p @data; exit unless @data; # unlikely my $xl = Spreadsheet::WriteExcel::Simple->new; $xl->write_bold_row(\@headers); $xl->write_row($_) for @data; $xl->save($filename) if $JUST_TESTING; my %mail = ( config => $config, subject => $subject, attachment => $xl->data, filename => $filename, ); $tools->send_mail(\%mail, \@recipients) unless $opt_q; sub _get_query { # data as arrays for write_row() so col aliases not necessary: my @cols = ( 'r.request_number', 'r.year', 'upper(ec.code)', 'ecd.details', 'rec.time', ); my @rels = ( 'requests|r' => q{rec.request_id = r.id} , 'request_error_code|rec' => q{rec.error_code_id = ec.id} , 'error_codes ec' => q!=>ecd.request_error_code_id=rec.id! , 'request_error_code_details|ecd' ); my %where = ( 'month(rec.time)' => { -in => \@months }, 'year(rec.time)' => $ref_date->year, # only works for @months 1..3, 4..6, etc 'ec.code' => { -rlike => '^(he|me|fc)' }, ); my @args = ( -columns => \@cols, -from => [ -join => @rels ], -where => \%where, -order_by => [ 'ec.code', 'rec.time' ], ); # p @args; my ($sql, @bind) = SQL::Abstract::More->new->select(@args); # p $sql; p \@bind; $dbix->dump_query($sql, @bind) if $opt_q; # exit; return ($sql, @bind); }