# 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', dna_extraction_protocol => 'extraction_protocol', ccft_dna => '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', local_lab_identifier => '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( ccft_dna ); # Specimens - blood 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); }