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_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';
# 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,
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,
}
}
#-------------------------------------------------------------------------------
sub get_previous_cases {
my ($self, $request_data) = @_;
my $patient_case = $request_data->{data}->patient_case;
my $patient = $patient_case->patient;
my %matches;
my %args = (
last_name => $patient_case->patient->last_name,
first_name => $patient_case->patient->first_name,
or => [
unit_number => $patient_case->unit_number,
dob => $patient_case->patient->dob,
],
);
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; # same patient, different request
}
else {
# patient cannot have same nhs_number as current request or would
# match above, and same patient cannot have a different nhs_number:
next if $patient->nhs_number
&& $record->patient_case->patient->nhs_number;
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;
}
#-------------------------------------------------------------------------------
# used by Request::do_email_report() to remove patient identifiers for non-secure addr
sub anonymise_report {
my ($self, $request_id) = @_;
# process request-specific data for template & return hashref of data:
my $data = $self->format_print_record_request_data($request_id);
my $request = $data->{data}; # warn Dumper $data->{has_optional};
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 $trial_id; # get possible patient trial ID:
if ( $data->{has_optional}->{clinical_trial} ) { # don't trigger unnecessary lookup
# get trial number:
my @args = ($patient->id, $request->request_trial->trial_id );
$trial_id = $self->model('ClinicalTrial')->get_trial_number(@args);
}
if ($trial_id) { # set patient last-name = trial ID
$patient->last_name($trial_id);
my $inits = uc ( join ',', $lname, $fname ); # because tt uses ucfirst
$patient->first_name($inits);
}
else { # set patient name to initials:
$patient->last_name($lname);
$patient->first_name($fname);
}
# 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:
$patient->nhs_number('**********'); # warn Dumper $request->as_tree;
$request->patient_case->unit_number('****'); # warn Dumper $request->as_tree;
if ($data->{outreach}) { # anonymise address if outreach request:
my $demographics = $data->{outreach}->{demographics}; # warn Dumper $demographics;
$demographics->{post_code} = '*****';
$demographics->{address} = '**********';
} # warn Dumper $data->{outreach};
return $self->_format_report($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 $data = $self->format_print_record_request_data($request_id);
return $self->_format_report($data);
}
#-------------------------------------------------------------------------------
# shared by format_report() & anonymise_report():
sub _format_report {
my ($self, $request_data) = @_; # warn Dumper $request_data;
$self->tt_params( request => $request_data );
# stash for mail_report.pl, also to save repeat lookup later:
$self->stash( request_data => $request_data->{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 );
}
{ # categories exempt from 'use NHS number':
my $nhs_number_exempt = $self->nhs_number_exempt;
$self->tt_params( nhs_number_exempt => $nhs_number_exempt );
}
# 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};
# 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 = sprintf '%s/%s.html',
$self->cfg->{tmpdir}, $request_data->{data}->id;
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;
}
#-------------------------------------------------------------------------------
# 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;
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_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;
}
#-------------------------------------------------------------------------------
# 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_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) = @_;
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;
}
}
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}; # 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;
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;
