• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/env perl

=begin -------------------------------------------------------------------------
emails XL list of new diagnoses of ALL & mixed phenotype leukaemia
discontinued July 2019, PM-C departed, no-one allocated to take over role
=cut ---------------------------------------------------------------------------

use Getopt::Std;
getopts('m:t'); # months, testing
our($opt_m,$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( pedro.martin-cabrera ); # using nhs.net address
################################################################################

use lib '/home/raj/perl5/lib/perl5';
use Data::Printer;
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 $duration = $opt_m || 1; # how many months back
my $date = $tools->date_subtract( months => $duration );

my $subject  = sprintf 'Lymphoblastic/mixed-phenotype AL data for %s.%s',
	$date->month_abbr, $date->year; # warn $subject; exit;
my $filename = 'all.xls';

# xl file headers:
my @headers = qw( request_number year last_name first_name dob age nhs_number
    location specimen clinical_details morphology comment flow_result
    cytogenetics_result molecular_result hb wbc plts diagnosis auth_date );
#-------------------------------------------------------------------------------

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

my @data;

# get SQL statements for queries:
my $requests = $sql_lib->retr('all_and_mixed_phenotype');

my @bind = ($duration, $duration); # required twice
my $result = $dbix->query( $requests, @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('all_and_mixed_phenotype.xls'); exit;
	$mail{attachment} = $xl->data;
    $mail{filename}   = $filename;
}
else {
	$mail{message} = sprintf 'No data for %s.%s', $date->month_abbr, $date->year;
} # p %mail;

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