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 ); __PACKAGE__->meta->make_immutable; use Data::Dumper; #------------------------------------------------------------------------------- sub update_lab_test_results { 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); } } { # insert/update results_summary: $self->do_results_summary_update(); # all params as $self->param } { # insert/update section notes: $self->do_section_notes_update(); } { # insert/update remote system id: $self->do_foreign_id_update(); } # maybe set all section test/investigation(s) to 'complete': if ( $data->{complete_all_tests} ) { $self->do_complete_all_tests; } # else check request_status and maybe revert from 'complete': else { $self->do_request_status_check(); } # last action - if auto_reportable config: if ( $data->{auto_reportable_config} ) { $self->do_auto_report(); } }; #$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_results() 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; my $update = sub { { # first clear any existing data for this request_id: 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; } } }; 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 { foreach my $id (@$request_lab_test_ids) { my $o = LIMS::DB::RequestLabTestStatus->new(id => $id) ->load(with => ['request','lab_test']); # need request for template display 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 $data = $o->as_tree; # if request to delete && success, add $data to result_updates: if ( $status eq 'delete' ) { $self->add_to_updates($data) if $o->delete; } # if update success, add $data to result_updates: else { $self->add_to_updates($data) 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; } } }; #$self->set_rose_debug(1); $db->do_transaction($update); #$self->set_rose_debug(0); if (my $err = $db->error) { return { error => 'update_lab_tests_from_worklist() error - ' . $err }; } else { return { updates => $self->result_updates, success => $self->count_updates, }; } } #------------------------------------------------------------------------------- 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;