• Files
• Commits
• Log
• Graph
• Stats

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, skips inactive tests
sub do_lab_tests {
    my $self = shift;
    my $data = shift;

    my %args = (
        query => [ screen_id => $data->{screen_id} ],
        require_objects => 'lab_test',
    );

    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->as_tree;
        # skip inactive lab-tests:
        next if $t->lab_test->is_active eq 'no';
        $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; # warn Dumper $data; # 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;