• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
# generates list of requests with diagnosis suggesting followup, then looks for
# subsequent samples on same patient.id - duration set for ( current month - 4 )
# to allow 3 full months for last request on 31st. Runs on 1st of month
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

my $JUST_TESTING = 0; # email to ra.jones only

use lib '/home/raj/perl5/lib/perl5';
use FindBin qw($Bin); # warn $Bin;
use lib "$Bin/../../../lib";

use IO::All;
use Data::Dumper;
use LIMS::Local::Utils;
use Date::Calc qw(Delta_Days);
use LIMS::Local::ScriptHelpers;

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

my $sql_lib = $tools->sql_lib();
my $config  = $tools->config();
my $today   = $tools->time_now; # yyyymmdd

#-------------------------------------------------------------------------------
my @recipients = map { $_ . '.secure' } qw(raj sheila.oconnor andrew.jack hmds);

my $months_ago = 4;

my @diagnoses = (
	'Inadequate sample',
	'Suspicious of malignancy but not diagnostic',
	'Diagnosis uncertain - further action required',
);
my @skip = ( # don't want these
    'Follow-up CML (PB)'
);
#-------------------------------------------------------------------------------

my $dbix = $tools->dbix();
my $date = $today->subtract( months => $months_ago );

# get hash of request.id => patient.id of diagnoses issued during period:
my $q1 = $sql_lib->retr('followup_requests_requiring');
# get follow-up requests on same patient.id (registration date > auth date)
my $q2 = $sql_lib->retr('followup_requests_followups');

my @data;

my $requests = $dbix->query($q1, $date->year, $date->month, @diagnoses);
REQ: while ( my $ref = $requests->hash ) {
    next REQ if grep $ref->{presentation} eq $_, @skip; # can't do multi (??)'s in sql 

    my $request_id = $ref->{id};
    my $patient_id = $ref->{patient_id}; # warn Dumper $patient_id;
    my $auth_date  = $ref->{authorised}; # warn Dumper $auth_date;

    my $followups = $dbix->query($q2, $patient_id, $auth_date)->hashes;
    
    # delta days (auth -> repeat registration):
	map { $_->{delta} = Delta_Days(
		( split '-', $ref->{authorised}   ), # from
		( split '-',   $_->{registered}   ), # to
	) } @$followups;     
    
    $ref->{followup} = $followups;
    push @data, $ref;
} # warn Dumper \%data;

my $subject = sprintf 'Diagnoses requiring followup samples for %s %s requests',
    $date->month_abbr, $date->year;

my $args = { date => $date, data => \@data };
my $message_body = $tools->process_template('cron/followup.tt', $args); # warn $message_body;
    # $message_body > io("$Bin/followup.html"); exit;

my %mail = (		
    subject => $subject,
    message => $message_body,
    content => 'html',
	config  => $config,
); # warn Dumper \%mail;

$tools->send_mail(\%mail, \@recipients);