#!/usr/bin/env perl
=begin -------------------------------------------------------------------------
records requiring final diagnosis confirmation (see .local/diagnosis_confirm.yml):
1) has no outstanding tests
2) has a cytogenetics, molecular or FISH results summary
3) request is authorised
4) request.status <> 'complete'
excluded if screened as:
Rheumatoid arthritis / Rituximab (RA) monitoring
Molecular miscellaneous
Roche Gallium trial
Chimerism sample
PNH / PNH (PB)
OR:
CML follow-up on PB sample
CMPD pres & follow-up on PB sample with JAK2 as sole test
Also sets request status to complete if status = authorised, has no outstanding
tests and NOT in incomplete_requests list ie requires final diagnosis/confirmation
=cut ---------------------------------------------------------------------------
use strict;
use warnings;
my $JUST_TESTING = 0; # dumps HTML file to $Bin/incomplete.html; no emails or db update
################################################################################
my @recipients = qw( hmds.secure raj ); # sinclair douglas bagguley oconnor
################################################################################
use lib '/home/raj/perl5/lib/perl5';
use IO::All;
use Data::Dumper;
use DateTime::Format::MySQL;
use FindBin qw($Bin); # warn $Bin;
use lib "$Bin/../../../lib";
use LIMS::Local::ScriptHelpers;
# get tools from 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 $dbix = $tools->dbix();
my $yaml = $tools->get_yaml_file('diagnosis_confirm'); # warn Dumper $yaml; exit;
my $excluded_screens = $yaml->{exempt_all_sample_types}; # warn Dumper $excluded_screens;
my $dump_file = "$Bin/incomplete.html"; # for use if JUST_TESTING
my $template = 'cron/incomplete_requests.tt';
# reset dump_file:
io($dump_file)->unlink if -e $dump_file;
# sql for REQUEST block:
my %SQL_FOR = (
results_summary => $sql_lib->retr('incomplete_requests_results_summary'),
request_report => $sql_lib->retr('incomplete_requests_request_report'),
initial_screen => $sql_lib->retr('incomplete_requests_initial_screen'),
request_ids => $sql_lib->retr('incomplete_requests_request_ids'),
lab_tests => $sql_lib->retr('incomplete_requests_lab_tests'),
specimen => $sql_lib->retr('incomplete_requests_specimen'),
); # warn Dumper \%SQL_FOR;
my (%h, @ids);
# get list of request_ids where request authorised, status incomplete and have
# molecular, cytogenetic or FISH result summary:
my $request_ids = _get_request_ids(); # warn Dumper scalar @$request_ids; # arrayref
my $dfm = DateTime::Format::MySQL->new();
REQUEST:
for my $id (@$request_ids) { # warn $id; next;
my $args = {
specimen => [], # array(ref) of sample_codes
lab_test => [], # AoH (keys = test_name & status)
section => [], # array(ref) of lab_section names
screen => undef, # str
yaml => $yaml,
};
# get initial_screen:
$dbix->query( $SQL_FOR{initial_screen}, $id )->into( $args->{screen} );
# get specimen(s) array(ref):
$args->{specimen} = $dbix->query( $SQL_FOR{specimen}, $id )->flat;
# get lab_tests (AoH):
$args->{lab_test} = $dbix->query( $SQL_FOR{lab_tests}, $id )->hashes;
{ # get results_summary section names => result_summary timestamp (AoH):
my $sections = $dbix->query( $SQL_FOR{results_summary}, $id )->hashes;
# convert mysql datetime to datetime object:
$_->{time} = $dfm->parse_datetime($_->{time}) for @$sections;
$args->{section} = $sections;
}
# get report data:
my $req = $dbix->query( $SQL_FOR{request_report}, $id )->hash;
# add authorisation date (as dt object) for comparison to result summary date:
$args->{authorisation_date} = $dfm->parse_datetime($req->{auth_date});
next REQUEST unless $tools->diagnosis_confirmation_required($args);
my $reporter = $req->{report_by};
push @{ $h{$reporter} }, $req;
# add request.id to @ids to skip incomplete requests lookup:
push @ids, $id unless $JUST_TESTING; # don't do db updates if testing
} # warn Dumper \%h;
# get list of requests where status = authorised (excluding those requiring final diagnosis):
my $authorised_requests = _get_authorised_requests(\@ids); # warn Dumper $authorised_requests;
my $status_option_id = _complete_status_option_id(); # id of 'complete'
DATA: # skip any requests with outstanding tests - set rest to status = complete:
for my $data( @$authorised_requests ) {
my $lab_test = $dbix->query( $SQL_FOR{lab_tests}, $data->{id} )->hashes;
my @status = map $_->{status}, @$lab_test; # warn Dumper \@status;
next DATA if grep $_ ne 'complete', @status; # skip if ANY test status NOT complete
# now have authorised case with no outstanding lab-tests, not requiring
# final diagnosis/confirmation, so set request status to 'complete':
my %h = (
status_option_id => $status_option_id,
updated_at => $data->{updated_at}, # preserve to avoid triggering unnecessary report
); # warn $data->{id};
$dbix->update( 'requests', \%h, { id => $data->{id} } );
}
my %mail = ( config => $config, content => 'html' );
while ( my($reporter, $d) = each %h ) {
my %tt_params = ( reporter => $reporter, data => $d );
my $msg = $tools->process_template($template, \%tt_params);
$mail{message} = $msg; # warn Dumper $msg; next;
$mail{subject} = sprintf 'HILIS records requiring final diagnosis '
. 'confirmation [%s]', uc $reporter;
$JUST_TESTING # dump to file only if just testing
? $msg >> io("$Bin/incomplete.html")
: $tools->send_mail(\%mail, \@recipients);
}
sub _get_request_ids {
my $sql = $SQL_FOR{request_ids}; # warn $sql;
my $request_ids = $dbix->query($sql, @$excluded_screens)->flat; # warn Dumper $request_ids;
return $request_ids;
}
sub _get_authorised_requests {
my $ids = shift;
return unless @$ids; # or we'll die here:
my $sql = $sql_lib->retr('authorised_requests'); # warn $sql;
my $requests = $dbix->query($sql, @$ids)->hashes; # warn Dumper $requests;
return $requests;
}
sub _complete_status_option_id {
my $sql = q!select id from status_options where description = 'complete'!;
$dbix->query($sql)->into(my $id);
return $id;
}
