#!/usr/bin/perl
=begin -------------------------------------------------------------------------
list of new, relasped or all cases from variety of age ranges & diagnoses:
=cut ---------------------------------------------------------------------------
use strict;
use warnings;
my $JUST_TESTING = 0; # email to ra.jones only
############ recipients from contacts.lib ######################################
my @recipients = qw(
cathy.burton
rod.johnson
amy.humphries
raj.secure
);
my $delta_days = 1;
################################################################################
use lib '/home/raj/perl5/lib/perl5';
use Data::Dumper;
use FindBin qw($Bin); # warn $Bin;
use lib "$Bin/../../../lib";
use LIMS::Local::ScriptHelpers;
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();
# get date yesterday - handles BST:
my $yesterday = $tools->date_subtract(days => 1)->dmy('/'); # warn $yesterday; exit;
# get sql statment:
my $sql = $sql_lib->retr('yhhn_potential_trial_cases');
# email subject line:
my $subject = "Potential clinical trial cases [$yesterday]";
# template:
my $tt_file = 'cron/potential_trial_cases.tt';
# my $network_locations_map = _get_network_locations(); slow query anyway so doing in sql
my $result = $dbix->query($sql, $delta_days)->hashes; # warn Dumper $result;
exit 0 unless @$result;
my @cols = qw(hmds_ref last_name first_name dob age nhs_number location
diagnosis status);
my $message = do{
my %args = ( data => $result, cols => \@cols, date => $yesterday );
$tools->process_template('cron/potential_trial_cases.tt', \%args);
};
my %mail = (
content => 'html',
config => $config,
message => $message,
subject => $subject,
); # warn Dumper \%mail; exit;
$tools->send_mail(\%mail, \@recipients);
=begin # query very slow anyway so no need to do separate location query
sub _get_network_locations {
my $sql = q!
select t3.display_name, 1
from local_network_locations t1
join parent_organisations t2 on t1.parent_id = t2.id
join referral_sources t3 on t3.parent_organisation_id = t2.id!;
my $map = $dbix->query($sql)->map;
return $map;
}
=cut