#!/usr/bin/perl =begin ------------------------------------------------------------------------- emails XL list of myelodysplastic & myeloproliferative diagnoses (new & follow-up) for LTH & Calderdale trusts, over past week =cut --------------------------------------------------------------------------- use strict; use warnings; my $JUST_TESTING = 1; # email to ra.jones only ############ recipients from contacts.lib ####################################### my @recipients = qw( sharon.heathcote.secure raj.secure ); ################################################################################ BEGIN { use FindBin qw($Bin); # warn $Bin; use lib "$Bin/../../../lib"; } use Data::Dumper; use LIMS::Local::ScriptHelpers; use Spreadsheet::WriteExcel::Simple; #------------------------------------------------------------------------------- my $last_month = DateTime->today->subtract( months => 1 ); my $subject = sprintf 'Myeloid diagnoses for Leeds & Calderdale [%s.%s]', $last_month->month_abbr, $last_month->year; my $filename = 'myeloid.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('myeloid_diagnoses'); my $result = $dbix->query($query, $last_month->month, $last_month->year); 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 myeloid 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; } }