package LIMS::Model::Roles::LabTestUpdate;
use Moose::Role;
has status_option_new => (
is => 'ro',
isa => 'LIMS::DB::LabTestStatusOption',
lazy_build => 1,
);
has skipped_lab_tests => (
is => 'ro',
isa => 'ArrayRef[Int]',
default => sub { [] },
lazy => 1,
traits => ['Array'],
handles => {
add_to_skipped_lab_tests => 'push',
have_skipped_lab_tests => 'elements',
},
);
has requested_lab_tests => (
is => 'ro',
isa => 'ArrayRef[Int]',
default => sub { [] },
lazy => 1,
traits => ['Array'],
handles => {
add_to_requested_lab_tests => 'push',
have_requested_lab_tests => 'elements',
reset_requested_lab_tests => 'clear',
},
);
=begin - for _have_required_sample_type_for_lab_test() - replaced with LIMS::DB queries
has $_ => ( is => 'ro', isa => 'HashRef', lazy_build => 1 )
for qw(
specimen_sample_type_map
section_sample_type_map
lab_test_section_map
);
=cut
use Data::Dumper;
#-------------------------------------------------------------------------------
# creates new lab_tests according to ScreenLabTest data for this screen_id
# doesn't overwrite existing tests
sub do_lab_tests {
my $self = shift;
my $data = shift;
my %args = (
query => [ screen_id => $data->{screen_id} ],
);
my $lab_tests
= LIMS::DB::ScreenLabTest::Manager->get_screen_lab_tests(%args);
foreach my $t (@$lab_tests) { # warn Dumper $t;
$data->{lab_test_id} = $t->lab_test_id;
$self->do_new_lab_test($data);
}
}
#-------------------------------------------------------------------------------
# shared by M::Request::new_request() & M::R::RequestUpdate::do_specimen_code_update()
sub do_specimen_associated_lab_tests {
my $self = shift;
my $args = shift;
my $request_id = $args->{request_id};
my $specimen = $args->{specimen}; # LIMS::DB::Specimen object
# get specimen -> lab_test map (for any auto-generated lab tests):
my $specimen_lab_test_map = $self->specimen_lab_test_map; # created in M::Request
# any auto-generated specimen-associated lab-tests ?
if ( my $lab_test_ref = $specimen_lab_test_map->{$specimen->id} ) {
map { # generate lab-test request(s):
$self->do_new_lab_test({ # may want to handle requested_ & skipped_lab_tests() ??
_request_id => $request_id, # method required underscored var
lab_test_id => $_,
});
} @$lab_test_ref;
}
}
#-------------------------------------------------------------------------------
# shared by M::Request::new_request(), M::Roles::RequestUpdate::do_specimen_code_update(),
# M::R::do_request_report(), M::Screen::do_initial_screen() & M::Screen::update_screen()
sub do_new_lab_test {
my $self = shift;
my $data = shift; # requires lab_test_id && user_id
# if sample type checking is active, check we have valid specimen for lab test:
if ( $self->lims_cfg->{settings}->{lab_section_sample_type} ) {
return 0 unless $self->_have_required_sample_type_for_lab_test($data);
}
my $status_option = $self->status_option_new;
my $lab_test_id = $data->{lab_test_id};
my $o = LIMS::DB::RequestLabTestStatus->new(
lab_test_id => $lab_test_id,
request_id => $data->{_request_id},
);
if ( $o->load(speculative => 1) ) { # already exists so just add to skipped:
$self->add_to_skipped_lab_tests($lab_test_id);
}
else {
$o->status_option_id($status_option->id);
$o->user_id($self->user_profile->{id});
$o->save;
$self->add_to_requested_lab_tests($lab_test_id);
}
}
#-------------------------------------------------------------------------------
sub do_lab_test_details {
my $self = shift;
my $data = shift; # warn Dumper $data;
# if sample type checking is active, check we have valid specimen for lab test:
if ( $self->lims_cfg->{settings}->{lab_section_sample_type} ) {
return 0 unless $self->_have_required_sample_type_for_lab_test($data);
}
my %args = (
query => [ screen_id => $data->{screen_id} ],
);
my $lab_test_details
= LIMS::DB::ScreenLabTestDetail::Manager->get_screen_lab_test_details(%args);
foreach my $detail (@$lab_test_details) { # should only be 0 or 1:
LIMS::DB::RequestLabSectionNote->new(
details => $detail->test_details,
request_id => $data->{_request_id},
lab_section_id => $detail->lab_section_id,
)->load_or_insert; # in case test_detail already exists
}
}
#-------------------------------------------------------------------------------
# called by M::Result::update_results_summary() - used only by C::DataImport::do_bcr_abl()
sub set_lab_test_complete {
my $self = shift;
my $data = $self->form_data; # warn Dumper $data->{lab_test_data};
return 0 unless $data->{lab_test_data}->{autocomplete}; # warn 'here';
my $user_profile_id = $self->user_profile->{id};
my $request_id = $data->{_request_id};
my $status_option
= LIMS::DB::LabTestStatusOption->new(description => 'complete')->load;
# get auto-requested lab-tests:
my $requested_tests = $self->_get_auto_requested_lab_test_data($request_id);
TEST: # set auto-requested lab-test status to complete (if not already):
for my $test (@$requested_tests) { # warn Dumper $test;
my @params = (
request_id => $request_id,
lab_test_id => $test->{id},
); # warn Dumper \@params;
# load speculative in case auto-requested tests config changed since screening:
my $o = LIMS::DB::RequestLabTestStatus->new(@params)->load_speculative
|| next TEST; # warn Dumper $o->as_tree;
# set to complete (if not already):
unless ($o->status_option_id == $status_option->id) {
$o->status_option_id($status_option->id);
$o->user_id($user_profile_id);
$o->save(changes_only => 1);
{ # log changes:
my $test_name = $test->{name};
my %data = (
request_id => $request_id,
user_id => $user_profile_id,
action => "set $test_name status to complete",
);
LIMS::DB::RequestLabTestHistory->new(%data)->save;
}
}
}
}
#-------------------------------------------------------------------------------
# called by Roles::ReportUpdate::do_request_report()
# & Roles::ResultsUpdate::do_results_summary_update()
sub auto_request_additional_tests {
my ($self, $args) = @_; # warn Dumper $args;
# get key for yaml file entry and name of action (result summary or report)
my ($key, $action) = map $args->{$_}, qw(key action);
my $data = $self->form_data; # warn Dumper $data;
my $cfg = $data->{additional_tests_config}; # warn Dumper $cfg;
# return unless key has entry in additional_tests config:
my $tests = $cfg->{$key} || return; # warn Dumper $tests;
my @test_ids = keys %$tests; # warn Dumper \@test_ids;
# create map for test_id => field_label:
my $lab_tests_map = $self->_lab_tests_map(); # warn Dumper $lab_tests_map;
my $user_profile_id = $self->user_profile->{id};
my %h = ( _request_id => $data->{_request_id} ); # lab_test_id supplied in loop
# create new request_lab_test for each entry in $tests:
for my $test_id (@test_ids) { # warn Dumper $self->requested_lab_tests;
$h{lab_test_id} = $test_id;
# warn Dumper [$data->{_request_id}, $test_id, $lab_tests_map->{$test_id}];
$self->do_new_lab_test(\%h);
# log action in request_lab_test_history:
if ( $self->have_requested_lab_tests ) { # set in do_new_lab_test() on save
my $field_label = $lab_tests_map->{$test_id}; # warn $field_label;
LIMS::DB::RequestLabTestHistory->new(
request_id => $data->{_request_id},
user_id => $user_profile_id,
action => "auto-requested $field_label triggered by $action",
)->save;
$self->reset_requested_lab_tests; # clear before saving next lab-test
}
}
}
#-------------------------------------------------------------------------------
sub _get_auto_requested_lab_test_data { # similar function name in R::ReportUpdate
my ($self, $request_id) = @_;
my @args = (
query => [
'request_id' => $request_id,
],
require_objects => [ qw(screen.request_initial_screen lab_test) ],
);
my $o = LIMS::DB::ScreenLabTest::Manager->get_screen_lab_tests(@args);
my @data = map {
{
name => $_->lab_test->field_label,
id => $_->lab_test->id,
}
} @$o; # warn Dumper \@data;
return \@data;
}
#-------------------------------------------------------------------------------
sub _have_required_sample_type_for_lab_test {
my ($self, $data) = @_;
# what lab section does new lab-test belong to?
my $lab_test_id = $data->{lab_test_id} || return 0; # warn Dumper $lab_test_id;
=begin - section replaced by LIMS::DB queries now - uncomment _build_* subs if required
my $lab_section_id = $self->lab_test_section_map->{$lab_test_id};
# what specimen type(s) does the lab section support (arrayref):
my $section_sample_type_map = $self->section_sample_type_map; # hashref of [sample_type ids]
my $required_specimen_type = $section_sample_type_map->{$lab_section_id};
# what specimen type id(s) do we have for this request:
my %sample_type_ids = ();
{ # get map of unique sample-type ids for this request:
my $specimen_id = $self->_get_specimen_id($data->{_request_id}); # arrayref
my $specimen_sample_type_map = $self->specimen_sample_type_map;
foreach my $id (@$specimen_id) {
my $ary = $specimen_sample_type_map->{$id}; # arrayref
$sample_type_ids{$_}++ for @$ary;
} # warn Dumper \%sample_type_ids;
}
# set true if one of available sample types matches a required type:
my $ok = ( grep $sample_type_ids{$_}, @$required_specimen_type );
=cut
=begin # required sql to do above in one go:
my $sql = q!
select count(*)
from request_specimen t4
join specimen_sample_type t5 on (t5.specimen_id = t4.specimen_id)
where
t4.request_id = ? and
t5.sample_type_id in (
select distinct(t3.sample_type_id)
from lab_tests t1
join lab_sections t2 on (t1.lab_section_id = t2.id)
join lab_section_sample_type t3 on (t3.lab_section_id = t2.id)
where t1.id = ?
)!;
=cut # Rose can't do sub-selects, so split query into 2 parts:
# part 1 - get distinct sample_type_id's:
my $lab_section_sample_type = do {
my %args = (
require_objects => [ qw( lab_section.lab_tests ) ],
select => [ 'sample_type_id' ],
query => [ 'lab_tests.id' => $lab_test_id ],
distinct => 1,
);
LIMS::DB::LabSectionSampleType::Manager
->get_lab_section_sample_types(%args);
}; # warn Dumper $lab_section_sample_type;
my @sample_type_ids = map { $_->sample_type_id } @$lab_section_sample_type;
# part 2 - count how many request_specimen rows contain required sample_type_id's:
my $count = do {
my %args = (
query => [
request_id => $data->{_request_id},
sample_type_id => \@sample_type_ids,
],
require_objects => [ 'specimen.specimen_sample_type' ],
);
LIMS::DB::RequestSpecimen::Manager->get_request_specimens_count(%args);
}; # warn Dumper $count;
# if we don't have at least 1 required sample type, add lab_test.id to failed list:
if (! $count) { $self->add_to_skipped_lab_tests($lab_test_id) }
return $count; # returns true if $count > 0
}
#-------------------------------------------------------------------------------
sub _build_status_option_new {
my $self = shift;
my $o = LIMS::DB::LabTestStatusOption->new(description => 'new')->load;
return $o;
}
=begin - not required, using LIMS::DB queries in _have_required_sample_type_for_lab_test
#-------------------------------------------------------------------------------
sub _build_section_sample_type_map { # return HoA of lab_section.id => [ sample_type.id ]
my $self = shift;
my $o = $self->get_objects_iterator('LabSectionSampleType');
my $map = {};
while ( my $t = $o->next ) {
my $lab_section_id = $t->lab_section_id;
my $sample_type_id = $t->sample_type_id;
push @{ $map->{$lab_section_id} }, $sample_type_id;
}
return $map;
}
#-------------------------------------------------------------------------------
sub _build_specimen_sample_type_map { # return HoA of specimen.id => [ sample_type.id ]
my $self = shift;
my $o = $self->get_objects_iterator('SpecimenSampleType');
my $map = {};
while ( my $t = $o->next ) {
my $specimen_id = $t->specimen_id;
my $sample_type_id = $t->sample_type_id;
push @{ $map->{$specimen_id} }, $sample_type_id;
}
return $map;
}
#-------------------------------------------------------------------------------
sub _build_lab_test_section_map {
my $self = shift;
my $o = $self->get_objects_iterator('LabTest');
my $map = {};
while ( my $t = $o->next ) {
$map->{$t->id} = $t->lab_section_id;
}
return $map;
}
#-------------------------------------------------------------------------------
sub _get_specimen_id {
my ($self, $request_id) = @_;
my %args = (
query => [ request_id => $request_id ],
select => 'specimen_id',
);
my $o = LIMS::DB::RequestSpecimen::Manager->get_request_specimens(%args);
return [ map $_->specimen_id, @$o ];
}
=cut
1;
