#!/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 Rheumatoid arthritis 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 = 1; # email to ra.jones only ################################################################################ my @recipients = qw( sinclair douglas bagguley oconnor raj ); my @excluded_screens = ( 'Molecular miscellaneous', 'Chimerism sample', 'PNH', 'Rheumatoid arthritis' ); # skip these screens ################################################################################ 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(); my $sql_lib = $tools->sql_lib(); my $config = $tools->config(); my $dbix = $tools->dbix(); # 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; RECIPIENT: foreach my $recipient (@recipients) { my $email = $tools->get_email_address($recipient) || next RECIPIENT; # warn Dumper $email; next; next RECIPIENT if $JUST_TESTING && $email !~ /ra\.jones/; $mail{recipient} = $email; my $rtn = LIMS::Model::Email->send_message(\%mail); warn "Error in $0: $rtn" if $rtn; } 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; }