#!/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