#!/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.
=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::Dumper;
use LIMS::Local::ScriptHelpers;
my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);
################################################################################
# my $duration = 7; # over past number of days - retrieving all data
my @recipients = qw(hmds.lth@nhs.net); # send to departmental addr for manual entries
my $filename = sprintf 'BO21223_%s.dat', $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();
# Quintiles test codes => HMDS test_name map:
my %SDL = (
cd3 => 'SDL2110',
cd5 => 'SDL2099',
cd10 => 'SDL2100',
cd20 => 'SDL2101',
cd23 => 'SDL2102',
bcl1 => 'SDL2104', # = Cyclin D1
bcl2 => 'SDL2103',
bcl6 => 'SDL2108',
irf4 => 'SDL2106',
ki67 => 'SDL2109',
fox_p1 => 'SDL2107',
'bcl-2' => 'SDL2115', # FISH
'bcl-6' => 'SDL2116', # FISH
);
my $requests = do {
my $sql = $sql_lib->retr('gallium_trial_data_quintiles'); # warn $sql;
$dbix->query($sql);
};
my @rows;
while ( my $vars = $requests->hash ) { # warn Dumper $vars;
no warnings 'uninitialized'; # loads of 'em
# common fields for all rows:
my @common = (
'Leeds', # referring lab
$vars->{hmds_ref}, # HMDS number
$vars->{accession_number}, # equivalent to QLABS accession number
$vars->{patient_id}, # subject ID
$vars->{dob},
'TISSUE FOR PATH REVIEW',
);
{ # SDL2087: [First Time Reviewer / Adjudicator]
my $result = $vars->{clinical_details} =~ /referred from Kiel/i
? 'Adjudicator' : 'First Time Reviewer';
push @rows, join '|', @common, ( 'SDL2087', $result, undef );
}
{ # SDL2088: [Anatomical localisation of biopsy]
# SDL2090: [Follicular lymphoma grade: 1, 2, 3a, 3b]
# SDL2093: [Pattern of involvement: interstitial, diffuse, etc]
my $comment = $vars->{comment};
# can't extract anatomical site or pattern of involvment yet:
push @rows, join '|', @common, ( 'SDL2088', 'CANCELLED', 'see morphology comment' );
push @rows, join '|', @common, ( 'SDL2093', 'CANCELLED', 'see morphology comment' );
# extract FL grade (1|I|2|II|3|III) - only if FL:
if ( $vars->{diagnosis} =~ /^Follicular lymphoma/ ) { # can't use ICDO3 (DLBCL with FL)
# use case-sensitive regex to capture "grade I" but not "grade is":
my ($grade) = $comment =~ /\b([Gg]rade\s[\d|I+]\w?)\b/; warn Dumper $grade;
if ( my $n = $grade =~ tr/I// ) { # convert Roman to Arabic digits:
$grade =~ s/(I+)/$n/; # $n = count of I's
} warn Dumper $grade;
push @rows, join '|', @common, ( 'SDL2090', lc $grade, undef );
}
}
{ # SDL2089: [Sample quality: Good/Average/Poor]
my $result = $vars->{specimen_quality};
$result =~ s/adequate/good/; # only using adequate & poor
push @rows, join '|', @common, ( 'SDL2089', ucfirst $result, undef );
}
{ # SDL2091: Morphology comment [free text]
my $comment = $vars->{comment};
$comment =~ s/[\n\r]/ /g; # remove new-lines
push @rows, join '|', @common, ( 'SDL2091', $comment, undef );
}
{ # SDL2092: Lymphoma involvement [%]
push @rows, join '|', @common, ( 'SDL2092', 100, undef ); # temp assessment
}
{ # SDL2099 - SDL2110 marker results [+, -, +/-, Not Evaluable]
TEST:
while ( my ($marker, $test_code) = each %SDL ) {
my $result = $vars->{$marker} || next TEST; # 'CANCELLED';
# TODO: might need to examine specimen type for suitability -> comment:
my $comment = $vars->{$marker} ? undef : 'Test not performed';
push @rows, join '|', @common, ( $test_code, $result, $comment );
}
# CD79a / SDL2105 not done:
# push @rows, join '|', @common, ( 'SDL2105', 'CANCELLED', 'Test not performed' );
}
{ # SDL2111: IgH-ASO-PCR [Done / Not Done]
push @rows, join '|', @common, ( 'SDL2111', 'Not Done', undef );
# 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]
# SDL2123: Kappa light chain [+, -, +/-, Not Evaluable]
# SDL2134: Lambda light chain [+, -, +/-, Not Evaluable]
}
{ # SDL2118: FISH comment [free text]
push @rows, join '|', @common, ( 'SDL2118', $vars->{fish_summary}, undef );
}
{ # SDL2094: Final diagnosis
push @rows, join '|', @common, ( 'SDL2094', $vars->{diagnosis}, undef );
}
{ # SDL2095: Discrepancy with local diagnosis [Yes, No]
# SDL2096: Urgent report required [Yes, No]
# SDL2097: Urgent block return required [Yes, No]
1;
}
{ # SDL2098: Insufficient material, retest required [Yes, No]
my $result = $vars->{diagnosis} eq 'Inadequate sample' ? 'Yes' : 'No';
push @rows, join '|', @common, ( 'SDL2098', $result, undef );
}
{ # SDL2125: ICDO3 code
push @rows, join '|', @common, ( 'SDL2094', $vars->{icdo3}, undef );
}
}
exit if ! @rows;
{ # pipe-delimited file:
no warnings 'uninitialized'; # empty fields in @$_:
my $data = join "\n", @rows;
$data > io($filename) if $JUST_TESTING;
my %mail = (
attachment => $data,
filename => $filename, # BO21223_yyyymmdd.dat
subject => $subject,
config => $config,
);
# $tools->send_mail(\%mail, \@recipients);
}
=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
