• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/env perl

=begin -------------------------------------------------------------------------
emails list of incomplete lab-tests for previous 7 days (or -d <num>)
=cut #--------------------------------------------------------------------------

use Getopt::Std;
getopts('d:qt'); # days, sql output, testing
our($opt_d,$opt_q,$opt_t);

use strict;
use warnings;

use lib '/home/raj/perl5/lib/perl5';
use Spreadsheet::WriteExcel::Simple;
use SQL::Abstract::More;
use FindBin qw($Bin); # warn $Bin;
use Data::Printer ;

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

use lib '/home/raj/perl-lib';
use Local::DB;

my $centre = $ENV{CENTRE} || die 'no centre param supplied';
my $dbname = $centre eq 'leeds' ? 'hilis4' : $centre;
my $dbix   = Local::DB->dbix({ dbname => $dbname }); # warn $dbix->dbh->{Name};

### recipients #################################################################
my @recipients = qw(raj uclh.sihmds );                                         #
my $duration   = $opt_d || 30;                                                  #
################################################################################

my $JUST_TESTING = $opt_t || 0;
$ENV{SQL_TRACE}  = $opt_q; # warn $ENV{SQL_TRACE}; switch on query trace

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

my $config = $tools->config();
my $today  = $tools->time_now;

my $filename = 'incomplete_lab_tests.xls';
my $subject  = sprintf 'Incomplete lab tests [%s]', $today->dmy; # p $subject;

my @headers = qw(request_number year last_name first_name dob test_name 
    section_name test_status last_update);

my $xl = Spreadsheet::WriteExcel::Simple->new;
$xl->write_bold_row(\@headers);

my ($sql, @bind) = _get_query();
my @result = $dbix->query( $sql, @bind )->arrays; # p $_ for @result; exit;
$xl->write_row($_) for @result;

if ($JUST_TESTING) {
    $xl->save($filename);  exit;
}

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

sub _get_query {
    my @col_names = qw(
		r.request_number  
        r.year
        p.last_name
        p.first_name
        p.dob
        lt.field_label|test_name
        ls.section_name
        so.description|test_status
        DATE(ts.time)|last_update
    );
    my @tbl_rels = (                     'requests|r'                   ,
        'r.patient_case_id=pc.id'     => 'patient_case|pc'              ,
        'pc.patient_id=p.id'          => 'patients|p'                   ,
        'ts.request_id=r.id'          => 'request_lab_test_status|ts'   ,
        'ts.status_option_id=so.id'   => 'lab_test_status_options|so'   ,
        'ts.lab_test_id=lt.id'        => 'lab_tests|lt'                 ,
        'lt.lab_section_id=ls.id'     => 'lab_sections|ls'
    );
    my $date = $today->clone->subtract( days => $duration )->ymd;
	my %where = (
        'so.description'    => { '!=' => 'complete' },
        'DATE(ts.time)'     => { '<'  =>  $date     },
    );
	my @sort = qw(ts.time r.id lt.field_label);

	my ($sql, @bind) = SQL::Abstract::More->new->select(
		-columns  => \@col_names,
		-from     => [ -join => @tbl_rels ],
		-where    => \%where,
		-order_by => \@sort,
	); # p $sql; p @bind;
    return ($sql, @bind);
}