#!/usr/bin/perl
=begin -------------------------------------------------------------------------
Compiles & emails authorised (or amended) reports as PDF attachments for
locations specified in email_contacts table, where 'type' col is set to 'report'
Required entries must be in email_contacts table (doesn't use lib/contacts.lib
as most of addresses are the same as for mdt contact), with 'type' col set to
'report'. Also requires entries in %report_status map, and %departments if
required - see config section below.
Scope = organisation, hospital or department. If set to 'organisation', records
are retrieved using parent_organisation_id; if scope set to 'department', expects
entry in %departments map to provide hospital_department.display_name to filter
on; if set to hospital, uses the referral_source_id to retrieve records
Uses LIMS::Controller::Roles::format_report() to generate PDF reports, via
LIMS::Local::Reports to provide methods - render_view(), model(), etc - required
by LIMS methods
=cut ---------------------------------------------------------------------------
use strict;
use warnings;
my $JUST_TESTING = 1; # skips history file update, emails just raj
################################################################################
use constant APP_URL => 'http://localhost:8080/hmds'; # # app address - for charts
my %departments = ( # entry MUST match display_name in email_contacts table
# email_contacts.display_name => hospital_departments.display_name
Airedale => 'histopathology',
Blackburn => 'histopathology',
Salford => 'histopathology',
Wigan => 'histopathology',
);
# recipients requiring only 'new' diagnoses - otherwise defaults to 'all':
my @require_new = ( # entry MUST match display_name in email_contacts table
'Calderdale (CWT)', # Cancer Waiting Times
'Scarborough (CWT)', # Cancer Waiting Times
);
my $delta = 1; # days ago - 1 for production
################################################################################
BEGIN {
use FindBin qw($Bin); # warn $Bin; exit;
use lib (
"$Bin/../../../lib",
'/home/raj/perl5/lib/perl5',
);
# override default db test:
$ENV{ROSEDB_DEVINIT} = "$Bin/../../../config/rosedb_devinit_prod.pl";
}
use IO::All;
use Config::Auto;
use Data::Dumper;
use DateTime::Format::MySQL;
use LIMS::Local::Reports;
use LIMS::Local::ScriptHelpers;
my $cfg_file = "$Bin/../lib/settings.cfg";
my $settings = Config::Auto::parse($cfg_file); # warn Dumper $settings;
# get tools from LIMS::Local::ScriptHelpers:
my $tools = LIMS::Local::ScriptHelpers->new();
my $sql_lib = $tools->sql_lib();
my $config = $tools->config();
my $dbix = $tools->dbix();
my $date = $tools->date_subtract( days => $delta )->ymd; # warn $date;
# substitutes LIMS methods required by Role::RecordHandler :
my $lims = LIMS::Local::Reports->new({tools => $tools});
$lims->tt_params( app_url => APP_URL ); # for charts
# common vars for email message:
my %mail = (
config => $config,
);
#-------------------------------------------------------------------------------
# get contents of email_contacts table:
my $email_contacts = get_email_contacts(); # AoH
# get referral_source_ids map of locations requiring only 'new' reports:
my $ids_requiring_new = get_locations_requiring_new($email_contacts); # hashref
# get referral_source_ids map of locations requiring departmental reports:
my $department_location_ids = get_department_locations($email_contacts); # hashref
#-------------------------------------------------------------------------------
# go:
{
# get base query, appended with restriction depending on scope (dept, hospital, organisation)
my $base_sql = $sql_lib->retr('mail_reports_request_ids');
# get list of request_ids to send to compile_reports():
ENTRY: # loop through each contact and get request_id's as required:
for my $recipient (@$email_contacts) { # warn Dumper $recipient;
next ENTRY unless $recipient->{is_active} eq 'yes';
my $email_address = $recipient->{contact_address};
my $ref_src_id = $recipient->{referral_source_id};
my $entry_id = $recipient->{id}; # email_contacts.id
my $scope = $recipient->{scope}; # dept, hospital or organisation
# copy of $base_sql initial state (gets modified inside blocks):
my $local_sql = $base_sql;
my @bind = ($date); # re-initialise with $date - universally required
# reports can be for department, hospital or organisation:
if ( $scope eq 'department' ) {
# add restrictions:
$local_sql .= q! AND rs.id = ? AND hd.display_name = ?!;
my $department = $department_location_ids->{$entry_id} # warn $department;
|| die "cannot find data for email_contacts.id = $entry_id";
push @bind, ($ref_src_id, $department);
}
elsif ( $scope eq 'organisation' ) {
# add restrictions:
$local_sql .= q! AND rd.parent_organisation_id = ?!;
# find parent_organisation of ref_src_id:
my $sql = q!select parent_organisation_id from referral_sources
where id = ?!;
$dbix->query( $sql, $ref_src_id )->into( my $parent_org_id );
push @bind, $parent_org_id;
}
elsif ( $scope eq 'hospital' ) {
# add restrictions:
$local_sql .= q! AND rs.id = ?!;
push @bind, $ref_src_id;
}
else { die "unknown scope: $scope" }
# restrict to new reports if required:
if ( $ids_requiring_new->{$entry_id} ) {
$local_sql .= q! AND rr.status = 'new'!;
}
my $request_ids = $dbix->query($local_sql, @bind)->flat;
compile_reports($email_address, $request_ids) if @$request_ids;
}
# compile_reports('ra.jones@nhs.net', [139936]); # has chart
}
{ # tidy up cgisess files in /tmp from LIMS::Local::Reports session()
my @files = io('/tmp')->all_files; # get all files in /tmp
map $_->unlink, grep $_->filename =~ /\Acgisess_/, @files;
}
sub compile_reports {
my ($email_address, $request_ids) = @_;
for my $request_id (@$request_ids) { # warn $request_id;
my $report = $lims->format_report($request_id); # L::C::Roles::RecordHandler
# $report > io("reports/$request_id.pdf");
my $data
= $lims->model('Request')->get_referrer_department($request_id);
my $referrer_department = $data->{referrer_department};
my $subject = sprintf 'HMDS Report for %s / %s',
$referrer_department->{hospital_department}->{display_name}, # speciality
$referrer_department->{referrer}->{name}, # referrer
my $filename = sprintf '%02d_%05d.pdf',
$data->{year} - 2000,
$data->{request_number};
$mail{attachment} = $report;
$mail{recipient} = $email_address;
$mail{filename} = $filename;
$mail{subject} = $subject; # warn Dumper \%mail;
dispatch_report({ request_id => $request_id, message => \%mail });
}
}
sub dispatch_report {
my $args = shift;
my $request_id = $args->{request_id};
my $message = $args->{message};
my $rtn = LIMS::Model::Email->send_attachment($message); # returns hashref:
if ($rtn->{success}) {
print "$0 reports " . lc $rtn->{message} . ' to ' . $message->{recipient} . "\n";
my %data = (
request_id => $request_id,
recipient => $message->{recipient},
);
{ # log details in request_dispatch_log & request_history tables:
my $rtn = $lims->model('Request')->update_request_dispatch_log(\%data);
warn "Error in $0: $rtn" if $rtn;
}
}
else {
warn $rtn->{message};
$tools->mail_admin({ script => $0, msg => $rtn->{message} });
}
}
sub get_email_contacts {
my $sql = q!select * from email_contacts where type = 'report'!;
my $email_contacts = $dbix->query($sql)->hashes; # warn Dumper $email_contacts;
return $email_contacts;
}
sub get_department_locations { # locations requiring departmental reports
my $email_contacts = shift;
my @locations = keys %departments;
my %map;
CONTACT: for my $entry (@$email_contacts) {
next CONTACT unless $entry->{scope} eq 'department'
&& ( grep $entry->{display_name} eq $_, @locations );
my $location = $entry->{display_name};
my $location_id = $entry->{id};
my $department = $departments{$location};
$map{$location_id} = $department;
}
return \%map;
}
sub get_locations_requiring_new { # require 'new' reports only
my $email_contacts = shift;
my @ids;
CONTACT: for my $location (@$email_contacts) {
next CONTACT unless grep $location->{display_name} eq $_, @require_new;
push @ids, $location->{id};
}
my %map = map { $_ => 1 } @ids;
return \%map;
}
