• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
sends a list of requests (non-trial) where referrer or source unknown; runs daily
appends 'PRIORITY' to email subject if last working day of month
* check date calcs in ~/scripts/code_unknown_run_dates.pl
* can force $JUST_TESTING using opt -t
=cut

use Getopt::Std;
getopts('t'); # test
our($opt_t); # warn $opt_t; exit;

#-------------------------------------------------------------------------------
my $JUST_TESTING = $opt_t || 0; # email to ra.jones only
my @recipients = qw(hmds.secure raj); # for non-secure info
#-------------------------------------------------------------------------------

use lib '/home/raj/perl5/lib/perl5';
use Data::Printer alias => 'p';
use DateTime::Format::MySQL;
use SQL::Abstract::More;
use Modern::Perl;
use Config::Auto;

use FindBin qw($Bin); # warn $Bin;
use lib "$Bin/../../../lib";
use LIMS::Local::ScriptHelpers;
use LIMS::Local::Utils;

use constant TODAY => LIMS::Local::Utils::today; # warn TODAY->day_name;
# use constant TODAY => DateTime->new( year => 2017, month => 06, day => 30 ); # last working day

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

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

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

# organisation codes NOT required in activity data:
my $skip_orgs = $settings->{skip_organisation_codes}; # warn Dumper $skip_orgs;

# my $query = $sql_lib->retr( 'national_code_unknown' ); # warn $query;
my ($sql, @bind) = get_query_params(); # p $sql; p @bind;
my $result = $dbix->query($sql, @bind);

my @rows;
while (my $vars = $result->hash) { # p $vars; next;
    my $lab_no = join '/', $vars->{request_number}, $vars->{year} - 2000;

    my $row = sprintf '%-9s %-12s %s',
        $lab_no,
        DateTime::Format::MySQL->parse_datetime($vars->{created_at})->dmy,
        $vars->{display_name};

    $row .= ' [WILL NOT BE BILLED]' if
        grep { $vars->{organisation_code} eq $_ } @$skip_orgs;
    push @rows, $row;
}

{ # send message:
	my $message_body = @rows
		? ( join "\n", @rows )
		: 'No unknown national codes so far this month';

	my $month_year = ( TODAY->day == 1 )
		? TODAY->clone->subtract( months => 1 )->strftime('%B %Y')
		: TODAY->strftime('%B %Y');

	my $subject = do {
		# prepend PRIORITY to message title if 1st of month, or last working day:
		last_working_date() || TODAY->day == 1
			? 'PRIORITY: unknown HILIS referral codes for ' . $month_year
			: 'Unknown HILIS referral codes';
	}; # p $subject;

	my %mail = (
		config  => $config,
		subject => $subject,
		message => $message_body,
	); # p %mail;  next;
	$tools->send_mail(\%mail, \@recipients);
}

#===============================================================================
sub get_query_params {
    my @col_names = qw(
		r.request_number
		r.year
		r.created_at
		rs.display_name
		rs.organisation_code
    );

    my @tbl_rels = (
        # table|alias                  	# FK-PK relationship
        'requests|r' 				,	'r.referrer_department_id = rd.id' ,
		'referrer_department|rd'	,	'rd.referrer_id = ref.id'		   ,
		'referrers|ref'				,	'r.patient_case_id = pc.id'        ,
		'patient_case|pc'			,	'pc.referral_source_id = rs.id'    ,
		'referral_sources|rs'		,	'=>rt.request_id = r.id'           , # left join
		'request_trial|rt'
    );

	# date restriction for where clause (1st of month):
	my $start_date = ( TODAY->day == 1 ) # if today = 1st of month
		? TODAY->clone->subtract( months => 1 ) # 1st of previous month
		: TODAY->clone->subtract( days => TODAY->day - 1 ); # 1st of this month

	my %where = (
		-or => {
			'rs.organisation_code' => { -in => [ qw/X99999 V81999/ ] },
			'ref.national_code'    => { like => '%' . 999998 },
		},
		'r.created_at'	=> { '>=' => $start_date->ymd },
		'rt.request_id' => undef, # not in clinical trial
    );

	my @sort = qw(r.year r.request_number);

	my ($sql, @bind) = SQL::Abstract::More->new->select(
		-columns  => \@col_names,
		-from     => [ -join => @tbl_rels ],
		-where    => \%where,
		-order_by => \@sort,
	); # p $sql; p @bind;
    return ($sql, @bind);
}

sub last_working_date { # returns true if today is last working day of month
    my $first_of_next_month = get_first_of_next_month(); # p $first_of_next_month->dmy;
    # get date of last *working* day before 1st of next month:
    my $last_working_date # considers weekends & public hols
        = LIMS::Local::Utils::last_working_date($first_of_next_month); # p $last_working_date->dmy;
    # returns true if delta_days() is false (no diff between $last_working_date & today):
    return ! LIMS::Local::Utils::delta_days(TODAY->ymd, $last_working_date->ymd);
}

sub get_first_of_next_month {
    my $dt = TODAY->clone; # add days until ->day equals 1:
    do { $dt->add(days => 1) } while $dt->day > 1;
    return $dt;
}