• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
sends notification of new/relapsed and possible new diagnosis to MDT contact

possible new diagnosis: presentation = non-(trial/PNH/HIV/Outreach/Rituximab) &&
diagnosis = ICDO3 (non-MGUS) && request.status = default && no previous record
on same patient.id

records request_history.action = "e-mailed diagnosis status alert to <email>"

TODO: ignores 'see comments' for possible new diagnosis; misses diagnosis change
from non-ICDO3 to ICDO3 after day of authorisation; misses 1st use of icdo3 where
a previous non-icdo3 exists
=cut ---------------------------------------------------------------------------

use Getopt::Std;
getopts('d:'); # days
our($opt_d); # warn $opt_d; exit;

use strict;
use warnings;

#======== WOULD NEED TO OVERRIDE CONTACT DETAILS IN email_contacts TABLE =======
my $JUST_TESTING = 0;
#===============================================================================

#===============================================================================
my $delta = $opt_d || 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;

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;

{ # get new & relapsed diagnoses:
    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;
    }
}

{ # get possible new diagnoses (status = 'default' with no previous request):
    my $result = do {
        my $sql = $sql_lib->retr( 'potential_new_diagnosis' ); # warn $sql;
        $dbix->query($sql, $delta);
    };

    # query to find previous requests on same patient.id:
    my $query = q!select count(*) from requests r join patient_case pc on
        r.patient_case_id = pc.id where pc.patient_id = ? and date(r.created_at)
        < ?!;

    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;

        { # next if previous record exists on same patient.id:
            my @bind = ( $vars->{patient_id}, $vars->{registered} );
            next REQUEST if $dbix->query($query, @bind)->list;
        }

        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
}