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