• Files
• Commits
• Log
• Graph
• Stats

#!/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();
$tools->test_only($JUST_TESTING);

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;

$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;
}