• Files
• Commits
• Log
• Graph
• Stats

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