RSS Git Download  Clone
Raw Blame History
#!/usr/bin/perl

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

my $JUST_TESTING = 0; # not relevant

use Scalar::Util;
use Modern::Perl;
use Config::Auto;
use Data::Printer;
use SQL::Abstract::More;

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

my $config = $tools->config();
my $dbix   = $tools->dbix();

my $start = LIMS::Local::Utils::last_working_date(); # considers public hols
#my $start = LIMS::Local::Utils::last_working_date->subtract(days => 20); # p $start;
my $end   = $tools->time_now; # 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 $multi = PDF::API2->new;

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

    my $title = sprintf 'Print run [%s - %s]', $start->ymd, $end->ymd;
    $multi->info( Title => $title );

    for my $request_id (@$request_ids) { # warn $request_id; next;
        # generate pdf:
		my $req = $lims->get_single_request_data($request_id); # L::C::Roles::RecordHandler
        import_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}; # $request_data is RDBO object
            $o->referrer_department->referrer->name('cc'); # replace referrer name
            import_pdf($req);
        }
    }
    my $file_name = '/backups/print_run/printrun_' . $end->ymd . '.pdf';
    $multi->saveas($file_name); # save file to disk
}

#===============================================================================
sub import_pdf {
    my $data = shift;
    my $pdf = $lims->format_print_run_report($data);
    my $api = PDF::API2->open_scalar($pdf);
    $multi->importpage($api, $_) foreach 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 = (
        'rr.updated_at'  => { -between => [ $start, $end ] },
        'so.description' => { -in => [ qw/authorised complete/ ] },
    );
    # 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);
}

sub dump_query {
# might need to use DBIx::Simple::_replace_omniholder() if sql contains '??'
    my ($sql, @bind) = @_;

    my $i = 0;
    for (@bind) { # replace each '?' with next element of array:
        my $val = Scalar::Util::looks_like_number($bind[$i])
            ? $bind[$i]
            : $dbix->dbh->quote($bind[$i]); # say $bind[$i];
        $sql =~ s/\Q?/$val/;
        $i++;
    }
    $sql =~ s/(FROM|INNER|WHERE|ORDER BY|GROUP BY)/\n$1/g; # p $sql;
}