# updates request_lab_test_results table from omics_dispatch.xlsx # defaults to lims_test db unless -d 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; }