#!/usr/bin/perl =begin ------------------------------------------------------------------------- sends notification of new/relapsed diagnosis for any requests without 'e-mailed diagnosis status alert' notification entry in request_history (assume authoriser forgot to send it) =cut --------------------------------------------------------------------------- use strict; use warnings; #======== WOULD NEED TO OVERRIDE CONTACT DETAILS IN email_contacts TABLE ======= my $JUST_TESTING = 0; #=============================================================================== #=============================================================================== my $delta = 1; # days ago #=============================================================================== BEGIN { use lib '/home/raj/perl5/lib/perl5'; # *must* come before FindBin($Bin) use FindBin qw($Bin); # warn $Bin; exit; use lib $Bin . '/../../../lib'; # override default db test: $ENV{ROSEDB_DEVINIT} = "$Bin/../../../config/rosedb_devinit_prod.pl"; } use Data::Dumper; use LIMS::Local::EmailAlert; use LIMS::Local::ScriptHelpers; # override default db test: $ENV{ROSEDB_DEVINIT} = "$Bin/../../../config/rosedb_devinit_prod.pl"; 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(); # substitutes LIMS methods required by C::Roles::RecordHandler: my $lims = LIMS::Local::EmailAlert->new({tools => $tools}); # get unique MDT centres from email_contacts table: my $mdt_centres = _get_unique_mdt_centres(); # warn Dumper $mdt_centres; exit; { # go: my $sql = $sql_lib->retr( 'unsent_diagnosis_status_alerts' ); my $result = $dbix->query($sql, $delta); REQUEST: while ( my $vars = $result->hash ) { # warn Dumper $vars; next; # get MDT centre if match exists in email_contacts table (maybe non-local case): my $mdt_centre = _get_mdt_centre($vars) || next REQUEST; # warn $mdt_centre; my %args = ( # args for LIMS::Local::EmailAlert::email_alert() request_id => $vars->{request_id}, mdt_centre => $mdt_centre, ); # warn Dumper \%args; my $rtn = $lims->email_alert(\%args); # returns msg only on error warn $rtn if $rtn; } } sub _get_unique_mdt_centres { my %saw; # get unique and active email_contact display_names: my $o = $lims->model('ReferralSource')->get_mdt_email_contacts; # warn Dumper $o; my @mdt_centres = grep { ! $saw{$_->display_name}++ } @$o; return \@mdt_centres; } sub _get_mdt_centre { my $vars = shift; # same logic as request/email_alert.tt for my $ctr (@$mdt_centres) { my $mdt_centre = $ctr->display_name; my $ref_src_id = $ctr->referral_source_id; my $parent_id = $ctr->referral_source->parent_organisation_id; # if request.ref_src.parent_organisation_id = mdt_centre.parent_organisation_id if ( $ctr->scope eq 'organisation' # do this 1st as hospital also matches && $vars->{parent_organisation_id} == $parent_id ) { return $mdt_centre; } # if request.ref_src_id = mdt_centre.ref_src_id elsif ( $ctr->scope eq 'hospital' && $vars->{ref_src_id} == $ref_src_id ) { return $mdt_centre; } } return 0; # no matches; triggers 'next' request }