package LIMS::Local::GalliumData;
# for use with gallium_data.pl (supercedes GalliumTrial for use with
# gallium_data_roche.pl & gallium_data_quintiles.pl)
use Moo;
use LIMS::Local::MooX::Types qw(HashReference);
has data => ( is => 'ro', isa => HashReference, required => 1 );
use Data::Dumper;
use LIMS::Local::Utils;
my $trim = sub { LIMS::Local::Utils::trim(@_) };
#===============================================================================
use Regexp::Common qw(pattern); # Regexp::Common patterns:
pattern # biopsy site
name => [ qw(biopsy site) ],
create => 'Site of biopsy\:\s*(.*?)\.'; # capture all between ':' and 1st full-stop
pattern # biopsy type
name => [ qw(biopsy type) ],
create => 'Type of biopsy\:\s*(.*?)\.'; # capture all between ':' and 1st full-stop
pattern # % lymphoma involvement
name => [ qw(lymphoma involvement) ],
create => 'Lymphoma involvement\:\s*(\d+?)%'; # capture digits before %
pattern # involvement pattern
name => [ qw(involvement pattern) ],
create => 'Pattern of involvement\:\s*(.*?)\.'; # capture all between ':' and 1st full-stop
pattern # lymphoma grade
name => [ qw(lymphoma grade) ],
create => '\b(grade\s\d\w?)\b'; # lymphoma grade 1,2,3[ab]
pattern # dna volume
name => [ qw(dna volume) ],
create => 'DNA volume\:(.*)ul'; # DNA volume\:(.*)ul
pattern # dna concentration
name => [ qw(dna concentration) ],
create => 'DNA concentration\:(.*)ng';
pattern # dna purity
name => [ qw(dna purity) ],
create => 'DNA purity OD260\/280\:\s?(\d*\.\d+)';
pattern # dna sections
name => [ qw(dna sections) ],
create => 'DNA sections\:(.*)micron';
pattern # rna volume
name => [ qw(rna volume) ],
create => 'RNA volume\:(.*)ul'; # DNA volume\:(.*)ul
pattern # rna concentration
name => [ qw(rna concentration) ],
create => 'RNA concentration\:(.*)ng';
pattern # rna purity
name => [ qw(rna purity) ],
create => 'RNA purity OD260\/280\:\s?(\d*\.\d+)';
pattern # rna sections
name => [ qw(rna sections) ],
create => 'RNA sections\:(.*)micron';
pattern # IgH-ASO assay
name => [ qw(igh_aso assay) ],
create => 'IgH-ASO assay\:\s?(\b\w+\b( \b\w+\b)?)'; # matches 1 or 2 words
pattern # IgH-ASO result
name => [ qw(igh_aso result) ],
create => 'IgH-ASO result\:\s?(not evaluable|(mono|oligo|poly)clonal)';
pattern # IgH-ASO bp length
name => [ qw(igh_aso bp_length) ],
create => 'IgH-ASO bp length\:\s?(\d+)';
pattern # IgH-ASO comment
name => [ qw(igh_aso comment) ],
create => 'IgH-ASO comment\:(.*)';
#===============================================================================
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_dna_results {
my $self = shift;
my $result = $self->data->{molecular_summary} || return {};
my %h = ();
if ( $result =~ $RE{dna}{volume}{-keep} ) { # warn $1;
$h{dna_volume} = &$trim($1);
}
if ( $result =~ $RE{dna}{concentration}{-keep} ) { # warn $1;
$h{dna_concentration} = &$trim($1);
}
if ( $result =~ $RE{dna}{purity}{-keep} ) { # warn $1;
$h{dna_purity} = $1;
}
if ( $result =~ $RE{dna}{sections}{-keep} ) { # warn $1
$h{dna_sections} = &$trim($1);
} # warn Dumper \%h;
return \%h;
}
sub get_rna_results {
my $self = shift;
my $result = $self->data->{molecular_summary} || return {};
my %h = ();
if ( $result =~ $RE{rna}{volume}{-keep} ) { # warn $1;
$h{rna_volume} = &$trim($1);
}
if ( $result =~ $RE{rna}{concentration}{-keep} ) { # warn $1;
$h{rna_concentration} = &$trim($1);
}
if ( $result =~ $RE{rna}{purity}{-keep} ) { # warn $1;
$h{rna_purity} = $1;
}
if ( $result =~ $RE{rna}{sections}{-keep} ) { # warn $1
$h{rna_sections} = &$trim($1);
} # warn Dumper \%h;
return \%h;
}
sub get_igh_pcr {
my $self = shift; return {}; # not doing this assay, but expects hashref rtn
my $result = $self->data->{molecular_summary} || return {};
my %h = ();
if ( $result =~ $RE{igh_aso}{assay}{-keep} ) { # warn $1;
$h{igh_pcr_assay} = &$trim($1);
}
if ( $result =~ $RE{igh_aso}{result}{-keep}{-i} ) { # warn $1;
$h{igh_pcr_result} = lc &$trim($1);
}
if ( $result =~ $RE{igh_aso}{bp_length}{-keep} ) { # warn $1;
$h{igh_pcr_bp_length} = $1;
}
if ( $result =~ $RE{igh_aso}{comment}{-keep} ) { # warn $1;
$h{igh_pcr_comment} = &$trim($1);
} # warn Dumper \%h;
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; # not implemented yet
if ( $self->data->{comment} =~ $RE{biopsy}{site}{-keep} ) {
return uc $1;
}
return 0;
}
sub get_biopsy_type { # FINE NEEDLE ASPIRATION / CORE BIOPSY / SURGICAL EXCISION / OTHER
my $self = shift; return 0; # not implemented yet
if ( $self->data->{comment} =~ $RE{biopsy}{type}{-keep} ) {
return uc $1;
}
return 0;
}
sub get_involvement_pattern {
my $self = shift;
if ( $self->data->{comment} =~ $RE{involvement}{pattern}{-keep} ) {
return lc $1; # lower-case
}
return 0;
}
sub get_lymphoma_grade {
my $self = shift;
my $comment = $self->data->{comment};
my $icdo3 = $self->data->{icdo3} || return 0;
if ( $icdo3 =~ /^9698/ ) { # Follicular lymphoma; large cell - automatically 3B
return 'grade 3b';
}
# extract grade - only if FL:
elsif ( $icdo3 =~ /^9690/ && $comment =~ $RE{lymphoma}{grade}{-keep} ) {
return lc $1;
}
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_trial_elegibility { # [YES/NO/PENDING]
my $self = shift;
return 'YES';
}
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_involvement {
my $self = shift;
if ( $self->data->{comment} =~ $RE{lymphoma}{involvement}{-keep} ) {
return $1; # numerical
}
return undef; # don't return 0 - valid result !!
}
sub get_test_results {
my ($self, $markers) = @_; # list of IHC markers
my %h = ();
for my $t(@$markers) {
my $result = $self->data->{$t};
$h{$t} = $result if defined $result; # can be zero
}; # warn Dumper \%h;
return \%h;
}
sub is_discrepant_diagnosis {
my $self = shift;
return 0; # pending
}
sub is_discrepant_localisation {
my $self = shift;
return 0; # pending clarification
}
sub is_urgent_report {
my $self = shift;
return 0; # pending
}
sub is_urgent_block_return {
my $self = shift;
return 0; # pending
}
1;
