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