#!/usr/bin/perl
=begin -------------------------------------------------------------------------
Generates pipe-delimited txt file on Roche Gallium trial cases for Quintiles.
Record must be authorised to be included in data feed. Later requests on same
QLABS accession number (Ennnnnnn) supercede earlier ones
Quintiles require unique accession number / test code combination - tested for
at end
=cut ---------------------------------------------------------------------------
use strict;
use warnings;
my $JUST_TESTING = 1; # dump data to file
use lib '/home/raj/perl5/lib/perl5';
use FindBin qw($Bin); # warn $Bin;
use lib "$Bin/../../../lib";
use IO::All;
use Data::Dump qw(dump);
use LIMS::Local::Utils;
use DateTime::Format::MySQL;
use LIMS::Local::GalliumTrial;
use LIMS::Local::ScriptHelpers;
use Spreadsheet::WriteExcel::Simple;
my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);
################################################################################
my @recipients = qw(
marvin.marcellana
hmds.lth@nhs.net
archana.ambily
);
my $filename = sprintf 'BO21223_%s', $tools->time_now->ymd;
my $subject = $filename;
################################################################################
# get tools from LIMS::Local::ScriptHelpers:
my $sql_lib = $tools->sql_lib();
my $config = $tools->config();
my $dbix = $tools->dbix();
my $results = do {
my $sql = $sql_lib->retr('gallium_trial_data'); # warn $sql;
$dbix->query($sql)->hashes;
};
my %results; # AoH
ROW: # group data by accession number:
for my $row ( @$results ) { # warn dump $row;
next ROW unless $row->{location} =~ /Quintiles/; # exclude Kiel data
my $accession_number = $row->{accession_number} || next ROW;
# collect as array of datasets for each accession number:
push @{ $results{$accession_number} }, $row;
}
my $trim = sub { LIMS::Local::Utils::trim(@_) };
my $NULL = ""; # to avoid need for no warnings 'uninitialized'
my @rows;
# process sole - or most recent if >1 - dataset for each accession number:
for my $accession_number ( sort keys %results ) { # warn dump $accession_number;
my $data = $results{$accession_number};
# $data is either hashref or array(ref) of hashrefs:
my $vars = ref $data eq 'ARRAY'
? $data->[-1] # use most recent dataset (query ensures request.id order)
: $data; # warn dump $vars;
my $dob;
if ( my $date = $vars->{dob} ) { # dd-MON-YYYY format required !!
$dob = DateTime::Format::MySQL->parse_date($date)->strftime('%d-%b-%Y');
$dob =~ tr/[a-z]/[A-Z]/; # warn $dob; # dd-mon-yyyy -> dd-MON-yyyy
}
my @common = ( # common fields for all rows:
'Leeds', # referring lab
$vars->{hmds_ref}, # HMDS number
$accession_number, # QLABS accession number (1st 8 chars only)
$vars->{patient_id} || $NULL, # subject ID
$dob || $NULL, # dd-MON-YYYY format required !!
'TISSUE FOR PATH REVIEW',
);
my $gallium = LIMS::Local::GalliumTrial->new(data => $vars);
{ # SDL2087: [First Time Reviewer / Adjudicator]
my $result = $gallium->get_lab_role; # warn Dumper $result;
push @rows, join '|', @common, ( 'SDL2087', $result, $NULL );
}
# SDL2088: [Anatomical localisation of biopsy]
if ( my $site = $gallium->get_biopsy_site ) { # warn Dumper $site;
push @rows, join '|', @common, ( 'SDL2088', $site, $NULL );
}
# SDL2093: [Pattern of involvement: interstitial, diffuse, etc]
if ( my $pattern = $gallium->get_involvement_pattern ) {
push @rows, join '|', @common, ( 'SDL2093', $pattern, $NULL );
}
# SDL2090: [Follicular lymphoma grade: 1, 2, 3a, 3b]
if ( my $grade = $gallium->get_lymphoma_grade ) { # extract grade (only if FL):
push @rows, join '|', @common, ( 'SDL2090', $grade, $NULL ); # warn $grade;
}
# SDL2089: [Sample quality: Good/Average/Poor]
if ( my $result = $gallium->get_sample_quality ) {
push @rows, join '|', @common, ( 'SDL2089', $result, $NULL );
}
# SDL2091: Morphology comment [free text]
if ( my $comment = $gallium->get_morphology_comment ) {
push @rows, join '|', @common, ( 'SDL2091', $comment, $NULL );
}
# SDL2092: Lymphoma involvement [%]
if ( my $num = $gallium->get_lymphoma_involvment ) {
push @rows, join '|', @common, ( 'SDL2092', $num, $NULL );
}
# SDL2099 - SDL2134 marker results [+, -, +/-, Not Evaluable]
if ( my $results = $gallium->get_test_results ) {
push @rows, join '|', @common, ( $_, $results->{$_} ) for keys %$results;
}
# SDL2111: IgH-ASO-PCR [Done / Not Done]
# SDL2112: IgH-ASO-PCR Result [not evaluable, monoclonal, oligoclonal, polyclonal]
# SDL2113: IgH-ASO-PCR Base-pair length [only if monoclonal; numeric]
# SDL2114: IgH-ASO-PCR Comment [free text]
if ( my $result = $gallium->get_igh_pcr ) {
if ( my $str = $result->{igh_pcr_assay} ) { # warn $str;
push @rows, join '|', @common, ( 'SDL2111', $str, $NULL );
}
if ( my $str = $result->{igh_pcr_result} ) { # warn $str;
push @rows, join '|', @common, ( 'SDL2112', $str, $NULL );
}
if ( my $int = $result->{igh_pcr_bp_length} ) { # warn $int;
push @rows, join '|', @common, ( 'SDL2113', $int, $NULL );
}
if ( my $str = $result->{igh_pcr_comment} ) { # warn $str;
push @rows, join '|', @common, ( 'SDL2114', $str, $NULL );
}
}
# SDL2115: BCL2 break-apart [Positive, Negative, Not Evaluable]
if ( my $result = $gallium->get_fish_break_apart_result('BCL2') ) {
push @rows, join '|', @common, ( 'SDL2115', $result, $NULL );
}
# SDL2116: BCL6 break-apart [Positive, Negative, Not Evaluable]
if ( my $result = $gallium->get_fish_break_apart_result('BCL6') ) {
push @rows, join '|', @common, ( 'SDL2116', $result, $NULL );
}
# SDL2117: t(14;18) fusion assay [Positive, Negative, Not Evaluable]
if ( my $result = $gallium->get_fish_fusion_assay_result('BCL2_IgH') ) {
push @rows, join '|', @common, ( 'SDL2117', $result, $NULL );
}
# SDL2118: FISH comment [free text]
if ( my $result = $gallium->get_fish_summary ) {
push @rows, join '|', @common, ( 'SDL2118', $result, $NULL );
}
# SDL2094: Final diagnosis
if ( my $diagnosis = $gallium->get_diagnosis ) {
push @rows, join '|', @common, ( 'SDL2094', $diagnosis, $NULL );
}
# SDL2095: Discrepancy with local diagnosis [Yes, No]
if ( my $result = $gallium->is_discrepant_diagnosis ) {
push @rows, join '|', @common, ( 'SDL2095', $result, $NULL );
}
# SDL2096: Urgent report required [Yes, No]
if ( my $result = $gallium->is_urgent_report ) {
push @rows, join '|', @common, ( 'SDL2096', $result, $NULL );
}
# SDL2097: Urgent block return required [Yes, No]
if ( my $result = $gallium->is_urgent_block_return ) {
push @rows, join '|', @common, ( 'SDL2097', $result, $NULL );
}
# SDL2098: Insufficient material, retest required [Yes, No]
if ( my $result = $gallium->get_sample_adequacy ) {
push @rows, join '|', @common, ( 'SDL2098', $result, $NULL );
}
# SDL2125: ICDO3 code
if ( my $icdo3 = $gallium->get_icdo3 ) {
push @rows, join '|', @common, ( 'SDL2125', $icdo3, $NULL );
}
}
exit if ! @rows;
{ # check accession number / test code is unique:
my %h;
for (@rows) {
my @data = split '\|'; # warn dump @data;
die "duplicate $data[2] / $data[6] combination"
if $h{$data[2]}{$data[6]}++; # [2] = accession number; [6] = test code
}
}
{ # xl spreadsheet (do this before .dat)
my $xl = Spreadsheet::WriteExcel::Simple->new;
for (@rows) {
my @row = split '\|';
$xl->write_row(\@row);
}
# save to file if just testing:
$xl->save("$Bin/$filename.xls") if $JUST_TESTING;
my %mail = (
attachment => $xl->data,
filename => "$filename.xls", # BO21223_yyyymmdd
subject => $subject,
config => $config,
);
# $tools->send_mail(\%mail, \@recipients);
}
=begin
{ # pipe-delimited file:
my $data = join "\n", @rows;
$filename .= '.dat'; # can append now
$data > io($Bin.'/'.$filename) if $JUST_TESTING;
my %mail = (
attachment => $data,
filename => $filename, # BO21223_yyyymmdd.dat
subject => $subject,
config => $config,
);
$tools->send_mail(\%mail, \@recipients);
}
=cut
# print duplicate accession number data to file:
my @ary = map $results{$_}, grep { scalar @{ $results{$_} } > 1 } keys %results;
( dump @ary ) > io($Bin.'/quintiles_duplicates.txt') if $JUST_TESTING;
=begin fields:
SDL2086: HMDS
SDL2087: [First Time Reviewer / Adjudicator]
SDL2088: [Anatomical localisation of biopsy: see list]
SDL2089: [Sample quality: Good/Average/Poor]
SDL2090: [Follicular lymphoma grade: 1, 2, 3a, 3b]
SDL2091: Morphology comment [free text]
SDL2092: Lymphoma involvement [%]
SDL2093: Pattern of involvement [interstitial, diffuse, nodular, intrasinusoidal]
SDL2099 - SDL2110 - test results [+, -, +/-, Not Evaluable]
SDL2111: IgH-ASO-PCR [Done / Not Done]
SDL2112: IgH-ASO-PCR Result [not evaluable, monoclonal, oligoclonal, polyclonal]
SDL2113: IgH-ASO-PCR Base-pair length [only if monoclonal; numeric]
SDL2114: IgH-ASO-PCR Comment [free text]
SDL2115: BCL2 break-apart [Positive, Negative, Not Evaluable]
SDL2116: BCL6 break-apart [Positive, Negative, Not Evaluable]
SDL2117: t(14;18) fusion assay [Positive, Negative, Not Evaluable]
SDL2118: FISH comment [free text]
SDL2094: Final diagnosis
SDL2095: Discrepancy with local diagnosis [Yes, No]
SDL2096: Urgent report required [Yes, No]
SDL2097: Urgent block return required [Yes, No]
SDL2098: Insufficient material, retest required [Yes, No]
SDL2125: ICDO3 code
SDL2123: Kappa light chain [+, -, +/-, Not Evaluable]
SDL2134: Lambda light chain [+, -, +/-, Not Evaluable]
9-field data file:
1: HMDS
2: HMDS_ref [optional]
3: accession number ie pc.unit_number
4: Patient ID [optional]
5: DoB [optional]
6: Visit description [optional]
7: QLAB test code ie SDLxxxx
8: Test result [or CANCELLED + comment in next field]
9: Comment [only for cancelled results]
=cut
