• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
sends notification of new/relapsed diagnosis to email_contacts.contact_address
where type = MDT
records request_history.action = "e-mailed diagnosis status alert to <email>"
=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 FindBin qw($Bin); # warn $Bin;
    use lib (
        "$Bin/../../../lib",
        '/home/raj/perl5/lib/perl5',
    );
    # override default db test:
    $ENV{ROSEDB_DEVINIT} = "$Bin/../../../config/rosedb_devinit_prod.pl";
}

use LIMS::Local::EmailAlert;
use LIMS::Local::ScriptHelpers;
use Data::Dumper;

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( 'diagnosis_status_alerts' ); # warn $sql;
    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; next;
    
        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
}