#!/usr/bin/perl
=begin -------------------------------------------------------------------------
emails XL list of MDS diagnoses (new & follow-up) over past week
=cut ---------------------------------------------------------------------------
use strict;
use warnings;
my $JUST_TESTING = 1; # email to ra.jones only
############ recipients from contacts.lib ######################################
my @recipients = qw( catherine.norton.secure raj.secure );
my $duration = 7; # over past number of days
################################################################################
BEGIN {
use FindBin qw($Bin); # warn $Bin;
use lib "$Bin/../../../lib";
}
use Data::Dumper;
use LIMS::Local::ScriptHelpers;
use Spreadsheet::WriteExcel::Simple;
#-------------------------------------------------------------------------------
my $today = DateTime->today->dmy;
my $from = DateTime->today->subtract( days => $duration )->dmy;
my $subject = "MDS diagnoses [$from to $today]";
my $filename = 'mds.xls';
# xl file headers:
my @headers = qw( lab_number last_name first_name case_number nhs_number dob
location diagnosis authorised status );
#-------------------------------------------------------------------------------
# get tools from LIMS::Local::ScriptHelpers:
my $tools = LIMS::Local::ScriptHelpers->new();
my $contacts = $tools->get_contacts();
my $sql_lib = $tools->sql_lib();
my $config = $tools->config();
my $dbix = $tools->dbix();
my @rows;
my $query = $sql_lib->retr('mds_diagnoses');
my $result = $dbix->query($query, $duration);
while (my $row = $result->array) { # warn Dumper $row; next;
push @rows, $row;
}
my %mail = (
config => $config,
subject => $subject,
);
if (@rows) {
my $xl = Spreadsheet::WriteExcel::Simple->new;
$xl->write_bold_row(\@headers);
$xl->write_row($_) for @rows;
$mail{attachment} = $xl->data;
$mail{filename} = $filename;
}
else {
$mail{message} = q!No MDS diagnoses were made during this period.!;
}
RECIPIENT:
foreach my $recipient (@recipients) {
my $email = $contacts->{$recipient} or next RECIPIENT; # in case doesn't exist
next RECIPIENT if $JUST_TESTING && $email !~ /ra\.jones/;
$mail{recipient} = $email; # warn Dumper $mail{recipient}; next;
if ($mail{attachment}) {
my $rtn = LIMS::Model::Email->send_attachment(\%mail); # returns hashref:
if ($rtn->{success}) {
print "$0 reports " . lc $rtn->{message} . " to $email\n";
}
else {
warn $rtn->{message};
}
}
else {
my $rtn = LIMS::Model::Email->send_message(\%mail);
warn "Error in $0: $rtn" if $rtn;
}
}