• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/env perl

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

use Getopt::Std;
getopts('d:t'); # days, testing
our($opt_d,$opt_t); # warn $opt_m; exit;

use strict;
use warnings;

my $JUST_TESTING = $opt_t || 0; # email to ra.jones only

############ recipients from contacts.lib #######################################
my @recipients = qw( paul.evan.secure polly.talley.secure raj.secure );
my $duration = $opt_d || 1; # days
my @screens = (
    'Suspected MPN other (BM)', 
    'Suspected ALL under-18', 
    'Suspected AML under-60', 
    'Suspected AML 60+', 
    'Suspected CMML (BM)', 
    'Suspected CMML (PB)', 
    'Suspected CML (BM)', 
    'Suspected CML (PB)', 
    '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 presentation source );
#-------------------------------------------------------------------------------

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

my @data;

# get SQL statement for query:
my ($sql, @bind) = _get_query();
my $result = $dbix->query( $sql, @bind );

while ( my $row = $result->array ) { # p $row; next;
    push @data, $row;
}

my %mail = (
	config  => $config,
	subject => $subject,
);

if (@data) {
	my $xl = Spreadsheet::WriteExcel::Simple->new;
	$xl->write_bold_row(\@headers);
	$xl->write_row($_) for @data;
 #   $xl->save($filename); exit;
	$mail{attachment} = $xl->data;
    $mail{filename}   = $filename;
}
else {
	# $mail{message} = sprintf 'No data for %s', $date->dmy;
} # p %mail;

$tools->send_mail(\%mail, \@recipients);

sub _get_query {
    my @cols = ( 'r.request_number', 'r.year', 's.description|presentation', 
        'rs.display_name' );
    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{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'  => \@screens,
        'po.parent_code' => 'RR8',
    );
    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); exit;
    return ($sql, @bind);
}