#!/usr/bin/env perl

=begin -------------------------------------------------------------------------
requests requiring confirmation of diagnosis (see .local/diagnosis_confirm.yml):

1) request is authorised
2) has no outstanding tests
3) request.status <> 'complete'
4) has a cytogenetics, molecular or FISH results summary timestamp AFTER auth date

screening terms with/without sample types and clinical trials which are exempt
from requiring diagnosis confirmation are defined in diagnosis_confirm.yml

Also sets request status to complete if status = authorised, has no outstanding
tests and NOT in incomplete_requests list ie requiring diagnosis confirmation
#---------------------------------------------------------------------------

# TODO: write .t then move to Local::DB & retest
=cut

use Getopt::Std;
getopts('t'); # testing
our($opt_t);

use strict;
use warnings;
use feature 'say';

my $JUST_TESTING = $opt_t || 0; # dumps HTML file to $Bin/incomplete.html; no emails or db update

#-------------------------------------------------------------------------------
my @recipients = qw( hmds.secure ); # raj sinclair douglas bagguley oconnor
#-------------------------------------------------------------------------------

use lib qw(
    /home/raj/perl5/lib/perl5
    /home/raj/perl-lib
);

use IO::All;
use Data::Printer;
use SQL::Abstract::More;

use FindBin qw($Bin); # warn $Bin;
use lib "$Bin/../../../lib";
use LIMS::Local::ScriptHelpers;
use Local::DB; # using date auto-inflation

# get tools from LIMS::Local::ScriptHelpers:
my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);

my $config  = $tools->config();

my $yaml = $tools->get_yaml_file('diagnosis_confirm'); # p $yaml; exit;
my $dbix = Local::DB->dbix({dbname => 'hilis4'}); # only in use by Leeds
my $sqla = SQL::Abstract::More->new;

my $excluded_screens = $yaml->{exempt_all_sample_types}; # p $excluded_screens;
my $excluded_trials  = $yaml->{exempt_clinical_trials};  # p excluded_trials;
# lab sections requiring confirmation of diagnosis:
my $lab_sections = $yaml->{lab_sections}; # p $lab_sections;

my $template  = 'cron/incomplete_requests.tt';
my $dump_file = "$Bin/incomplete.html"; # for use if JUST_TESTING
# reset dump_file:
io($dump_file)->unlink if -e $dump_file;

# get list of request_ids where request authorised, status incomplete and have
# molecular, cytogenetic or FISH result summary:
my $request_ids = _get_request_ids(); # p scalar @$request_ids; # arrayref

# globals:
my (
    %h,                     # reporter => request data
    %all_lab_tests,         # request.id => test_name & status
    @requires_confirmation, # request id's requiring confirmation
);

REQUEST:
for my $id (@$request_ids) { # p $id;  next unless $id == 241124;
	# data for determining whether diagnosis confirmation is required:
	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
        trial    => undef, # str (optional)
		yaml     => $yaml,
	};

    # get clinical trial:
    $args->{trial} = _get_clinical_trial($id); # p $args;
	# get initial_screen:
    $args->{screen} = _get_initial_screen($id); # p $args;
	# get specimen(s) array(ref):
	$args->{specimen} = _get_specimen_code($id);
	# get lab_tests (AoH):
	$args->{lab_test} = _get_lab_tests($id);
	# get results_summary section names => result_summary timestamp (AoH):
    $args->{section} = _get_rs_section_datetime($id);
	# get report data:
	my $req = _get_request_report($id);
	# add authorisation date for comparison to result summary date:
	$args->{authorisation_date} = $req->{auth_date};
	# next request if diagnosis confirmation NOT required:
	next REQUEST unless $tools->diagnosis_confirmation_required($args);

    my $reporter = $req->{report_by}; # p $reporter; next REQUEST;
	push @{ $h{$reporter} }, $req;

	next REQUEST if $JUST_TESTING; # don't want to update db

    # add to @requires_confirmation for use in _get_authorised_requests() query:
    push @requires_confirmation, $id; # ie diagnosis confirmation IS required
} # p %h; p @requires_confirmation;

my %mail = ( config  => $config, content => 'html' );

# email messages:
REPORTER:
while ( my($reporter, $d) = each %h ) {
    my %tt_params = ( reporter => $reporter, data => $d );
    my $msg = $tools->process_template($template, \%tt_params);
### uncomment next line to dump to file and NOT send email:
	# $msg >> io("$Bin/incomplete.html"); next REPORTER; die;

    $mail{message} = $msg; # p $msg; next REPORTER;
    $mail{subject} =
		sprintf 'HILIS records requiring confirmation of diagnosis on %s [%s]',
			$tools->time_now->dmy, uc $reporter;

    $JUST_TESTING # dump to file only if just testing
        ? $msg > io("/tmp/${reporter}_incomplete.html")
        : $tools->send_mail(\%mail, \@recipients);
}

set_request_status() unless $JUST_TESTING; # don't want to update db

#===============================================================================

sub set_request_status { # warn 'here'; # die;
	# status_option.id of 'complete' requests:
	my $status_option_id = _complete_status_option_id();
	# server username:
	my $server_user = $tools->get_server_user_details(); # p $server_user;

	# get list of requests where status = authorised and don't require diagnosis
	# confirmation (using @requires_confirmation array to supply list of requests
    # where confirmation IS required):
	my $authorised_requests = _get_authorised_requests(); # p $authorised_requests;

	DATA: # skip any requests with outstanding tests - set rest to status = complete:
	for my $data( @$authorised_requests ) { # p $data;
		my $lab_test = _get_lab_tests($data->{id}); # p $lab_test;
		my @status = map $_->{status}, @$lab_test; # p @status;

		next DATA if grep $_ ne 'complete', @status; # skip if ANY test status NOT complete
            # warn 'here';
		{ # now have authorised case with no outstanding lab-tests and not requiring a
		  # diagnosis confirmation, so set request status to 'complete':
			my %h = (
				status_option_id => $status_option_id,
				# preserve timestamp to avoid triggering unnecessary report:
				updated_at => $data->{updated_at},
			); # p %h;
			$dbix->update( 'requests', \%h, { id => $data->{id} } );
		}
		{ # log action in request_history:
			my %data = (
				request_id 	=> $data->{id},
				user_id 	=> $server_user->{id},
				action 		=> 'set request status to complete',
			); # p %data;
			$dbix->insert('request_history', \%data);
		}
	}
}

# queries ======================================================================
sub _get_request_ids {
	my @cols = qw( r.id );
    my @rels = (
        'requests|r'                   => 'ris.request_id=r.id'               ,
        'request_initial_screen|ris'   => 'ris.screen_id=s.id'                ,
        'screens|s'                    => 'rrs.request_id=r.id'               ,
        'request_result_summaries|rrs' => 'rrs.lab_section_id=ls.id'          ,
        'lab_sections|ls'              => 'rrd.request_id=r.id'               ,
        'request_report_detail|rrd'    => 'rrd.diagnosis_id=d.id'             ,
        'diagnoses|d'                  => '=>rt.request_id=r.id'              ,
        'request_trial|rt'             => '=>rt.trial_id=ct.id'               ,
        'clinical_trials|ct'           => 'r.status_option_id=so.id'          ,
        'status_options|so'
    );
	my %where = (
        -and => [
            's.description'     => { -not_in => $excluded_screens },
            -or => [
                'ct.trial_name' => { -not_in => $excluded_trials  },
                'ct.trial_name' => undef,
            ],
            -or => [
                {
                    'so.description'  => 'authorised',
                    'ls.section_name' => { -in => $lab_sections },
                },
                {
                    'so.description' => 'complete',
                    'd.name' => {
                        -rlike => 'awaiting final (diagnosis|review)'
                    },
                },
            ],
        ],
	);
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => \%where,
        -group_by => 'r.id',
        -order_by => [ 'r.year', 'r.request_number' ],
	);
	my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
	   # $dbix->dump_query($sql, @bind); # exit;
    my $request_ids = $dbix->query($sql, @bind)->column; # p $request_ids;
    return $request_ids;
}

sub _get_authorised_requests {
	my @cols = qw( r.id r.updated_at );
    my @rels = qw( requests|r   r.status_option_id=so.id   status_options|so );
	my %where = (
        'so.description' => 'authorised',
        'r.id' => { -not_in => \@requires_confirmation }, # global var
    );
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => \%where,
	);
	my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
	   # $dbix->dump_query($sql, @bind); exit;
    my $requests = $dbix->query($sql, @bind)->hashes; # p $requests;
    return $requests;
}

sub _get_request_report {
     my $request_id = shift;
    my @cols = (
        'r.request_number', 'r.year', 'd.name|diagnosis',
        'MAX(CASE WHEN rs.action = "reported" THEN rs.username END)|report_by',
        'MAX(CASE WHEN rs.action = "reported" THEN rs.time END)|report_date',
        'MAX(CASE WHEN rs.action = "authorised" THEN rs.username END)|auth_by',
        'MAX(CASE WHEN rs.action = "authorised" THEN rs.time END)|auth_date',
    );
    my @rels = (
        'requests|r' =>  'rs.request_id=r.id',
        'request_status_view|rs' => 'rr.request_id=r.id',
        'request_report_view|rr' => 'rr.diagnosis_id = d.id',
        'diagnoses|d'
    );
    my %where = ( 'r.id' => $request_id );
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => \%where,
	);
	my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
	   # $dbix->dump_query($sql, @bind); exit;
    my $ref = $dbix->query($sql, @bind)->hash; # p $ref;
    return $ref;
}

sub _get_clinical_trial {
    my $request_id = shift;
    my @cols = qw( ct.trial_name );
    my @rels = qw( request_trial|rt   rt.trial_id=ct.id   clinical_trials|ct );
	my %where = ( 'rt.request_id' => $request_id );
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => \%where,
	);
	my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
	   # $dbix->dump_query($sql, @bind); exit;
    my $val = $dbix->query($sql, @bind)->value; # p $val;
    return $val;
}

sub _get_initial_screen {
    my $request_id = shift;
    my @cols = qw( s.description );
    my @rels = qw( request_initial_screen|ris  ris.screen_id=s.id  screens|s );
	my %where = ( 'ris.request_id' => $request_id );
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => \%where,
	);
	my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
	   # $dbix->dump_query($sql, @bind); exit;
    my $val = $dbix->query($sql, @bind)->value; # p $val;
    return $val;
}

sub _get_specimen_code {
    my $request_id = shift;
    my @cols = qw( s.sample_code );
    my @rels = qw( request_specimen|rs  rs.specimen_id=s.id  specimens|s );
	my %where = ( 'rs.request_id' => $request_id );
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => \%where,
	);
	my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
	   # $dbix->dump_query($sql, @bind); exit;
    my $ref = $dbix->query($sql, @bind)->column; # p $ref;
    return $ref;
}

sub _get_lab_tests {
    my $request_id = shift; # p $request_id;
    # function called twice, from REQUEST block & again from set_request_status()
        # say "returning $request_id" if $all_lab_tests{$request_id};
    return $all_lab_tests{$request_id} if $all_lab_tests{$request_id};

    my @cols = qw( lt.test_name so.description|status );
    my @rels = (
        'request_lab_test_status|ts' =>  'ts.status_option_id=so.id'  ,
        'lab_test_status_options|so' =>  'ts.lab_test_id=lt.id'       ,
        'lab_tests lt'
    );
	my %where = ( 'ts.request_id' => $request_id );
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => \%where,
	);
	my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
	   # $dbix->dump_query($sql, @bind);  exit;
    my $ref = $dbix->query($sql, @bind)->hashes; # p $ref;
    $all_lab_tests{$request_id} = $ref; # in case requested later
    return $ref;
}

sub _get_rs_section_datetime {
    my $request_id = shift;
    my @cols = qw( ls.section_name rrs.time );
    my @rels = qw(
        request_result_summaries|rrs  rrs.lab_section_id=ls.id  lab_sections|ls
    );
	my %where = ( 'rrs.request_id' => $request_id );
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => \%where,
	);
	my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
	   # $dbix->dump_query($sql, @bind); exit;
    my $ref = $dbix->query($sql, @bind)->hashes; # p $ref;
    return $ref;
}

sub _complete_status_option_id {
    $dbix->select('status_options', 'id',
		{ description => 'complete' })->into(my $id); # p $id;
    return $id;
}