#!/usr/bin/perl
=begin -------------------------------------------------------------------------
Generates spreadsheet on Gallium trial cases. Authorised cases only. Excludes
diagnosis terms: Awaiting final diagnosis, See comments, or beginning with
Gallium trial
# TODO:
modify 'See comments' diagnoses + others (
WHERE ct.trial_name = 'Roche Gallium' and ( d.name IN ('Awaiting final diagnosis',
'See comments') or d.name LIKE 'Gallium trial%' ))
biopsy type (fna, core, excision, etc)
lymphoma involvement (%)
how to answer 'elegible for trial'
how to get diagnosis discrepancy
how to get localisation discrepancy
are we doing IgH break-apart & clonality?
DNA results
TMA results
sections (but not DNA or RNA ones ??)
=cut ---------------------------------------------------------------------------
use strict;
use warnings;
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 DateTime::Format::MySQL;
use LIMS::Local::GalliumData;
use LIMS::Local::ScriptHelpers;
use Spreadsheet::WriteExcel::Simple;
my $tools = LIMS::Local::ScriptHelpers->new();
my $today = $tools->time_now->ymd;
################################################################################
my $SUPPRESS_EMAIL = 1;
my $JUST_TESTING = 1; # email to ra.jones only if ! $SUPPRESS_EMAIL
my $filename = sprintf 'gallium_data_%s.xls', $today;
my $subject = sprintf 'GALLIUM trial data %s', $today;
my @recipients = qw(hmds.lth@nhs.net); # archana.ambily irfan.shaikh ??
use constant DATE_FORMAT => '%d%b%Y'; # required format
################################################################################
$tools->test_only($JUST_TESTING);
# 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;
my $round = sub { LIMS::Local::Utils::round_value(@_) };
my $requests = do {
my $sql = $sql_lib->retr('gallium_data'); # warn $sql;
$dbix->query($sql);
};
my @data;
ROW: while ( my $vars = $requests->hash ) { # warn Dumper $vars; next;
my $gallium = LIMS::Local::GalliumData->new(data => $vars);
my $request_id = $vars->{request_id}; # next unless $request_id == 175235;
my @row = (); # reset
# 1) QLABS accession number:
push @row, $vars->{accession_number};
# 2) lab origin (always Leeds):
push @row, 'LEEDS';
# 3) registration date (DDMMYYYY):
push @row, _date_transform($vars->{registered});
# 4) Leeds lab number:
push @row, $vars->{hmds_ref};
# 5) Keil lab number:
push @row, 'NOT APPLICABLE';
{ # 6) Biopsy type:
my $result = $gallium->get_biopsy_type || 'OTHER';
push @row, $result;
}
{ # 7, 8, 9) 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
}
# 10) specimen quality:
push @row, uc $vars->{specimen_quality};
# 11) date of diagnosis (= authorised; DDMMYYYY):
push @row, _date_transform($vars->{authorised});
{ # 12, 13, 14) 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, $diagnosis )
: 'NO DIAGNOSIS MADE';
{ # lymphoma grade - only applicable to FL:
if ($grade) {
my %h = (
'grade 1' => '9695/3 - FL GRADE 1',
'grade 2' => '9691/3 - FL GRADE 2',
'grade 3a' => '9698/3 - FL GRADE 3A',
'grade 3b' => '9698/3 - FL GRADE 3B',
);
push @row, $h{$grade} || 'UNGRADED';
}
else { push @row, undef }
}
{ # reason for no diagnosis - only applicable if no ICDO3:
my @permitted = ( # only accept following diagnoses as valid reasons:
'Inadequate sample',
'Unsuitable specimen',
'No evidence of lymphoma',
);
if (! $icdo3 && grep $diagnosis eq $_, @permitted ) {
push @row, uc $diagnosis;
}
else { push @row, 'NOT APPLICABLE' }
}
}
{ # 15) eligible for trial:
my $result = $gallium->get_trial_elegibility;
push @row, $result;
}
{ # 16) discrepancy with local diagnosis
my $result = $gallium->is_discrepant_diagnosis; # returns false if not
push @row, $result ? 'YES' : 'NO';
}
{ # 17) adjudicated
my $result = $gallium->get_lab_role; # warn Dumper $result;
push @row, lc $result eq 'adjudicator' ? 'YES' : 'NO';
}
{ # 18) discrepant localisation
my $result = $gallium->is_discrepant_localisation;
push @row, $result ? 'YES' : 'NO';
}
{ # 19) lymphoma involvement (%)
my $result = $gallium->get_lymphoma_involvement;
push @row, defined $result ? $result : 'NOT APPLICABLE'; # could be zero
}
{ # 20 .. 33 # 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
}
}
{ # 34) t(14;18) fusion
my $result = $gallium->get_fish_fusion_assay_result('BCL2_IgH');
push @row, $result || 'NOT DONE';
}
{ # 35, 36) BCL2 & BCL6 break-apart
for ( qw/BCL2 BCL6/ ) {
my $result = $gallium->get_fish_break_apart_result($_);
push @row, $result || 'NOT DONE';
}
}
# 37) IgH break-apart (not doing it)
push @row, 'NOT DONE';
{ # 38, 39 BioMed2 IgH Clonality & BP length (not doing it)
my $result = $gallium->get_igh_pcr; # return hashref
push @row, $result->{igh_pcr_result} || 'NOT DONE';
push @row, $result->{igh_pcr_bp_length} || 'NOT DONE';
}
{ # 40 .. 45 RNA results:
my $result = $gallium->get_rna_results; # warn Dumper $vars;
# extraction done:
push @row, %$result ? 'YES' : 'NO';
# rna purity (should be to 2dp):
push @row, $result->{rna_purity} ?
sprintf '%.2f', $result->{rna_purity} : 'NOT DONE';
# rna concentration (integer):
push @row, defined $result->{rna_concentration} ? # probably can't be 0
&$round($result->{rna_concentration}) : 'NOT DONE';
{ # 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 DONE';
push @row, $volume || 'NOT DONE';
}
{ # 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 DONE'; # don't need thickness ($t)
}
}
{ # 46 .. 51 DNA results:
my $result = $gallium->get_dna_results; # warn Dumper $vars;
# extraction done:
push @row, %$result ? 'YES' : 'NO';
# dna purity (should be to 2dp):
push @row, $result->{dna_purity} ?
sprintf '%.2f', $result->{dna_purity} : 'NOT DONE';
# dna concentration (integer):
push @row, defined $result->{dna_concentration} ? # probably can't be 0
&$round($result->{dna_concentration}) : 'NOT DONE';
{ # 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 DONE';
push @row, $volume || 'NOT DONE';
}
{ # 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 DONE'; # don't need thickness ($t)
}
}
{ # 52 .. 56 TMA
push @row, 'NO'; # TMA taken?
push @row, 'NOT APPLICABLE'; # reason not taken [or INSUFFICIENT MATERIAL]
push @row, 0; # no. of TMA cores
push @row, 'GALLIUM-Leeds-' . $vars->{hmds_ref}; # Name of TMA
push @row, 0; # position on TMA
}
{ # 57, 58, 59 sections
push @row, 'NO'; # sections taken?
push @row, 'NOT APPLICABLE'; # reason not taken [or INSUFFICIENT MATERIAL]
push @row, 0; # no. of sections
}
push @data, \@row; # warn Dumper \@row;
}
exit if ! @data;
{ # construct excel spreadsheet:
my $xl = Spreadsheet::WriteExcel::Simple->new;
# $xl->write_bold_row(\@cols);
$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 $dob; # ddmonyyyy -> ddMONyyyy
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)
}
__DATA__
lab_origin
registered_date
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
cyclin_d1
bcl2
bcl6
irf4
ki67
foxp1
kappa
lambda
immuno_status
fish_summary
BCL2
BCL6
BCL2_IgH
rna_volume
rna_concentration
rna_purity
rna_sections
dna_volume
dna_concentration
dna_purity
dna_sections
referred_to_kiel
returned_from_kiel
diagnosis
lymphoma_grade
icdo3
comment
__END__
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]
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]
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]
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]
Reason Sections Not Taken [INSUFFICIENT MATERIAL / NOT APPLICABLE]
Number of Sections Taken (1-10)
