# data for molecular/genetic tests for English referral sources in 2017
# expands panels -> lab-tests

use Modern::Perl;
use DBIx::Simple;
use Data::Dumper;
use Data::Printer;
use Sort::Naturally;
use Spreadsheet::WriteExcel::Simple;

use lib '/home/raj/perl-lib';
use Local::DB;

#==============================================================================
my @lab_sections = (
	'FISH', 'Molecular', 'High-throughput sequencing', 'Micro-array',
    'Multiplex Ligation-dependent Probe Amplification', # commenced 05/2017
);
my @excluded_lab_tests = qw(
    cell_selection_quality
    hts_quantification
    sanger_sequencing
    refer_material
    fish_h_and_e
    abl_control
); # also excluding d/rna: lt.test_name not rlike '(d|r)na'
#==============================================================================

my $dbix = Local::DB->dbix({ dbname => 'hilis4' });
$dbix->lc_columns = 0; # 'NHS number'

my $panel_test_map = _panel_lab_test(); # p $panel_test_map;
my $test_section_map = _test_section_map();
my $diagnosis_subtype_map = _diagnosis_subtype_map();

my $excluded_lab_tests = join ',', map qq!'$_'!, @excluded_lab_tests;
my $lab_section_names  = join ',', map qq!'$_'!, @lab_sections;

my $query = do {
	my $sql = _main_query(); # p $sql; exit;
	$dbix->query($sql);
};

my @cols = ( 'investigation', 'section name', 'NHS number', 'diagnosis',
    'referral organisation', 'organisation code'
);
my %data;
while ( my $ref = $query->hash ) { # p $ref;
	my $test_type = $ref->{'test type'};
	my $test_name = $ref->{investigation};

	if ( $test_type eq 'panel' ) { # expand panel -> lab-tests:
		my $tests = $panel_test_map->{$test_name}; # array(ref)
		for ( @$tests ) { # replace panel name with test name for each test:
			$ref->{investigation} = $_;
			push @{ $data{$_} }, [ map $ref->{$_}, @cols ];
		}
	}
	else {
		push @{ $data{$test_name} }, [ map $ref->{$_}, @cols ];
	}
} # p %data;

{ # write data in nsorted lab-test order, then sorted by section name then organisation:
    my $xl = Spreadsheet::WriteExcel::Simple->new;
    $xl->write_bold_row( \@cols );
    my $out_file = './nhse_2017_data.xls';

    for my $test ( nsort keys %data ) { # say $test;
        my $aref = $data{$test}; # p $aref; # AoA's
        $xl->write_row($_) for @$aref; # $_ is an arrayref
    }
    $xl->save( $out_file );
}

{ # group by diagnosis, then lab_test:
    my @cols = ( 'diagnosis', 'category', 'lab test', 'section name', 'n' );

    my $xl = Spreadsheet::WriteExcel::Simple->new;
    $xl->write_bold_row( \@cols );
    my $out_file = './nhse_2017_by_diagnosis.xls';

    my %h;
    while ( my($lab_test, $aref) = each %data ) { # say $test;
        for my $req (@$aref) {
            my $diagnosis = $req->[3];
            $h{$diagnosis}{$lab_test}++;
        }
    }
    for my $diagnosis ( nsort keys %h ) {
        my $ref = $h{$diagnosis}; # p $ref; # href
        while ( my($test, $n) = each %$ref ) {
            my $category = $diagnosis_subtype_map->{$diagnosis} || '';
            my $section  = $test_section_map->{$test};
            my @data = ( $diagnosis, $category, $test, $section, $n );
            $xl->write_row(\@data);
        }
    }
    $xl->save( $out_file );
}
{ # just group by lab tests:
    my @cols = ( 'lab test', 'section name', 'n' );

    my $xl = Spreadsheet::WriteExcel::Simple->new;
    $xl->write_bold_row(\@cols);
    my $out_file = './nhse_2017_by_lab_test.xls';

    my ($total, @data); # temp array for sorting
    while ( my($test, $aref) = each %data ) {
        my $n = @$aref; # size of array
        push @data, [ $test, $test_section_map->{$test}, $n ];
        $total += $n;
    }
    $xl->write_row($_) for sort by_section @data;
    $xl->write_bold_row(['','total:',$total]);
    $xl->save( $out_file );
}

{ # by referrer:
    my @cols = (
        'referrer', 'national code', 'speciality', 'referral location',
        'organisation code', 'parent organisation', 'parent code', 'referrals',
    );
    
    my $xl = Spreadsheet::WriteExcel::Simple->new;
    $xl->write_bold_row(\@cols);
    my $out_file = './nhse_2017_by_referrer_location.xls';

    my $sql = _by_referrer(); # p $sql; exit;
    my @data = $dbix->query($sql)->arrays;
    $xl->write_row($_) for @data;
    $xl->save( $out_file );
}

{ # sample preps (xna extraction):
   my @cols = ( 'procedure', 'n' );

    my $xl = Spreadsheet::WriteExcel::Simple->new;
    $xl->write_bold_row(\@cols);
    my $out_file = './nhse_2017_processing.xls';

    my $sql = _extraction_procedures();
    my @data = $dbix->query($sql)->arrays;
    $xl->write_row($_) for @data;
    $xl->save( $out_file );
}

sub by_section { # 0 = lab-test, 1 = lab-section:
    return $a->[1] cmp $b->[1] || lc $a->[0] cmp lc $b->[0];
}

sub _main_query {
	return qq!
		select
			lt.field_label as 'investigation',
			lt.test_type as 'test type',
			ls.section_name as 'section name',
			p.nhs_number as 'NHS number',
            d.name as 'diagnosis',
			po.description as 'referral organisation',
			po.parent_code as 'organisation code'
		from requests r
			join request_lab_test_status t2 on r.id = t2.request_id
			join lab_tests lt on t2.lab_test_id = lt.id
			join lab_sections ls on lt.lab_section_id = ls.id
			join patient_case pc on r.patient_case_id = pc.id
			join patients p on pc.patient_id = p.id
			join referral_sources rs on pc.referral_source_id = rs.id
			join parent_organisations po on rs.parent_organisation_id = po.id
            join request_report_view rrv on rrv.request_id = r.id
            join diagnoses d on rrv.diagnosis_id = d.id
			left join request_trial rt on rt.request_id = r.id
		where r.year = 2017
			and rt.request_id is null
			and ls.section_name in ($lab_section_names)
			and lt.test_name not rlike '(d|r)na'
			and lt.test_name not in ($excluded_lab_tests)
			and po.parent_code not rlike '^(S|Z)' /* scotland/ireland */
			and po.parent_code not in (
				'RWM', 	 /* Cardiff */
				'RVA', 	 /* Carmarthen */
				'RT8', 	 /* Conwy */
				'RVF', 	 /* Gwent */
				'RT9', 	 /* NE Wales */
				'RT7', 	 /* NW Wales */
				'RVC', 	 /* Swansea */
				'RQF', 	 /* Velidre, Wales */
				'8EQ15', /* Drs Lab */
				'X99999', 'V81999' /* unknowns */
			)
		order by d.name, ls.section_name, po.description; /* will sort by lab-test later */
	!;
}

sub _extraction_procedures {
    return q!
        select lt.field_label, count(lt.id)
        from requests r
            join patient_case pc on r.patient_case_id = pc.id
			join request_lab_test_status t2 on r.id = t2.request_id
			join lab_tests lt on t2.lab_test_id = lt.id
			join referral_sources rs on pc.referral_source_id = rs.id
			join parent_organisations po on rs.parent_organisation_id = po.id
			left join request_trial rt on rt.request_id = r.id
		where r.year = 2017
			and rt.request_id is null
			and ( lt.test_name rlike '(d|r)na_extraction'
                or lt.test_name = 'hts_quantification' )
			and po.parent_code not rlike '^(S|Z)' /* scotland/ireland */
			and po.parent_code not in (
				'RWM', 	 /* Cardiff */
				'RVA', 	 /* Carmarthen */
				'RT8', 	 /* Conwy */
				'RVF', 	 /* Gwent */
				'RT9', 	 /* NE Wales */
				'RT7', 	 /* NW Wales */
				'RVC', 	 /* Swansea */
				'RQF', 	 /* Velidre, Wales */
				'8EQ15', /* Drs Lab */
				'X99999', 'V81999' /* unknowns */
			)
        group by lt.id
		!;
}

sub _by_referrer {
    return qq!
        select
            /* lt.field_label as 'investigation',
            ls.section_name as 'section_name', */
            ref.name as 'referrer',
            ref.national_code,
            hd.display_name as 'speciality',
            rs.display_name as 'referral_location',
            rs.organisation_code,
            po.description as 'parent_organisation',
            po.parent_code,
            count(*) as 'referrals'
        from requests r
      	join patient_case pc on r.patient_case_id = pc.id
      	join referral_sources rs on pc.referral_source_id = rs.id
            join request_lab_test_status t2 on r.id = t2.request_id
            join lab_tests lt on t2.lab_test_id = lt.id
            join lab_sections ls on lt.lab_section_id = ls.id                        
        	join referrer_department rd on r.referrer_department_id = rd.id
        	join parent_organisations po on rd.parent_organisation_id = po.id
        	join hospital_departments hd on rd.hospital_department_code = hd.id
        	join referrers ref on rd.referrer_id = ref.id
            left join request_trial rt on rt.request_id = r.id
		where r.year = 2017
			and rt.request_id is null
			and ls.section_name in ($lab_section_names)
			and lt.test_name not rlike '(d|r)na'
			and lt.test_name not in ($excluded_lab_tests)
			and po.parent_code not rlike '^(S|Z)' /* scotland/ireland */
			and po.parent_code not in (
				'RWM', 	 /* Cardiff */
				'RVA', 	 /* Carmarthen */
				'RT8', 	 /* Conwy */
				'RVF', 	 /* Gwent */
				'RT9', 	 /* NE Wales */
				'RT7', 	 /* NW Wales */
				'RVC', 	 /* Swansea */
				'RQF', 	 /* Velidre, Wales */
				'8EQ15', /* Drs Lab */
				'X99999', 'V81999' /* unknowns */
			)
		group by ref.id
        order by referrals desc!;
}

# get panel -> lab_test map:
sub _panel_lab_test {
	my %h;
    my $sql = q!
		select t2.field_label as panel, t3.field_label as test
		from panel_lab_test t1
			join lab_tests t2 on t1.panel_test_id = t2.id
			join lab_tests t3 on t1.lab_test_id = t3.id
			join lab_sections ls on t2.lab_section_id = ls.id
		where ls.section_name in (
			'FISH', 'Molecular', 'High-throughput sequencing', 'Micro-array',
            'Multiplex Ligation-dependent Probe Amplification' /* commenced 05/2017 */
		)
		order by t2.field_label, t3.field_label
    !;
	my $q = $dbix->query($sql);
	while ( my $ref = $q->hash ) {
		my $panel = $ref->{panel};
		my $test  = $ref->{test};
		push @{ $h{$panel} }, $test;
	}
	return \%h;
}

sub _test_section_map {
    my $sql = q!
        select lt.field_label, ls.section_name
        from lab_tests lt
			join lab_sections ls on lt.lab_section_id = ls.id
        where ls.section_name in (
			'FISH', 'Molecular', 'High-throughput sequencing', 'Micro-array',
            'Multiplex Ligation-dependent Probe Amplification' /* commenced 05/2017 */
		)!;
    my $ref = $dbix->query($sql)->map;
    return $ref;
}

sub _diagnosis_subtype_map {
    my $sql = q!
        select d.name,
        case
            when d.name rlike 'chronic myeloid leukaemia' then 'CML'
            else dc.description
        end
        from diagnoses d
            join icdo_category ic on ic.icdo3 = d.icdo3
            join diagnostic_categories dc on ic.diagnostic_category_id = dc.id
        where dc.category_type = 'sub' or dc.description in ('cll')
    !;
    my $ref = $dbix->query($sql)->map;
    return $ref;

}