• Files
• Commits
• Log
• Graph
• Stats

# updates request_lab_test_results table from omics_dispatch.xlsx
# defaults to lims_test db unless -d <db> supplied

use Getopt::Std;
getopts('qtd:'); # output sql query; testing
our($opt_q,$opt_t,$opt_d); # warn $opt_t; exit;

# switch on sql output to console:
$ENV{SQL_TRACE}  = $opt_q;
my $JUST_TESTING = $opt_t; # outputs to stdout only, doesn't do db updates

#===============================================================================
my $src = 'omics_dispatch_2019.xlsx';
my $db  = $opt_d || 'lims_test'; # warn $db; exit;
#===============================================================================

use Spreadsheet::Read qw(ReadData rows);
use FindBin qw($Bin);
use Data::Printer;
use Modern::Perl;

use lib '/home/raj/perl-lib';
use Local::DB;

my $dbix = Local::DB->dbix({ dbname => $db });
my $xls  = ReadData($Bin.'/src/'.$src) || die "cannot read $src"; # p $xls; exit;

my $sheet = $xls->[1]; # p $sheet; # 1st sheet
my @rows  = rows($sheet); # p \@rows; # AoA

my $headers = shift @rows; # p $headers; exit;
$_ =~ s/\s/_/g for @$headers;
$_ =~ s/(\w+)/lc $1/eg for @$headers; # p $headers; exit;

my $i = 0;   # success counter

my $sql = 'select r.id from genomics.requests r join genomics.patient_case pc
    on r.patient_case_id = pc.id where pc.unit_number = ?';

my $user_id = $dbix->select('genomics.users', 'id', { username => 'camm' })->value
    or die 'cannot find user_id'; # p $user_id;

my @lab_tests = qw(omics_dispatched omics_consignment_number);
my $lab_tests_map = $dbix->select('genomics.lab_tests', [ qw/test_name id/ ],
    { test_name => { -in => \@lab_tests } })->map; # p $lab_tests_map; exit;
my $test_names_map = $dbix->select('genomics.lab_tests', [ qw/test_name field_label/ ],
    { test_name => { -in => \@lab_tests } })->map; # p $test_names_map; exit;

# clear lims_test request_lab_test_results, request_lab_test_status &
# request_lab_test_history tables:
$dbix->dbh->do("delete from lims_test.$_") for
    qw(request_lab_test_results request_lab_test_status request_lab_test_history);

ROW:
for my $row (@rows) { # arrayref
    my $ref = _to_hash($row); # p $ref; next;

    my $participant_id = $ref->{participant_id}
        or say 'no particpant_id' and next ROW; # p $participant_id;
    my $request_id = $dbix->query($sql, $participant_id)->value
        or say "no request found for participant_id $participant_id" and next ROW;
        # say "$participant_id: $request_id";
    my ($dispatch_date, $consignment_number) =
        @{$ref}{ qw/gmc_sample_dispatch_date gmc_sample_consignment_number/ };
    # remove 'T' from datetime result:
    $dispatch_date =~ s/T/ /; # p $dispatch_date; # next;

    { # update request_lab_test_results table with $dispatch_date:
        my $test_name = 'omics_dispatched';
        my $lab_test_id = $lab_tests_map->{$test_name};
        my %h = (
            lab_test_id => $lab_test_id,
            request_id  => $request_id,
        ); # p %h; next ROW;
        if ( $dbix->select("$db.request_lab_test_results", 1, \%h)->value ) {
            say "dispatch_date already exists for $participant_id";
        }
        elsif ($JUST_TESTING) {
            say "will insert $dispatch_date for " . $participant_id;
        }
        else {
            $h{result} = $dispatch_date;
            my $result = $dbix->insert("$db.request_lab_test_results", \%h);
            say "participant_id $participant_id $test_name result $dispatch_date"
                . ' failed to insert' and next ROW unless $result->rows;
            # set lab test status to complete:
            $dbix->update("$db.request_lab_test_status",
                { status_option_id => 2 },
                { request_id => $request_id, lab_test_id => $lab_test_id });
            say "inserted $test_name $dispatch_date for $participant_id";
            # history log:
            $h{test_name} = $test_names_map->{$test_name};
            do_request_lab_test_history(\%h);
            $i += $result->rows;
        }
    }
    { # update request_lab_test_results table with $consignment_number:
        my $test_name = 'omics_consignment_number';
        my $lab_test_id = $lab_tests_map->{$test_name};
        my %h = (
            lab_test_id => $lab_test_id,
            request_id  => $request_id,
        ); # p %h; next ROW;
        if ( $dbix->select("$db.request_lab_test_results", 1, \%h)->value ) {
            say "consignment_number already exists for $participant_id";
        }
        elsif ($JUST_TESTING) {
            say "will insert $consignment_number for " . $participant_id;
        }
        else {
            $h{result} = $consignment_number;
            my $result = $dbix->insert("$db.request_lab_test_results", \%h);
            say "participant_id $participant_id $test_name result $consignment_number"
            . ' failed to insert' and next ROW unless $result->rows;
            # set lab test status to complete:
            $dbix->update("$db.request_lab_test_status",
            { status_option_id => 2 },
            { request_id => $request_id, lab_test_id => $lab_test_id });
            say "inserted $test_name $consignment_number for $participant_id";
            # history log:
            $h{test_name} = $test_names_map->{$test_name};
            do_request_lab_test_history(\%h);
            $i += $result->rows;
        }
    }
}

say "inserted $i new records";

sub trim {
    local $_ = shift || return;
    $_ =~ s/^\s+|\s+$//g;
    return $_;
}

sub _to_hash {
    my $ref = shift; # p $ref; # arrayref
    my %h;
    my $i = 0;
    for (@$headers) { # p $_;
        $h{$_} = $ref->[$i++];
    } # p %h;
    return \%h;
}

sub do_request_lab_test_history {
    my $ref = shift;

    my $lab_test = $ref->{test_name}; # field_label
    my $req_id   = $ref->{request_id};

    my %h = (
        request_id => $req_id,
        user_id	   => $user_id,
        action     => "auto-set $lab_test status to complete",
    ); # p \%h;
    my $result = $dbix->insert("$db.request_lab_test_history", \%h);
    say "failed to update request_lab_test_history for request $req_id"
        unless $result->rows;
}