#!/usr/bin/env perl
=begin #------------------------------------------------------------------------
* generates messages to registered recipients when new report available or updated
* includes request status (new/relapsed/default) to allow selective messaging
* excludes clinical trial samples
* select requests >5 mins old to allow for further updates within short time span
* runs every 30 (?) mins
* see __DATA__ section for sql queries
Event Triggers:
* New authorised report
* Any change to summary comment or diagnosis
* New Diagnosis
* Relapsed Diagnosis
* Manual Trigger (as in with the right permissions, the reporter can trigger
a notification to any recipient)
* New & relapsed diagnosis covered in new authorised report or diagnosis update
Any existing row only updated with a more recent datetime, using:
"ON DUPLICATE KEY UPDATE
datetime = IF(VALUES(datetime) > datetime, VALUES(datetime), datetime)"
*** see __DATA__ section for validation ****
#-------------------------------------------------------------------------------
=cut
BEGIN {
use constant DURATION => 1800; # default if no value passed as -t
use Getopt::Std;
getopts('t:'); # time (seconds)
our($opt_t);
} # warn $opt_t; exit;
my $JUST_TESTING = 1; # emails admin only
#===============================================================================
my $delta = $opt_t || DURATION; # warn $delta; # time window (seconds) to detect update
my $delay = 300; # seconds delay - to allow for reflection before sending notification
#===============================================================================
# delta value cannot be less than $delay (needs to be much greater to avoid risk
# of task repeating before previous instance finished, so set at 2x):
die "run frequency ($delta seconds) cannot be less than 2x delay time ($delay seconds)"
unless $delta >= $delay * 2;
my $dbname = $ENV{CENTRE} || 'hilis4'; # cron exports 'CENTRE' for non-HMDS tasks
use lib (
'/home/raj/perl5/lib/perl5',
'/home/raj/perl-lib',
);
use Local::DB;
use Modern::Perl;
use Config::Auto;
use Data::Printer;
use FindBin qw($Bin); # warn $Bin; exit;
use SQL::Abstract::More;
use lib "$Bin/../../../lib";
use LIMS::Local::ScriptHelpers;
$Local::QueryLogger::NO_QUERY_LOGS = 1; # don't need queries in logs dir
$Local::DBIx::Simple::Result::NO_AUTO_DATE_INFLATION = 1; # don't need DT object
# get tools from LIMS::Local::ScriptHelpers:
my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);
my $config = $tools->config(); # p $config;
my $table = 'request_notification';
my $sqla = SQL::Abstract::More->new;
my $dbix = Local::DB->dbix({dbname => $dbname});
# get user.id of server_username from config:
my $server_name = $config->{server_username};
my $user_id = $dbix->select('users', 'id', { username => $server_name })->value;
my $NOW = $tools->time_now;
# duration to detect a change of request status:
my $window = $NOW->clone->subtract( seconds => $delta ); # p $window;
# timepoint at time now minus delay:
my $t_max = $NOW->clone->subtract( seconds => $delay ); # p t_max;
# run update queries ===========================================================
{ # newly authorised requests within past $delta mins:
my @rels = (
'request_history|rh' => '=>rh.request_id = rt.request_id' ,
'request_trial|rt'
);
my @args = (
-columns => [ 'rh.request_id', 'rh.time|datetime' ],
-from => [ -join => @rels ],
-where => {
'rt.request_id' => undef,
'rh.action' => 'authorised',
'rh.time' => { '>=' => $window },
}
);
my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
# $dbix->dump_query($sql, @bind); exit;
my $result = $dbix->query($sql, @bind);
while ( my $ref = $result->hash ) {
# $ref->{status} = 'authorised';
$dbix->insert_or_update_if_greater($table, $ref, 'datetime');
}
}
{ # diagnosis update within past $delta mins:
my @rels = (
'requests|r' => 'r.status_option_id=so.id' ,
'status_options|so' => 'rdh.request_id = r.id' ,
'request_diagnosis_history|rdh' => '=>rt.request_id = r.id' ,
'request_trial|rt'
);
my @args = (
-columns => [ 'r.id|request_id', 'rdh.time|datetime' ],
-from => [ -join => @rels ],
-where => {
'rt.request_id' => undef,
'so.description' => { -in => [ 'authorised','complete' ] },
'rdh.time' => { '>=' => $window },
}
);
my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
my $result = $dbix->query($sql, @bind);
while ( my $ref = $result->hash ) {
# $ref->{status} = 'updated';
$dbix->insert_or_update_if_greater($table, $ref, 'datetime');
}
}
{ # results_summary update within past $delta mins - a bit slow ??
my @rels = (
'requests|r' => 'r.status_option_id=so.id' ,
'status_options|so' => 'rrs.request_id = r.id' ,
'request_result_summaries|rrs' => '=>rt.request_id = r.id' ,
'request_trial|rt'
);
my @args = (
-columns => [ 'r.id|request_id', 'rrs.time|datetime' ],
-from => [ -join => @rels ],
-where => {
'rt.request_id' => undef,
'so.description' => { -in => [ 'authorised','complete' ] },
'rrs.time' => { '>=' => $window },
}
);
my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
my $result = $dbix->query($sql, @bind);
while ( my $ref = $result->hash ) {
# $ref->{status} = 'updated';
$dbix->insert_or_update_if_greater($table, $ref, 'datetime');
}
}
my @req_ids = $dbix->select($table, 'request_id',
{ datetime => { '<' => $t_max } })->column; # say $_ for @req_ids; exit;
# @req_ids = (300001 .. 300005); # for testing
# get details for all request_id's =============================================
my @notifications = do {
my @cols = qw(
p.last_name
p.first_name
p.nhs_number
p.dob
r.id|request_id
rrv.status
pc.referral_source_id
rs.parent_organisation_id
ref.national_code|gmc_code
rd.hospital_department_code
); # r.request_number r.year ref.name|referrer rs.display_name|location
my @rels = (
'requests|r' => 'r.patient_case_id=pc.id' ,
'patient_case|pc' => 'pc.patient_id=p.id' ,
'patients|p' => 'pc.referral_source_id=rs.id' ,
'referral_sources|rs' => 'rrv.request_id=r.id' ,
'request_report_view|rrv' => 'r.referrer_department_id=rd.id' ,
'referrer_department|rd' => 'rd.referrer_id=ref.id' ,
'referrers|ref'
);
my @args = (
-columns => \@cols,
-from => [ -join => @rels ],
-where => { 'r.id' => { -in => \@req_ids } },
); # p @args;
my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
# $dbix->dump_query($sql, @bind); exit;
$dbix->query($sql, @bind)->hashes;
}; # p \@notifications;
=begin
Each selected request is checked for any registered recipient(s), message(s)
sent, then deleted from request_notification. Any row with timestamp more
recent than the delay (5 mins) will be processed by subsequent cycle.
=cut
for my $ref (@notifications) { # p $ref;
my @addr = _retrieve_addresses($ref);
_notify($ref, @addr) if @addr;
# delete row whether message sent or not:
$dbix->delete($table, { request_id => $ref->{request_id} });
}
#===============================================================================
sub _retrieve_addresses {
my $data = shift;
return $config->{email_from} if $JUST_TESTING;
my @cols = qw( hospital_department_code parent_organisation_id
referral_source_id gmc_code );
my ($department_id, $parent_id, $source_id, $gmc_number) = @{$data}{@cols};
my @where = (
{ type => 'organisation', identifier => $parent_id },
{ type => 'hospital', identifier => $source_id },
{ type => 'referrer', identifier => $gmc_number },
{ -and => [
department_id => $department_id,
[
{ type => 'organisation', identifier => $parent_id },
{ type => 'hospital', identifier => $source_id },
]
],
},
);
my @args = (
-columns => 'contact_address',
-from => 'report_notification',
-where => \@where,
); # p @args;
my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
# $dbix->dump_query($sql, @bind); exit;
my @addr = $dbix->query( $sql, @bind )->array;
return @addr;
}
sub _notify {
my ($data, @recipients) = @_; # href, array
my $message = sprintf '<%s/search/notification/%s>',
$config->{application_url}, $data->{request_id}; # p $message;
my $subject = $data->{status} eq 'new'
? 'HMDS new diagnosis report available'
: 'HMDS report available';
$subject .= sprintf ' [%s %s :: %s]',
ucfirst $data->{first_name}, uc $data->{last_name},
$data->{nhs_number} || $data->{dob}; # p $subject;
my $table = $JUST_TESTING ? 'lims_test.request_history' : 'request_history';
my %mail = (
config => $config,
subject => $subject,
message => $message,
); # p \%mail;
ADDR:
for my $addr (@recipients) {
warn "unsafe recipient address $mail{recipient}" and next ADDR
unless $addr =~ /\@nhs.net\Z/;
$mail{recipient} = $addr;
my $result = LIMS::Model::Email->send_message(\%mail); # Return::Value
if ( $result->type eq 'success' ) { # log
my %h = (
request_id => $data->{request_id},
user_id => $user_id,
action => 'dispatched report notification to ' . $addr,
);
$dbix->insert($table, \%h);
}
}
}
__DATA__
# test of ON DUPLICATE KEY UPDATE datetime:
# http://stackoverflow.com/questions/10081481/mysql-update-if-value-is-greater-than-that-current-value
$dbix->delete('test.'$table); # don't do this on live server !!
{ # insert row:
my $sql = qq!
INSERT INTO 'test.$table(request_id, datetime) VALUES(??)
ON DUPLICATE KEY UPDATE datetime
= IF(VALUES(datetime) > datetime, VALUES(datetime), datetime)
!;
my $res = $dbix->query($sql, 10, '2017-01-01 02:00:00'); say $res->rows;
}
say "check test.$table now"; sleep 5;
{ # earlier datetime - should *not* update:
my $sql = qq!
INSERT INTO 'test.$table(request_id, datetime) VALUES(??)
ON DUPLICATE KEY UPDATE datetime
= IF(VALUES(datetime) > datetime, VALUES(datetime), datetime)
!;
my $res = $dbix->query($sql, 10, '2017-01-01 01:00:00'); say $res->rows;
}
say "check test.$table now"; sleep 5;
{ # later datetime - *should* update:
my $sql = qq!
INSERT INTO 'test.$table(request_id, datetime) VALUES(??)
ON DUPLICATE KEY UPDATE datetime
= IF(VALUES(datetime) > datetime, VALUES(datetime), datetime)
!;
my $res = $dbix->query($sql, 10, '2017-01-01 03:00:00'); say $res->rows;
}
say "check test.$table now"; exit;
================================================================================
INSERT INTO $table
/* do not use request_status_view in cron - maybe exceeds /tmp capacity for tmp table */
SELECT rsv.request_id, rsv.time
FROM request_status_view rsv
LEFT JOIN request_trial rt on rt.request_id = rsv.request_id
WHERE rsv.time > DATE_SUB(NOW(), INTERVAL ? MINUTE)
and rsv.action = 'authorised'
and rt.request_id IS NULL
ON DUPLICATE KEY UPDATE datetime
= IF(VALUES(datetime) > datetime, VALUES(datetime), datetime)
INSERT INTO $table
SELECT rdh.request_id, rdh.time
FROM request_diagnosis_history rdh
JOIN requests r on rdh.request_id = r.id
LEFT JOIN request_trial rt on rt.request_id = r.id
WHERE rdh.time > DATE_SUB(NOW(), INTERVAL ? MINUTE)
and r.status_option_id IN (4,5)
and rt.request_id IS NULL
ON DUPLICATE KEY UPDATE datetime
= IF(VALUES(datetime) > datetime, VALUES(datetime), datetime)
INSERT INTO $table
SELECT rrs.request_id, rrs.time
FROM request_result_summaries rrs
JOIN requests r on rrs.request_id = r.id
LEFT JOIN request_trial rt on rt.request_id = r.id
WHERE rrs.time > DATE_SUB(NOW(), INTERVAL ? MINUTE)
and r.status_option_id IN (4,5)
and rt.request_id IS NULL
ON DUPLICATE KEY UPDATE datetime
= IF(VALUES(datetime) > datetime, VALUES(datetime), datetime)
SELECT contact_address
FROM notification_contacts
WHERE
( type = 'referrer' and identifier = ? ) or
( type = 'hospital' and identifier = ? ) or
( type = 'organisation' and identifier = ? ) or
( department = ? and (
( type = 'hospital' and identifier = ? ) or
( type = 'organisation' and identifier = ? )
) )
