• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
# generates list of requests with diagnosis requiring followup, then looks for
# followup samples on same patient.id - duration set for current month - 3 months
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

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();

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

#-------------------------------------------------------------------------------
my @recipients = qw(raj);

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;

    $data{$request_id} = $ref;
    
    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;     
    
    $data{$request_id}{followup} = $followups;
} # 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('./followup.html');

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

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