• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
sends email alert for new diagnosis of DLBCL/Burkitt unless one already sent
=cut ---------------------------------------------------------------------------

use Getopt::Std;
getopts('d:'); # days
our($opt_d); # warn $opt_d; exit;

use strict;
use warnings;

my $JUST_TESTING = 0; # email to ra.jones only

### recipients usernames (for non-secure info) ################
my @recipients = qw(oconnor turner raj);                      #
###############################################################

use lib '/home/raj/perl5/lib/perl5';
use Data::Dumper;

use FindBin qw($Bin); # warn $Bin;
use lib $Bin . '/../../../lib';
use LIMS::Local::ScriptHelpers;

#-------------------------------------------------------------------------------
# action col entry for request_history SELECT & INSERT queries:
my $action = 'dispatched DLBCL/Burkitt lymphoma email alert';
# email subject line:
my $subject = 'DLBCL or Burkitt lymphoma diagnosis';
# email body:
my $message = 'Case no %s has a diagnosis of DLBCL or Burkitt lymphoma. '
	. 'Further tests pending';
# past x days:
my $duration = $opt_d || 1; # days
#-------------------------------------------------------------------------------

# get tools from LIMS::Local::ScriptHelpers:
my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);

my $sql_lib = $tools->sql_lib();
my $config  = $tools->config();
my $dbix    = $tools->dbix();

# get sql statments:
my $requests = $sql_lib->retr( 'dlbcl_or_burkitt_diagnosis' );

# server username:
my $server_user = $tools->get_server_user_details();

my %log = ( # common fields for request_history log:
    user_id => $server_user->{id},
    action  => $action,
); # warn Dumper \%log; exit;

my %mail = ( # common fields for email:
	config  => $config,
	subject => $subject,
); # warn Dumper \%mail; exit;

# request_history lookup:
my $sql = 'select 1 from request_history where request_id = ? and action = ?';

my $result = $dbix->query($requests, $duration);
CASE: while ( my $vars = $result->hash ) { # warn Dumper $vars; next;
    my $request_id = $vars->{request_id};
    # skip if already sent email alert:
	next CASE if $dbix->query($sql, $request_id, $action)->list;

    my $labno = sprintf 'H%s/%s', $vars->{request_number}, $vars->{year} - 2000;
    $mail{message} = sprintf $message, $labno;

    $tools->send_mail(\%mail, \@recipients);

    $log{request_id} = $request_id;
	$dbix->insert('request_history', \%log);
}