package RequestForm::DB;
use LIMS::Local::QueryLibrary;
use DateTime::Format::MySQL;
use LIMS::Local::Utils;
use Path::Tiny;
use FindBin;
use lib '/home/raj/perl-lib';
use Local::DB;
use RequestForm::Class; # provides Moo, Local::MooX::Types & LIMS::Local::Debug::p
has dbname => ( is => 'ro', isa => String, required => 1 ); # uclh, hilis4, etc
has sql_lib => ( is => 'lazy' ); # returns SQL::Library obj
has dbix => ( is => 'lazy' ); # returns DBIx::Simple object
sub _build_dbix {
my $db = $_[0]->dbname; # dbname = uclh, leeds, etc
$db =~ s/leeds/hilis4/; # leeds -> hilis4 symlink doesn't work on innodb tables
Local::DB->dbix($db);
}
sub _build_sql_lib {
my $lib = path($FindBin::Bin, '..', 'sql.lib')->realpath;
LIMS::Local::QueryLibrary->new({ lib => $lib });
}
sub save_params {
my $self = shift;
my $vars = shift; # p $vars;
# get field names from request_form table:
my $cols = $self->get_cols('request_form'); # p $cols;
my %h = map +($_ => $vars->{$_}), @$cols; # p %h;
my $db = $self->dbix();
$db->insert('request_form', \%h);
}
sub search_patient {
my ($self, $nhs_number) = @_; # p $nhs_number;
my $db = $self->dbix();
my $data = $db->select('patients', '*', { nhs_number => $nhs_number })->hash;
return $data;
}
sub get_referral_sources {
my ($self, $str) = @_; # part of referral_location (string)
my $db = $self->dbix();
my $lib = $self->sql_lib;
my $sql = $lib->retr('referral_sources');
my $data = $db->query( $sql, $str )->hashes; # p $vars;
return $data;
}
sub get_previous_cml_monitoring {
my ($self, $nhs_number) = @_;
my $db = $self->dbix();
my $lib = $self->sql_lib;
my $sql = $lib->retr('previous_cml_monitoring');
my $query = $db->query( $sql, $nhs_number );
my (@data, $last_result);
# get bcr-abl results in reverse chronological order:
while ( my $ref = $query->hash ) { # p $ref;
# registration date to DT object:
my $reg_date = DateTime::Format::MySQL->parse_date($ref->{registered});
# extract bcr-abl:abl ratio if exists:
my ($ratio) = $ref->{result} =~ /(BCR-ABL : ABL ratio = .*%)/;
# date of last result is reg date of most recent bcr-abl ratio:
$last_result = $reg_date if ( $ratio and ! $last_result );
# set result to bcr-abl:abl ratio, otherwise keep original:
push @data, {
registered => $reg_date,
result => $ratio || $ref->{result},
};
}
my %h = (
date_last => $last_result,
results => \@data,
); # p %h;
return \%h;
}
sub get_userid {
my ($self, $username) = @_;
my $db = $self->dbix();
$db->select('users', 'id', { username => $username })->into(my $user_id);
return $user_id;
}
sub get_cols {
my ($self, $table) = @_;
my $meta = $self->get_meta($table); # p $meta;
return [ keys %$meta ];
}
sub get_meta {
my ($self, $table) = @_;
my $dbh = $self->dbix;
my $t = $dbh->query("show columns from $table")->hashes; # p $t;
my %meta = map { $_->{field} => $_ } @$t; # p %meta;
return \%meta;
}
1;