• 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 day is Sunday, date is 1st of month, or last working day before
1st of next month
=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 => 2016, month => 4, day => 29 );

{ # 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;
	exit 0 unless
		TODAY->day == 1 # run on 1st regardless of day
		|| TODAY->day_name eq 'Sunday'
		|| TODAY->dmy eq $last_working_date->dmy;
}
#===============================================================================
# to get here it's 1st of month, last working day before 1st of month, or Sunday
#===============================================================================

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 = sprintf '%s%s/%s',
        $config->{lab_number_prefix},
        $vars->{request_number},
        $vars->{year} - 2000;

    my $row = sprintf '%-10s %-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';

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'
    );

	my %where = (
		-or => {
			'ref.national_code'    => { like => '%' . 999998 },
			'rs.organisation_code' => { -in => [ qw/X99999 V81999/ ] },
		},
		'rt.request_id' => undef,
    );
	# add date restriction to where clause:
	my $start_day = ( TODAY->day == 1 ) # if today = 1st of month
		? TODAY->clone->subtract( months => 1 ) # 1st of last month
		: TODAY->clone->subtract( days => TODAY->day - 1 ); # 1st of this month
	$where{'DATE(r.created_at)'} = { '>=' => $start_day->ymd };

	my @sort_by = 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_by,
	);  p $sql; p @bind;
    return ($sql, @bind);
}