# data for molecular/genetic tests for English referral sources in 2017
# expands panels -> lab-tests - see also SQL searches/north-west-molecular-tests.sql
# for how to do it in sql
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 @excluded_parent_codes = (
'RWM', # Cardiff
'RVA', # Carmarthen
'RT8', # Conwy
'RVF', # Gwent
'RT9', # NE Wales
'RT7', # NW Wales
'RVC', # Swansea
'RQF', # Velidre, Wales
'8EQ15', # Drs Lab
'MSDMDH', # Mater Dei
'X99999', 'V81999' # unknowns
);
#==============================================================================
my $excluded_parent_codes = join ',', map qq!'$_'!, @excluded_parent_codes;
my $excluded_lab_tests = join ',', map qq!'$_'!, @excluded_lab_tests;
my $lab_section_names = join ',', map qq!'$_'!, @lab_sections;
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(); # p $diagnosis_subtype_map;
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 );
}
{ # by location:
my @cols = (
'referral location', 'organisation code', 'number',
);
my $xl = Spreadsheet::WriteExcel::Simple->new;
$xl->write_bold_row(\@cols);
my $out_file = './nhse_2017_by_location.xls';
my $sql = _by_location(); # 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 ($excluded_parent_codes)
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 ($excluded_parent_codes)
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 ($excluded_parent_codes)
group by ref.id
order by referrals desc!;
}
sub _by_location {
return qq!
select
rs.display_name as 'referral_location',
rs.organisation_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 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 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 ($excluded_parent_codes)
group by rs.id
order by referrals desc, rs.display_name!;
}
# 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, dc.description
from diagnoses d
join icdo_sub_category ic on ic.icdo3 = d.icdo3
join diagnostic_categories dc on ic.diagnostic_category_id = dc.id!;
my $ref = $dbix->query($sql)->map;
return $ref;
}
