• Files
• Commits
• Log
• Graph
• Stats

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

use Moose::Role;
with 'LIMS::Controller::Roles::PDF'; # render_pdf()
with 'LIMS::Controller::Roles::Barcode';

use LIMS::Local::Utils;

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

use Data::Dumper;

# for callers not having access to get_single_request_data->{is_locked} var:
sub is_record_complete { shift->_set_request_status(@_) } # true if complete < today

# ------------------------------------------------------------------------------
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_data);
#warn 'here';
	my $outstanding_tests = $self->_get_outstanding_tests($raw_lab_test_data);
#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';
    # previous requests:
    my $previous_requests = $self->_get_previous_requests($request_data);
#warn 'here';
    # diagnosis history
    my $previous_diagnoses
        = $self->model('Request')->get_previous_diagnoses($request_id);
#warn 'here';
    # request_report_history
    my $report_history = $self->_get_report_history($request_id);
#warn 'here';
	# request status_options:
	my $status_options = $self->status_options_map;
#warn 'here';
    # request_options (also looks for previous doi samples):
    my $request_options = $self->_get_request_options($request_data);
#warn 'here';
    # request_consent:
    my $request_consent = $self->_get_request_consent($request_id);
#warn 'here';
	my $request_errors = $self->_get_request_errors($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';
    my $dispatch_log
        = $self->model('Request')->get_request_dispatch_logs($request_id);
#warn 'here';
	my $special_tmpl_formatting
        = $self->_get_special_formatting($request_data) || {}; # needs hashref
	# get outreach if required:
    my $outreach = $special_tmpl_formatting->{has_outreach}
		? $self->model('Outreach')->get_all_data($request_id)
		: undef; # warn Dumper $outreach;
#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);
#warn 'here';
	my $report_data_maps = $self->_get_report_data_maps;
#warn 'here';
    my $small_2d_barcode = $self->_render_small_2d_barcode();

    $self->_debug_path('timer');

    return {
        data               => $request_data,
        history            => $request_history,
		outreach		   => $outreach,
		is_locked          => $is_locked,
        has_optional       => $might_have,
        dispatch_log       => $dispatch_log,
        has_phonelog       => $has_phonelog,
        specimen_map       => $specimen_map,
		status_options	   => $status_options,
        report_history     => $report_history,
        request_options    => $request_options,
		request_errors     => $request_errors,
        request_consent    => $request_consent,
        result_summaries   => $result_summaries,
        previous_requests  => $previous_requests,
        report_data_maps   => $report_data_maps,
        small_2d_barcode   => $small_2d_barcode,
		outstanding_tests  => $outstanding_tests,
        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,
	}
}

#-------------------------------------------------------------------------------
# shared by print_record (via format_report) & print_run to process request-specific
# data for tt params; returns hashref of data:
=begin # all functions performed elsewhere now - can be deleted
sub format_print_record_request_data {
	my ($self, $request_id) = @_;

	my $request_data = $self->get_single_request_data($request_id);

	# simplified print view - using same data/tt as guest view:
	# 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;
}
=cut

#-------------------------------------------------------------------------------
# used by Request::do_email_report() to remove patient identifiers for non-secure addr
sub anonymise_report {
	my ($self, $request_id) = @_;

    # set flag for tt to pass to chart:
    $self->tt_params( anonymise_chart => 1 );

	# process request-specific data for template & return hashref of data:
	my $r = $self->get_single_request_data($request_id); # warn Dumper $r->{has_optional};

    my $request = $r->{data}; # warn Dumper $request;
    my $patient = $request->patient_case->patient; # warn Dumper $patient->as_tree;

    my $fname = ( substr $patient->first_name, 0, 1 ); # 1st char
    my $lname = ( substr $patient->last_name,  0, 1 ); # 1st char
    my $mname = $patient->middle_name
        ? ( substr $patient->middle_name, 0, 1 ) # 1st char
        : '';

    my $patient_trial_id = do { # get possible patient trial ID:
        if ( $r->{has_optional}->{clinical_trial} ) { # don't trigger unnecessary lookup
            my @args = ($patient->id, $request->request_trial->trial_id );
            $self->model('ClinicalTrial')->get_trial_number(@args); # get trial number
        }
    };
    if ($patient_trial_id) { # set patient last-name = trial ID
        $patient->last_name($patient_trial_id);
        my $inits = uc ( join ',', grep $_, $lname, $fname, $mname ); # because tt uses ucfirst
        $patient->first_name($inits);
        # delete middle name if exists:
        $patient->middle_name(undef) if $mname;
    }
    else { # set patient name to initials:
        $patient->last_name($lname);
        $patient->first_name($fname);
        $patient->middle_name($mname) if $mname;
    }

    # partly anonymise dob:
    if ($patient->dob) { # _has_ to be valid date:
        # $patient->dob->truncate(to => 'year'); # warn Dumper $patient->dob;
    }
    # anonymise unit_number & nhs_number:
    if ( my $nhs_no = $patient->nhs_number ) {
        $nhs_no =~ s/./*/g; # replace each char with asterisks
        $patient->nhs_number($nhs_no);
    }
    if ( my $unit_no = $request->patient_case->unit_number ) {
        $unit_no =~ s/./*/g; # replace each char with asterisks
        $request->patient_case->unit_number($unit_no);
    } # warn Dumper $request->as_tree;
    # anonymise address if outreach request:
    if ($r->{outreach}) {
        my $demographics = $r->{outreach}->{demographics}; # warn Dumper $demographics;
        $demographics->{$_} =~ s/./*/g for qw(address post_code);
    } # warn Dumper $r->{outreach};
    # fully anomymise certain trials:
    elsif ( my $trials = $self->get_yaml_file('anonymised_trials') ) { # warn Dumper $trials;
        if ( $r->{has_optional}->{clinical_trial} ) {
            my $trial_name = $request->request_trial->trial->trial_name; # warn Dumper $trial_name;
            if ( grep $trial_name eq $_, @$trials ) {
                my $dob = $self->cfg('settings')->{default_unknown_date}; # warn $dob;
                $patient->dob($dob); # can't replace with asterisks or validation fails
                $patient->first_name('Trial ID:'); # last_name should already = trial_id, but:
                # ensure last_name removed if trial ID not supplied:
                $patient->last_name('NOT STATED') if (! $patient_trial_id);
            }
        }
    } # warn Dumper $patient->as_tree;

    return $self->_format_report($r);
}

#-------------------------------------------------------------------------------
# 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 $data = $self->get_single_request_data($request_id);
    return $self->_format_report($data);
}

#-------------------------------------------------------------------------------
# handles print_run.pl reports + cc - just forwards data for pdf gen:
sub format_print_run_report { shift->_format_report($_[0]) }

#-------------------------------------------------------------------------------
# shared by format_report() & anonymise_report():
sub _format_report {
    my ($self, $request_data) = @_; # warn Dumper $request_data;

	# add processed lab test data to $request_data:
	$self->process_raw_lab_test_data($request_data);

	# stash for mail_report.pl, also to save repeat lookup later:
    $self->stash( request_data => $request_data->{data} );

    # for tt to pass USE_FILE_SESSIONS flag to chart if called via cron:
	$self->tt_params( use_file_sessions => $ENV{USE_FILE_SESSIONS} ); # warn Dumper \%ENV;

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

	my $tmpl = 'record/default.tt';
    my $html = $self->render_view($tmpl, $request_data); # return $html;
		return $html if $ENV{REPORT_HTML}; # for lims_server and/or no PDF reader

	my %args = (
		content    => $html,
		session_id => $self->session->id, # for charts
	);

	my $pdf = $self->render_pdf(\%args);
	return $pdf;
}

#-------------------------------------------------------------------------------
# shared by C::Request::email_alert() & L::Local::EmailAlert::email_alert()
sub send_email_alert {
	my ($self, $mdt_centre) = @_; $self->_debug_path();

	# request data:
	my $request_data = $self->stash->{request_data};

	my $email_contacts = $self->model('ReferralSource')->get_email_contacts;

	# get all active addresses listed for location mdt:
	my @recipients = map { $_->contact_address }
		grep {
            $_->display_name eq $mdt_centre &&
            $_->type eq 'mdt' &&
            $_->is_active eq 'yes';
        } @$email_contacts;
    return 0 if ! @recipients;

	# stash for later:
	$self->stash( recipients => \@recipients );

	my $config = $self->cfg('settings');
	# add $cfg to $request_data so tmpl doesn't have to use c.cfg('settings')
	# so it can be shared with stand-alone scripts:
	$request_data->{config} = $config;

	my $subject = $config->{lab_name_abbreviation} . ' Diagnosis Status Notice';

	my $message_body = do { # turn off POST_CHOMP to retain formatting in .tt:
		local $self->cfg('tt_config')->{TEMPLATE_OPTIONS}->{POST_CHOMP} = undef;
		$self->tt_process('request/message/body.tt', $request_data);
	};

	$self->model('Email')->set_request_id($request_data->{data}->id);

	my %data = (
		all_recipients => \@recipients,
		message        => ${$message_body}, # dereference scalar ref 1st
		config         => $config,
		subject        => $subject,
	); # warn Dumper \%data; return 0;

	my $rtn = $self->model('Email')->diagnosis_status_alert(\%data);
	# return error, or false value to avoid triggering error page:
	return $rtn || 0;
}

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

    my $cfg = $self->get_yaml_file('nhs_number_exempt') || return {};

    my %data;
    while ( my ($category, $d) = each %$cfg ) {
        $data{$category}{$_} = 1 for @$d;
    } # warn Dumper \%data;
    return \%data;
}

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

	# this is only needed once - return stashed data if print-run:
	return $self->stash->{report_data_maps}
		if $self->stash->{report_data_maps};

	# get some data maps for report template:
	my %h;
	{ # allowed report error_codes:
		my $report_error_codes = $self->report_error_codes_map;
		$h{report_error_codes} = $report_error_codes;
	}
	{ # diagnosis_context_warnings:
		my $context_warning = $self->diagnosis_context_warning_map;
		$h{context_warning_map} = $context_warning;
	}
    { # categories exempt from 'use NHS number':
        my $nhs_number_exempt = $self->nhs_number_exempt;
		$h{nhs_number_exempt} = $nhs_number_exempt;
    }
	# stash in case it's a print request:
	$self->stash( report_data_maps => \%h );
	return \%h;
}

#-------------------------------------------------------------------------------
sub _get_outstanding_tests {
	my ($self, $data) = @_; $self->_debug_path();

	my $lab_tests = $data->{lab_tests_status}; # arrayref

	my %outstanding;
	for my $test ( @$lab_tests ) { # warn Dumper $_->as_tree;
		next if $test->status->description eq 'complete';

		my $section_name = $test->lab_test->lab_section->section_name;
		my $field_label  = $test->lab_test->field_label;
		push @{ $outstanding{$section_name} }, $field_label;
	}

	return \%outstanding;
}

#-------------------------------------------------------------------------------
sub _get_previous_requests {
	my ($self, $request_data) = @_;

	my $patient_case = $request_data->patient_case;
	my $patient = $patient_case->patient;

	my %args = ( # explicit table name to disambiguate authorised_reports_view cols
        'requests.id' => { ne => $request_data->id }, # skip current request
		or => [
			unit_number    => $patient_case->unit_number,
            'patients.dob' => $patient->dob,
        ],
		'patients.last_name'  => $patient->last_name,
		'patients.first_name' => $patient->first_name,
	);
	my $o = $self->model('Request')->get_previous_requests(\%args);

	my %matches;
	RECORD:
    for my $record( @$o ) {
		my $this_record_patient_id = $record->patient_case->patient_id;
		if ( $this_record_patient_id == $patient->id ) {
			push @{ $matches{this_id} }, $record; # same patient, different request
		}
		else {
			# patient cannot have same NHS number as current request or patient
            # id would match above, but 2 entries with same lname AND fname AND
            # (dob OR unit_number) can have 2 NHS numbers, normally different
            # patients, unless patient has both english & scottish NHS numbers:
            next RECORD if $patient->nhs_number
                && $record->patient_case->patient->nhs_number;
			push @{ $matches{others} }, $record;
		}
	} # warn Dumper \%matches;
	return \%matches;
}

#-------------------------------------------------------------------------------
sub _get_report_history {
    my ($self, $request_id) = @_;
    my %args = (
        request_id => $request_id,
        field      => 'comment',
    );
    my $o = $self->model('History')->get_report_history(\%args); # warn Dumper $_->as_tree for @$o;
    return $o;
}

#-------------------------------------------------------------------------------
# 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; # warn Dumper \%data;

    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 %$data ]);

    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_specimen_detail} ) {
        $might_have{request_specimen_detail} = 1;
    }
    if ( $data->{request_initial_screen} ) {
        $might_have{initial_screen} = 1;
    }
    if ( $data->{request_report} ) {
        $might_have{report} = 1;
    }

	if (! $data->{request_trial}) { # check for previous clinical trials:
        # model needs request.id & patient.id:
        my %h = (
            patient_id => $request_data->patient_case->patient_id,
            request_id => $request_data->id,
        );
		my $trials
			= $self->model('ClinicalTrial')->get_patient_trials(\%h);
		$might_have{previous_clinical_trials} = $trials if %$trials;
	}

    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) = @_;

    my $request_id = $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,
    );

	# haematology data:
    if ( $self->cfg('settings')->{have_haematology_data} ) { # warn 'here';
        my %args = (
            request_number => $request->request_number,
            year => $request->year,
        );
        if ( my $data = $self->model('Result')->get_haematology_data(\%args) ) {
            $lab_test_data{haematology_data} = $data;
        }
    }
    { # all previous lab tests & results on this patient identity:
        my $patient_id = $request->patient_case->patient_id;
        my $tests = $self->model('Result')
            ->get_all_previous_tests_and_results($patient_id);
        $lab_test_data{lab_test_history} = $tests;
    }
    return \%lab_test_data;
}

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

	my $request_id = $data->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}; # warn Dumper \%request_options;

	# add $active_options data to %request_options:
	for (@$active_options) {
		my $option_name = $_->option->option_name; # warn Dumper $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;

	{ # any other doi samples (no need if current record is doi):
		my $doi = $request_options{doi}; # it's a hashref if exists
		if ( $doi && $doi->{is_active} eq 'yes' && not $doi->{is_selected} ) {
			$request_options{doi}{has_others} = $self->_get_other_doi($data);
		} # 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_errors {
    my ($self, $request_id) = @_;

	my $o = $self->model('Request')->get_request_errors($request_id);
		# warn Dumper $_->as_tree for @$o;
	return $o;
}

#-------------------------------------------------------------------------------
sub _render_small_2d_barcode {
    my $self = shift;
	my $_self = $self; Scalar::Util::weaken $_self; # required or get cron failures
	return sub {
		my $text = shift || return undef; # warn $text;
        my $type = shift || die 'no barcode type specified'; # warn $type;
		my %args = ( $type =~ 'qrcode|data_matrix' )
            ? ( css_class => 'hbc2d_small' )
            : ( show_text => 1, bar_height => 25 );
        my $barcode = 'barcode_' . $type;
		return $_self->$barcode($text, %args);
	};
}

#-------------------------------------------------------------------------------
sub _get_other_doi {
    my ($self, $data) = @_;

	my %args = (
		request_id => $data->{id},
		patient_id => $data->{patient_case}->{patient_id},
	);
	my $i = $self->model('Request')->count_biohazard_records(\%args);
	return $i;
}

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