• Files
• Commits
• Log
• Graph
• Stats

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