RSS Git Download  Clone
Raw Blame History
#!/usr/bin/env perl

# updates 67 requests where test = DNA quantitation to RNA quantitation & histories
# INSERT INTO `hilis4`.`lab_tests`
#    (`test_name`, `field_label`, `lab_section_id`, `test_type`, `has_results`)
#    VALUES ('rna_quantification', 'RNA quantification', 4, 'test', 'no');

# run as "export SQL_TRACE=1; perl ./xna-quantification-change.pl" for query output

use FindBin;

use lib '/home/raj/perl-lib';
use Local::DB;
use Modern::Perl;
use DBIx::Simple;
use Data::Printer use_prototypes => 0;

my @data = <DATA>; # say scalar @data;

my $dbix = Local::DB->dbix({ dbname => 'hilis4' });
# $dbix->dbh->trace(2, './dbi_trace.log');

#warn $dbix->dbh->{AutoCommit}; # it's on
$dbix->begin; # turns auto-commit off
#warn $dbix->dbh->{AutoCommit}; # it's off

$dbix->select('lab_tests', ['id'], { test_name => 'dna_quantification' })
    ->into(my $dna_id);
$dbix->select('lab_tests', ['id'], { test_name => 'rna_quantification' })
    ->into(my $rna_id); # p [$dna_id, $rna_id];

my $rows = 0;
foreach my $labno (@data) { # p $labno; next;
    chomp $labno;
    my ( $reqNum, $year ) = ( $labno =~ /H?(\d+)\/(\d{2})/ ); # p [$reqNum, $year];
    $year += 2000;

    $dbix->select('requests', ['id'], { request_number => int $reqNum, year => $year })
        ->into(my $request_id);
    # p [$labno, $request_id]; next;

    if ( $request_id ) {
        my %h = ( request_id => $request_id, lab_test_id => $dna_id );
        $dbix->select('request_lab_test_status', 'count(*)', \%h)->into(my $n); # p [$labno, $n];
        if ( $n == 1 ) {
            say "have 1 request_lab_test_status entry for $labno";
            $dbix->select('request_lab_test_status', 'time', \%h)->into(my $time);
            my %set = (
                lab_test_id => $rna_id,
                time        => $time,
            );
            my $r = $dbix->update('request_lab_test_status', \%set, \%h)
                or die $dbix->error;
            $rows += $r->rows; say $rows;
            { # history: 'requested DNA quantification'
                my %h = ( request_id => $request_id, user_id => 788,
                    action => 'requested DNA quantification' );
                $dbix->select('request_lab_test_history', 'count(*)', \%h )
                    ->into(my $i); # p $i;
                if ( $i == 1 ) {
                    $dbix->select('request_lab_test_history', 'time', \%h)
                        ->into(my $time);
                    my %set = (
                        action => 'requested RNA quantification',
                        time   => $time,
                    );
                    my $r = $dbix->update('request_lab_test_history', \%set, \%h);
                    $rows += $r->rows; say $rows;
                }
                else {
                    say "$labno has $i request_lab_test_history entries for "
                        . "requested DNA quantification";
                }
            }
            { # history: 'set DNA quantification status to complete'
                my %h = ( request_id => $request_id, user_id => 788,
                    action => 'set DNA quantification status to complete' );
                $dbix->select('request_lab_test_history', 'count(*)', \%h )
                    ->into(my $i); # p $i;
                if ( $i == 1 ) {
                    $dbix->select('request_lab_test_history', 'time', \%h)
                        ->into(my $time);
                    my %set = (
                        action => 'set RNA quantification status to complete',
                        time   => $time,
                    );
                    my $r = $dbix->update('request_lab_test_history', \%set, \%h);
                    $rows += $r->rows; say $rows;
                }
                else {
                    say "$labno has $i request_lab_test_history entries for "
                        . "set DNA quantification status to complete";
                }
            }
        }
        else {
            say "$labno has $n request_lab_test_status entries for dna_extraction";
        }
    }
    else {
        say 'Request ID not found for ' . $labno;
    }
}

say "total db updates = $rows"; # $dbix->rollback; exit;
$rows = ( scalar @data ) * 3 # 3 updates per labno
    ? $dbix->commit
    : $dbix->rollback;

__DATA__
H9414/11
H10488/11
H11265/11
H12518/11
H12824/11
H13009/11
H13302/11
H14045/11
H14484/11
H15057/11
H15066/11
H15329/11
H15761/11
H15852/11
H16503/11
H16535/11
H16596/11
H16722/11
H16799/11
H17029/11
H17169/11
H17511/11
H17512/11
H17670/11
H17731/11
H18159/11
H18644/11
H18829/11
H19060/11
H19061/11
H19141/11
H19142/11
H19210/11
H19211/11
H19324/11
H19328/11
H19590/11
H19591/11
H19860/11
H19948/11
H19988/11
H20091/11
H20651/11
H21203/11
H21451/11
H21452/11
H21457/11
H21459/11
H21983/11
H22300/11
H22588/11
H22792/11
H22894/11
H23053/11
H23104/11
H23109/11
H23375/11
H23495/11
H23516/11
H23578/11
H23579/11
H23787/11
H23906/11
H24127/11
H00204/12
H00318/12
H00413/12