• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/env perl

=begin -------------------------------------------------------------------------
emails list of FLAIR trial cases
=cut ---------------------------------------------------------------------------

#------------------------------------------------------------------------------
my @recipients = qw( detute bagguley andy.rawstron.secure raj );
#------------------------------------------------------------------------------

BEGIN {
	use lib '/home/raj/perl5/lib/perl5'; # *must* come before FindBin($Bin)
 	use FindBin qw($Bin); # warn $Bin; exit;
 	use lib ("$Bin/../../../lib", '/home/raj/perl-lib');
 	# override default db test:
 	$ENV{ROSEDB_DEVINIT} = "$Bin/../../../config/rosedb_devinit_prod.pl";
}

use Getopt::Std;
getopts('m:t'); # months, testing
our($opt_m,$opt_t); # warn $opt_m; exit;

my $months = $opt_m || 1; # months

# emails only 'service_email' addr in config
my $JUST_TESTING = $opt_t || 0;

use strict;
use warnings;

use Data::Printer;
use SQL::Abstract::More;
use LIMS::Local::ScriptHelpers;

my $cfg_file = "$Bin/../lib/settings.cfg";
my $settings = Config::Auto::parse($cfg_file); # p $settings;

# get tools from LIMS::Local::ScriptHelpers:
my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);

my $config = $tools->config();
my $dbix   = $tools->dbix;
my $sqla   = SQL::Abstract::More->new;

my $last_month = $tools->date_subtract( months => $months );

my $subject  = sprintf 'FLAIR trial cases registered %s %s',
	$last_month->month_name, $last_month->year; # warn $subject; exit;

my $requests = get_requests();

my @rows;
for my $req (@$requests) { # p $req; # next;
    push @rows, sprintf '%s/%s :: %s :: %s :: %s :: %s',
        $req->{request_number},
        $req->{year} - 2000,
        $req->{registered},
        $req->{source},
        $req->{specimen},
        $req->{presentation};
}
if (@rows) {
    my %mail = (
        config  => $config,
        subject => $subject,
        message => join "\n", @rows,
    ); # p %mail;
    $tools->send_mail(\%mail, \@recipients);
 }

sub get_requests {
	my @cols = qw(
        r.request_number
        r.year
        date(r.created_at)|registered
        s2.description|presentation
        rs1.display_name|source
        group_concat(s1.sample_code)|specimen
    );
    my @rels = (
        'requests|r'                  => 'r.patient_case_id=pc.id'           ,
        'patient_case|pc'             => 'pc.referral_source_id=rs1.id'      ,
        'referral_sources|rs1'        => 'ris.request_id=r.id'               ,
        'request_initial_screen|ris'  => 'ris.screen_id=s2.id'               ,
        'screens|s2'                  => 'rs2.request_id=r.id'               ,
        'request_specimen|rs2'        => 'rs2.specimen_id=s1.id'             ,
        'specimens|s1'
    );
	my %where = (
        'YEAR(r.created_at)'  => $last_month->year,
		'MONTH(r.created_at)' => $last_month->month,
        's2.description'      => { rlike => 'flair' },
	);
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => \%where,
        -group_by => 'r.id',
        -order_by => ['rs1.display_name','r.id'],
	);
	my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
	   # $dbix->dump_query($sql, @bind); exit;
    my $ref = $dbix->query($sql, @bind)->hashes; # AoH
    return $ref;
}