• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/env perl

# alerts Outreach admins of low blood counts for Outreach patients
# requires heamatology result to be available at time of screening
# runs every 3 hrs

#===============================================================================
my @recipients = qw(rawstron martin raj);
my $low_hb_threshold   = 100;
my $low_plt_threshold  = 50;
#===============================================================================

use strict;
use warnings;

use lib '/home/raj/perl5/lib/perl5';

use FindBin qw($Bin); # warn $Bin; exit;
use Getopt::Std;
use Data::Printer;

use lib ("$Bin/../../../lib", '/home/raj/perl-lib');
use LIMS::Local::ScriptHelpers;

getopts('t:d:'); # testing, duration (hours)
our($opt_d,$opt_t); # warn $opt_d; exit;

# emails only raj:
my $JUST_TESTING = $opt_t || 0;
my $duration     = $opt_d || 3; # hours

# get tools from LIMS::Local::ScriptHelpers:
my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);

my $config = $tools->config();
my $dbix   = $tools->dbix;

my $sql = _get_query(); # p $sql;
my @results = $dbix->query($sql, $duration)->arrays; # p @results; exit;
exit unless @results;

for my $aref (@results) {
    my ($request_number, $year, $hb, $plts) = @$aref;
    my $labno = join '/', $request_number, $year - 2000;
    my $message = sprintf '%s: Hb = %s, Plts = %s',
        $labno, int $hb, int $plts;

    my %mail = (
        subject => 'Outreach patient low blood count alert',
        message => $message,
        config  => $config,
    ); # p %mail;
    $tools->send_mail(\%mail, \@recipients);
}

sub _get_query { # hb & plt vars don't work as '?' placeholders - WTF??
    return qq!
    SELECT r.request_number, r.year, rh2.hb, rh2.plt
    FROM requests r
        JOIN request_initial_screen ris on ris.request_id = r.id
        JOIN screens s on ris.screen_id = s.id
        JOIN request_history rh1 on rh1.request_id = r.id
        JOIN request_haematology rh2 on rh2.lab_number
            = CONCAT(r.year - 2000, '_', LPAD(r.request_number, 5, 0))
    WHERE rh1.`action` = 'screened'
        and rh1.time >= DATE_SUB(NOW(), INTERVAL ? HOUR)
        and s.description rlike 'outreach' /* to accommodate Outreach CML, etc */
        and ( rh2.hb < $low_hb_threshold or rh2.plt < $low_plt_threshold )!;
}