package LIMS::Model::Result;
use Moose;
extends 'LIMS::Model::Base';
with (
'LIMS::Model::Roles::SessionData', # provides $self->user_profile
'LIMS::Model::Roles::ResultsUpdate', # do_[lab_tests/results_summary]_update()
'LIMS::Model::Roles::RequestUpdate',
'LIMS::Model::Roles::ReportUpdate',
);
use MooseX::AttributeHelpers;
use namespace::clean -except => 'meta';
has $_ => ( is => 'ro', isa => 'HashRef', lazy_build => 1 )
foreach ( qw/
lab_test_map
lab_test_status_options_map
/ );
has form_data => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
has result_updates => (
is => 'ro',
isa => 'ArrayRef[HashRef]',
default => sub { [] },
metaclass => 'Collection::Array',
provides => {
push => 'add_to_updates',
count => 'count_updates',
},
# auto_deref => 1, # not needed
);
has update_failures => (
is => 'ro',
isa => 'ArrayRef[Str]',
default => sub { [] },
metaclass => 'Collection::Array',
provides => {
push => 'add_to_failures',
count => 'count_failures',
},
# auto_deref => 1, # not needed
);
__PACKAGE__->meta->make_immutable;
use Data::Dumper;
#-------------------------------------------------------------------------------
sub update_lab_test_requests {
my $self = shift;
my $data = shift; # $self->debug($data);
# put $dfv->valid into $self:
$self->form_data($data);
my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
my $update_lab_tests = sub {
# new investigation/test(s):
if ( my $test_id = $data->{test_id} ) {
if ( ref $test_id eq 'ARRAY' ) {
for my $id(@$test_id) {
$self->do_new_lab_investigation($id);
}
}
else {
$self->do_new_lab_investigation($test_id);
}
# check request_status, maybe revert from 'complete':
$self->do_request_status_check();
}
{ # insert/update section notes:
$self->do_section_notes_update();
}
{ # insert/update remote system id:
$self->do_foreign_id_update();
}
};
#$self->set_rose_debug(1);
# do_transaction() returns true if succeeds; sets $db->error on failure:
my $ok = $db->do_transaction( $update_lab_tests );
#$self->set_rose_debug(0);
return $ok ? 0 : 'update_lab_test_requests() error - ' . $db->error;
}
#-------------------------------------------------------------------------------
sub update_results_summary {
my $self = shift;
my $args = shift; # hashref of LabSection object, request_id & result
my $request_id = $args->{request_id};
my $section = $args->{section}; # LabSection object
my $result = $args->{result};
# Roles::do_results_summary_update() requires _section_id, _section_name,
# _request_id & results_summary:
my %data = (
results_summary => $result,
_request_id => $request_id,
_section_id => $section->id,
_section_name => $section->section_name,
);
# put %data into $self for do_results_summary_update():
$self->form_data(\%data);
my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
my $update = sub { # updates request_results_summary & logfile, so use Tx:
$self->do_results_summary_update();
};
my $ok = $db->do_transaction($update);
return $ok ? 0 : 'update_results_summary() error - ' . $db->error;
}
#-------------------------------------------------------------------------------
sub get_request_lab_test_results {
my ($self, $request_id) = @_;
my %args = (
query => [ request_id => $request_id ],
require_objects => 'lab_test',
);
my $lab_test_results = LIMS::DB::RequestLabTestResult::Manager
->get_request_lab_test_results(%args);
return $lab_test_results;
}
#-------------------------------------------------------------------------------
sub get_request_results_summary {
my $self = shift;
my $args = shift;
my %args = (
request_id => $args->{request_id},
lab_section_id => $args->{section_id},
);
my $results_summary = LIMS::DB::RequestResultSummary->new(%args);
# return row object if exists:
if (my $o = $results_summary->load_speculative) {
return $o;
}
return $results_summary;
}
#-------------------------------------------------------------------------------
sub general_notes { # uses Role::RequestUpdate::update_general_notes() method:
my $self = shift;
my $data = shift;
my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
my $update = sub {
$self->update_general_notes($data);
};
# do it as transaction to use Role::RequestUpdate method & capture any errs:
my $ok = $db->do_transaction( $update );
return $ok ? 0 : 'update_general_notes() error - ' . $db->error;
}
#-------------------------------------------------------------------------------
sub get_status_option_count {
my ($self, $option_id) = @_;
my %args = (
query => [ status_option_id => $option_id ],
);
my $count = LIMS::DB::RequestLabTestStatus::Manager
->get_request_lab_test_status_count(%args);
return $count;
}
#-------------------------------------------------------------------------------
sub update_request_lab_test_results {
my $self = shift;
my $data = shift; # warn Dumper $data;
my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
my $lab_test_data = $data->{lab_test_data} || {}; # in case submitted empty to clear
my @lab_test_ids = keys %$lab_test_data; # warn Dumper \@lab_test_ids;
$self->form_data($data); # for do_results_summary_update()
my $update = sub {
# first clear any existing test result data for this request_id:
if (@lab_test_ids) {
my %args = (
where => [
request_id => $data->{_request_id},
lab_test_id => \@lab_test_ids,
],
);
LIMS::DB::RequestLabTestResult::Manager
->delete_request_lab_test_results(%args);
{ # insert new data:
while ( my ($test_id, $result) = each %$lab_test_data ) {
next unless $result; # warn Dumper($test_id, $result);
my %data = (
request_id => $data->{_request_id},
lab_test_id => $test_id,
result => $result,
);
LIMS::DB::RequestLabTestResult->new(%data)->save;
}
}
}
{ # insert/update results_summary:
$self->do_results_summary_update(); # all params as $self->param
}
# maybe set all section test/investigation(s) to 'complete':
if ( $data->{complete_all_tests} ) {
$self->do_complete_all_tests;
}
# last action - if auto_reportable config:
if ( $data->{auto_reportable_config} ) {
$self->do_auto_report();
}
};
my $ok = $db->do_transaction( $update );
return $ok ? 0 : 'update_results_data() error - ' . $db->error;
}
#-------------------------------------------------------------------------------
sub import_results {
my $self = shift;
my $data = shift; # $self->debug($data);
# $data = hashref of report, result_summary & lab_test data + request_id:
my $result_data = $data->{result_summary_data};
my $lab_test_data = $data->{lab_test_data};
my $report_data = $data->{report_data};
my $request_id = $data->{request_id}; # warn $request_id;
my $user_profile_id = $self->user_profile->{id};
my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
my $import = sub {
if ($lab_test_data) {
{ # update request_lab_test_status to complete:
my $date_acquired = $lab_test_data->{date_acquired}; # DT object
my $acquisition_userid = $lab_test_data->{acquisition_userid};
my $status_option = LIMS::DB::LabTestStatusOption
->new(description => 'complete')->load;
my $lab_test_id = $self->_get_lab_test_id($lab_test_data);
# load request_lab_test_status object on unique_key:
my %params = (
lab_test_id => $lab_test_id,
request_id => $request_id,
);
my $o = LIMS::DB::RequestLabTestStatus->new(%params)->load;
# update request_lab_test_status object:
$o->status_option_id($status_option->id);
$o->user_id($acquisition_userid);
$o->time($date_acquired);
$o->save(changes_only => 1);
}
{ # request_lab_test history:
my $acquisition_userid = $lab_test_data->{acquisition_userid};
my $lab_test_name = $lab_test_data->{lab_test_name};
my $action = "set $lab_test_name status to complete";
# if logged_in user id NOT same as datafile user id:
if ( $acquisition_userid != $user_profile_id ) {
my $user = uc $lab_test_data->{acquired_by};
$action .= " for $user";
}
my %args = (
request_id => $request_id,
user_id => $user_profile_id, # id of LOGGED IN USER HERE
action => $action,
);
LIMS::DB::RequestLabTestHistory->new(%args)->save;
}
}
{ # request_result_summaries:
my $results_summary = $result_data->{results_summary};
my $section_name = $result_data->{lab_section};
my $lab_section
= LIMS::DB::LabSection->new(section_name => $section_name)->load;
my %data = (
results_summary => $results_summary,
lab_section_id => $lab_section->id,
request_id => $request_id,
);
LIMS::DB::RequestResultSummary->new(%data)->save;
}
{ # results_summary histories:
my $lab_section = $result_data->{lab_section};
my $action = "new $lab_section result summary";
my %args = (
request_id => $request_id,
user_id => $user_profile_id, # id of LOGGED IN USER HERE
action => $action,
);
LIMS::DB::RequestLabTestHistory->new(%args)->save;
}
{ # report:
# add db & request_id directly to $report_data:
$report_data->{request_id} = $request_id;
# get diagnosis.id & delete 'diagnosis' key:
my $diagnosis_id = $self->_get_diagnosis_id($report_data);
# load request_report object:
my $o = LIMS::DB::RequestReport->new(%$report_data);
# update request_report object:
$o->diagnosis_id($diagnosis_id);
$o->save;
}
};
#$self->set_rose_debug(1);
my $ok = $db->do_transaction( $import );
#$self->set_rose_debug(0);
return $ok ? 0 : 'import_results() error - ' . $db->error;
}
#-------------------------------------------------------------------------------
sub _get_lab_test_id {
my $self = shift;
my $data = shift;
# lab_test has U.K. on field_label, lab_section_id & test_type
my $lab_section
= LIMS::DB::LabSection->new(section_name => $data->{lab_section})->load;
my %data = (
lab_section_id => $lab_section->id,
test_name => $data->{lab_test_name},
test_type => $data->{test_type}
);
my $lab_test = LIMS::DB::LabTest->new(%data)->load;
return $lab_test->id;
}
#-------------------------------------------------------------------------------
sub update_lab_tests_from_worklist {
my $self = shift;
my $data = shift; # $self->debug($data); # hashref
my $request_lab_test_ids = $data->{request_lab_test_ids};
my $status_option_id = $data->{status_option_id};
my $user_id = $data->{user_id};
# get map of lab_test_status_options:
my $status_option = $self->lab_test_status_options_map; # warn Dumper $status_option;
# get status from form submission:
my $status = $status_option->{$status_option_id}->{description}; # warn $status;
# get user profile:
my $user_profile = $self->user_profile;
# check user_id matches user_profile id, or get new user_profile:
if ($user_id != $user_profile->{id}) {
my $o = LIMS::DB::User->new(id => $user_id)->load;
$user_profile = $o->as_tree;
}
# get users' initials:
my @name = map $user_profile->{$_}, qw(first_name last_name);
my $initials = join '', map { $_ =~ /^(\w)/ } @name; # warn $inits;
my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
my $update = sub {
LABTEST:
foreach my $id (@$request_lab_test_ids) {
my $o = LIMS::DB::RequestLabTestStatus->new(id => $id);
my @args = ( # need request for template display:
with => ['request','lab_test'],
speculative => 1,
);
if (! $o->load(@args) ) { # in case back-button & resubmit deletions:
$self->add_to_failures($id);
next LABTEST;
}
my $lab_test = $o->lab_test->field_label;
my $request_id = $o->request_id;
# update test status (even for delete - for template):
$o->status_option_id($status_option_id);
$o->user_id($user_id);
my $entry = $o->as_tree;
# if request to delete && success, add entry to result_updates:
if ( $status eq 'delete' ) {
# check no foreign key constraint ??
$self->add_to_updates($entry) if $o->delete;
}
# if update success, add entry to result_updates:
else {
$self->add_to_updates($entry) if $o->save(changes_only => 1);
}
{ # history log:
my $history = $status eq 'delete'
? "deleted $lab_test entry"
: "set $lab_test status to $status";
# if logged_in user id NOT same as submitted user id:
if ($self->user_profile->{id} != $user_profile->{id}) {
my $user = uc $user_profile->{username};
$history .= " for $user";
}
my %args = (
request_id => $request_id,
user_id => $self->user_profile->{id}, # id of LOGGED IN USER HERE
action => $history,
);
LIMS::DB::RequestLabTestHistory->new(%args)->save;
}
}
};
my $ok = $db->do_transaction($update);
=begin # causes error after search involving a date field - "error" stays in system
if (my $err = $db->error) {
return { error => 'update_lab_tests_from_worklist() error - ' . $err };
}
else {
return {
updates => $self->result_updates,
success => $self->count_updates,
failures => $self->count_failures,
};
}
=cut
if ($ok) {
return {
updates => $self->result_updates,
success => $self->count_updates,
failures => $self->count_failures,
};
}
else {
my $err = $db->error;
return { error => 'update_lab_tests_from_worklist() error - ' . $err };
}
}
#-------------------------------------------------------------------------------
sub get_results_summary_options {
my $self = shift;
my %args = (
sort_by => 'description',
require_objects => 'lab_section',
);
my $results_summary_options = LIMS::DB::ResultSummaryOption::Manager
->get_result_summary_options(%args);
return $results_summary_options;
}
#-------------------------------------------------------------------------------
sub get_result_data_type {
my ($self, $data_type_id) = @_;
my $data_type
= LIMS::DB::LabTestResultDataType->new(id => $data_type_id)->load;
return $data_type;
}
# ------------------------------------------------------------------------------
sub update_result_data_type {
my $self = shift;
my $data = shift; # $self->debug( $data );
my %args = ( class => 'LabTestResultDataType', data => $data );
return $self->update_object(\%args);
}
#-------------------------------------------------------------------------------
sub get_results_summary_option {
my ($self, $option_id) = @_;
my $option = LIMS::DB::ResultSummaryOption->new(id => $option_id)->load;
return $option;
}
#-------------------------------------------------------------------------------
sub get_results_summary_options_for_section {
my ($self, $section_id) = @_;
my %args = (
query => [ lab_section_id => $section_id ],
sort_by => 'description',
# require_objects => 'lab_section',
);
my $results_summary_options = LIMS::DB::ResultSummaryOption::Manager
->get_result_summary_options(%args);
return $results_summary_options;
}
# ------------------------------------------------------------------------------
sub update_result_summary_options {
my $self = shift;
my $data = shift; # $self->debug( $data );
my %args = ( class => 'ResultSummaryOption', data => $data );
return $self->update_object(\%args);
}
#-------------------------------------------------------------------------------
sub _get_diagnosis_id {
my $self = shift;
my $data = shift;
my $diagnosis = LIMS::DB::Diagnosis->new(name => $data->{diagnosis})->load;
# delete unrequired 'diagnosis' key:
delete $data->{diagnosis};
return $diagnosis->id;
}
#-------------------------------------------------------------------------------
# returns hashref of lab_test.id => lab_test.field_label for submitted lab section:
sub _build_lab_test_map {
my $self = shift;
my %args = (
query => [ lab_section_id => $self->form_data->{_section_id} ],
);
my $o = LIMS::DB::LabTest::Manager->get_lab_tests(%args);
my %lab_test_map = map {
$_->id => $_->field_label;
} @$o; # warn Dumper \@lab_test_ids;
return \%lab_test_map;
}
#-------------------------------------------------------------------------------
sub _build_lab_test_status_options_map {
my $self = shift;
my $o = LIMS::DB::LabTestStatusOption::Manager->get_lab_test_status_options;
my %map = map {
$_->id => $_->as_tree;
} @$o;
return \%map;
}
1;
