#!/usr/bin/env perl
=begin -------------------------------------------------------------------------
Generates spreadsheet on Gallium trial cases. Authorised cases only. Requires
ICDO3 or one of following diagnoses: 'no evidence of lymphoma', 'unsuitable
specimen', 'inadequate sample'. Anything else picked up by gallium_pending.pl
=cut ---------------------------------------------------------------------------
use strict;
use warnings;
use lib '/home/raj/perl5/lib/perl5';
use Data::Dumper;
use DateTime::Format::MySQL;
use Spreadsheet::WriteExcel::Simple;
use FindBin qw($Bin); # warn $Bin;
use lib "$Bin/../../../lib";
use LIMS::Local::Utils;
use LIMS::Local::GalliumData;
use LIMS::Local::ScriptHelpers;
my $tools = LIMS::Local::ScriptHelpers->new();
my $today = $tools->time_now->ymd(''); # yyyymmdd
################################################################################
my $SUPPRESS_EMAIL = 0;
my $JUST_TESTING = 0; # save locally, email to raj only (if ! $SUPPRESS_EMAIL)
my $subject = sprintf 'BO21223_%s', $today;
my $filename = $subject . '.xls'; # warn $filename;
my @recipients = qw(
hmds.lth@nhs.net
archana.ambily
marvin.marcellana
); # irfan.shaikh ??
use constant DATE_FORMAT => '%d-%b-%Y'; # required format
################################################################################
$tools->test_only($JUST_TESTING);
# xl file headers:
my $col_headers = _col_headers(); # warn Dumper $col_headers; exit;
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();
my $cfg_file = "$Bin/../lib/settings.cfg";
my $settings = Config::Auto::parse($cfg_file); # warn Dumper $settings; exit;
# permitted non-ICDO3 diagnoses:
my $non_icdo3 = $settings->{non_icdo3}; # warn Dumper $non_icdo3;
# ensure case-sensitivity of col names preserved (eg bcl2 & BCL2):
$dbix->lc_columns = 0;
my $nearest = sub { LIMS::Local::Utils::nearest_value(@_) };
my $round = sub { LIMS::Local::Utils::round_value(@_) };
my $requests = do {
my $sql = $sql_lib->retr('gallium_data'); # warn $sql;
$dbix->query($sql, @$non_icdo3); # permitted non-ICDO3 diagnoses
};
my @data = my @errors = ();
ROW: while ( my $vars = $requests->hash ) { # warn Dumper $vars; next;
my $hmds_ref = $vars->{hmds_ref};
# need to check "optional" comment field exists or will get fatal error:
unless ($vars->{comment}) {
push @errors, "empty comment field $vars->{hmds_ref}";
next ROW;
}
my $gallium = LIMS::Local::GalliumData->new(data => $vars);
my @row = (); # reset
# 1) Lab ID (always 21223LEEDS)
push @row, '21223LEEDS';
# 2) QLABS accession number:
push @row, $vars->{accession_number};
# 3) lab origin (always Leeds):
push @row, 'LEEDS';
# 4) registration date (DD-MON-YYYY):
push @row, _date_transform($vars->{registered});
# 5) Leeds lab number:
push @row, $vars->{hmds_ref};
# 6) Kiel lab number:
push @row, 'NOT APPLICABLE';
{ # 7) Biopsy type:
my $result = $gallium->get_biopsy_type || 'OTHER';
push @row, uc $result; # warn $result;
}
{ # 8, 9, 10) slides & blocks:
my $h = $gallium->get_external_reference; # warn Dumper $h;
{ # either, both or neither:
if ( $h->{slides} && $h->{blocks} ) {
push @row, 'BOTH';
}
elsif ($h->{slides}) {
push @row, 'SLIDES';
}
elsif ($h->{blocks}) {
push @row, 'BLOCKS';
}
else {
push @row, 'NONE';
}
}
push @row, $h->{slides} || 0; # number of slides
push @row, $h->{blocks} || 0; # number of blocks
}
# 11) specimen quality:
push @row, uc $vars->{specimen_quality};
# 12) date of diagnosis (= authorised; DD-MON-YYYY):
push @row, _date_transform($vars->{authorised});
{ # 13, 14, 15) diagnosis, lymphoma grade, reason for no diagnosis:
my $diagnosis = $gallium->get_diagnosis;
my $grade = $gallium->get_lymphoma_grade; # returns 0 if not FL
my $icdo3 = $gallium->get_icdo3; # returns 0 if not ICDO3
# diagnosis (override entry if no ICDO3):
push @row, $icdo3
? ( join ' - ', $icdo3, uc $diagnosis )
: 'NO DIAGNOSIS MADE';
{ # lymphoma grade - only applicable to FL:
if ($grade) {
my %h = (
'1' => '9695/3',
'2' => '9691/3',
'3a' => '9698/3',
'3b' => '9698/3',
);
push @row, $h{$grade}
? sprintf '%s - FL GRADE %s', $h{$grade}, uc $grade
: 'UNGRADED';
}
elsif ( $icdo3 =~ /^9690/ ) { # FL without defined $grade
push @row, 'UNGRADED';
}
else { push @row, 'NOT APPLICABLE' }
}
{ # reason for no diagnosis - only applicable to non-ICDO3 diagnoses:
push @row, $icdo3
? 'NOT APPLICABLE' # don't need reason
: uc $diagnosis; # will be one of permitted entries in $non_icdo3
}
}
{ # 16) eligible for trial:
my $result = $gallium->get_trial_elegibility;
unless ( grep lc $result eq $_, qw/yes no/ ) { # warn Dumper $result;
push @errors, qq!trial eligibility "$result" invalid for $hmds_ref!;
next ROW;
}
push @row, uc $result; # default handled by get_trial_elegibility()
}
{ # 17) discrepancy with local diagnosis
my $result = $gallium->is_discrepant_diagnosis || 'no'; # returns false if not
unless ( grep lc $result eq $_, qw/yes no/ ) { # warn Dumper $result;
push @errors, qq!discrepant diagnosis "$result" invalid for $hmds_ref!;
next ROW;
}
push @row, uc $result; # default NO
}
{ # 18) adjudicated # query now exclusively Quintiles src so will always be NO
my $result = $gallium->get_lab_role; # warn Dumper $result;
push @row, lc $result eq 'adjudicator' ? 'YES' : 'NO';
}
{ # 19) discrepant localisation
my $result = $gallium->is_discrepant_localisation || 'no';
unless ( grep lc $result eq $_, qw/yes no/ ) { # warn Dumper $result;
push @errors, qq!discrepant localisation "$result" invalid for $hmds_ref!;
next ROW;
}
push @row, uc $result; # default NO
}
{ # 20) lymphoma involvement (%)
my $result = $gallium->get_lymphoma_involvement; # warn $result;
push @row, defined $result
? &$nearest(10, $result) # rounds to nearest 10
: 'NOT APPLICABLE'; # could be zero
}
{ # 21 .. 34 # IHC
my @markers = qw( cd3 cd5 cd10 cd20 cd23 cd79 ki67 cyclin_d1 bcl2 bcl6
foxp1 irf4 kappa lambda );
my $results = $gallium->get_test_results(\@markers); # hashref
for my $t(@markers) {
my $result = $results->{$t};
push @row, defined $result ? $result : 'NOT DONE'; # could be zero
}
}
{ # 35) t(14;18) fusion
my $result = $gallium->get_fish_fusion_assay_result('BCL2_IgH');
push @row, uc $result || 'NOT DONE';
}
{ # 36, 37, 38) BCL2, BCL6 & IgH break-apart
for ( qw/BCL2 BCL6 IgH/ ) {
my $result = $gallium->get_fish_break_apart_result($_);
push @row, uc $result || 'NOT DONE';
}
}
{ # 39, 40 BioMed2 IgH Clonality & BP length
my $result = $gallium->get_igh_pcr; # warn Dumper $result; # hashref
my $igh_status = $result->{igh_pcr_assay} || 'NOT DONE';
# if IgH clonality done:
if ( lc $igh_status eq 'done' ) {
push @row, uc $result->{igh_pcr_result} || 'NOT DONE';
push @row, $result->{igh_pcr_bp_length} || 'NOT DONE';
}
else {
push @row, ('NOT DONE', 'NOT DONE');
}
}
{ # 41 .. 46 RNA results:
my $result = $gallium->get_rna_results; # warn Dumper $result; # hashref
# extraction done:
push @row, %$result ? 'YES' : 'NO';
# rna purity (should be to 2dp):
push @row, $result->{rna_purity} ?
sprintf '%.2f', $result->{rna_purity} : 'NOT APPLICABLE';
# rna concentration (integer):
push @row, defined $result->{rna_concentration} ? # probably can't be 0
&$round($result->{rna_concentration}) : 'NOT APPLICABLE';
{ # rna aliquots & volume per aliquot:
no warnings 'uninitialized'; # maybe no $result->{rna_volume}
my ($number, $volume) = split ' x ', $result->{rna_volume}; # eg 2 x 15;
push @row, $number || 'NOT APPLICABLE';
push @row, $volume || 'NOT APPLICABLE';
}
{ # number of rna sections:
no warnings 'uninitialized'; # maybe no $result->{rna_sections}
my ($number, $t) = split ' x ', $result->{rna_sections}; # eg 10 x 5;
push @row, $number || 'NOT APPLICABLE'; # don't need thickness ($t)
}
}
{ # 47 .. 52 DNA results:
my $result = $gallium->get_dna_results; # warn Dumper $result; # hashref
# extraction done:
push @row, %$result ? 'YES' : 'NO';
# dna purity (should be to 2dp):
push @row, $result->{dna_purity} ?
sprintf '%.2f', $result->{dna_purity} : 'NOT APPLICABLE';
# dna concentration (integer):
push @row, defined $result->{dna_concentration} ? # probably can't be 0
&$round($result->{dna_concentration}) : 'NOT APPLICABLE';
{ # dna aliquots & volume per aliquot:
no warnings 'uninitialized'; # maybe no $result->{dna_volume}
my ($number, $volume) = split ' x ', $result->{dna_volume}; # eg 2 x 15;
push @row, $number || 'NOT APPLICABLE';
push @row, $volume || 'NOT APPLICABLE';
}
{ # number of dna sections:
no warnings 'uninitialized'; # maybe no $result->{dna_sections}
my ($number, $t) = split ' x ', $result->{dna_sections}; # eg 10 x 5;
push @row, $number || 'NOT APPLICABLE'; # don't need thickness ($t)
}
}
{ # 53 .. 57 TMA
my $result = $gallium->get_tma_results; # warn Dumper $result; # hashref
# was TMA taken [YES, or reason if not]:
my $tma_status = $result->{tma_status};
# if TMA taken:
if ( $tma_status && uc $tma_status eq 'YES' ) {
my $tma_position = $result->{tma_position};
my $tma_block = $result->{tma_block};
if ( $tma_block && $tma_position ) {
push @row, 'YES'; # TMA taken
push @row, 'NOT APPLICABLE'; # reason
push @row, $result->{tma_cores} || 0; # no. of TMA cores [1/2]
push @row, 'GALLIUM-Leeds-' . $tma_block; # name of TMA
push @row, $tma_position; # position on TMA
}
else { # pending manual edit (probably regex failed on core positions)
push @errors, "no TMA block/position for $vars->{hmds_ref}";
push @row, ('PENDING','PENDING');
push @row, 'NOT APPLICABLE' for (1..3);
}
}
else { # $result->{tma_taken} != YES, or no $result:
push @row, $tma_status ? 'NO' : 'PENDING'; # ie tma_status != YES
push @row, $tma_status ? ( uc $tma_status ) : 'PENDING'; # reason
push @row, 'NOT APPLICABLE' for (1..3); # no of cores, name & position
}
}
{ # 58, 59, 60 sections (which ones, DNA, RNA or what else?)
push @row, 'NO'; # sections taken?
push @row, 'NOT APPLICABLE'; # reason not taken [or INSUFFICIENT MATERIAL]
push @row, 0; # no. of sections [or NOT APPLICABLE]
}
push @data, \@row; # warn Dumper \@row;
}
if (@errors) {
my $msg = "Gallium trial request errors:\n\t" . join "\n\t", @errors;
$JUST_TESTING ? warn $msg : $tools->mail_admin({ script => $0, msg => $msg });
}
exit if ! @data;
{ # construct excel spreadsheet:
my $xl = Spreadsheet::WriteExcel::Simple->new;
$xl->write_bold_row($col_headers); # arrayref
$xl->write_row($_) for @data;
# save to file if just testing:
$xl->save($Bin.'/'.$filename) if $JUST_TESTING;
_send_mail($xl->data) unless $SUPPRESS_EMAIL;
}
sub _date_transform {
my $date = DateTime::Format::MySQL->parse_date(@_)->strftime(DATE_FORMAT);
$date =~ tr/[a-z]/[A-Z]/; # warn $date; # dd-mon-yyyy -> dd-MON-yyyy
return $date;
}
sub _send_mail {
my $data = shift;
my %mail = (
attachment => $data,
filename => $filename,
subject => $subject,
config => $config,
); # warn Dumper \%mail;
$tools->send_mail(\%mail, \@recipients)
}
sub _col_headers {
my @cols = (
[ NULL => 'lab_id' ], # don't need col header
[ NULL => 'accession_number' ], # don't need col header
[ SDL2086 => 'lab_origin' ],
[ SDL2605 => 'registered' ],
[ SDL2606 => 'hmds_ref' ],
[ SDL2607 => 'kiel_ref' ],
[ SDL2608 => 'biopsy_type' ],
[ SDL2609 => 'slides_or_blocks' ],
[ SDL2610 => 'slides' ],
[ SDL2611 => 'blocks' ],
[ SDL2089 => 'specimen_quality' ],
[ SDL2612 => 'reported' ],
[ SDL2094 => 'diagnosis' ],
[ SDL2090 => 'grade' ],
[ SDL2703 => 'no_diagnosis_reason' ],
[ SDL2613 => 'elegible' ],
[ SDL2095 => 'discrepant_diagnosis' ],
[ SDL2614 => 'adjudicated' ],
[ SDL2615 => 'discrepant_localisation' ],
[ SDL2092 => 'lymphoma_involvement' ],
[ SDL2110 => 'cd3' ],
[ SDL2099 => 'cd5' ],
[ SDL2100 => 'cd10' ],
[ SDL2101 => 'cd20' ],
[ SDL2102 => 'cd23' ],
[ SDL2105 => 'cd79' ],
[ SDL2109 => 'ki67' ],
[ SDL2104 => 'cyclin_d1' ],
[ SDL2103 => 'bcl2' ],
[ SDL2108 => 'bcl6' ],
[ SDL2107 => 'foxp1' ],
[ SDL2106 => 'irf4' ],
[ SDL2123 => 'kappa' ],
[ SDL2134 => 'lambda' ],
[ SDL2117 => 't(14;18)_fusion' ],
[ SDL2115 => 'BCL2_breakapart' ],
[ SDL2116 => 'BCL6_breakapart' ],
[ SDL2638 => 'IgH_breakapart' ],
[ SDL2639 => 'IgH_clonality' ],
[ SDL2113 => 'IgH_BP_length' ],
[ SDL2616 => 'rna_extraction' ],
[ SDL2617 => 'rna_purity' ],
[ SDL2618 => 'rna_concentration' ],
[ SFL2619 => 'rna_aliquots' ],
[ SDL2620 => 'rna_volume' ],
[ SDL2621 => 'rna_sections' ],
[ SDL2623 => 'dna_extraction' ],
[ SDL2624 => 'dna_purity' ],
[ SDL2625 => 'dna_concentration' ],
[ SDL2626 => 'dna_aliquots' ],
[ SDL2627 => 'dna_volume' ],
[ SDL2628 => 'dna_sections' ],
[ SDL2629 => 'tma_taken' ],
[ SDL2630 => 'tma_reason' ],
[ SDL2631 => 'tma_cores' ],
[ SDL2632 => 'tma_name' ],
[ SDL2633 => 'tma_position' ],
[ SDL2634 => 'sections_taken' ],
[ SDL2635 => 'reason' ],
[ SDL2636 => 'sections' ],
);
my @headers = map $_->[0], @cols; # warn Dumper \@headers;
# convert NULL's to empty string:
map { s/NULL//; } @headers; # warn Dumper \@headers;
return \@headers;
}
__DATA__
Qlabs Accession number
Central Pathology Lab [LEEDS]
Registered Date at Central Pathology [DDMMMYYYY]
Accession no in central pathology-Leeds: 5 digit number/2 digit year
Accession no in central pathology-Kiel: [NOT APPLICABLE]
Biopsy [FINE NEEDLE ASPIRATION / CORE BIOPSY / SURGICAL EXCISION / OTHER]
Slides or Blocks [SLIDES / BLOCKS]
Number of Slides Received [1-100]
Number of Blocks Received [1-10]
Specimen Quality [ADEQUATE / INADEQUATE / POOR / NO TISSUE LEFT]
Date of Final Diagnosis by Central Pathology [DDMMMYYYY]
Final Diagnosis by Central Pathology (including Adjudication) According to Modified WHO 2011
FL Grades [9695/3 - FL GRADE 1 / 9691/3 - FL GRADE 2 / 9698/3 - FL GRADE 3A / 9698/3 - FL GRADE 3B / UNGRADED]
Reason Why No Diagnosis Made [INSUFFICIENT MATERIAL FOR CENTRAL PATHOLOGY - QUINTILES TO REQUEST
ANOTHER SAMPLE / UNSUITABLE MATERIAL - QUINTILES TO REQUEST ANOTHER SAMPLE / NO
LYMPHOMA IN SPECIMEN - QUINTILES TO REQUEST ANOTHER SAMPLE / NOT APPLICABLE]
Eligible to Gallium [YES / NO / PENDING]
Discrepancy with Diagnosis of Local Pathology [YES - QUINTILES TO NOTIFY SITE / NO]
Adjudicated [YES / NO]
Discrepant Localization [YES - QUINTILES TO REQUEST ANOTHER SAMPLE / NO]
Bone Marrow Result-% of Lymphoma Involvement [ 0, 10, 20 .. 100 / NOT APPLICABLE]
CD3 [+ or - or +/- / NOT DONE / NOT EVALUABLE]
CD5 [+ or - or +/- / NOT DONE / NOT EVALUABLE]
CD10 [+ or - or +/- / NOT DONE / NOT EVALUABLE]
CD20 [+ or - or +/- / NOT DONE / NOT EVALUABLE]
CD23 [+ or - or +/- / NOT DONE / NOT EVALUABLE]
CD79A [+ or - or +/- / NOT DONE / NOT EVALUABLE]
KI67 [0, 10, 20 .. 100 / NOT DONE / NOT EVALUABLE]
Cyclin D1 [+ or - or +/- / NOT DONE / NOT EVALUABLE]
Bcl-2 [+ or - or +/- / NOT DONE / NOT EVALUABLE]
Bcl-6 [+ or - or +/- / NOT DONE / NOT EVALUABLE]
Foxp1 [+ or - or +/- / NOT DONE / NOT EVALUABLE]
IRF4 [+ or - or +/- / NOT DONE / NOT EVALUABLE]
kappa [+ or - or +/- / NOT DONE / NOT EVALUABLE]
lambda [+ or - or +/- / NOT DONE / NOT EVALUABLE]
t(14;18) Fusion [POSITIVE / NEGATIVE / NOT DONE / NOT EVALUABLE]
Bcl-2 Break-Apart [POSITIVE / NEGATIVE / NOT DONE / NOT EVALUABLE]
Bcl-6 Break-Apart [POSITIVE / NEGATIVE / NOT DONE / NOT EVALUABLE]
IgH Break-Apart [POSITIVE / NEGATIVE / NOT DONE / NOT EVALUABLE]
BioMed2 IgH Clonality [MONOCLONAL / OLIGOCLONAL / POLYCLONAL / NO MARKER / NOT DONE / NOT EVALUABLE]
BioMed2 IgH Clonality Length of Clonal Peak in Base Pairs (if IgH monoclonal) [0-1000 / NOT DONE]
RNA Extraction [YES / INSUFFICIENT MATERIAL / NO / PENDING]
RNA Purity OD 260/280 [n.nn / NOT APPLICABLE]
RNA Concentration (�g/�l) [0-999 / NOT APPLICABLE]
Number of RNA Aliquots [1-9 / NOT APPLICABLE]
RNA Volume per Aliquot in �l [1-20 / NOT APPLICABLE]
Number of Sections for RNA Extraction [1-5 / NOT APPLICABLE]
DNA Extraction [YES / INSUFFICIENT MATERIAL / NO / PENDING]
DNA Purity OD 260/280 [n.nn / NOT APPLICABLE]
DNA concentration (�g/�l) [0-999 / NOT APPLICABLE]
Number of DNA Aliquots (1-9 or NOT APPLICABLE
DNA Volume per Aliquot in �l [1-20 / NOT APPLICABLE]
Number of Sections for DNA Extraction [1-5 / NOT APPLICABLE]
TMA Taken? [YES / NO / PENDING]
Reason TMA Not Taken [INSUFFICIENT MATERIAL / NOT APPLICABLE]
Number of TMA Cores Taken [1 / 2]
Name of TMA [GALLIUM-Leeds-LAB-number] respectively [GALLIUM-Kiel-LAB-number] - what ??
Position on TMA [1-50]
Sections Taken? [YES / NO / PENDING]
Reason Sections Not Taken [INSUFFICIENT MATERIAL / NOT APPLICABLE]
Number of Sections Taken (1-10)
