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', }, ); has $_ => ( is => 'ro', isa => 'HashRef', lazy_build => 1 ) for qw( request_specimen_sample_type lab_test_sample_type lab_test_section_map panel_lab_test_map linked_lab_tests lab_section_map lab_test_map ); use Data::Dumper; # use Data::Printer alias => 'ddp'; #------------------------------------------------------------------------------- # 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); # linked_lab_tests_map: my $linked_tests_map = $self->linked_lab_tests; foreach my $t (@$lab_tests) { # warn Dumper $t; $data->{lab_test_id} = $t->lab_test_id; $self->do_new_lab_test($data); # add linked tests if configured: if ( my $test_id = $linked_tests_map->{$t->lab_test_id} ) { # arrayref $self->do_linked_lab_tests($test_id, $data->{_request_id}); } } } #------------------------------------------------------------------------------- # 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_id = $args->{specimen_id}; # array(ref) # 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 # linked_lab_tests_map: my $linked_tests_map = $self->linked_lab_tests; # any auto-generated specimen-associated lab-tests ? for my $id (@$specimen_id) { if ( my $ref = $specimen_lab_test_map->{$id} ) { # arrayref of lab_test.id's # generate lab-test request(s): for my $t (@$ref) { my %h = ( # may want to handle requested_ & skipped_lab_tests() ?? _request_id => $request_id, # method required underscored var lab_test_id => $t, ); $self->do_new_lab_test(\%h); # add linked tests if configured: if ( my $test_id = $linked_tests_map->{$t}) { # arrayref $self->do_linked_lab_tests($test_id, $request_id); } } } } } #------------------------------------------------------------------------------- # 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() # __PACKAGE__do_linked_lab_tests() 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}; # ddp $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_linked_lab_tests { my ($self, $test_id, $request_id) = @_; for my $id(@$test_id) { my %h = ( lab_test_id => $id, _request_id => $request_id, ); $self->do_new_lab_test(\%h); } } #------------------------------------------------------------------------------- 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; 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", ); # warn "============= updating $test_name ================="; 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 lab-test ids and name of action (result summary or report) my ($test_ids, $action) = map $args->{$_}, qw(test_ids action); { # possibly expand panels to lab-tests if configured: my $lab_test_section_map = $self->lab_test_section_map; # warn Dumper $lab_test_section_map; my $panel_lab_test_map = $self->panel_lab_test_map; # warn Dumper $panel_lab_test_map; my $all_lab_sections = $self->lab_section_map; # warn Dumper $all_lab_sections; # to find array index position using List::MoreUtils::firstidx(): my $get_index = sub { LIMS::Local::Utils::get_first_index(@_) }; for my $lt_id (@$test_ids) { # warn $lt_id; # if panel has lab-test expansion: if ( my $panel_test_ids = $panel_lab_test_map->{$lt_id} ) { # arrayref # warn Dumper $panel_test_ids; # get lab-section for this lab-test: my $section_id = $lab_test_section_map->{$lt_id}; # warn $section_id; my $lab_section = $all_lab_sections->{$section_id}; # if section is configured to auto-expand panels: if ( $lab_section->{auto_expand} eq 'yes' ) { # warn 'here'; # replace panel.id with lab-test.id(s) in @test_ids: my $index = &$get_index($lt_id, $test_ids); # warn $index; # panel.id -> test>id(s) - works for multiple panel ids: splice( @$test_ids, $index, 1, @$panel_test_ids ); } } } } # warn Dumper $test_ids; my $data = $self->form_data; # warn Dumper $data; # create map for test_id => field_label: my $lab_tests_map = $self->lab_test_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 # linked_lab_tests_map: my $linked_tests_map = $self->linked_lab_tests; my $new_lab_tests = 0; # counter for use in do_request_report() # 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 \%h; # warn Dumper [$data->{_request_id}, $test_id, $lab_tests_map->{$test_id}]; $self->do_new_lab_test(\%h); # add linked tests if configured: if ( my $ref = $linked_tests_map->{$test_id} ) { # arrayref of linked test.id's $self->do_linked_lab_tests($ref, $data->{_request_id}); } # log action in request_lab_test_history: if ( my @ids = $self->have_requested_lab_tests ) { # set in do_new_lab_test() on save do { # warn Dumper $_; my $field_label = $lab_tests_map->{$_}; # 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; } for @ids; # clear before saving next lab-test: $self->reset_requested_lab_tests; # increment $new_lab_tests counter for do_request_report(): $new_lab_tests++; } } # warn $new_lab_tests; # return $new_lab_tests so do_request_report() can revert request status if necesssary: return $new_lab_tests; } #------------------------------------------------------------------------------- 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 _build_lab_test_section_map { my $self = shift; my $o = LIMS::DB::LabTest::Manager->get_objects; my %map = map { $_->id => $_->lab_section_id } @$o; return \%map; } #------------------------------------------------------------------------------- sub _build_panel_lab_test_map { my $self = shift; my $o = LIMS::DB::PanelLabTest::Manager->get_objects; my %h; do { push @{ $h{$_->panel_test_id} }, $_->lab_test_id } for @$o; # warn Dumper \%h; return \%h; } #------------------------------------------------------------------------------- sub _have_required_sample_type_for_lab_test { # returns true if we have at least 1 my ($self, $data) = @_; my $lab_test_id = $data->{lab_test_id} || return 0; # warn $lab_test_id; # get configured sample_type_id's for this lab-test: my $lab_test_sample_type_map = $self->lab_test_sample_type; # hashref my $sample_type_ids = $lab_test_sample_type_map->{$lab_test_id}; # warn Dumper ['sample_type_ids',$sample_type_ids]; # $data->{_request_id} always exists, $self->form_data->{_request_id} may not eg # auto-generated via new request - request_specimen_sample_type() uses form_data $self->form_data->{_request_id} ||= $data->{_request_id}; # ensure it exists # count how many request_specimen rows contain a required sample_type_id: my $request_specimen_map = $self->request_specimen_sample_type; # warn Dumper ['request_specimen_map',$request_specimen_map]; my $count = grep $request_specimen_map->{$_}, @$sample_type_ids; # warn $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 } #------------------------------------------------------------------------------- # returns hashref of lab_test.id => lab_test.field_label for submitted lab section: sub _build_lab_test_map { my $self = shift; my $o = LIMS::DB::LabTest::Manager->get_lab_tests(); my %lab_test_map = map { $_->id => $_->field_label; } @$o; # warn Dumper %lab_test_map; return \%lab_test_map; } #------------------------------------------------------------------------------- # returns hashref of lab_test.id => lab_test.field_label for submitted lab section: sub _build_lab_section_map { my $self = shift; my $o = LIMS::DB::LabSection::Manager->get_objects(); my %section_map = map { $_->id => $_->as_tree; } @$o; # warn Dumper %section_map; return \%section_map; } #------------------------------------------------------------------------------- sub _build_lab_test_sample_type { my $self = shift; my $o = LIMS::DB::LabTestSampleType::Manager->get_lab_test_sample_types; my %h; for (@$o) { my $test_id = $_->{lab_test_id}; push @{ $h{$test_id} }, $_->{sample_type_id}; } # warn Dumper \%h; return \%h; } #------------------------------------------------------------------------------- sub _build_request_specimen_sample_type { my $self = shift; my $data = $self->form_data; # warn Dumper $data; my @args = ( query => [ request_id => $data->{_request_id} ], require_objects => [ 'specimen.specimen_sample_type' ], ); my $o = LIMS::DB::RequestSpecimen::Manager->get_request_specimens(@args); my %h; # $o is arrayref of 1 - specimen_sample_type is also arrayref: for (@$o) { # warn Dumper $_->as_tree; my $specimen_sample_type = $_->specimen->specimen_sample_type; # arrayref $h{$_->sample_type_id}++ for @$specimen_sample_type; } # warn Dumper \%h; return \%h; } #------------------------------------------------------------------------------- sub _build_status_option_new { my $self = shift; my $o = LIMS::DB::LabTestStatusOption->new(description => 'new')->load; return $o; } #------------------------------------------------------------------------------- sub _build_linked_lab_tests { my $self = shift; my $o = LIMS::DB::LinkedLabTest::Manager->get_linked_lab_tests(); my %h; # map of { parent_test_id => [ linked_test_id ] } for (@$o) { my $test_id = $_->parent_test_id; push @{ $h{$test_id} }, $_->linked_test_id; } return \%h; } =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;