• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
records overdue for authorisation based on mean reporting time for sample:
generates 2 lists - outreach (> 21d overdue), and others (> sample_type mean + 2d)
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

my $JUST_TESTING = 1; # email to ra.jones only

################################################################################
my %request_type = (
	outreach => {
		recipient => [ qw(andy.rawstron.secure raj.secure) ],
		subject   => q!CMP records >21 days overdue!,
	},
	other => {
		recipient => [ qw(lynda.blythe.secure david.blythe.secure paul.evans.secure
						raj.secure) ],
		subject   => q!HILIS records requiring attention!,
	},
);
my $duration = 6; # how many months to calculate mean time to authorisation
################################################################################

my @fields = qw(lab_number delta name location specimen);

BEGIN {
    use FindBin qw($Bin); # warn $Bin;
    use lib "$Bin/../../../lib";
}

use POSIX; # ceil
use Data::Dumper;
use LIMS::Local::Utils;
use Date::Calc qw(Delta_Days);
use LIMS::Local::ScriptHelpers;

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

my $contacts = $tools->get_contacts();
my $sql_lib  = $tools->sql_lib();
my $config   = $tools->config(); 
my $dbix     = $tools->dbix();

# sample_type => mean duration to authorisation:
my $mean_duration_map = _get_mean_time_to_authorisation_by_sample_type();
	# warn Dumper $mean_duration_map; exit;

my %data;

my $query = $sql_lib->retr('overdue_for_authorisation');
my $result = $dbix->query($query);

RESULT:
while (my $ref = $result->hash) { # warn Dumper $ref; next;
	my $specimen = $ref->{specimen}; 
	my $screen   = $ref->{description};
	my $req_id   = $ref->{id};
	
	# don't want Outreach PB samples:
	next RESULT if ($screen eq 'Community monitoring' && $specimen eq 'PB');
	
	# calculate age of request, and add to $ref as 'delta':
	my $delta = $ref->{delta} = Delta_Days(
		( split '-', $ref->{registered}   ), # from
		( split '-', DateTime->today->ymd ), # to
	); # warn Dumper [ $ref->{registered}, $delta ];

	# in case no similar samples over previous 180 days:
	$mean_duration_map->{$specimen}->{mean} ||= 7; # probably histology
	
	# skip if less than 3 days above mean time to auth for specimen type:
	next RESULT if $delta <= $mean_duration_map->{$specimen}->{mean} + 2;
	
	# 2 lists, 1 for Outreach, 1 for others:
	my $type = $screen eq 'Community monitoring'
		? 'outreach'
		: 'other';
	
	# skip if already have this request with another sample type with delta >= current
	my $previous_delta = $data{$type}{$req_id}[1] || 0; # warn $previous_delta;
	next RESULT if $delta <= $previous_delta; # skip unless this sample delta > previous || 0
	
	$data{$type}{$req_id} = [ @{ $ref }{@fields} ];	
} # warn Dumper \%data;

my %mail = (		
	config => $config,
);

my $msg_header = join ' :: ', @fields;

while ( my($type, $val) = each %request_type ) {
	# get request ids in numerical order (oldest 1st):
	my @request_ids = sort keys %{ $data{$type} };
	
	# join request data fields using | delimiter:
	my @msg_body = map {
			join ' | ', @{ $data{$type}{$_} }
		} @request_ids; 
	
	$mail{message} = $msg_header . "\n\n" . ( join "\n", @msg_body );
	$mail{subject} = $val->{subject}; # warn Dumper \%mail; next;
	
	RECIPIENT:
	foreach my $recipient ( @{ $val->{recipient} } ) {
		my $email = $contacts->{$recipient} or next RECIPIENT; # in case doesn't exist
		next RECIPIENT if $JUST_TESTING && $email !~ /ra\.jones/;
		$mail{recipient} = $email;  warn Dumper $mail{recipient}; next;
		
		my $rtn = LIMS::Model::Email->send_message(\%mail);
		warn "Error in $0: $rtn" if $rtn;		
	}	
}

# create map of mean times to authorisation by sample type for last 180 days:
sub _get_mean_time_to_authorisation_by_sample_type {
	my $query = $sql_lib->retr('time_to_authorisation_by_specimen');
	my $result = $dbix->query($query, $duration);    

	my %map;
	
	while (my $ref = $result->hash) { # warn Dumper $vars; next;
		my $specimen = $ref->{sample_code};
		
		my $from  = $ref->{registered};
		my $to    = $ref->{authorised};
		my $delta = LIMS::Local::Utils::delta_business_days($from, $to);
		
		$map{$specimen}{duration} += $delta; # increment total time for specimen type
		$map{$specimen}{total}++; # increment total count for specimen type
	}
	
	# calculate average duration for each sample type:
	while ( my($specimen, $data) = each %map ) {
		my $avg = ceil( $data->{duration} / $data->{total} );
		$map{$specimen}{mean} = $avg;
	}
	
	# make Outreach CMP samples 19 days (to make 21 after +2):
	$map{CMP}{mean} = 19;
	
	return \%map;
}