# updates genomics.lab_test_data_type tables with new lab-tests
# safe to re-run - deletes & re-inserts
# creates screening term -> lab-test map for screen_lab_test table - OK to rerun
BEGIN {
use Getopt::Std;
getopts('q');
our($opt_q);
$ENV{SQL_TRACE} = $opt_q;
}
use lib '/home/raj/perl-lib';
use Local::SQL::Abstract::Plugin::InsertMulti; # adds replace_multi() to SAPIM
use Data::Printer use_prototypes => 0;
use SQL::Abstract::More;
use Modern::Perl;
use Local::DB;
$Local::QueryLogger::NO_QUERY_LOGS = 1; # don't need queries in logs dir
my $dbix = Local::DB->dbix({ dbname => 'genomics' });
my $sqla = SQL::Abstract::More->new;
do_lab_test_data_types();
do_screen_lab_tests_cancer();
do_screen_lab_tests_rare_disease();
# lab_test_data_types ==========================================================
sub do_lab_test_data_types { say 'running lab_test_data_types';
my %lab_tests = (
appointment_date => 'date',
approach_date => 'date',
approach_followup_date => 'date',
approach_method => 'approach_method',
biopsy_gauge => 'numeric_range[1-20]',
clinic_sample_type => 'clinic_sample_type',
copath_lab_number => 'free_text',
dna_extraction_protocol => 'extraction_protocol',
edta10 => 'free_text',
excision_margin => 'excision_margin',
family_id => 'free_text',
ffpe_macrodissected => 'yes_no',
ffpe_dissection_details => 'free_text',
first_outcome => 'approach_response',
fixation_comments => 'free_text',
fixation_end => 'datetime',
fixation_start => 'datetime',
fixative_type => 'fixative_type',
formalin_duration => 'numeric_range[1-36]',
frozen_macrodissected => 'yes_no',
frozen_dissection_details => 'free_text',
number_of_biopsies => 'numeric_range[1-15]',
number_of_blocks => 'numeric_single',
number_of_sections => 'numeric_range[1-10]',
omics_arrived_ccp => 'datetime',
omics_consignment_number => 'free_text',
omics_sent_ccp => 'datetime',
pre_invasive_elements => 'free_text',
processing_schedule => 'processing_schedule',
prolonged_storage_method => 'prolonged_storage',
received_by_cytogenetics => 'datetime',
second_outcome => 'approach_response',
section_thickness => 'numeric_range[1-10]',
sent_from_histopathology => 'datetime',
snap_freezing_start => 'datetime',
tissue_source => 'tissue_source',
tracking_number => 'free_text',
tumour_lab_number => 'free_text',
tumour_sample_id => 'free_text',
tumour_sample_taken => 'datetime',
tumour_sample_type => 'tumour_sample_type',
tumour_size => 'free_text',
tumour_type => 'tumour_type',
tumour_volume_stored => 'free_text',
unsent_sample_reason => 'unsent_sample_reason',
withdrawal_date => 'date',
withdrawal_form => 'withdrawal_form',
withdrawal_option => 'withdrawal_option',
);
my $data_types_map = do {
my @params = ( 'lab_test_result_data_types', ['description','id'] );
$dbix->select(@params)->map;
}; # p $data_types_map; # exit;
while ( my($test_name, $data_type) = each %lab_tests ) { # p $test_name; p $data_type;
my $test_id = get_lab_test_id($test_name) || die "no test_id for $test_name";
# p [$test_name, $test_id, $data_type];
my $type_id = $data_types_map->{$data_type} || die "no type for $test_name";
# p [$test_name, $test_id, $data_type, $type_id]; next;
my %h = ( lab_test_id => $test_id );
$dbix->delete('lab_test_data_type', \%h);
$h{data_type_id} = $type_id;
$dbix->insert('lab_test_data_type', \%h);
}
}
# screen-lab-test map function =================================================
sub do_screen_lab_tests_cancer { say 'running screen_lab_tests for cancer';
my @screen_ids = get_screen_ids_cancer(); # p \@screen_ids; exit;
my @lab_tests = get_lab_tests_cancer(); # p \@lab_tests; exit;
for my $screen_id (@screen_ids) {
$dbix->delete('screen_lab_test', { screen_id => $screen_id } );
my @dataset = map { [ $screen_id, $_ ] } @lab_tests; # p \@dataset;
my @params = ( 'screen_lab_test', [ qw/screen_id lab_test_id/ ], \@dataset );
my ($stmt, @bind) = $sqla->insert_multi(@params); # p [$stmt, @bind];
$dbix->query($stmt, @bind);
}
}
sub do_screen_lab_tests_rare_disease { say 'running screen_lab_tests for rare disease';
$dbix->delete('screen_lab_test', { screen_id => 1 } );
my @lab_tests = get_lab_tests_rare_disease(); # p \@lab_tests; exit;
my @dataset = map { [ 1, $_ ] } @lab_tests; # p \@dataset;
my @params = ( 'screen_lab_test', [ qw/screen_id lab_test_id/ ], \@dataset );
my ($stmt, @bind) = $sqla->insert_multi(@params); # p [$stmt, @bind];
$dbix->query($stmt, @bind);
}
sub get_lab_tests_cancer {
# lab section names:
my @section_names = do {
my %h = (
section_name => { -not_in => 'Consent withdrawal' },
is_active => 'yes',
);
$dbix->select('lab_sections', ['section_name'], \%h )->column;
}; # p \@sections;
my @skip_tests = qw( family_id total_samples unsent_sample_reason );
my @all_tests;
for my $section (@section_names) { # p $section;
# get lab-tests for section:
my @col_names = qw( lt.id );
my @tbl_rels = (
'lab_tests|lt' => 'lt.lab_section_id=ls.id' => 'lab_sections|ls'
);
my %where = (
'ls.section_name' => $section,
'lt.is_active' => 'yes',
'lt.test_name' => { -not_in => \@skip_tests },
);
my @sort = ( 'lt.id' );
my ($sql, @bind) = get_query_params(
cols => \@col_names,
joins => \@tbl_rels,
where => \%where,
sort => \@sort,
); # p $sql; p \@bind;
my @lab_test_ids = $dbix->query($sql, @bind)->column; # p \@lab_test_ids;
push @all_tests, @lab_test_ids;
}
return @all_tests;
}
sub get_lab_tests_rare_disease {
# lab section names:
my @section_names = (
'Approach', 'Consent', 'Dispatch', 'DNA - blood', 'Specimens - blood',
);
my @skip_tests = qw( edta10 );
my @all_tests;
for my $section (@section_names) { # p $section;
# get lab-tests for section:
my @col_names = qw( lt.id );
my @tbl_rels = (
'lab_tests|lt' => 'lt.lab_section_id=ls.id' => 'lab_sections|ls'
);
my %where = (
'ls.section_name' => $section,
'lt.is_active' => 'yes',
'lt.test_name' => { -not_in => \@skip_tests },
);
my @sort = ( 'lt.id' );
my ($sql, @bind) = get_query_params(
cols => \@col_names,
joins => \@tbl_rels,
where => \%where,
sort => \@sort,
); # p $sql; p \@bind;
my @lab_test_ids = $dbix->query($sql, @bind)->column; # p \@lab_test_ids;
push @all_tests, @lab_test_ids;
}
return @all_tests;
}
sub get_lab_test_id {
my $test_name = shift;
my @params = ( 'lab_tests', ['id'], { test_name => $test_name } );
my $id = $dbix->select(@params)->value;
return $id;
}
sub get_screen_ids_cancer {
my @col_names = qw( s.id );
my @tbl_rels = (
'screens|s' => 's.category_id=sc.id' => 'screen_category|sc'
);
my %where = ( 'sc.name' => 'cancer' );
my @sort = ( 's.id' );
my ($sql, @bind) = get_query_params(
cols => \@col_names,
joins => \@tbl_rels,
where => \%where,
sort => \@sort,
); # p $sql; p \@bind;
my @data = $dbix->query($sql, @bind)->column; # p $data;
return @data;
}
sub get_query_params {
my %h = @_; # p \%h;
my @params = ( -columns => $h{cols} );
push @params, ( -where => $h{where} ) if $h{where};
push @params, ( -group_by => $h{group} ) if $h{group};
push @params, ( -order_by => $h{sort} ) if $h{sort};
# expects joins OR tbls:
if ( my $joins = $h{joins} ) {
push @params, ( -from => [ -join => @$joins ] );
}
elsif ( my $tables = $h{tbls} ) {
push @params, ( -from => $tables );
}
else { die "require join relationships or list of tables" }
my ($sql, @bind) = $sqla->select(@params); # p $sql; p \@bind;
return ($sql, @bind);
}
