• 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',
);

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 $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;
	
	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';
	}

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

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