• 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 and no other changes to req_rpt table:
            $self->_update_timestamp($report) if ( ! $report->dirty_columns );
            $report->save(cascade => 1, changes_only => 1); # + update related object
        }

        if ( $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->save(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 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) { # 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 $request_id   = $self->form_data->{_request_id}; # warn $request_id;
	my $diagnosis_id = $self->form_data->{secondary_diagnosis_id};

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

	if ( $o->load_speculative ) {
		if ( $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->delete;
			$self->add_to_actions('deleted 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 & diagnosis_id & request_id:
            next PARAM if grep $param eq $_,
				( 'diagnosis_id', 'request_id', @$opts );

            my $new = $form_data->{$param} || 'NULL';
			my $old = $o->$param || 'NULL'; # warn Dumper [$param, $new, $old];
			next PARAM if $new eq $old;
			$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:
    for my $o ($report, $report->request_specimen_detail) {
        my @params = grep { 
            $o->meta->column($_)->type !~ /serial|timestamp/;
        } $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;    
    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;