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; } #------------------------------------------------------------------------------- # so far ONLY used by C::DataImport::do_bcr_abl() - does auto_report as well: 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, _section_name => $section->section_name, _request_id => $request_id, _section_id => $section->id, ); # warn Dumper \%data; # add auto_reportable_config if exists: if ( my $auto_rpt_cfg = $args->{auto_reportable_config} ) { $data{auto_reportable_config} = $auto_rpt_cfg; # for do_auto-report() $data{lab_test_data} = $args->{lab_test_data}; # for set_lab_test_complete() } # put %data into $self for do_results_summary_update() & do_auto_report(): $self->form_data(\%data); # warn Dumper \%data; my $db = $self->lims_db; # ie LIMS::DB->new_or_cached; my $update = sub { $self->do_results_summary_update(); $self->set_lab_test_complete(); # do_request_history() here depends on do_auto_report() $self->do_auto_report(); # will silently skip if no config supplied or already reported }; 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 check_request_lab_test { # just need to check lab-test been requested: my $self = shift; my $args = shift; # warn Dumper $args; my $lab_test_data = $args->{lab_test_data}; my $request_id = $args->{request_id}; my $lab_test_id = $self->_get_lab_test_id($lab_test_data); # warn $lab_test_id; my %params = ( lab_test_id => $lab_test_id, request_id => $request_id, ); my $o = LIMS::DB::RequestLabTestStatus->new(%params)->load(speculative => 1); return $o ? 1 : 0; # just return success flag } #------------------------------------------------------------------------------- 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; } #------------------------------------------------------------------------------- # shared by __PACKAGE__check_request_lab_test() & __PACKAGE__import_results() 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;