#!/usr/bin/perl

=begin -------------------------------------------------------------------------
uploads activity data to ftp server - can be set to test mode using $JUST_TESTING
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

my $JUST_TESTING = 1; # skips ftp, sets /tmp dir for data file, emails just raj

#######################################
my @recipients = qw(douglas raj);     #
my $duration   = 1; # months ago      #
#######################################
 
BEGIN {
    use FindBin qw($Bin); # warn $Bin;
    use lib (
        "$Bin/../../../lib",
        '/home/raj/perl5/lib/perl5',
    );
}

use IO::All;
use Data::Dumper;
use DateTime::Format::MySQL;
use LIMS::Local::ScriptHelpers;

my $cfg_file = "$Bin/../lib/settings.cfg";
my $settings = Config::Auto::parse($cfg_file); # warn Dumper $settings;

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

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

my $query = $sql_lib->retr('activity_data');

my $delimiter = '|';

my (@rows, %request_numbers);

my %log = (
	unsourced => [], # initialise to avoid possible undef value error later
	failed    => [],
);


my $result = $dbix->query($query, $duration, $duration); # needs duration twice
my $is_private = q!select 1 from request_option ro join additional_options ao on
    ro.option_id = ao.id where ro.request_id = ? and ao.option_name = 'private'!;

ROW:
while (my $vars = $result->hash) { # warn Dumper $vars; next;
    my $id = $vars->{id}; 
    my $lab_no = join '/', $vars->{request_number}, ($vars->{year} - 2000);    
    
    # log & skip unknown referral_source:
    if ( grep $vars->{organisation_code} eq $_, qw/X99999 V81999/ ) { 
        push @{ $log{unsourced} }, $lab_no;
        next ROW; 
    }  
    
    # log failures (unknown clinicians for non-study requests):
    if ( $vars->{referrer_code} =~ /9999998\Z/ && $vars->{category} ne 'ST' ) {
        next if $log{seen}{$id}++; # duplicates if request has >1 specimen
        push @{ $log{failed} }, $lab_no;
        my $location = $vars->{display_name};
        $log{unknown}{$location}++;
    }

    # non-NHS sources:
	if ( $vars->{organisation_code} =~ /^NT\d{3}|8EQ15/ ) { 
		$vars->{category} = '04';
	}
    # private patient in NHS hospital:
	elsif ( $dbix->query($is_private, $vars->{id})->list ) { 
		$vars->{category} = '02'; # warn $vars->{id};
	}
    
    # apply any local billing rules before upload:
    apply_local_rules($vars);
    
    # generate data row:
    my $data = parse_data($vars);
    push @rows, $data;
}

my $cfg = $settings->{activity_data_server};

my $local_filename = $JUST_TESTING
	? '/tmp/hmds.dat' # override path for testing
	: $cfg->{path_to_datafile};
	
my $content = join "\n", @rows;
$content > io($local_filename);


unless ($JUST_TESTING) {
	my %args = (
		local_filename  => $local_filename,
		remote_filename => $cfg->{remote_filename},
		server_addr     => $cfg->{remote_address},
		username        => $cfg->{username},
		password        => $cfg->{password},
	);

    # ftp file (returns str on failure, undef on success):
    my $rtn = $tools->ftp_file(\%args);

    if ($rtn) {
        $tools->mail_admin({ script => $0, msg => $rtn });
        die "$0 - $rtn\n"; # dump to logs
    }
}

my $month = $tools->date_subtract(months => $duration)->month_name;
print "$0 - data for $month succesfully uploaded\n"; # for cron log

# calculate some vars for email message:
my $total_requests      = scalar @rows;
my $number_unsourced    = scalar @{ $log{unsourced} };
my $unsourced_labnos    = join "\n\t", map "$_ - WILL NOT BE BILLED", @{ $log{unsourced} };
my $number_failed       = scalar @{ $log{failed} };
my $percent_failed      = 100 * $number_failed / $total_requests;
my $no_referrer_reqs    = join "\n\t", @{ $log{failed} };
my $no_referrer_src     = join "\n\t", map "$_: $log{unknown}{$_}",
                            reverse sort {
                                $log{unknown}{$a} <=> $log{unknown}{$b}
                            } keys %{ $log{unknown} };
    
# send emails to recipients:
my $message
    = sprintf qq!Activity data file created successfully (%s entries).\n\n!
    . qq!Unknown source: %s\n\t%s\n\n!
    . qq!Unknown referrer: %s (%.2f%%)\n\t%s\n\n!
    . qq!Sources for unknown referrer:\n\t%s!,
        $total_requests, 
        $number_unsourced,
        $unsourced_labnos,
        $number_failed,
        $percent_failed,
        $no_referrer_reqs,
        $no_referrer_src; # print $message . "\n"; # exit;

my %mail = (		
	config  => $config,
	message => $message,
	subject => 'Activity data for month ' . $month, 	
); # warn Dumper \%mail; 
    
$tools->send_mail(\%mail, \@recipients);

sub parse_data {
    my $vars = shift; # hashref
    
    my $line = join $delimiter, (
		'HMDS',
        'H' . $vars->{request_number} . '/' . ( $vars->{year} - 2000 ),
		uc $vars->{last_name},
		( join ' ', map ucfirst $vars->{$_}, grep $vars->{$_}, qw/first_name middle_name/ ),
		$vars->{unit_number}, # have to handle default unknown
		$vars->{dob} ? DateTime::Format::MySQL->parse_date($vars->{dob})->dmy('/') : '',   # have to handle default unknown
		$vars->{age} || '',
		$vars->{gender} || 'U',
		$vars->{organisation_code}, 
		$vars->{referrer_code}, 
		$vars->{organisation_code} =~ /\A(RR8|RAE)/ ? $vars->{hospital_department_code} : '', 
		'HM' . $vars->{sample_code}, 
		'HM' . $vars->{sample_code}, 
		$vars->{category},
		$vars->{on_call},
		DateTime::Format::MySQL->parse_datetime($vars->{created_at})->dmy('/'),
        DateTime::Format::MySQL->parse_datetime($vars->{created_at})->strftime('%d/%m/%Y:%H:%M'),
        '', # external ref - not used
		$vars->{nhs_number}	|| '',	
	);
    
    return $line;
}

sub apply_local_rules {
    my $vars = shift; # hashref
    
	$vars->{first_name} = uc $vars->{first_name}
        if (
            $vars->{first_name} =~ /\A(lgi|pin)\Z/i ||
            $vars->{last_name}  =~ /\Ahtg\d+/i
        );

	# $vars->{unit_number} = '' if $vars->{unit_number} eq 'UNKNOWN';

	$vars->{trial_name} ||= ''; # avoid uninitialized value error
    
    # haematology needs to be clinical not laboratory:
    $vars->{hospital_department_code} =~ s/823/303/; 
    
   # Castleford & Normanton DH now RGX18, unless Dermatology which has its own code:
    if ( $vars->{organisation_code} eq 'RXF07' ) {
        if ( # examine both speciality & specimen:
            $vars->{hospital_department_code} == 330 ||
            $vars->{sample_description} =~ /^skin/i
        ) {
            $vars->{organisation_code} = '5N301D';
        }
        else {
            $vars->{organisation_code} = 'RGX18';
        }
    }
    
    # special case for outreach samples:
    if ( # not safe to rely on trial name so use presentation:
            $vars->{presentation} eq 'Community monitoring' &&
            $vars->{sample_code}  eq 'PB'
        )
    {
        $vars->{category} = '01'; # set sample type to chargeable
        $vars->{sample_code} = 'CMPB'; # set special sample_type
    }
    
    # override ST category for research PB samples from non-LTH source:
    if ( $vars->{sample_code} eq 'RXPB' && $vars->{organisation_code} !~ /^RR8/) {
        $vars->{category} = '01';
    }

    # NCRI Arctic trials billed as normal:
    if ( $vars->{trial_name} eq 'NCRI CLL ARCTIC' ) {
        $vars->{category} = '01'; # override ST code
    }
}