• Files
• Commits
• Log
• Graph
• Stats

#!/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)
=cut ###########################################################################

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 );

my ($sql, @bind) = get_query_params(); # $dbix->dump_query($sql, @bind); exit;
my $request_ids = $dbix->query($sql, @bind)->flat; # p $request_ids;

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;

#===============================================================================
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 @tbl_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'
    );

    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 ] };

    # 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;
    my @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;
    return ($sql, @bind);
}