#!/usr/bin/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 =cut --------------------------------------------------------------------------- use strict; use warnings; my $JUST_TESTING = 0; # email to ra.jones only ################################################################################ my @recipients = qw( sinclair douglas bagguley oconnor raj ); ################################################################################ BEGIN { use FindBin qw($Bin); # warn $Bin; use lib ( "$Bin/../../../lib", '/home/raj/perl5/lib/perl5', ); } use IO::All; use Data::Dumper; use LIMS::Local::Utils; # diagnosis_confirmation_required() 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 $src = $Bin . '/../../../config/.local/diagnosis_confirm.yml'; my $yaml = YAML::Tiny->read($src)->[0]; # warn Dumper $yaml; my $excluded_screens = $yaml->{exempt_all_sample_types}; # warn Dumper $excluded_screens; # sql for REQUEST block: my %SQL_FOR = ( lab_number => q!select request_number, year from requests where 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 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; # get list of request_ids where request authorised, status incomplete and have # molecular, cytogenetic or FISH result summary: my $request_ids = _get_request_ids(); # arrayref 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 => '', # str }; # 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 array(ref): $args->{section} = $dbix->query( $SQL_FOR{results_summary}, $id )->flat; next REQUEST unless LIMS::Local::Utils::diagnosis_confirmation_required($args); # get labno: $dbix->query( $SQL_FOR{lab_number}, $id )->into( my($req_number, $year) ); # warn Dumper [$request_number,$year]; push @rows, sprintf 'H%s/%s %s', $req_number, $year - 2000, $args->{screen}; } # dump to file for test: #my $content = join "\n", @rows; #$content > io('HILIS4_records_requiring_final_diagnosis.txt'); my $n = scalar @rows; my %mail = ( config => $config, subject => "HILIS records requiring final diagnosis [$n]", message => join "\n", @rows, ); # 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; }