#!/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 " 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 }