#!/usr/bin/perl =begin ------------------------------------------------------------------------- sends email alert for new diagnosis of dlbcl/burkitt lymphoma unless already done so =cut --------------------------------------------------------------------------- use strict; use warnings; ### recipients usernames (for non-secure info) ### my @recipients = qw(oconnor bradley turner raj); # ################################################## BEGIN { use FindBin qw($Bin); # warn $Bin; use lib "$Bin/../../../lib"; } use LIMS::Local::ScriptHelpers; use LIMS::Model::Email; use Data::Dumper; my $tools = LIMS::Local::ScriptHelpers->new(); # get tools from LIMS::Local::ScriptHelpers: 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' ); # email subject line: my $subject = 'DLBCL or Burkitt lymphoma diagnosis'; my $result = $dbix->query($requests); while (my $vars = $result->hash) { # warn Dumper $vars; next; next if already_sent_email($vars->{request_id}); my $msg = sprintf 'Case no H%s/%s has a diagnosis of DLBCL or Burkitt lymphoma.' . ' Further tests pending', $vars->{request_number}, $vars->{year} - 2000; my %mail = ( config => $config, message => $msg, subject => $subject, ); warn Dumper \%mail; next; foreach (@recipients) { warn Dumper $_; next; $mail{recipient} = $tools->get_email_address($_); warn Dumper $mail{recipient}; next; my $rtn = LIMS::Model::Email->send_message(\%mail); warn "Error in $0: $rtn" if $rtn; } # $dbix->do( insert into etc ) } sub already_sent_email { my $request_id = shift; # request_history lookup: }