#!/usr/bin/env perl
=begin
* generates messages to registered recipients when new report available or updated
* excludes clinical trial samples
* runs every 30 (?) mins
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 ****
Uses columns() and maybe hash_map() methods so needs Local::DB
TODO:
* how to register clinician?
- at request registration if request box checked (consultant/registrar/etc)
will require registered user on HILIS
- individual request - take email from logged-in user
- always for some clinicians?
* use insert_multi($new_table, [ +{ 1 => time, 2 => time, etc }], { ignore => 1 } # INSERT IGNORE query
* select requests from new table < 5 mins old - allows for 2 updates within short time span
* include request status (new/relapsed/default) to allow selective messaging
* checks for recipient(s), emails message(s), deletes entry
=cut
my $JUST_TESTING = 1;
#===============================================================================
my $delta = $ARGV[0] || 30; # warn $delta; # time window (mins) to detect update
my $delay = 5; # mins delay - to allow for reflection before sending notification
#===============================================================================
# delta value cannot be less than $delay (needs to be much greater or risk of
# task repeating before previous instance finished, so set at 2x):
die "run frequency ($delta mins) cannot be less than 2x delay time ($delay mins)"
unless $delta >= $delay * 2;
my $dbname = $ENV{CENTRE} || 'hilis4'; # cron exports 'CENTRE' if task not for HMDS
use lib (
'/home/raj/perl5/lib/perl5',
'/home/raj/perl-lib',
);
use Local::DB;
use Modern::Perl;
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 $table = 'request_notification';
my $sqla = SQL::Abstract::More->new;
my $dbix = Local::DB->dbix({dbname => $dbname});
# calculate timepoint at time now minus delay (preferably before queries run):
my $t_max = $tools->time_now->subtract( minutes => $delay ); # p t_max;
{ # newly authorised requests within past $delta mins:
my $sql = qq!
INSERT INTO $table
SELECT t1.request_id, t1.time
FROM request_status_view t1
LEFT JOIN request_trial rt on rt.request_id = t1.request_id
WHERE t1.time > DATE_SUB(NOW(), INTERVAL ? MINUTE)
and t1.action = 'authorised'
and rt.request_id IS NULL
ON DUPLICATE KEY UPDATE datetime
= IF(VALUES(datetime) > datetime, VALUES(datetime), datetime)
!;
$dbix->query($sql, $delta);
}
{ # diagnosis update within past $delta mins:
my $sql = qq!
INSERT INTO $table
SELECT t1.request_id, t1.time
FROM request_diagnosis_history t1
JOIN requests r on t1.request_id = r.id
LEFT JOIN request_trial rt on rt.request_id = r.id
WHERE t1.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)
!;
$dbix->query($sql, $delta);
}
{ # results_summary update within past $delta mins - a bit slow ??
my $sql = qq!
INSERT INTO $table
SELECT t1.request_id, t1.time
FROM request_result_summaries t1
JOIN requests r on t1.request_id = r.id
LEFT JOIN request_trial rt on rt.request_id = r.id
WHERE t1.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)
!;
$dbix->query($sql, $delta);
}
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 TODO: may not need all cols:
my %notifications = do {
my @cols = qw(
p.last_name
p.first_name
p.nhs_number
p.dob
r.id|request_id
r.request_number
r.year
pc.referral_source_id
rs.display_name|location
rs.parent_organisation_id
ref.name|referrer
rd.hospital_department_code
);
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' => '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)->map_hashes('request_id'); # could also use hash_map()
}; # 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
while ( my($req_id, $data) = each %notifications ) { p $data;
# send notification to registered recipient:
# delete request_id:
$dbix->delete($table, { request_id => $req_id });
}
__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;
