• Files
• Commits
• Log
• Graph
• Stats

# 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' => { -in => ['Cancer', 'HaemOnc'] } );
	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);
}