#!/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
    
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; # 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::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 = (
	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, @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

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 array(ref):
	$args->{section} = $dbix->query( $SQL_FOR{results_summary}, $id )->flat;
	
	next REQUEST unless $tools->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};
        
    # add request.id to @ids to skip incomplete requests lookup:
    push @ids, $id;
}

# 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} } );
}

# dump to file for test:
#my $content = join "\n", @rows;
#$content > io('HILIS4_records_requiring_final_diagnosis.txt');

my $n = scalar @rows; # warn $n;
my $msg = $n
    ? ( join "\n", @rows )
    :  'no records found';

my %mail = (		
	config  => $config,
    subject => "HILIS records requiring final diagnosis [$n]",
    message => $msg,
); # 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;
}