#!/usr/bin/env perl =begin ------------------------------------------------------------------------- # generates list of requests with diagnosis suggesting follow-up, then looks for # subsequent samples on same patient.id; duration set for ( current month - 4 ) # to allow 3 full months from last day of month under scrutiny. =cut --------------------------------------------------------------------------- use strict; use warnings; my $JUST_TESTING = 0; # email to ra.jones only use lib '/home/raj/perl5/lib/perl5'; use IO::All; use Data::Dumper; use Date::Calc qw(Delta_Days); use FindBin qw($Bin); # warn $Bin; use lib "$Bin/../../../lib"; use LIMS::Local::Utils; 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);