#!/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' [YES/NO/PENDING]
    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, uc $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';
            }
            elsif ( $icdo3 =~ /^9690/ ) { # FL without defined $grade
                push @row, 'UNGRADED';
            }
            else { push @row, 'NOT APPLICABLE' }
        }
        { # 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, uc $result || 'NOT DONE';
    }
    
    { # 35, 36) BCL2 & BCL6 break-apart
        for ( qw/BCL2 BCL6/ ) {
            my $result = $gallium->get_fish_break_apart_result($_);
            push @row, uc $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 (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
    }
    
    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)