• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Controller::Roles::RecordHandler;

use Moose::Role;
use LIMS::Local::Utils;

has $_ => (
	is  => 'ro',
	isa => 'HashRef',
	lazy_build => 1,
) for qw(status_options_map additional_options_map );

use Data::Dumper;
use IO::All;

# ------------------------------------------------------------------------------
sub get_single_request_data {
    my ($self, $request_id) = @_; $self->_debug_path('timer'); # warn $request_id;
#warn 'here'; 
    # get 'horizontal' data (from tables returning single row joined on request_id):
    my $request_data = $self->model('Request')->get_single_request($request_id)
	|| return 0; # in case request_id manually input into url and doesn't exist
#warn 'here';
    # request history data:
    my $request_history = $self->_parse_request_history($request_data);
#warn 'here';
    # request.id => [ specimen_code(s) ] map - needs arrayref of request.id's:
    my $specimen_map = $self->specimen_map([ $request_data->id ]);  
#warn 'here';
    # get unprocessed lab_test data (all lab tests, this requests' lab_tests,
    # result_summaries, lab_sections, etc):
    my $raw_lab_test_data = $self->_get_lab_test_data($request_id);
#warn 'here';
    # format result summaries for template:
    my $result_summaries = $self->_format_result_summaries($raw_lab_test_data);
#warn 'here';
	# format remote system numbers
    my $remote_system_ids
		= $self->_format_remote_system_ids($raw_lab_test_data);
#warn 'here';
    # diagnosis history
    my $previous_diagnoses
        = $self->model('Request')->get_previous_diagnoses($request_id);
#warn 'here';
	# request status_options:
	my $status_options = $self->status_options_map;
#warn 'here';
    # request_options:
    my $request_options = $self->_get_request_options($request_id);
#warn 'here';
    # request_consent:
    my $request_consent = $self->_get_request_consent($request_id);
#warn 'here';
	#  lab section notes map:
	my $lab_section_notes = $self->section_notes_map($request_id);
#warn 'here';
    my $has_phonelog = $self->model('PhoneLog')->get_phonelog_count($request_id);
#warn 'here'; # to save template-derived db queries (or use as_tree):
    my $might_have = $self->_get_might_have_data($request_data);
#warn 'here';
	# any special formatting for template?
	my $special_tmpl_formatting
        = $self->_get_special_formatting($request_data) || {}; # needs hashref
#warn 'here';
	# has, or is elegible for, clinical data:
	my $clinical_data_link = $self->_format_clinical_data_link($request_data);
#warn 'here';
	my $is_locked = $self->_set_request_status($request_data);
	
    $self->_debug_path('timer');

    return {
        data               => $request_data,
        history            => $request_history,
		is_locked          => $is_locked,
        has_optional       => $might_have,
        has_phonelog       => $has_phonelog,
        specimen_map       => $specimen_map,
		status_options	   => $status_options,
        request_options    => $request_options,
        request_consent    => $request_consent,
        result_summaries   => $result_summaries,
        raw_lab_test_data  => $raw_lab_test_data,
		lab_section_notes  => $lab_section_notes,
		remote_system_ids  => $remote_system_ids,
		clinical_data_link => $clinical_data_link,
        previous_diagnoses => $previous_diagnoses,
		special_formatting => $special_tmpl_formatting,
	}
}

#-------------------------------------------------------------------------------
sub get_previous_cases {
	my ($self, $request_data) = @_;
	
	my $patient_case = $request_data->{data}->patient_case;
	
	my %matches;
	
	my %args = (
		or => [
			patient_id => $patient_case->patient_id,
			and => 	[
				last_name  => $patient_case->patient->last_name,
				first_name => $patient_case->patient->first_name,
			],
#			unit_number => $patient_case->unit_number, # big performance hit ?why
		],
	);

	my $o = $self->model('Request')->get_previous_requests(\%args);
		
	while ( my $record = $o->next ) {
		# skip current request:
		next if $record->id == $request_data->{data}->id;
		
		if ( $record->patient_case->patient_id == $patient_case->patient_id ) {
			push @{ $matches{this_id} }, $record;
		}
		else {
			push @{ $matches{others} }, $record;
		}
	}
	
	# skip current request:
#	my @records = grep { $_->id != $request_data->{data}->id } @$o;
#	$matches{nhs_number} = \@records;	
	
	return \%matches;
}

#-------------------------------------------------------------------------------
# shared by print_record (via format_report) & print_run to process request-specific
# data for tt params; returns hashref of data:
sub format_print_record_request_data {
	my ($self, $request_id) = @_;
	
	my $request_data = $self->get_single_request_data($request_id);

	# format lab_test data for print template:
    if ($request_data->{special_formatting}->{has_outreach}) {
        my $data
            = $self->model('Outreach')->get_all_data($request_data->{data}->{id});
        $request_data->{outreach} = $data;
        $self->stash( css_required => 1 ); # for format_report() - uses wkhtmltopdf
    }
    else {
        $self->process_raw_lab_test_data($request_data);	
    
        { # request_dispatch_logs:
            my $dispatch_log
                = $self->model('Request')->get_request_dispatch_logs($request_id);
            $self->tt_params( dispatch_log => $dispatch_log );
        }
        { # request_error_codes:
            my $errors = $self->model('Request')->get_request_errors($request_id);
            $self->tt_params( request_errors => $errors );		
        }
    }
    return $request_data;
}

#-------------------------------------------------------------------------------
# shared by print_record(), email_record() & mail_reports.pl to return formatted
# report as pdf:
sub format_report {
	my ($self, $request_id) = @_;
 	
	# process request-specific data for template & return hashref of data:
	my $request_data = $self->format_print_record_request_data($request_id);
	$self->tt_params( request => $request_data );

	# get some data maps for template:
	{ # allowed report error_codes:
		my $report_error_codes = $self->report_error_codes_map;
		$self->tt_params( report_error_codes => $report_error_codes );		
	}
	{ # diagnosis_context_warnings:
		my $context_warning = $self->diagnosis_context_warning_map;
		$self->tt_params( context_warning_map => $context_warning );		
	}

	# set flag for template to pass CGISESSID in url in case img called in tmpl:
	# (uncomment here & in tmpl to activate url-based session param)
	# $self->tt_params( url_session_id_required => 1 ) unless $ENV{REPORT_HTML};
    
    # template depends on whether it's outreach data:
	my $tmpl = $request_data->{outreach}
        ? 'outreach/report.tt'
        : 'record/print_pdf.tt'; # warn $tmpl;

    my $html = $self->render_view($tmpl); # return $html;
		return $html if $ENV{REPORT_HTML}; # for lims_server and/or no PDF reader	
    my $o = LIMS::Local::PDF->new( config => $self->cfg );

	my $pdf;
	
	if ($self->stash->{css_required}) { # if we need to create intermediate temp files:
        my $tmp_file = $self->cfg->{tmpdir} . '/' . $request_id . '.html';
		io($tmp_file)->print(${$html});	# save file to disk

		# $pdf = $o->make_pdf({ file => $tmp_file }); # HTMLDOC method
		my %args = (
			file  => $tmp_file,
			session_id => $self->session->id, # for charts
		);
		$pdf = $o->make_pdf_with_css(\%args);
        
		io($tmp_file)->unlink; # delete temp file
	}
	else {
		my %args = (
			html 	=> $html,
			session => $self->session,
		);
		$pdf = $o->make_pdf(\%args); # html in memory
	}
	
	return $pdf;
}

#-------------------------------------------------------------------------------
# set record to locked ?
sub _set_request_status {
    my ($self, $request) = @_;

    { # return if request.updated_at is today:
		# DateTime->compare() returns true if dates not equal - need to truncate
		# timestamp field so compare() works at day level (not hr, min, sec):
        my $last_modified  
            = $request->updated_at->truncate(to => 'day'); # warn $last_modified;
        return 0 unless DateTime->compare( $last_modified, DateTime->today() );
    }

	# for devel/test:
	return 0 if $ENV{OVERRIDE_LOCK}; # $self->authen->username eq 'raj';
	
	# return 'true' if status = complete:
	return ( $request->status_option->description eq 'complete' );
}

=begin # not in use - using requests.created_at now
#-------------------------------------------------------------------------------
# maps request to its registration time via request.id => request_history.time
sub get_request_histories {
    my $self = shift;
    my $requests = shift; # arrayref

    # get list of request.id's from requests arrayref:
    my @request_ids = map { $_->id } @$requests; # DEBUG \@record_ids;

    # get histories object, ie:
    # SELECT .. FROM request_history WHERE request_id IN (@request_ids) and action = 'foo'
    my $histories = $self->model('History')
        ->get_request_histories_for_action('registered', \@request_ids);

    # create history_map of keys = request_id, vals = registration time:
    my %history_map = map {
        $_->request_id => $_->time;
    } @$histories;

    return \%history_map;
}
=cut

#--------------------- PRIVATE SUBS --------------------------------------------


#-------------------------------------------------------------------------------
# extracts register, screen, report & authorise data from request_history array(ref):
sub _parse_request_history {
    my ($self, $data) = @_;

    # get array(ref) of history actions (register, screen, etc):
    my $history = $self->model('History')->get_request_history($data->id);

    # create hash with keys = action & values = associated history object:
    my %data = map { $_->action => $_ } @$history;

    return \%data;
}

#-------------------------------------------------------------------------------
# left outer join rels with no data don't get accessor in data object, so testing
# for presence of data in template causes db query; returns hashref 
sub _get_might_have_data {
    my ($self, $request_data) = @_;
    
    my $data = $request_data->as_tree; # $self->debug( [ keys %$rd ]);
    
    my %might_have = ();

    if ( $data->{request_trial} ) {
        $might_have{clinical_trial} = 1;
    }
    if ( $data->{request_external_ref} ) {
        $might_have{external_ref} = 1;
    }
    if ( $data->{request_initial_screen} ) {
        $might_have{initial_screen} = 1;
    }
    if ( $data->{request_report} ) {
        $might_have{report} = 1;
    }
    
    return \%might_have;
}

#-------------------------------------------------------------------------------
# overrides default report format for special cases - needs to be screened & have
# screen entry in .local/special_formatting.yml file:
sub _get_special_formatting {
	my $self = shift;
	my $data = shift;

	# don't try to call methods on request_initial_screen unless exists:
	$data->request_initial_screen || return 0;
	my $request_initial_screen
		= $data->request_initial_screen->screen->description;

	my $yaml = $self->get_yaml_file('special_formatting') || return 0;

	# return 0 unless initial_screen in special_formatting list:
	my $yaml_entry = $yaml->{$request_initial_screen} || return 0;
	return $yaml_entry;
}

#-------------------------------------------------------------------------------
# get various lab_test data (all lab tests, all lab sections, this requests' lab_tests,
# this requests' result_summaries, etc); return a hashref for use in methods & templates
sub _get_lab_test_data {
    my ($self, $request_id) = @_;
#warn 'here';
    # get list of all lab sections:
    my $all_lab_sections = $self->model('LabSection')->get_lab_sections;
#warn 'here';
    # get list of all lab_tests:
    my $all_lab_tests = $self->model('LabTest')->get_lab_tests;
#warn 'here';
	my $lab_tests_status
		= $self->model('LabTest')->get_request_lab_tests_status($request_id);
#warn 'here';
    # get test results for this request:
    my $lab_test_results
        = $self->model('Result')->get_request_lab_test_results($request_id);
    # get result summaries for this request:
    my $result_summaries
        = $self->model('LabSection')->get_section_result_summaries($request_id);
#warn 'here';
	# get remote system identifiers:
	my $remote_system_ids
		= $self->model('LabSection')->get_labsection_remote_system_ids($request_id);
		
    # create data structure to hold info:
    my %lab_test_data = (
        all_lab_tests     => $all_lab_tests,
        all_lab_sections  => $all_lab_sections,
        result_summaries  => $result_summaries,
        lab_test_results  => $lab_test_results,
        lab_tests_status  => $lab_tests_status,
		remote_system_ids => $remote_system_ids,
    );

    return \%lab_test_data;
}

#-------------------------------------------------------------------------------
sub _get_request_options {
    my ($self, $request_id) = @_; 

	# get active options for this request:    
    my $active_options
        = $self->model('Request')->get_request_options($request_id);

	# get list of all available request options:
	my $additional_options = $self->additional_options_map; # warn Dumper $additional_options;

	# copy $additional_options to avoid altering $self->additional_options_map:
	my %request_options = %{ $additional_options };

	# add $active_options data to %request_options:
	for (@$active_options) {
		my $option_name = $_->option->option_name;		
		
		# replace existing $request_options{$option_name} hashref data:
		$request_options{$option_name} = { # create new hashref:
			%{ $request_options{$option_name} }, # preserve existing data
			is_selected => 1, # add new 'is_selected' key
		};
		
=begin	# alternative way of doing it:
		my %copy_opts = %{ $request_options{$option_name} };
		$copy_opts{is_selected} = 1; # add new 'is_selected' key
		$request_options{$option_name} = \%copy_opts; # replace existing with new
		# wrong way of doing it - too shallow (only copies the top level hashref,
		# not the second level ones):
		$request_options{$option_name}{is_selected} = 1;
=cut
	} # warn Dumper \%request_options;
	
    return \%request_options;
}

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

	# get list of all available request options:
	my $all_options = $self->model('RequestOption')->get_request_options;
	
	# create hash of option_name => is_active:
	my %options = map {
		$_->option_name => {
			is_active => $_->is_active,
		}
	} @$all_options; # warn Dumper \%options;

	return \%options;
}

#-------------------------------------------------------------------------------
sub _build_status_options_map {
	my $self = shift; 
	
	my $status_options = $self->model('Option')->get_status_options;
	
	my %map = map {
		$_->description => $_->as_tree;
	} @$status_options;
	
	return \%map;
}

#-------------------------------------------------------------------------------
sub _get_request_consent {
    my ($self, $request_id) = @_;
    
    my $request_consent
        = $self->model('Request')->get_request_consent($request_id);

    # hash map of selected request_consent:
    my %active_consent = map {
        $_->consent->consent_name => $_->status;
    } @$request_consent; # $self->debug(\%active_consent);

    return \%active_consent;
}

#-------------------------------------------------------------------------------
# returns hashref of section_name => result_summary for all results summaries for
# current request:
sub _format_result_summaries {
    my ($self, $lab_test_data) = @_;

    my $result_summaries = $lab_test_data->{result_summaries};

    my %data;
    
    foreach my $result (@$result_summaries) {
        my $section_name = $result->lab_section->section_name;
        $data{$section_name} = $result->as_tree(deflate => 0);
    }
    return \%data;
}

#-------------------------------------------------------------------------------
sub _format_clinical_data_link {
	my ($self, $request_data) = @_;
	
	return 0 unless $self->cfg('settings')->{have_hmrn}; # no point if no db
	
	# does request.patient_case.patient_id already have data (ie in hmrn.mdt or
	# hmrn.chronologies table)?
	my $patient_id = $request_data->patient_case->patient_id;
	my $has_data = $self->model('HMRN')->has_data($patient_id); # warn Dumper $has_data;
	
	# request is elegible if referred from network location and has ICDO3 diagnosis,
	# or already has data (so no need to do unnecessary db lookup):
	my $is_elegible = $has_data || $self->_is_request_elegible($request_data);	
	
	return {
		is_elegible => $is_elegible,
		has_data 	=> $has_data,
	};
}

#-------------------------------------------------------------------------------
sub _is_request_elegible { # for HMRN data:
	my ($self, $request_data) = @_;	# warn Dumper $request_data->as_tree;
	
	{ # does request come from the local network:
		my $parent_organisation_id
			= $request_data->patient_case->referral_source->parent_organisation_id;
		my $locations = $self->model('Base')->get_objects('LocalNetworkLocation');
		
		my @parent_ids = map $_->parent_id, @$locations;
		return 0 unless grep $parent_organisation_id == $_, @parent_ids;
	} 
	{ # is diagnosis ICDO3:
		return 0 unless $request_data->request_report;
		my $icdo3 = $request_data->request_report->diagnosis->icdo3;
		return ( $icdo3 && $icdo3 =~ /[13]\Z/ ); # ICDO3 ends in 1 or 3
	}
}

#-------------------------------------------------------------------------------
# returns hashref of section_name => remote_system_id for current request:
sub _format_remote_system_ids {
    my ($self, $lab_test_data) = @_;

    my $remote_system_ids = $lab_test_data->{remote_system_ids};

    my %data;

    foreach my $id (@$remote_system_ids) {
        my $section_name = $id->lab_section->section_name;
        $data{$section_name} = $id->as_tree(deflate => 0);
    }

    return \%data;
}

1;