• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/env perl

=begin -------------------------------------------------------------------------
sends email alert for requests screened as Suspected B-ALL (25 or under & over 25)
=cut ---------------------------------------------------------------------------

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

use strict;
use warnings;

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

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

use lib '/home/raj/perl5/lib/perl5';
use Data::Printer;
use SQL::Abstract::More;

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 a suspected B-ALL email alert';
# email subject line:
my $subject = 'Suspected B-ALL request';
# email body:
my $message = 'Request %s has been screened as %s';
# 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 $config  = $tools->config();
my $dbix    = $tools->dbix();

# get sql statments:
my ($sql, @bind) = _query();

# 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,
); # p %log; exit;

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

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

my $result = $dbix->query($sql, @bind);
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($rh, $request_id, $action)->list;

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

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

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

sub  _query {
    my @cols = qw( r.id r.request_number r.year s.description );
    my @rels = (                    'requests|r'                 ,
        'rsv.request_id=r.id'   =>  'request_status_view|rsv'    ,
        'ris.request_id=r.id'   =>  'request_initial_screen|ris' ,
        'ris.screen_id=s.id'    =>  'screens|s'                  ,
    );
    my %where = (
        'DATE(rsv.time)' => $tools->date_subtract( days => $duration )->ymd,
        'rsv.action'     => 'screened',
        's.description'  => { -like => 'Suspected B-ALL %' },
    );
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => \%where,
    ); # p @args;
    my ($sql, @bind) = SQL::Abstract::More->new->select(@args); # p $sql; p \@bind;
         $dbix->dump_query($sql, @bind) if $opt_q; # exit;
    return ($sql, @bind);
}