package LIMS::Local::GalliumTrial;
use Moose;
has data => (
is => 'ro',
isa => 'HashRef',
required => 1,
);
has test_codes => (
is => 'ro',
isa => 'HashRef',
lazy_build => 1,
);
__PACKAGE__->meta->make_immutable;
use Data::Dumper;
use LIMS::Local::Utils;
my $trim = sub { LIMS::Local::Utils::trim(@_) };
#===============================================================================
# regex's:
my $words_re = qr{\s?(\b\w+\b( \b\w+\b)?)}; # matches 1 or 2 words
my $igh_aso_re = qr{\s?(not evaluable|(mono|oligo|poly)clonal)}i;
my $biopsy_re = qr/
biopsy\:\s*(.*?)\.
/ix; # capture all between ':' and 1st full-stop
my $grade_re = qr{\b(grade\s\d\w?)\b}i; # lymphoma grade 1,2,3[ab]
#===============================================================================
sub get_lab_role {
my $self = shift;
my $clinical_details = $self->data->{clinical_details} || return 0;
my $result = $clinical_details =~ /referred from Kiel/i
? 'Adjudicator' : 'First Time Reviewer';
return $result;
}
# extract block ref + number of slides & blocks from external_ref:
sub get_external_reference {
my $self = shift;
my $exref = $self->data->{external_reference} or return 0;
# just capture 1st item of block_ref eg (125-16696) x20uss
my ($block_ref) = split /\sx(:?\d+)[spu]/, $exref; # warn $block_ref;
my ($unstained_slides) = $exref =~ /x(\d+)uss/; # warn $unstained_slides
my ($stained_slides) = $exref =~ /x(\d+)ss/; # warn $stained_slides
my ($blocks) = $exref =~ /x(\d+)p/; # warn $blocks;
my $slides = do {
no warnings 'uninitialized';
$unstained_slides + $stained_slides;
}; # warn Dumper [$block_ref, $slides, $blocks];
my %h = (
block_id => &$trim($block_ref),
slides => $slides || 0,
blocks => $blocks || 0,
);
return \%h;
}
sub get_rna_results {
my $self = shift;
my $result = $self->data->{molecular_summary} || return 0;
my %h = ();
if ( $result =~ /RNA volume\:(.*)ul/ ) { # warn $1
$h{rna_volume} = &$trim($1);
}
if ( $result =~ /RNA concentration\:(.*)ng/ ) { # warn $1;
$h{rna_concentration} = &$trim($1);
}
if ( $result =~ /OD260\/280\:\s?(\d*\.\d+)/ ) { # warn $1;
$h{rna_purity} = $1;
}
if ( $result =~ /RNA sections\:(.*)micron/ ) { # warn $1
$h{rna_sections} = &$trim($1);
} # warn Dumper [@{$vars}{qw(rna_volume rna_concentration rna_purity rna_sections)}];
return \%h;
}
sub get_igh_pcr {
my $self = shift;
my $result = $self->data->{molecular_summary} || return 0;
my %h = ();
if ( $result =~ /IgH-ASO assay\:$words_re/ ) { # warn $1;
$h{igh_pcr_assay} = &$trim($1);
}
if ( $result =~ /IgH-ASO result\:$igh_aso_re/ ) { # warn $1;
$h{igh_pcr_result} = lc &$trim($1);
}
if ( $result =~ /IgH-ASO bp length\:\s?(\d+)/ ) { # warn $1;
$h{igh_pcr_bp_length} = $1;
}
if ( $result =~ /IgH-ASO comment\:(.*)/ ) { # warn $1;
$h{igh_pcr_comment} = &$trim($1);
}
return \%h;
}
sub get_fish_break_apart_result {
my $self = shift;
my $col = shift;
my $val = $self->data->{$col} || return 0;
my $result = $val =~ /rearranged/
? 'Positive'
: $val eq 'failed'
? 'Not Evaluable' : 'Negative';
return $result;
}
sub get_fish_fusion_assay_result {
my $self = shift;
my $col = shift;
my $val = $self->data->{$col} || return 0;
my $result = $val =~ /translocation/
? 'Positive'
: $val eq 'failed'
? 'Not Evaluable' : 'Negative';
return $result;
}
sub get_biopsy_site {
my $self = shift; return 0; # pending
my ($site) = $self->data->{comment} =~ /$biopsy_re/;
return $site;
}
sub get_involvement_pattern {
my $self = shift;
return 0; # can't extract pattern of involvment from comment yet
}
sub get_lymphoma_grade {
my $self = shift;
my $icdo3 = $self->data->{icdo3} || return 0;
# extract grade - only if FL:
if ( $icdo3 =~ 9690 && $self->data->{comment} =~ /$grade_re/ ) {
return lc $1; # captures content of $grade_re
}
return 0;
}
sub get_sample_quality {
my $self = shift;
my $result = $self->data->{specimen_quality} || return 0;
$result =~ s/adequate/good/; # only using adequate & poor
return ucfirst $result;
}
sub get_morphology_comment {
my $self = shift;
my $comment = $self->data->{comment} || return 0;
$comment =~ s/[\n\r]/ /g; # replace new-lines with spaces
return $comment;
}
sub get_fish_summary {
my $self = shift;
return $self->data->{fish_summary} || 0;
}
sub is_retest_required {
my $self = shift;
my $diagnosis = $self->get_diagnosis || return 0;
return $diagnosis eq 'Inadequate sample' ? 'Yes' : 'No'; # inadequate needs re-test
}
sub get_diagnosis {
my $self = shift;
return $self->data->{diagnosis} || 0;
}
sub get_icdo3 {
my $self = shift;
return $self->data->{icdo3} || 0;
}
sub get_lymphoma_involvment {
my $self = shift;
return 100; # temp assessment
}
sub get_test_results {
my $self = shift;
my %SDL = %{ $self->test_codes }; # warn Dumper \%SDL;
my %h = ();
TEST: while ( my ($marker, $test_code) = each %SDL ) {
my $result = $self->data->{$marker} || next TEST;
$h{$test_code} = $result;
}; # warn Dumper \%h;
return \%h;
}
sub is_discrepant_diagnosis {
my $self = shift;
return 0; # pending
}
sub is_urgent_report {
my $self = shift;
return 0; # pending
}
sub is_urgent_block_return {
my $self = shift;
return 0; # pending
}
sub test_decodes { # reverses $self->test_codes
my $self = shift;
my $codes = $self->test_codes;
my %decodes = reverse %$codes;
return \%decodes;
}
# Quintiles test codes => HMDS test_name map:
sub _build_test_codes {
my $self = shift;
return {
cd3 => 'SDL2110',
cd5 => 'SDL2099',
cd10 => 'SDL2100',
cd20 => 'SDL2101',
cd23 => 'SDL2102',
cd79 => 'SDL2105',
bcl2 => 'SDL2103',
bcl6 => 'SDL2108',
irf4 => 'SDL2106',
ki67 => 'SDL2109',
foxp1 => 'SDL2107',
kappa => 'SDL2123',
lambda => 'SDL2134',
cyclin_d1 => 'SDL2104', # = bcl1
# BCL2 => 'SDL2115', # FISH - handled by get_fish_break_apart_result()
# BCL6 => 'SDL2116', # FISH - handled by get_fish_break_apart_result()
# BCL2_IgH => 'SDL2117', # FISH - handled by get_fish_fusion_assay_result()
};
}
1;
