• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
sends a list of requests (non-trial) where referrer or source unknown; runs daily
and exits unless date is 1st of month, or last working day of month, or Sunday
other than 2nd day of month (as list will have dispatched previous day)
check date calcs in ~/scripts/run_dates.pl
=cut

#-------------------------------------------------------------------------------
my $JUST_TESTING = 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 => 2015, month => 12, day => 10 );

{ # do we run today? - only Sundays & last working day on or before 1st of month
	# get date 1 month ahead:
    my $date = TODAY->clone->add( months => 1 ); # say $date->dmy;
	# create datetime object for 1st day of next month:
	my $first_of_month = DateTime->new(
		month => $date->month,
		year  => $date->year,
		day   => 1,
	); # say $first_of_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_month);
		# say $last_working_date->dmy; say TODAY->dmy;
	my $delta = sub { LIMS::Local::Utils::delta_days(@_) };

	exit 0 unless $JUST_TESTING
		or TODAY->day == 1 # run on 1st regardless of day
		or ( TODAY->day_name eq 'Sunday' && TODAY->day > 2 ) # skip Sunday 2nd
	#	or ( TODAY->dmy eq $last_working_date->dmy );
		or (! &$delta(TODAY->ymd, $last_working_date->ymd) ); # Delta_Days = 0
}
#===============================================================================
# to get here it's 1st of month, last working day of month, or Sunday (not day 2)
#===============================================================================

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 $subject = do {
		my $month_year = ( TODAY->day == 1 )
			? TODAY->clone->subtract( months => 1 )->strftime('%B %Y')
			: TODAY->strftime('%B %Y');
		'Unknown national codes for ' . $month_year;
	}; # p $subject;

	my %mail = (
		config  => $config,
		subject => $subject,
		message => $message_body,
	); # warn Dumper \%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);
}