• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/env perl

=begin -------------------------------------------------------------------------
RfC343L - discontinued Jan/2019

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 $ref_date = $tools->date_subtract( months => $duration );

my $subject = sprintf '100K Genomes - DNA sample saved [%s]',
	$ref_date->month_name; # warn $subject;
my $filename = sprintf '100k_patients_%s-%s.xls',
	$ref_date->year, $ref_date->month; # warn $filename;

# 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) unless $opt_q;

sub _get_query {
    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{r.id=rlts.request_id},
        'request_lab_test_status|rlts' => q{rlts.lab_test_id=lt.id},
        'lab_tests|lt'                 => q{=>rrd.request_id=r.id},
        'request_report_detail|rrd'    => q{=>rrd.diagnosis_id=d.id},
        'diagnoses|d'                  => q{r.patient_case_id=pc.id},
        'patient_case|pc'              => q{pc.patient_id=p.id},
        'patients|p'                   => q{pc.referral_source_id=rs.id},
        'referral_sources|rs'          => q{r.referrer_department_id=rd.id},
        'referrer_department|rd'       => q{rd.referrer_id=ref.id},
        'referrers|ref'                => q{r.id=ris.request_id},
        'request_initial_screen|ris'   => q{ris.screen_id=s.id},
        'screens|s'
    );
    my %where = (
		'year(r.created_at)'  => $ref_date->year,
		'month(r.created_at)' => $ref_date->month,
        'lt.test_name' 	      => '100kg_dna_extraction',
    );
    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);
}