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 dev server, unless explicitly require PDF:
$ENV{REPORT_HTML} = undef if $ENV{PDF_REPORT}; # PDF_REPORT overrides REPORT_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;
}
# UKAS unaccredited tests:
if ( my $date = $self->cfg('settings')->{ukas_accreditation_date} ) {
# get accreditation date as datetime object:
my $accreditation_date = LIMS::Local::Utils::mysql_parse_date($date);
# warn Dumper [$accreditation_date, $request->created_at];
# skip reports registered before ukas accreditation date:
if ( $request->created_at >= $accreditation_date ) {
# warn Dumper $_->as_tree for @$lab_tests_status;
# get lab-tests not accredited on date of registration:
my $ref = $self->model('LabTest')
->get_unaccredited_lab_tests($request->created_at); # warn Dumper $ref;
# get array of non-accredited lab-tests for this request:
my @unaccredited_tests = map $_->lab_test,
grep $ref->{$_->lab_test->id}, @$lab_tests_status;
# add unaccredited tests to $lab_test_data - empty list OK as .tt flag:
$lab_test_data{ukas_unaccredited_tests} = \@unaccredited_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;