#!/usr/bin/env perl =begin ------------------------------------------------------------------------- emails list of incomplete lab-tests for previous 7 days (or -d ) =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); }