• Files
• Commits
• Log
• Graph
• Stats

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_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:
    OPT: 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:
            next OPT if $data->{$option}; # OK, not zero, still want opt
			$o->delete;
            $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_detail & request_specimen_detail tables:
	my $self = shift;

	my $data = $self->form_data; # warn Dumper $data;

	my $request_id = $data->{_request_id};

	my $report = LIMS::DB::RequestReportDetail->new(request_id => $request_id);

	my $request_status = ''; # set below

	# if report exists, load it:
	my @args_to_load = ( with => 'request_specimen_detail',  speculative => 1 );
	if ( $report->load(@args_to_load) ) { # 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/log original data (if changed) before update:
            $self->_archive_report_details($report);

            $self->_load_report_data($report); # warn Dumper $report->as_tree;

            # to ensure record will be picked up by mail_reports.pl if
            # authorise/final diagnosis with no other changes to req_rpt table
            # and not a specific flag to avoid triggering new report:
            unless ( $report->dirty_columns || $data->{no_new_report} ) {
                $self->_update_timestamp($report);
            }

            # cascade generates (non-fatal) error on updating with a new anatomical_site:
            # $report->save(cascade => 1, changes_only => 1); # + update related object
            $_->save(changes_only => 1) # avoids above error
                for ($report, $report->request_specimen_detail);
        }
        if ( $data->{no_new_report} ) { # eg for ancient requests unlocked for minor edits
            $self->add_to_actions('closed record [no amended report to be issued]');
        }
        elsif ( $data->{final_diagnosis} ) {
            $self->add_to_actions('confirmed final diagnosis');
        }
	}
	else { # create new report:
        my $o = LIMS::DB::RequestSpecimenDetail->new(request_id => $request_id);
        # add request_specimen_detail:
        $report->request_specimen_detail($o);
		$self->_load_report_data($report); # warn Dumper $report->as_tree;
		$report->insert_or_update(cascade => 1); # + update related object

		$self->add_to_actions('reported');
        $request_status = 'reported';
	}

	# secondary diagnosis:
	$self->_do_secondary_diagnosis();

	# 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 (before 'has_outstanding_tests'):
    if ( $self->has_changed_diagnosis and not $data->{_is_outreach}) { # skip outreach
        my @args = ( query => [ diagnosis_id => $data->{diagnosis_id} ]);
        my $o = LIMS::DB::DiagnosisLabTest::Manager->get_objects(@args);
        if (@$o) { # warn Dumper $_->as_tree for @$o;
            my @test_ids = map $_->lab_test_id, @$o;
            my %args = ( action => 'diagnosis', test_ids => \@test_ids );
            my $n = $self->auto_request_additional_tests(\%args); # no. of new tests
            # revert request status if set to 'complete':
            if ($n) {
                my $request = LIMS::DB::Request->new(id => $request_id)
                    ->load(with => 'status_option');
                if ( $request->status_option->description eq 'complete' ) {
                    # set 'downgraded' request_status (reported/authorised):
                    $request_status = $self->does_authorisation
                        ? 'authorised' : 'reported'; # warn $request_status
                }
            }
        }
    }

    # 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 = (
				(not $is_authorisation_active)
				|| $data->{final_diagnosis}
				|| ( $request_status eq 'authorised' and
					not $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 = (
		results_summary => $summary,
		lab_section_id  => $lab_section->id,
		request_id      => $data->{_request_id},
        user_id 	    => $self->user_profile->{id},
	);

	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) { # warn Dumper $_->as_tree;
        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); # warn 'here';
    }

    return 0;
}

#-------------------------------------------------------------------------------
sub _do_secondary_diagnosis {
	my $self = shift;

	my $data = $self->form_data; # warn Dumper $data;

	my $diagnosis_id = $data->{secondary_diagnosis_id};
	my $for_deletion = $data->{delete_secondary_diagnosis};
	my $request_id   = $data->{_request_id}; # warn $request_id;

	my $o = LIMS::DB::RequestSecondaryDiagnosis->new(request_id => $request_id);

	if ( $o->load_speculative ) { # warn $o->secondary_diagnosis_id;
		if ( $for_deletion ) { # form flag as empty text doesn't change autosuggest id
			$o->delete;
			$self->add_to_actions('deleted secondary diagnosis');
		}
		elsif ( $diagnosis_id && $diagnosis_id != $o->secondary_diagnosis_id ) {
			$o->secondary_diagnosis_id($diagnosis_id);
			$o->save;
			$self->add_to_actions('amended secondary diagnosis');
		}
	}
	elsif ($diagnosis_id) {
		$o->secondary_diagnosis_id($diagnosis_id);
		$o->save;
	}
}

#-------------------------------------------------------------------------------
sub _archive_report_details {
    my ($self, $data) = @_; # warn Dumper $data->as_tree; # report data

    my $form_data = $self->form_data; # warn Dumper $form_data;

    # get request_report_history.field opts:
    my $opts = LIMS::DB::RequestReportHistory
        ->new->meta->column('field')->values; # warn Dumper $opts;

    for my $opt (@$opts) { # warn Dumper [$opt, $data->$opt, $form_data->{$opt}];
		no warnings 'uninitialized';

		if ( $data->$opt && ! $form_data->{$opt} ) {
			$self->add_to_actions("deleted $opt");
		}
		elsif ( $form_data->{$opt} && ! $data->$opt ) {
			$self->add_to_actions("added $opt");
		}
        elsif ( $data->$opt ne $form_data->{$opt} ) {
			LIMS::DB::RequestReportHistory->new(
				request_id 	=> $form_data->{_request_id},
				user_id 	=> $self->user_profile->{id},
				content 	=> $data->$opt,
				field 		=> $opt,
			)->save;

			$self->add_to_actions("amended $opt");
		}
    }

    # do rest of request_report_detail & request_specimen_detail params:
    for my $o ($data, $data->request_specimen_detail) {
        my @params = grep {
            $o->meta->column($_)->type !~ /serial|timestamp/;
        } $o->meta->column_names; # warn Dumper \@params;

        PARAM: foreach my $param (@params) { # warn $param;
			# skip request_report_history opts, specimen_date (param not used
            # in report form), diagnosis_id & request_id:
            my @skip = ( 'diagnosis_id', 'request_id', 'specimen_date', @$opts );
            next PARAM if grep $param eq $_, @skip;

            my $new = $form_data->{$param} || 'NULL';
			my $old = $o->$param || 'NULL'; # warn Dumper [$param, $new, $old];
			next PARAM if $new eq $old; # warn Dumper [$param, $old, $new];
			$self->add_to_actions("amended $param [$old -> $new]");
        }
    }
}

# ------------------------------------------------------------------------------
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;

    # report = request_report_detail (=$report) + request_specimen_detail
    my @objects = ( $report, $report->request_specimen_detail );
    for my $o (@objects) {
        my @params = grep {
            $o->meta->column($_)->type !~ /serial|timestamp|datetime/;
        } $o->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'; # not supplied by form

            my $val = $form_data->{$param}; # warn Dumper [$param, $val];
            { # update changed cols:
                no warnings 'uninitialized'; # in case null:
                $o->$param($val) if $o->$param ne $val;
            }
        }
    }
}

#-------------------------------------------------------------------------------
# if auto_reportable_config loaded, maybe elegible for auto-reporting:
sub _get_auto_report_data {
    my $self = shift;

    my $data = $self->form_data; # warn Dumper $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 result_summaries, get section_name & result_summary timestamp:
			my @sections = map +(
				{
					section_name => $_->lab_section->section_name,
					time         => $_->time,
				}
			), @$o;
			$args->{section} = \@sections;
		}
	}
	{ # get report/authorisation date:
		my $dbix = $self->lims_dbix;
		my $map = $dbix->select('status_options', [ qw/description id/ ])->map;
		my $option_id = $self->does_authorisation
			? $map->{authorised} : $map->{reported};

		my @args = (request_id => $request_id, status_option_id => $option_id);

		my $o = LIMS::DB::RequestStatusView->new(@args); # warn Dumper $o;
		if ( $o->load_speculative ) { # warn Dumper $o->as_tree;
			$args->{authorisation_date} = $o->time;
		}
	}

	# 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);
}

# ------------------------------------------------------------------------------
# gets report section of auto_reportable.yml, selected using result_summary as key
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(speculative => 1); # speculative in case no result summary (eg deleted)
    return 0 unless $request_result_summary; # or next line fails:

    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;