• 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('d:q'); # database name, sql trace
	our($opt_d,$opt_q);
	$ENV{SQL_TRACE} = $opt_q;
} # warn $opt_d; warn $opt_t; exit;
# need this BEFORE use libs:
my $database = $opt_d || die "usage: $0 -d <database>";

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 => $database });
my $sqla = SQL::Abstract::More->new;

do_screen_lab_tests_rare_disease();
do_screen_lab_tests_haem_onc();
do_screen_lab_tests_cancer();

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_haem_onc { say 'running screen_lab_tests for HaemOnc';
	my @screen_ids = get_screen_ids('HaemOnc'); # p \@screen_ids; exit;
	my @lab_tests  = get_lab_tests('HaemOnc');  # 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 {
    my $type = shift; # p $type; # Cancer, HaemOnc
	# lab section names:
    my @skip_sections = ('Consent withdrawal','Consent update');
	# HaemOnc-specific sections:
	push @skip_sections, ('Specimens - saliva', 'DNA - saliva',
		'Specimens - bone marrow', 'DNA - bone marrow') if $type eq 'Cancer';
	push @skip_sections, ('Specimens - tumour', 'DNA - tumour',
		'Specimens - FFPE', 'Specimens - frozen') if $type eq 'HaemOnc';

	my @section_names = sort do {
		my %h = (
			section_name => { -not_in => \@skip_sections },
			is_active    => 'yes',
        );
		$dbix->select('lab_sections', ['section_name'], \%h )->column;
	}; # p \@section_names;

    # lab-tests skipped for both Cancer & HaemOnc:
    my @common_tests = qw( family_id total_samples unsent_sample_reason );
    # lab-tests skippped for HaemOnc:
    my @haem_onc_tests = qw(
        prolonged_storage_method tissue_source tumour_type excision_margin
        biopsy_gauge number_of_biopsies number_of_blocks number_of_sections
        section_thickness tumour_sample_type );
	my %skip_tests = (
        Cancer  => [ @common_tests ],
        HaemOnc => [ ( @common_tests, @haem_onc_tests ) ],
    );

	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{$type} },
		);
		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 {
    my $type = shift; # Cancer, HaemOnc
	my @col_names = qw( s.id );
    my @tbl_rels = (
        'screens|s' => 's.category_id=sc.id' => 'screen_category|sc'
	);
    my %where = ( 'sc.name' => $type );
	my @sort  = ( 's.id' );

    my ($sql, @bind) = get_query_params(
        cols  => \@col_names,
        joins => \@tbl_rels,
        where => \%where,
		sort  => \@sort,
    ); # p $sql; # p \@bind;
		# $dbix->dump_query($sql, @bind); exit;
	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);
}