• Files
• Commits
• Log
• Graph
• Stats

#!/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);
    }
}