• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Local::Role::DiagnosisConfirm;

use Moose::Role;
use Data::Dumper;

# shared by ReportUpdate::do_request_report() & incomplete_requests.pl cron

sub diagnosis_confirmation_required {
    my $self = shift;
	my $args = shift; # expect keys = screen, specimen, lab_tests, lab_sections, yaml

=begin # a "final_diagnosis" confirmation IS required if:
	1) request.status = 'authorised' (already been tested for)
	2) no outstanding tests
	3) has a cytogenetics, molecular or FISH results summary with timestamp > auth_date
	4) has not been screened as:
		Molecular miscellaneous
		Chimerism sample
		PNH
		Rheumatoid arthritis
		CML follow-up (post-BMT, imatinib, interferon, STI) on PB sample
		CMPD pres & follow-up on PB sample with JAK2 as sole test
=cut

	return 0 unless $args->{yaml}; # eg function not configured
    
	my $auth_date = $args->{authorisation_date}; # request_status.time
	my $specimen  = $args->{specimen}; # array(ref) of sample_codes
	my $lab_test  = $args->{lab_test}; # AoH (keys = test_name & status)
	my $section   = $args->{section};  # AoH (section name & result_summary timestamp)
	my $screen    = $args->{screen};   # str
	my $yaml      = $args->{yaml};     # hashref

	# get list of lab_test names:
	my @lab_tests = map $_->{test_name}, @$lab_test; # warn Dumper \@lab_tests;

	{ # exempted screens with any sample type:
		# NB - already checked in incomplete_requests.pl
		my $exempt_screens = $yaml->{exempt_all_sample_types}; # arrayref
		return 0 if grep $screen eq $_, @$exempt_screens;		
	} # warn 'here';
	
	{ # exempted screens with specific sample type:
		my $data = $yaml->{exempt_if_sample_type}; # hashref
		while ( my($exempt_screen, $exempt_specimen) = each %$data ) {
			return 0 if $screen eq $exempt_screen
				&& lc(join '', @$specimen) eq lc $exempt_specimen;
		}
	} # warn 'here';
	
	{ # # exempted screens with specific sample type and lab test:
		my $data = $yaml->{exempt_if_sample_type_and_lab_test}; # hashref
		my $ary_diff = sub { LIMS::Local::Utils::get_array_diff(@_) };

		# need to force $specimen entries to lc to match $d->{sample} for $ary_diff:
		my @sample = map lc $_, @$specimen; # warn Dumper \@sample;
		
		while ( my($exempt_screen, $d) = each %$data ) {
			my $required_sample = $d->{sample};
			my $required_tests  = $d->{test_name}; # warn Dumper $required_tests;

			return 0 if
				( $screen eq $exempt_screen ) &&
				( not &$ary_diff(\@lab_tests, $required_tests) ) &&
				( not &$ary_diff(\@sample,    $required_sample) );
		}
	} # warn 'here';
	
	{ # require result_summary from molecular, cytogenetics or FISH sections:
		# NB - already checked in incomplete_requests.pl
		my $lab_sections = $yaml->{lab_sections}; # arrayref
		# map of lab section names (values == 1):
		my %map = map { $_ => 1 } @$lab_sections; # create hash from array(ref)		
		
		my $post_authorisation = sub { # returns true if 1st date > 2nd date
			LIMS::Local::Utils::check_chronological_order(@_);
		};
		# return 0 unless we have one or more relevant result summaries with
		# timestamp AFTER authorisation time:
		return 0 unless grep {
			$map{ _get_section_name($_) } &&
				( &$post_authorisation($_->{time}, $auth_date) > 0 );
		} @$section;
	} # warn 'here';
	
	{ # require all lab_test status = complete:
		# NB - already checked in _diagnosis_confirmation_required()
		my @status = map $_->{status}, @$lab_test; # warn Dumper \@status;
		return 0 if grep $_ ne 'complete', @status;		
	} # warn 'here';
	
	# OK, not an exempt initial_screen/specimen combination, do have necessary
	# result summary > auth_date & all lab_tests complete so DO need confirmation:
	return 1;	
}

sub _get_section_name { $_->{section_name} }

=begin
# ------------------------------------------------------------------------------
# shared by __PACKAGE__ & M::R::ReportUpdate (not used - cannot be used by crons
# - can't load DB:: classes)
sub get_auto_requested_lab_tests_for_screen {
	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->test_name, @$o; # warn Dumper \@lab_tests;
	return \@lab_tests;
}
=cut

1;