#!/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: Molecular miscellaneous Chimerism sample PNH / PNH (PB) Rheumatoid arthritis / Rituximab (RA) monitoring 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 ################################################################################ my @recipients = qw( sinclair douglas bagguley oconnor raj ); ################################################################################ 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; # sql for REQUEST block: my %SQL_FOR = ( request_report => q!select r.request_number, r.year, d.name as 'diagnosis', max(case when rs.action = 'reported' then rs.username end) as 'report_by', max(case when rs.action = 'reported' then rs.time end) as 'report_date', max(case when rs.action = 'authorised' then rs.username end) as 'auth_by', max(case when rs.action = 'authorised' then rs.time end) as 'auth_date' from requests r join request_status_view rs on rs.request_id = r.id join ( request_report_view rr join diagnoses d on rr.diagnosis_id = d.id ) on rr.request_id = r.id where r.id = ?!, initial_screen => q!select s.description from request_initial_screen ris join screens s on ris.screen_id = s.id where ris.request_id = ?!, specimen => q!select sample_code from request_specimen rs join specimens s on rs.specimen_id = s.id where rs.request_id = ?!, results_summary => q!select ls.section_name, rrs.time from request_result_summaries rrs join lab_sections ls on rrs.lab_section_id = ls.id where rrs.request_id = ?!, lab_tests => q!select lt.test_name, so.description as 'status' from requests r join request_lab_test_status rs on rs.request_id = r.id join lab_tests lt on rs.lab_test_id = lt.id join lab_test_status_options so on rs.status_option_id = so.id where r.id = ?!, ); my (@rows, @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); push @rows, $req; # add request.id to @ids to skip incomplete requests lookup: push @ids, $id unless $JUST_TESTING; # don't do db updates if testing } # 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 $n = scalar @rows; # warn $n; my $message_body = $n ? $tools->process_template('cron/incomplete_requests.tt', { data => \@rows }) : 'no records found'; if ($JUST_TESTING) { $message_body > io("$Bin/incomplete.html"); exit; } my %mail = ( config => $config, subject => "HILIS records requiring final diagnosis confirmation [$n]", content => $n ? 'html' : undef, message => $message_body, ); # warn Dumper \%mail; $tools->send_mail(\%mail, \@recipients); sub _get_request_ids { my $sql = $sql_lib->retr('incomplete_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; }