#!/usr/bin/perl =begin ------------------------------------------------------------------------- sends details of outreach return-to-clinic patients to local MDT co-ordinator frequency: 2009: 23, 2010: 35, 2011: 43 =cut --------------------------------------------------------------------------- use strict; use warnings; my $JUST_TESTING = 0; # email to raj.secure only use lib '/home/raj/perl5/lib/perl5'; use Data::Dumper; use FindBin qw($Bin); # warn $Bin; use lib $Bin . '/../../../lib'; use LIMS::Local::ScriptHelpers; my $tools = LIMS::Local::ScriptHelpers->new(); $tools->test_only($JUST_TESTING); ############ recipients from contacts.lib ###################################### my $duration = 7; # over past number of days my $date_from = $tools->date_subtract(days => $duration); # warn $date_from; exit; my @recipients = map { $tools->recipient_address($_ . '.secure') } ('andy.rawstron', 'raj'); # warn Dumper \@recipients; ################################################################################ # get tools from LIMS::Local::ScriptHelpers: my $sql_lib = $tools->sql_lib(); my $config = $tools->config(); my $dbix = $tools->dbix(); # template: my $tt_file = 'cron/outreach_clinic_return.tt'; # email subject line: my $subject = 'Outreach patient returned to clinic'; # datetime converter: my $parse_date = sub { DateTime::Format::MySQL->parse_date(@_) }; # add raj.secure if testing and not already recipient (will be sole addressee) push @recipients, $tools->recipient_address('raj.secure') if ( $JUST_TESTING && ! grep { $_ eq $tools->recipient_address('raj.secure') } @recipients ); # warn Dumper \@recipients; my %mail = ( # common fields for email: config => $config, subject => $subject, ); my %args = ( prefix => $config->{lab_number_prefix}, format => $parse_date, data => {}, # replaced in loop ); my $sql = $sql_lib->retr('outreach_clinic_return_alert'); # warn $sql; my $result = $dbix->query($sql, $date_from->ymd); while ( my $vars = $result->hash ) { # warn Dumper $vars; my @contacts = split ',', $vars->{contacts}; # warn Dumper \@recipients; $args{data} = $vars; my $message_body = $tools->process_template($tt_file, \%args); $mail{message} = $message_body; # warn Dumper \%mail; for (@recipients, @contacts) { # warn $_; $mail{recipient} = $_; $tools->send_message(\%mail); } }