#!/usr/bin/perl
=begin -------------------------------------------------------------------------
sends a list of requests (non-trial) where referrer (clinician/GP) unknown
runs weekly, and on 1st day of month (substitutes 7 day for 1 month in sql)
=cut ---------------------------------------------------------------------------
use strict;
use warnings;
my $JUST_TESTING = 1; # email to ra.jones only
##### recipients usernames (for non-secure info) ####
my @recipients = qw(douglas sinclair bagguley raj); #
my $duration = 7; #
#####################################################
BEGIN {
use FindBin qw($Bin); # warn $Bin;
use lib "$Bin/../../../lib";
}
use Data::Dumper;
use DateTime::Format::MySQL;
use LIMS::Local::ScriptHelpers;
my $tools = LIMS::Local::ScriptHelpers->new();
# get tools from LIMS::Local::ScriptHelpers:
my $sql_lib = $tools->sql_lib();
my $config = $tools->config();
my $dbix = $tools->dbix();
my $query = $sql_lib->retr( 'unknown_referrers' );
# email subject line:
my $subject = 'Unknown referrers for ' . DateTime->today->dmy;
# check date - if 1st of month, change '7 day' to '1 month' in query:
if (DateTime->today->day == 1) {
$query =~ s/(INTERVAL \?) DAY/$1 MONTH/;
$duration = 1;
}
my @rows;
my $result = $dbix->query($query, $duration);
while (my $vars = $result->hash) { # warn Dumper $vars; next;
my $lab_no = sprintf '%s%s/%s',
$config->{lab_number_prefix},
$vars->{request_number},
$vars->{year} - 2000;
my $row = sprintf '%-10s %-12s %s',
$lab_no,
DateTime::Format::MySQL->parse_datetime($vars->{created_at})->dmy,
$vars->{display_name};
$row .= ' [WILL NOT BE BILLED]' if $vars->{display_name} =~ /unknown/;
push @rows, $row;
}
my $message_body = join "\n", @rows;
my %mail = (
config => $config,
message => $message_body,
subject => $subject,
); # warn Dumper \%mail; # next;
RECIPIENT:
foreach my $recipient (@recipients) {
my $email = $tools->get_email_address($recipient); warn Dumper $email; next;
next RECIPIENT if $JUST_TESTING && $email !~ /ra\.jones/;
$mail{recipient} = $email;
my $rtn = LIMS::Model::Email->send_message(\%mail);
warn "Error in $0: $rtn" if $rtn;
}