package LIMS::Model::Roles::ReportUpdate; use Moose::Role; with ( 'LIMS::Model::Roles::Outreach', # do_outreach_request_pack_dispatch() 'LIMS::Model::Roles::HistoryAction', 'LIMS::Model::Roles::LabTestUpdate', 'LIMS::Local::Role::DiagnosisConfirm', ); has request_lab_tests => ( is => 'ro', isa => 'ArrayRef[Str]', default => sub { [] }, lazy => 1, traits => ['Array'], handles => { add_request_lab_test => 'push', all_request_lab_tests => 'elements', reset_request_lab_tests => 'clear', }, ); use Data::Dumper; # ------------------------------------------------------------------------------ sub do_request_diagnosis_history { my $self = shift; my $data = $self->form_data; my $diagnosis_id = $data->{_diagnosis_id}; my $request_id = $data->{_request_id}; my $option_id = $data->{option_id}; my $user_id = $self->user_profile->{id}; my $reason = $data->{reason}; LIMS::DB::RequestDiagnosisHistory->new( diagnosis_id => $diagnosis_id, request_id => $request_id, option_id => $option_id, user_id => $user_id, )->save; $self->add_to_actions("amended diagnosis ($reason)"); } # ------------------------------------------------------------------------------ sub do_gross_description { my ($self, $gross_description) = @_; my $request_id = $self->form_data->{_request_id}; my $o = LIMS::DB::RequestGrossDescription->new( request_id => $request_id, ); if ( $o->load_speculative ) { if ( $o->detail ne $gross_description ) { # warn Dumper $o; $o->detail($gross_description); $o->save; # no need for changes_only - 'detail' is the only col $self->add_to_actions('amended gross description'); } } else { $o->detail($gross_description); $o->save; } } # ------------------------------------------------------------------------------ sub do_additional_options { my $self = shift; my $data = $self->form_data; # warn Dumper $self->form_data; my $request_id = $data->{_request_id}; # get possible additional options: my $additional_options = LIMS::DB::AdditionalOption::Manager ->get_additional_options(); # clear any existing request_options (NO - clears doi, copy_to, etc): # LIMS::DB::RequestOption::Manager->delete_request_options( # where => [ request_id => $request_id ] ); # add any new ones: for my $opt( @$additional_options ) { my $option = $opt->option_name; next unless defined $data->{$option}; # maybe '0' my $o = LIMS::DB::RequestOption->new( request_id => $request_id, option_id => $opt->id, ); if ($o->load_speculative) { # exists, only delete if input empty: $o->delete if $data->{$option}; $self->add_to_actions("delete option $option"); } elsif ($data->{$option}) { # didn't exist so create if new input: $o->save; $self->add_to_actions("new $option option"); } } } # ------------------------------------------------------------------------------ # detects a change of diagnosis during reporting/authorisation stages (shared by # update_report() and do_request_report(): sub has_changed_diagnosis { my $self = shift; my $data = $self->form_data; # warn Dumper $data; my $original_diagnosis_id = $data->{_diagnosis_id} || 0; # optional my $this_diagnosis_id = $data->{diagnosis_id}; # required 'report' field return ( $original_diagnosis_id != $this_diagnosis_id ); } # ------------------------------------------------------------------------------ sub do_request_report { # request_report table: my $self = shift; my $data = $self->form_data; # warn Dumper $data; my $request_id = $data->{_request_id}; my $report = LIMS::DB::RequestReport->new( request_id => $request_id, ); my $request_status = ''; # set below # if report exists, load it: if ($report->load_speculative) { # warn Dumper $report->as_tree; # check is reported (ie not received report via results import): if (! $self->_has_report_history($request_id) ) { # just need to record reporter info in history table: $self->add_to_actions('reported'); } else { # update report: # archive original comment (if changed) before update: $self->_archive_comment($report); $self->_load_report_data($report); # to ensure record will be picked up by mail_reports.pl if # authorise/final diagnosis and no other changes to req_rpt table: $self->_update_timestamp($report) if ( ! $report->dirty_columns ); $report->save(changes_only => 1); } if ( $data->{final_diagnosis} ) { $self->add_to_actions('confirmed final diagnosis'); } } else { # create new report: $self->_load_report_data($report); # warn Dumper $report->as_tree; $report->save; $self->add_to_actions('reported'); $request_status = 'reported'; } # can be submitted with report (if self-authorisable), or separately: if ( $data->{authorise} ) { $self->add_to_actions('authorised'); $request_status = 'authorised'; } # Outreach followup option (if configured): $self->do_outreach_request_pack_dispatch($data) if $self->lims_cfg->{settings}->{have_outreach} && $data->{followup_option_id}; { # auto-generate any additional tests if configured (before 'has_outstanding_tests'): my $cfg = $data->{additional_tests_config}; if ( $cfg && $self->has_changed_diagnosis ) { # detect new or changed diagnosis $self->_do_additional_tests(); } } # set request status (may override $request_status set above): { # is authorisation step required: my $is_authorisation_active = $self->does_authorisation; # have any outstanding tests: my $have_outstanding_tests = $self->has_outstanding_tests($request_id); # override request status to 'complete' if no outstanding tests AND: unless ($have_outstanding_tests) { # action = report & no authorisation required OR # action = authorise & no final_diagnosis required OR # 'final_diagnosis' param supplied my $record_is_complete = ( ! $is_authorisation_active || $data->{final_diagnosis} || ( $request_status eq 'authorised' && ! $self->_diagnosis_confirmation_required($request_id) ) ); # warn Dumper $record_is_complete; # override $request_status if above criteria satisfied: $request_status = 'complete' if $record_is_complete; } # update request_status if required (may not exist eg just a # diagnosis revision without either authorisation or final_diagnosis): if ($request_status) { $self->update_request_status($request_status, $request_id); } } } # ------------------------------------------------------------------------------ sub do_auto_report { my $self = shift; # get report data if request is auto-reportable - or returns empty: my $auto_report_data = $self->_get_auto_report_data() || return 0; # warn Dumper $auto_report_data; my $data = $self->form_data; # warn Dumper $data; my $report_data; # if report section is a hash(ref) of hashrefs, assume we have result_summary-specific sections: my $HoH = grep { ref $auto_report_data->{report}->{$_} eq 'HASH' } keys %{ $auto_report_data->{report} }; # will be 'true' if it's a HoH if ($HoH) { # warn 'here'; report section is hash(ref) of hashrefs: $report_data = $self->_get_report_data($auto_report_data) || return 0; } else { # warn 'here'; # report section is hash(ref) of strings: $report_data = $auto_report_data->{report} || return 0; } # add results_summary data if supplied: if ( my $results_summary = $auto_report_data->{results_summary} ) { # warn 'here'; map { $data->{$_} = $results_summary->{$_}; } qw(lab_section summary); # do request_results_summary update using modified $self->form_data: $self->do_request_results_summary(); } # add report_data to $data: map { # warn $_; $data->{$_} = $report_data->{$_}; } qw(comment status clinical_details specimen_quality); # add diagnosis to data if supplied: if ( my $diagnosis = $report_data->{diagnosis} ) { # get diagnosis_id from diagnosis: my $d = LIMS::DB::Diagnosis->new(name => $diagnosis)->load; $data->{diagnosis_id} = $d->id; } # add 'authorise' to data (if required): if ($auto_report_data->{authorise}) { $data->{authorise} = 1; } # do request_report update using modified $self->form_data: $self->do_request_report(); $self->do_request_history(); # return 'true' value in case caller tests for it: return 1; } # ------------------------------------------------------------------------------ sub do_request_results_summary { my $self = shift; my $data = $self->form_data; # warn Dumper $data; my $section = $data->{lab_section}; my $summary = $data->{summary}; my $lab_section = LIMS::DB::LabSection->new(section_name => $section)->load; my %data = ( request_id => $data->{_request_id}, lab_section_id => $lab_section->id, results_summary => $summary, ); LIMS::DB::RequestResultSummary->new(%data)->save; } # ------------------------------------------------------------------------------ # returns 1 if any lab tests status != 'complete', otherwise returns 0: sub has_outstanding_tests { my ($self, $request_id) = @_; # warn $request_id; my %args = ( query => [ request_id => $request_id ], require_objects => ['status', 'lab_test'], ); my $lab_tests = LIMS::DB::RequestLabTestStatus::Manager ->get_request_lab_test_status(%args); for (@$lab_tests) { return 1 if $_->status->description ne 'complete'; # add test to request_lab_tests attr for do_auto_report(): $self->add_request_lab_test($_->lab_test->field_label); } return 0; } #------------------------------------------------------------------------------- sub _archive_comment { my ($self, $report) = @_; my $form_data = $self->form_data; return if $report->comment eq $form_data->{comment}; LIMS::DB::RequestReportHistory->new( request_id => $form_data->{_request_id}, field => 'comment', content => $report->comment, user_id => $self->user_profile->{id}, )->save; $self->add_to_actions('amended comment'); } # ------------------------------------------------------------------------------ sub _has_report_history { my ($self, $request_id) = @_; my %args = ( query => [ request_id => $request_id, action => 'reported', ], ); return LIMS::DB::RequestHistory::Manager->get_request_histories_count(%args); } # ------------------------------------------------------------------------------ sub _load_report_data { my ($self, $report) = @_; my $form_data = $self->form_data; my @params = grep { $report->meta->column($_)->type !~ /serial|timestamp/; } $report->meta->column_names; # warn Dumper \@params; # update report with form params: COL: foreach my $param (@params) { # warn $param; next COL if $param eq 'request_id'; # already have it my $val = $form_data->{$param}; # warn $val; # skip unchanged cols: next COL if $report->$param && $report->$param eq $val; $report->$param($val); } } #------------------------------------------------------------------------------- # if auto_reportable_config loaded, maybe elegible for auto-reporting: sub _get_auto_report_data { my $self = shift; my $data = $self->form_data; my $cfg = $data->{auto_reportable_config} || return 0; # warn 'here'; my $request_id = $data->{_request_id}; # get initial_screen term: my $initial_screen = $self->_get_initial_screen || return 0; # warn 'here'; # return 0 unless initial_screen in auto-reportable list: my $auto_report_data = $cfg->{$initial_screen} || return 0; # warn 'here'; # check request has only 1 specimen: my $request_specimen = $self->_get_request_specimen($request_id); return 0 unless scalar @$request_specimen == 1; # warn 'here'; # check specimen matches requirement: return 0 unless $request_specimen->[0] eq $auto_report_data->{specimen}; # warn 'here'; # check no outstanding tests (returns 'true' if so): return 0 if $self->has_outstanding_tests($request_id); # warn 'here'; # get auto-requested lab-tests: my $requested_tests = $self->_get_auto_requested_lab_tests($initial_screen); # if lab-tests allocated at screening stage: if ( @$requested_tests ) { # warn Dumper $lab_test; # get list of completed lab-tests: my @complete = $self->all_request_lab_tests; # warn Dumper \@complete; # check required lab_test(s) status set to complete: my $all_complete = sub { LIMS::Local::Utils::is_array_subset(@_) }; # is 1st array(ref) a subset of (or same as) 2nd array(ref): return 0 unless &$all_complete($requested_tests, \@complete); } # warn 'here'; # check not already reported: my $o = LIMS::DB::RequestReport->new(request_id => $request_id); return 0 if $o->load_speculative; # warn 'here'; # OK, can auto-report: return $auto_report_data; } # ------------------------------------------------------------------------------ # does request need a final_diagnosis confirmation # uses L::L::R::DiagnosisConfirm::diagnosis_confirmation_required() sub _diagnosis_confirmation_required { my ($self, $request_id) = @_; my $yaml = $self->get_yaml_file('diagnosis_confirm'); return 0 unless $yaml; # no need to continue my $args = { specimen => [], # array(ref) of sample_codes lab_test => [], # AoH (keys = test_name & status) section => [], # array(ref) of lab_section names screen => undef, # str yaml => $yaml, }; { # get initial_screen: my $o = LIMS::DB::RequestInitialScreen->new(request_id => $request_id) ->load( with => 'screen' ); # warn Dumper $o->as_tree; $args->{screen} = $o->screen->description; } { # get specimen(s) array(ref): my @args = ( query => [ request_id => $request_id ], require_objects => 'specimen', ); my $o = LIMS::DB::RequestSpecimen::Manager->get_request_specimens(@args); $args->{specimen} = [ map $_->specimen->sample_code, @$o ]; # warn $specimen; } { # get lab_tests (AoH): my @args = ( query => [ request_id => $request_id ], require_objects => [ qw(lab_test status) ], ); my $o = LIMS::DB::RequestLabTestStatus::Manager ->get_request_lab_test_status(@args); if (@$o) { # if any lab_tests: # diagnosis_confirmation_required() method needs array of hashrefs: my @lab_tests = map { { test_name => $_->lab_test->test_name, status => $_->status->description, } } @$o; $args->{lab_test} = \@lab_tests; # warn \@lab_tests; } } { # get section_names of results summaries array(ref): my @args = ( query => [ request_id => $request_id ], require_objects => 'lab_section', ); my $o = LIMS::DB::RequestResultSummary::Manager ->get_request_result_summaries(@args); if (@$o) { # if any result_summaries: $args->{section} = [ map $_->lab_section->section_name, @$o ]; } } # calculation of whether confimation is required is done by external method # shared by incomplete_requests.pl cron: my $result = $self->diagnosis_confirmation_required($args); # L::L::R::DiagnosisConfirm # warn Dumper $result; return $result; } #------------------------------------------------------------------------------- sub _get_auto_requested_lab_tests { # similar function name in R::LabTestUpdate my ($self, $presentation) = @_; my @args = ( query => [ 'screen.description' => $presentation, ], require_objects => [ qw(lab_test screen) ], ); my $o = LIMS::DB::ScreenLabTest::Manager->get_screen_lab_tests(@args); my @lab_tests = map $_->lab_test->field_label, @$o; # warn Dumper \@lab_tests; return \@lab_tests; } #------------------------------------------------------------------------------- sub _get_initial_screen { my $self = shift; my $data = $self->form_data; # if it's a screening action, will have screen_id: if ( my $screen_id = $data->{screen_id} ) { my $screen = LIMS::DB::Screen->new( id => $screen_id )->load; return $screen->description; } else { my $request_initial_screen = LIMS::DB::RequestInitialScreen ->new(request_id => $data->{_request_id}) ->load( with => 'screen', speculative => 1 ) || return 0; # in case results update on unscreened request return $request_initial_screen->screen->description; } } # ------------------------------------------------------------------------------ # force update on request_report.timestamp col to trigger mail report: sub _update_timestamp { # warn 'here'; my ($self, $report) = @_; my $now = LIMS::Local::Utils::time_now(); $report->updated_at($now); } # ------------------------------------------------------------------------------ sub _do_additional_tests { my $self = shift; my $data = $self->form_data; # warn Dumper $data; my $diagnosis # get diagnosis name from form_data: = LIMS::DB::Diagnosis->new(id => $data->{diagnosis_id})->load; my $cfg = $data->{additional_tests_config}; # warn Dumper $cfg; # return unless diagnosis has entry in additional_tests config: my $tests = $cfg->{$diagnosis->name} || return; # warn Dumper $tests; my @test_ids = keys %$tests; # warn Dumper \@test_ids; # create map for test_id => field_label: my $lab_tests_map = $self->_lab_tests_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 # 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 [$data->{_request_id}, $test_id, $lab_tests_map->{$test_id}]; $self->do_new_lab_test(\%h); # log action in request_lab_test_history: if ( $self->have_requested_lab_tests ) { # set in do_new_lab_test() on save my $field_label = $lab_tests_map->{$test_id}; # warn $field_label; LIMS::DB::RequestLabTestHistory->new( request_id => $data->{_request_id}, user_id => $user_profile_id, action => "auto-requested $field_label triggered by diagnosis", )->save; $self->reset_requested_lab_tests; # clear before saving next lab-test } } } sub _lab_tests_map { my $self = shift; my $o = LIMS::DB::LabTest::Manager->get_lab_tests; my %map = map +($_->id => $_->field_label), @$o; return \%map; } # ------------------------------------------------------------------------------ sub _get_report_data { my ($self, $auto_report_data) = @_; my $report_data = $auto_report_data->{report}; my $data = $self->form_data; # get result_summary for lab_test lab_section: my $section_name = $auto_report_data->{lab_test}->{lab_section}; my $lab_section = LIMS::DB::LabSection->new( section_name => $section_name )->load; my $request_id = $data->{_request_id}; my $request_result_summary = LIMS::DB::RequestResultSummary ->new(request_id => $request_id, lab_section_id => $lab_section->id) ->load; my $result_summary = $request_result_summary->results_summary; # return data for entry = $result_summary: return $report_data->{$result_summary}; } # ------------------------------------------------------------------------------ sub _get_request_specimen { my ($self, $request_id) = @_; my %args = ( query => [ request_id => $request_id ], require_objects => 'specimen', ); my $request_specimen = LIMS::DB::RequestSpecimen::Manager->get_request_specimens(%args); my @specimens = map { $_->specimen->sample_code; } @$request_specimen; return \@specimens; } 1;