• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/env perl

# CENTRE=bristol perl $0 # manual run (need CENTRE to find usrname in users table)

use Getopt::Std;
getopts('tm:'); # testing, months
our($opt_m,$opt_t);

use strict;
use warnings;

my $JUST_TESTING = $opt_t || 0; # dumps xl file only

### recipients #################################################################
my @recipients = qw(raj.secure paul.virgo.secure);                                     #
################################################################################

use lib '/home/raj/perl5/lib/perl5'; # *must* come before FindBin($Bin)
use SQL::Abstract::More;
use FindBin qw($Bin); # warn $Bin; exit;
use Data::Printer;

use lib $Bin . '/../../../lib';
use LIMS::Local::ScriptHelpers;

use lib '/home/raj/per-lib';
use Local::WriteExcel;
use Local::DB;

my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);

my $config = $tools->config();
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 'nbt_activity_%s.xls', $date->ymd('');
my $subject  = sprintf 'NBT activity data %s-%s %s',
	$ref_date->month_abbr,
    $ref_date->clone->add(months => 2)->month_abbr,
	$ref_date->year; # warn $subject; # exit;
my @months = ( $ref_date->month .. $ref_date->month + 2 ); # p @months;

my $dbix = Local::DB->dbix({ dbname => 'bristol' });

my $xl = Local::WriteExcel->new( filetype => 'xlsx' );
# set worksheet name to Qn:
my $quarter = int ( $ref_date->clone->add(months => 2)->month / 3 ); # p $quarter;
$xl->worksheet_name('Activity data Q'.$quarter);

my @cols = qw(
    request_number year last_name first_name dob nhs_number unit_number
    location registered sample test_name test_status section_name
    results_summary diagnosis external_reference
);
$xl->write_bold_row(\@cols);

my @rows = do {
    my ($sql, @bind) = _query();
    $dbix->query($sql, @bind)->arrays; # for XL output
};
$xl->write_row($_) for @rows;

if ($JUST_TESTING) {
    $xl->save(join '/',$Bin,$filename);  exit;
}

my %mail = (
	config  => $config,
	subject => $subject,
	filename   => $filename,
	attachment => $xl->data,
);
$tools->send_mail(\%mail, \@recipients);

sub _query {
    my @cols = (
        qw/
            r.request_number
            r.year
            p.last_name
            p.first_name
            p.dob
            p.nhs_number
            pc.unit_number
            rs1.display_name|location
            r.created_at|registered
            group_concat(s.sample_code)|sample
            lt.test_name
            so.description|test_status
            ls.section_name
            rrs.results_summary
            d.name|diagnosis
            rer.external_reference
        /,
    ); # p @cols;

    my @rels = (
        'requests|r'                    => q{r.patient_case_id=pc.id}		   ,
        'patient_case|pc'               => q{pc.patient_id=p.id}     		   ,
        'patients|p'       	            => q{pc.referral_source_id=rs1.id}     ,
        'referral_sources|rs1'          => q{rs2.request_id=r.id}              ,
        'request_specimen|rs2'          => q{rs2.specimen_id=s.id}             ,
        'specimens|s'                   => q{ts.request_id=r.id}               ,
        'request_lab_test_status|ts'    => q{ts.status_option_id=so.id}        ,
        'lab_test_status_options|so'    => q{ts.lab_test_id=lt.id}             ,
        'lab_tests|lt'                  => q{lt.lab_section_id=ls.id}          ,
        'lab_sections|ls'               => q{=>rrd.request_id=r.id}            ,
        'request_report_detail|rrd'     => q{=>rrd.diagnosis_id=d.id}          ,
        'diagnoses|d'
                    => q{=>rrs.lab_section_id=ls.id,rrs.request_id=r.id}       ,
        'request_result_summaries|rrs'  => q{=>rer.request_id=r.id}            ,
        'request_external_ref|rer'
    );
    # previous 3 months:
    my %where = (
        'month(ts.time)' => { -in => \@months },
        'year(ts.time)'  => $ref_date->year, # only works for @months 1..3, 4..6, etc
    );
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => \%where,
        -group_by => [ qw(r.id lt.id ) ], # for group_concat(s.sample_code)
        -order_by => [ qw(r.year r.request_number lt.test_name) ],
    ); # p @args;
    my ($sql, @bind) = SQL::Abstract::More->new->select(@args); # p $sql; p \@bind;
        # $dbix->dump_query($sql, @bind); exit;
    return ($sql, @bind);
}