#!/usr/bin/perl
=begin ------------------------------------------------------------------------
* performs daily print run - creates pdf in /backups/print_run dir (or to /tmp
if JUST_TESTING flag set with getopt -t)
* compiles separate list of trial cases and emails to contacts
=cut
#===============================================================================
my @recipients = qw(hmds.secure raj); # for clinical trial cases
#===============================================================================
BEGIN {
use lib '/home/raj/perl5/lib/perl5'; # *must* come before FindBin($Bin)
use FindBin qw($Bin); # warn $Bin; exit;
use lib $Bin . '/../../../lib';
# override default db test:
$ENV{ROSEDB_DEVINIT} = "$Bin/../../../config/rosedb_devinit_prod.pl";
}
use autodie;
no autovivification;
use Getopt::Std;
use Modern::Perl;
use Config::Auto;
use Data::Printer;
use SQL::Abstract::More;
getopts('t'); # t for testing
our ($opt_t);
my $JUST_TESTING = $opt_t; # saves pdf to /tmp instead of backup dir
use LIMS::Local::Utils;
use LIMS::Local::Reports;
use LIMS::Local::ScriptHelpers;
# get tools from LIMS::Local::ScriptHelpers:
my $tools = LIMS::Local::ScriptHelpers->new();
# $tools->test_only($JUST_TESTING); # not relevant
my $config = $tools->config();
my $today = $tools->time_now();
my $dbix = $tools->dbix();
#my $start = LIMS::Local::Utils::last_working_date->subtract(days => 27); # p $start;
my $start = LIMS::Local::Utils::last_working_date(); # considers public hols
# end date is today - 1 day (query uses ymd so includes full day to midnight):
my $end = $today->clone->subtract( days => 1 ); # p $start; p $end; exit;
# substitutes LIMS methods required by Role::RecordHandler :
my $lims = LIMS::Local::Reports->new({ tools => $tools });
# localhost http address - for charts; is_print_request for tt formatting:
$lims->tt_params(
app_url => 'http://localhost/hilis4',
is_print_request => 1, # can't use c.get_current_runmode method
);
my $pdf_title = ( $start->ymd eq $end->ymd )
? sprintf ( 'Print run [%s]', $start->dmy('.') )
: sprintf ( 'Print run [%s - %s]', $start->dmy('.'), $end->dmy('.') ); # p $pdf_title;
my $pdf_name = 'printrun_' . $today->ymd . '.pdf'; # p $pdf_name;
my $pdf_path = $JUST_TESTING ? '/tmp' : '/backups/print_run'; # p $pdf_path;
my $pdf = PDF::API2->new(-file => join '/', $pdf_path, $pdf_name);
$pdf->info( Title => $pdf_title );
{ # non-trial cases (generate pdfs):
my ($sql, @bind) = get_query_params('non-trial'); # $dbix->dump_query($sql, @bind); exit;
my $request_ids = $dbix->query($sql, @bind)->flat; # p $request_ids; exit;
for my $request_id (@$request_ids) { # warn $request_id; # next;
my $req = $lims->get_single_request_data($request_id); # L::C::Roles::RecordHandler
add_new_pdf($req);
# generate 2nd copy with 'cc' as referrer if copy_to selected:
if ( $req->{request_options}->{copy_to}->{is_selected} ) { # p $request_id;
my $o = $req->{data}; # $req->{data} is RDBO object
$o->referrer_department->referrer->name('cc'); # replace referrer name
add_new_pdf($req);
}
}
$pdf->save;
}
{ # trial cases (generate list for email):
my ($sql, @bind) = get_query_params('clinical-trial'); # $dbix->dump_query($sql, @bind); exit;
my $request_ids = $dbix->query($sql, @bind)->flat; # p $request_ids; exit;
my @rows;
for my $request_id (@$request_ids) { # warn $request_id; # next;
my $req = $lims->get_single_request_data($request_id); # L::C::Roles::RecordHandler
my $data = $req->{data}; # RDBO
# TODO: identify skip_paper_report locations
push @rows, sprintf '%s :: %s/%s :: %s',
$data->request_trial->trial->trial_name,
$data->request_number,
$data->year - 2000,
$data->patient_case->referral_source->display_name;
}
if (@rows) {
my %mail = (
config => $config,
subject => 'Clinical trial reports ' . $end->dmy,
message => join "\n", @rows,
); # p %mail;
$tools->send_mail(\%mail, \@recipients);
}
}
#===============================================================================
sub add_new_pdf {
my $data = shift;
my $pdf_string = $lims->format_print_run_report($data);
my $api = PDF::API2->open_scalar($pdf_string);
$pdf->importpage($api, $_) for (1 .. $api->pages);
}
sub get_query_params {
my $type = shift; # trial or non-trial cases
my $tbl_rels = get_tbl_rels($type);
my %query = ( 'so.description' => { -in => [ qw/authorised complete/ ] } );
$query{'DATE(rr.updated_at)'} = ( $start->ymd eq $end->ymd )
? $start->ymd # or $end->ymd, both same
: { -between => [ $start->ymd, $end->ymd ] };
my @sort_by;
if ( $type eq 'clinical-trial' ) { # don't exclude any locations
@sort_by = qw(ct.trial_name r.year r.request_number);
}
elsif ( $type eq 'non-trial' ) {
# $query{'rt.request_id'} = undef; # skip trial cases - not yet !!
# exclude any locations which don't require paper copies:
if ( my $cfg = $tools->get_yaml_file('skip_paper_reports') ) { # p $cfg;
if ( my $org_codes = $cfg->{organisation} ) { # p $org_codes;
$query{'po.parent_code'} = { -not_in => $org_codes };
}
if ( my $hospitals = $cfg->{hospital} ) { # p $hospitals;
$query{'rs.organisation_code'} = { -not_in => $hospitals };
}
if ( my $departments = $cfg->{department} ) { # p $departments;
for (@$departments) { # eg RWA/823
my ($location, $department) = split '/'; # p $location; p $department;
# 5-digits (hospital) or 3-digits (organisation) code:
my $site_type = length $location > 3
? 'rs.organisation_code'
: 'po.parent_code';
my %h = (
$site_type => $location,
'rd.hospital_department_code' => $department,
);
push @{ $query{-not_bool} }, \%h;
}
}
} # p %query; exit;
@sort_by = qw(ref.name r.year r.request_number);
}
my ($sql, @bind) = SQL::Abstract::More->new->select(
-columns => 'r.id',
-from => [ -join => @$tbl_rels ],
-where => \%query,
-order_by => \@sort_by,
); # p $sql; p @bind;
# $dbix->dump_query($sql, @bind); exit;
return ($sql, @bind);
}
sub get_tbl_rels {
my $type = shift; # trial or non-trial cases
my @rels = (
# table|alias # FK-PK relationship
'requests|r' , 'r.referrer_department_id = rd.id' ,
'referrer_department|rd' , 'rd.referrer_id = ref.id' ,
'referrers|ref' , 'r.patient_case_id = pc.id' ,
'patient_case|pc' , 'rr.request_id = r.id' ,
'request_report_view|rr' , 'r.status_option_id = so.id' ,
'status_options|so' , 'pc.referral_source_id = rs.id' ,
'referral_sources|rs' , 'rs.parent_organisation_id = po.id' ,
'parent_organisations|po'
);
if ( $type eq 'clinical-trial' ) { # include request_trial/clinical_trials:
push @rels, ( 'rt.request_id=r.id' => 'request_trial|rt' ,
'rt.trial_id=ct.id' => 'clinical_trials|ct' );
}
elsif ( $type eq 'non-trial' ) { # left join request_trial to exclude:
push @rels, ( '=>rt.request_id=r.id' => 'request_trial|rt' );
}
return \@rels;
}
