#!/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 ALL/B-ALL/T-ALL email alert'; # action_previous_version so that old query still picks up B-ALL history # entries my $action_previous_version = 'dispatched a Suspected B-ALL email alert'; # email subject line: my $subject = 'Suspected ALL/B-ALL/T-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 in (?,?)'; 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, $action_previous_version)->list; my $labno = sprintf 'H%s/%s', $vars->{request_number}, $vars->{year} - 2000; $mail{message} = sprintf $message, $labno, $vars->{description}; if (not $JUST_TESTING) { $tools->send_mail(\%mail, \@recipients); $log{request_id} = $request_id; $dbix->insert('request_history', \%log); } } sub _query { my @cols = qw( r.id|request_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 %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); }