#!/usr/bin/perl =begin ------------------------------------------------------------------------- emulates function of email_alert() for records matching complex rules: notification of: new/relapsed diagnosis where age <= 25 and authorised yesterday to: Teenage & Young Adult Oncology email contact (age 15 - 25) Paediatric email contact (age < 18) =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 from contacts.lib ###################################### my $duration = $opt_d || 1; # days my @young_adult = qw( young.adult.secure ); # 15 - 25 yo my @paediatric = qw( paediatrics.secure ); # < 18 yo my @cc = qw( ); # raj.secure ################################################################################ use lib '/home/raj/perl5/lib/perl5'; use Data::Dumper; use FindBin qw($Bin); # warn $Bin; use lib $Bin . '/../../../lib'; use LIMS::Local::ScriptHelpers; my $tools = LIMS::Local::ScriptHelpers->new(); $tools->test_only($JUST_TESTING); # get tools from LIMS::Local::ScriptHelpers: my $sql_lib = $tools->sql_lib(); my $config = $tools->config(); my $dbix = $tools->dbix(); # get sql statment: my $requests = $sql_lib->retr( 'juvenile_diagnosis_status_alert' ); # template: my $tt_file = 'request/message/body.tt'; # email subject line: my $subject = 'HMDS Diagnosis Status Notice'; # HMDS.LTH user_id for request_history: my $service_user = $tools->get_server_user_details(); my $result = $dbix->query($requests, $duration); while (my $vars = $result->hash) { # warn Dumper $vars; next; my $data = $tools->get_diagnosis_alert_data($vars); my $message_body = $tools->process_template($tt_file, $data); my %mail = ( config => $config, message => $message_body, subject => $subject, ); # warn Dumper \%mail; next; # reset @contacts: my @contacts = qw(); # query retrieves patients <= 25 yo: push @contacts, @paediatric if $vars->{age} < 18; push @contacts, @young_adult if $vars->{age} >= 15; next unless @contacts; # probably never, but JIC my $ok = $tools->send_mail(\%mail, [ @contacts, @cc ]); if ($ok and not $JUST_TESTING) { # log to request_history: my %args = ( request_id => $vars->{request_id}, user_id => $service_user->{id}, action => 'e-mailed diagnosis alert', ); $tools->log_diagnosis_alert(\%args, \@contacts); } }