package LIMS::Model::Roles::ReportUpdate; use Moose::Role; with 'LIMS::Model::Roles::HistoryAction'; 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', }, ); 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 $user_id = $self->user_profile->{id}; my $reason = $data->{revision}; LIMS::DB::RequestDiagnosisHistory->new( request_id => $request_id, diagnosis_id => $diagnosis_id, reason => $reason, 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; 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: LIMS::DB::RequestOption::Manager->delete_request_options( where => [ request_id => $request_id ], ); # add any new ones: for ( @$additional_options ) { my $option = $_->option_name; next unless $data->{$option}; LIMS::DB::RequestOption->new( request_id => $request_id, option_id => $_->id, )->save; $self->add_to_actions("new $option option"); } } # ------------------------------------------------------------------------------ sub do_request_report { # request_report table: my $self = shift; my $request_status = ''; # set below my $data = $self->form_data; # warn Dumper $data; my $request_id = $data->{_request_id}; my $report = LIMS::DB::RequestReport->new( request_id => $request_id, ); # 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); $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'; } # auto-generate any additional tests if configured (before 'has_outstanding_tests'): $self->_do_additional_tests($request_id) if $data->{additional_tests_config}; # 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) = @_; 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 ony 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'; # if there's a lab_test section in cfg file (for results stage): if ( my $lab_test = $auto_report_data->{lab_test} ) { # warn 'here'; # check no outstanding tests (returns 'true' if so): return 0 if $self->has_outstanding_tests($request_id); # warn 'here'; # check has required lab_test completed: return 0 unless grep { $lab_test->{lab_test_name} eq $_; } $self->all_request_lab_tests; } # 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::Local::Utils::diagnosis_confirmation_required() sub _diagnosis_confirmation_required { my ($self, $request_id) = @_; my $args = { specimen => [], # array(ref) of sample_codes lab_test => [], # AoH (keys = test_name & status) section => [], # array(ref) of lab_section names screen => '', # str }; { # 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 = LIMS::Local::Utils::diagnosis_confirmation_required($args); # warn Dumper $result; return $result; } =begin # moved to LIMS::Local::Utils::diagnosis_confirmation_required() for code-share with incomplete_requests.pl sub _diagnosis_confirmation_required_OLD { my ($self, $request_id) = @_; # get initial_screen & specimen type: my ($screened_as, $specimen); { my $o = LIMS::DB::RequestInitialScreen->new(request_id => $request_id) ->load( with => 'screen' ); # warn Dumper $o->as_tree; die; $screened_as = $o->screen->description; } { my $o = LIMS::DB::RequestSpecimen::Manager->get_request_specimens( request_id => $request_id, require_objects => 'specimen', ); $specimen = join ',', map $_->specimen->sample_code, @$o; # warn $specimen; } { # consider initial_screen only: my @exempted_screens = ( 'Molecular miscellaneous', 'Rheumatoid arthritis', 'Chimerism sample', 'PNH', ); return 0 if grep $screened_as eq $_, @exempted_screens; } # warn 'here'; { # initial_screen + sample_type: # CML follow-up (any) on PB (only): return 0 if $screened_as =~ /^CML(.*)follow-up/ && $specimen eq 'PB'; } # warn 'here'; { # initial_screen + sample_type + lab_test: my @args = ( request_id => $request_id, require_objects => 'lab_test', ); my $o = LIMS::DB::RequestLabTestStatus::Manager ->get_request_lab_test_status(@args); my $lab_test = join ',', map $_->lab_test->test_name, @$o; # warn $lab_test; # CMPD pres & follow-up on PB (only) with JAK2 as sole test: return 0 if $screened_as =~ /^CMPD pres & follow-up/ && $specimen eq 'PB' && $lab_test eq 'jak2'; } # warn 'here'; { # has cytogenetics, molecular or FISH results summary: my %args = ( request_id => $request_id, require_objects => 'lab_section', ); my $o = LIMS::DB::RequestResultSummary::Manager ->get_request_result_summaries(%args); return 0 unless @$o ; # or we die trying to call 'lab_section' method below # lab sections requiring a final diagnosis confirmation: my %confirmation_required = map { $_ => 1 } qw(Molecular Cytogenetics FISH); # does any result_summary section_name match required section: return 0 unless grep $confirmation_required{ $_->lab_section->section_name }, @$o; } # warn 'here'; # OK, not an exempt initial_screen type, and do have necessary result summary, # so DO need a final_diagnosis confirmation: return 1; } =cut #------------------------------------------------------------------------------- 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; } } # ------------------------------------------------------------------------------ sub _do_additional_tests { my ($self, $report_id) = @_; 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; # create new request_lab_test for each entry in $tests: TEST: while ( my($test_id, $test_name) = each %$tests ) { # warn Dumper ($test_id, $test_name); my $lab_test = LIMS::DB::RequestLabTestStatus->new( request_id => $data->{_request_id}, lab_test_id => $test_id, ); # skip if already exists: next TEST if $lab_test->load_speculative; $lab_test->user_id($self->user_profile->{id}); $lab_test->save; # skip status_option_id - uses meta data default value # log action in request_lab_test_history: LIMS::DB::RequestLabTestHistory->new( user_id => $self->user_profile->{id}, request_id => $data->{_request_id}, action => "requested $test_name based on diagnosis", )->save; } } # ------------------------------------------------------------------------------ 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;