# creates screening term -> lab-test map for screen_lab_test table # safe to re-run - deletes & re-inserts 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 => 'test' }); my $sqla = SQL::Abstract::More->new; do_screen_lab_tests_cancer(); do_screen_lab_tests_rare_disease(); 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 @skip_sections = ('Consent withdrawal','Consent update'); my @section_names = do { my %h = ( section_name => { -not_rlike => [ -and => @skip_sections ] }, 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' => { rlike => $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); }