#!/usr/bin/env perl
=begin -------------------------------------------------------------------------
RfC343L
Emails list of 100K Genomics samples with DNA sample saved last calendar month
use -m2 for last-but-one month etc.
Garry Quested
Mon Dec 18 13:10:40 GMT 2017
=cut ---------------------------------------------------------------------------
use Getopt::Std;
getopts('m:tq'); # month, testing, query output
our($opt_m,$opt_t,$opt_q); # warn $opt_t; exit;
use strict;
use warnings;
my $JUST_TESTING = $opt_t || 0; # email to ra.jones only
############ recipients from contacts.lib #######################################
my @recipients = qw( polly.talley.secure raj.secure );
my $duration = $opt_m || 1; # month
################################################################################
use lib '/home/raj/perl5/lib/perl5';
use Data::Printer;
use SQL::Abstract::More;
use Spreadsheet::WriteExcel::Simple;
use FindBin qw($Bin); # warn $Bin;
use lib $Bin . '/../../../lib';
use LIMS::Local::ScriptHelpers;
# get tools from LIMS::Local::ScriptHelpers:
my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);
#-------------------------------------------------------------------------------
my $date = $tools->date_subtract( months => $duration );
my $subject = sprintf '100K Genomes - DNA sample saved [%s]', $date->month_name; # warn $subject; exit;
my $filename = sprintf '100k_patients_%s-%s.xls', $date->year , $date->month;
# xl file headers:
my @headers = (
'Request number', 'Year', 'Last name', 'First name',
'Middle name', 'DOB', 'Date registered', 'Presentation',
'Source', 'Referrer', 'Diagnosis'
);
#-------------------------------------------------------------------------------
my $config = $tools->config();
my $dbix = $tools->dbix();
my ($sql, @bind) = _get_query();
my @data = $dbix->query( $sql, @bind )->arrays; # p @data;
#$DB::single=1;
exit unless @data;
my $xl = Spreadsheet::WriteExcel::Simple->new;
$xl->write_bold_row(\@headers);
$xl->write_row($_) for @data;
$xl->save($filename) if $JUST_TESTING;
my %mail = (
config => $config,
subject => $subject,
attachment => $xl->data,
filename => $filename,
);
$tools->send_mail(\%mail, \@recipients);
sub _get_query {
my $between_params =
q{BETWEEN DATE_FORMAT(NOW() - INTERVAL }
. $duration
. q{ MONTH, '%Y-%m-01 00:00:00') AND DATE_FORMAT(LAST_DAY(NOW() - INTERVAL }
. $duration
. q{ MONTH), '%Y-%m-%d 23:59:59')};
my @cols = (
'r.request_number', 'r.year',
'p.last_name', 'p.first_name',
'p.middle_name', 'p.dob',
'date(r.created_at)|registered', 's.description|presentation',
'rs.display_name|location', 'ref.name|referrer',
'd.name|diagnosis'
);
my @rels = (
'requests|r' => q{rlts.request_id=r.id},
'request_lab_test_status|rlts' => q{rlts.lab_test_id=lt.id},
'lab_tests|lt' => q{rlts.status_option_id=ltso.id},
'lab_test_status_options|ltso' => q{=>rrd.request_id=r.id},
'request_report_detail|rrd' => q{rrd.diagnosis_id=d.id},
'diagnoses|d' => q{pc.id=r.patient_case_id},
'patient_case|pc' => q{pc.patient_id=p.id},
'patients|p' => q{pc.referral_source_id=rs.id},
'referral_sources|rs' => q{rs.parent_organisation_id=po.id},
'parent_organisations|po' => q{r.referrer_department_id=rd.id},
'referrer_department|rd' => q{rd.referrer_id=ref.id},
'referrers|ref' => q{ris.request_id=r.id},
'request_initial_screen|ris' => q{ris.screen_id=s.id},
'screens|s'
);
my %where = (
'r.created_at' => \$between_params,
'lt.field_label' => '100KG DNA extraction',
'ltso.description' => 'complete',
);
my @args = (
-columns => \@cols,
-from => [ -join => @rels ],
-where => \%where,
-order_by => 'r.id',
); # p @args;
my ($sql, @bind) = SQL::Abstract::More->new->select(@args); # p $sql; p \@bind;
$dbix->dump_query($sql, @bind) if $opt_q; # exit;
return ($sql, @bind);
}
