#!/usr/bin/perl
=begin -------------------------------------------------------------------------
Generates spreadsheet on Roche Gallium trial cases. Assumptions for cases referred
to Kiel: if diagnosis is, or was, "Gallium trial - referred to Kiel", date of
referral = authorisation date. If diagnosis subsequently updated, then return date
assumed to be date of diagnosis change (taken from request_diagnosis_history table
where entry = "Gallium trial - referred to Kiel")
=cut ---------------------------------------------------------------------------
use strict;
use warnings;
my $JUST_TESTING = 0; # email to ra.jones only
use lib '/home/raj/perl5/lib/perl5';
use FindBin qw($Bin); # warn $Bin;
use lib "$Bin/../../../lib";
use Data::Dumper;
use LIMS::Local::Utils;
use LIMS::Local::GalliumTrial;
use LIMS::Local::ScriptHelpers;
use Spreadsheet::WriteExcel::Simple;
my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);
my $today = $tools->time_now->ymd;
################################################################################
my @recipients = qw(archana.ambily irfan.shaikh hmds.lth@nhs.net);
my $filename = sprintf 'gallium_data_%s.xls', $today;
my $subject = sprintf 'GALLIUM trial data %s', $today;
################################################################################
# xl file headers:
my @cols = <DATA>; chomp(@cols); # warn Dumper @cols;
push @recipients, 'raj' if $JUST_TESTING; # will be sole recipient
# get tools from LIMS::Local::ScriptHelpers:
my $sql_lib = $tools->sql_lib();
my $config = $tools->config();
my $dbix = $tools->dbix();
# ensure case-sensitivity of col names preserved (eg bcl2 & BCL2):
$dbix->lc_columns = 0;
# get cases referred to Kiel:
my $referrals = do {
my $sql = $sql_lib->retr('gallium_trial_referred_to_kiel');
$dbix->query($sql)->map;
};
my $requests = do {
my $sql = $sql_lib->retr('gallium_trial_data'); # warn $sql;
$dbix->query($sql);
};
# get specimens - can't combine GROUP_CONCAT with MAX(CASE .. WHEN .. THEN ..END)
# used for results_summaries
my $specimens = do {
my $sql = $sql_lib->retr('gallium_trial_request_specimen');
$dbix->query($sql)->map_hashes('request_id');
};
my $trim = sub { LIMS::Local::Utils::trim(@_) };
my @rows;
ROW: while ( my $vars = $requests->hash ) { # warn Dumper $vars;
my $gallium = LIMS::Local::GalliumTrial->new(data => $vars);
my $request_id = $vars->{request_id};
# lab role (first-time reviewer / adjudicator):
if ( my $result = $gallium->get_lab_role ) { # warn Dumper $result;
$vars->{lab_role} = $result;
}
# slides & blocks:
if ( my $exref = $gallium->get_external_reference ) { # warn Dumper $exref;
$vars->{$_} = $exref->{$_} for qw(block_id slides blocks);
}
# lymphoma grade:
if ( my $grade = $gallium->get_lymphoma_grade ) { # extract grade (only if FL):
$vars->{lymphoma_grade} = $grade;
}
# IgH PCR:
if ( my $result = $gallium->get_igh_pcr ) {
$vars->{$_} = $result->{$_} for grep $result->{$_},
qw(igh_pcr_assay igh_pcr_result igh_pcr_bp_length igh_pcr_comment);
}
# RNA result:
if ( my $result = $gallium->get_rna_results ) { # warn Dumper $vars;
$vars->{$_} = $result->{$_} for grep $result->{$_},
qw(rna_volume rna_concentration rna_purity rna_sections);
}
{ # referred to/from Kiel (from separate query):
my $diagnosis = $vars->{diagnosis} || ''; # avoid uninitialized warning
if ( $referrals->{$request_id} || $diagnosis =~ /referred to kiel/i ) {
$vars->{referred_to_kiel} = $vars->{reported}; # date
}
if ( my $return_date = $referrals->{$request_id} ) { # assume diagnosis change date
$vars->{returned_from_kiel} = $return_date;
}
}
if ( my $result = $gallium->is_retest_required ) {
$vars->{retest_required} = $result;
}
my @data = @{$vars}{@cols}; # warn Dumper $vars;
push @rows, \@data;
}
exit if ! @rows;
{ # construct excel spreadsheet:
my $xl = Spreadsheet::WriteExcel::Simple->new;
$xl->write_bold_row(\@cols);
$xl->write_row($_) for @rows;
# save to file if just testing:
$xl->save($Bin.'/'.$filename) if $JUST_TESTING;
my %mail = (
attachment => $xl->data,
filename => $filename,
subject => $subject,
config => $config,
); # warn Dumper \%mail;
$tools->send_mail(\%mail, \@recipients);
}
__DATA__
hmds_ref
lab_role
accession_number
site_id
patient_id
dob
gender
specimen_quality
retest_required
registered
reported
slides
blocks
block_id
consent
immuno_summary
cd3
cd5
cd10
cd20
cd23
cd79
bcl1
bcl2
bcl6
irf4
ki67
foxp1
kappa
lambda
immuno_status
igh_pcr_assay
igh_pcr_result
igh_pcr_bp_length
igh_pcr_comment
fish_summary
BCL2
BCL6
BCL2_IgH
rna_volume
rna_concentration
rna_purity
rna_sections
referred_to_kiel
returned_from_kiel
diagnosis
lymphoma_grade
icdo3
comment