• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/env perl

=begin -------------------------------------------------------------------------
emails list of potential 100K Genomics patients, based on screening term
discontinued Jan/2019
=cut ---------------------------------------------------------------------------

use Getopt::Std;
getopts('d:tq'); # days, testing, query output
our($opt_d,$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( paul.evans.secure polly.talley.secure raj.secure );
my $duration   = $opt_d || 1; # days
my @locations  = qw( RR8 RWA );
my @screens = (
    'CLL - pre-treatment / progressive disease',
    'Suspected MPN other (BM)',
    'Suspected ALL under-18', # discontinued
    'Suspected B-ALL 25 or under',
    'Suspected B-ALL over 25',
    'Suspected AML under-60',
    'Suspected AML 60+',
    'Suspected CMML (BM)',
    'Suspected CMML (PB)',
    'Suspected CML (BM)',
    'Suspected CML (PB)',
    'Probable B-LPD',
    'Suspected MDS',
    'FLAIR baseline',
    'MF presentation',
    'Probable myeloma',
    'Cytopenia',
);
################################################################################

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( days => $duration );

my $subject  = sprintf 'Potential 100K Genomes patients [%s]', $date->dmy; # warn $subject; exit;
my $filename = sprintf '100k_patients_%s.xls', $date->ymd('');

# xl file headers:
my @headers = qw( request_number year registered presentation source referrer );
#-------------------------------------------------------------------------------

my $config  = $tools->config();
my $dbix    = $tools->dbix();

my ($sql, @bind) = _get_query();
my @data = $dbix->query( $sql, @bind )->arrays; # p @data;
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 @cols = ( 'r.request_number', 'r.year', 'date(r.created_at)|registered',
        's.description|presentation', 'rs.display_name|location',
        'ref.name|referrer' );
    my @rels = (
        'requests|r'                  =>  q{r.patient_case_id=pc.id}         ,
        'patient_case|pc'             =>  q{pc.referral_source_id=rs.id}     ,
        'referral_sources|rs'         =>  q{rs.parent_organisation_id=po.id} ,
        'parent_organisations|po'     =>  q{rsv.request_id=r.id}			 ,
        'request_status_view|rsv'     =>  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 = (
        'date(rsv.time)' => $date->ymd,
        's.description'  => { -in => \@screens },
        'po.parent_code' => { -in => \@locations },
        'rsv.action'     => 'screened',
    );
    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);
}