• Files
• Commits
• Log
• Graph
• Stats

#!/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;
################################################################################

BEGIN {
    use FindBin qw($Bin); # warn $Bin;
    use lib (
        "$Bin/../../../lib",
        '/home/raj/perl5/lib/perl5',
    );
}

use Data::Dumper;
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