package LIMS::Controller::Report;
use Moose;
BEGIN { extends 'LIMS::Base' }
with (
'LIMS::Controller::Roles::Misc',
'LIMS::Controller::Roles::Aspell',
'LIMS::Controller::Roles::DataMap',
'LIMS::Controller::Roles::DataFile',
'LIMS::Controller::Roles::DataImport',
'LIMS::Controller::Roles::RecordHandler',
'LIMS::Controller::Roles::ResultHandler',
);
use namespace::clean -except => 'meta';
__PACKAGE__->meta->make_immutable(inline_constructor => 0);
use Data::Dumper;
#-------------------------------------------------------------------------------
sub default : Startrunmode {
my $self = shift;
# shouldn't be called here - redirect to /
$self->redirect( $self->query->url );
}
#-------------------------------------------------------------------------------
sub load : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $errs = shift || {}; # $self->stash(errs => $errs );
# need permission to report, or to edit_outreach_data if outreach case:
return $self->forbidden() unless $self->user_can('report')
|| ( $self->stash->{is_outreach} && $self->user_can('edit_outreach_data') );
my $request_id = $self->param('id')
|| return $self->error('no id passed to ' . $self->get_current_runmode);
my $request_data = $self->get_single_request_data($request_id);
# check record is screened & not locked, and user allowed to report:
unless ( $self->_check_request_status($request_data) ) {
my $target = $self->stash->{redirection_target}; # set in check_request_status()
return $self->redirect( $self->query->url . "/$target/=/$request_id" );
}
{ # previous patient matches:
my $previous_cases = $self->get_previous_cases($request_data);
$self->tt_params( previous_cases => $previous_cases );
}
{ # diagnosis change options:
my %args = ( sort_by => 'option_name' );
my $options
= $self->model('Base')->get_objects('DiagnosisChangeOption', \%args);
$self->tt_params( diagnosis_change_options => $options );
}
{ # do we want gross_description field displayed:
my $want_gross_desc = $self->_display_gross_description($request_data);
$self->tt_params( want_gross_description => $want_gross_desc );
}
{ # is request self_authorisable:
my $is_self_authorisable = $self->_is_self_authorisable($request_data);
$self->tt_params( self_authorisable => $is_self_authorisable );
}
{ # if it's an authorisation_request, load authorisation_check profile:
my $validation_profile = $self->stash->{authorisation_request}
? 'pre_authorisation_check'
: 'report';
$self->js_validation_profile($validation_profile);
}
unless ( $self->stash->{is_outreach} ) { # some functions not required for Outreach:
# send $request_data to process_raw_lab_test_data() for template; adds
# 'all_results' to $request_data:
$self->process_raw_lab_test_data($request_data);
{ # outstanding tests:
my $outstanding = $self->_get_outstanding_tests($request_data);
$self->tt_params( outstanding_tests => $outstanding );
}
{ # diagnoses list:
my $diagnoses = $self->diagnoses_categories_map;
$self->tt_params( diagnoses => $diagnoses );
}
}
# combine $request_data & $errs into single hashref:
return $self->render_view('report/default.tt', { %$errs, %$request_data });
}
#-------------------------------------------------------------------------------
sub outreach : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless
$self->cfg('settings')->{have_outreach} # have outreach &&
&& $self->user_can('edit_outreach_data'); # user can edit outreach
my $request_id = $self->param('id')
|| return $self->error('no id passed to ' . $self->get_current_runmode);
# load validation profiles into tt_params for all departments:
my $profiles = $self->validate('outreach_lab_results'); # profiles for all depts
my @departments = qw(haematology immunology biochemistry flow_cytometry);
for my $dept( @departments ) {
my $profile_name = 'outreach_'.$dept; # supply name + profile:
$self->js_validation_profile($profile_name, $profiles->{$dept});
}
{ # get outreach data:
my $outreach_data = $self->model('Outreach')->get_all_data($request_id);
$self->tt_params( outreach => $outreach_data ); # warn Dumper $outreach_data;
}
{ # provide restricted diagnoses list for Outreach subset:
my $all_diagnoses = $self->diagnoses_categories_map; # HoAoH
# ids for Outreach diagnoses:
my $outreach_diagnosis_ids = $self->model('Outreach')->get_diagnosis_ids;
my %ids = map +($_ => 1), @$outreach_diagnosis_ids; # create hash from array
my %diag = (); # new data structure
while ( my($category, $d) = each %$all_diagnoses ) {
# get hashrefs where diagnosis_id in $outreach_diagnosis_ids list
my @required = grep $ids{ $_->{id} }, @$d;
$diag{$category} = \@required if @required;
} # warn Dumper \%diag;
$self->tt_params( diagnoses => \%diag );
}
# callbacks for template:
my $_self = $self; weaken $_self; # or get circular refs inside the callbacks
$self->tt_params(
have_data_file => sub {
my $data_files = $_self->get_result_data_file(@_); # warn Dumper $data_files;
return ( grep { $_ =~ /CMP\.txt\Z/ } @$data_files ) ? 1 : 0;
},
incomplete_dataset => sub { # receives section data (eg haem dataset)
my $data = shift; # warn Dumper $data;
my $has_incomplete = grep +(! defined $data->{$_}->{result}),
keys %$data;
return $has_incomplete;
},
missing_fields => sub { # receives required fields + data hashref:
my ($required_fields, $data) = @_; # warn Dumper [$required_fields, $data];
my $has_missing = grep +(! $data->{$_}), @$required_fields;
return $has_missing;
},
tube_type => sub { $_self->get_blood_tube_type(@_) },
);
# set flag & forward to load():
$self->stash( is_outreach => 1 );
return $self->forward('load');
}
#-------------------------------------------------------------------------------
sub authorise : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $errs = shift;
# just set stash & tt flags, and forward to load():
$self->stash( authorisation_request => 1 );
$self->tt_params( authorisation_request => 1 );
return $self->forward('load', $errs);
}
#-------------------------------------------------------------------------------
sub pre_authorisation_check : Runmode {
# only used if status_option 'authorised' set to 'yes'
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('report');
my $request_id = $self->param('id')
|| return $self->error('no id passed to ' . $self->get_current_runmode);
my $dfv = $self->check_rm('authorise', $self->validate('pre_authorisation_check') )
|| return $self->dfv_error_page;
my $data = $dfv->valid; # $self->debug($data);
$data->{_request_id} = $request_id;
{ # get original report data:
my $report = $self->model('Report')->get_report_data($request_id);
$self->tt_params( report => $report );
# add report.diagnosis_id to $data for authorisation_diagnosis():
$data->{_report_diagnosis_id} = $report->diagnosis_id;
my $patient_case = $self->model('PatientCase')
->retrieve_patient_data($report->request->patient_case_id);
$self->tt_params( patient_case => $patient_case );
my $history = $self->request_history_map($report->request_id);
$self->tt_params( history => $history );
}
{ # pre-authorisation-check diagnosis:
my $diagnosis = $self->model('Diagnosis')
->get_diagnosis($data->{diagnosis_id})->as_tree;
$self->tt_params( authorisation_check_diagnosis => $diagnosis );
}
{ # diagnoses map:
my $diagnoses_map = $self->diagnoses_map('id'); # send key
$self->tt_params( diagnoses_map => $diagnoses_map );
}
# log selected diagnosis_id (returns true value on success):
$self->model('Report')->log_authorisation_diagnosis($data)
|| # just set flash warning - not serious enough to terminate with error:
$self->flash( warning => $self->messages('report')->{no_auth_diagnosis} );
return $self->tt_process;
}
#-------------------------------------------------------------------------------
sub update_report : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('report');
my $request_id = $self->param('id')
|| return $self->error('no id passed to ' . $self->get_current_runmode);
my $dfv = $self->check_rm('load', $self->validate('report') )
|| return $self->dfv_error_page;
# if mandatory spell-checker enabled, require preview flag:
if ( $self->cfg('settings')->{require_spell_check} eq 'yes'
&& ! $self->query->param('_spelling_checked') ) {
return $self->forward('preview_report');
}
my $data = $dfv->valid;
$data->{_request_id} = $request_id;
# get (optional) config file for auto-requesting additional_tests:
if ( my $cfg = $self->_get_additional_tests_config ) {
$data->{additional_tests_config} = $cfg;
}
# if reason given for update:
if ( my $option_id = $data->{option_id} ) {
my $reason
= $self->model('Diagnosis')->get_diagnosis_change_option($option_id);
$data->{reason} = $reason->option_name;
}
my $rtn = $self->model('Report')->update_report($data);
return $self->error($rtn) if ($rtn);
# issue revised diagnosis alert if reason for revision =~ error:
if ( $data->{reason} && $data->{reason} =~ /^error/ ) {
$self->issue_diagnosis_revision_alert($data);
}
$self->flash( info => $self->messages('action')->{edit_success} );
return $self->redirect( $self->query->url . '/search/=/' . $request_id );
}
#-------------------------------------------------------------------------------
sub issue_diagnosis_revision_alert {
my ($self, $data) = @_; # warn Dumper $data;
my $cfg = $self->cfg('settings');
return 0 unless $self->user_can('report')
&& $cfg->{have_revised_diagnosis_alert} && $cfg->{is_in_production_mode};
my $request_id = $data->{_request_id};
# get original reporter and diagnosis:
my $previous_diagnoses
= $self->model('History')->get_diagnosis_history($request_id);
my $original = $previous_diagnoses->[0]; # warn Dumper $original->as_tree;
{ # no need for email if original reporter records error, or user inactive:
my $reporter = $original->user;
my $this_user = $self->user_profile; # warn Dumper $this_user;
return 0 if ( $original->user->active ne 'yes'
|| $this_user->{id} == $reporter->id );
}
# get current diagnosis, request_number & year:
my $current = $self->model('Report')->get_report_data($request_id);
my %data = ( # tt data
original => $original,
current => $current,
); # warn Dumper \%data;
my $msg = $self->tt_process('report/diagnosis_revision.tt', \%data);
my $message_body = LIMS::Local::Utils::deindent(${$msg}); # deref 1st
my %mail = (
recipient => $original->user->email,
config => $self->cfg('settings'),
subject => 'Revised Diagnosis Alert',
message => $message_body,
); # warn Dumper \%mail; return 0;
my $rtn = $self->model('Email')->send_message(\%mail);
# only warn if error - don't return error page:
warn $rtn if $rtn;
return 0; # not expected or used
}
#-------------------------------------------------------------------------------
sub preview_report : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
# initialise id_generator (for unique div id's):
$self->id_generator('a');
# check spelling on selected textfields:
foreach my $field( qw/clinical_details comment/ ) { # do it in order on page
my $unrecognised = $self->do_spellcheck($field); # $self->debug($unrecognised);
$self->tt_params( 'unrecognised_' . $field . '_words' => $unrecognised );
}
# colourise text in textarea field for display:
foreach my $field( qw/clinical_details comment/ ) { # do it in order on page
my $highlighted_text = $self->colourise_text($field);
$self->tt_params( 'highlighted_' . $field => $highlighted_text );
}
# set previewed flag:
$self->tt_params( spelling_checked => 1 );
# load unrecognised words flag:
$self->tt_params( has_unrecognised => $self->words );
# fill_form preserves selected fields:
my $html = $self->query->param('is_outreach')
? $self->forward('outreach')
: $self->forward('load'); # warn Dumper $html;
return $self->fill_form($html);
}
#-------------------------------------------------------------------------------
=begin # incorpotated into report validation
# if _diagnosis_id passed as hidden field (eg at authorisation stage where diagnosis
# re-submitted, but revision is optional) and is different to diagnosis_id,
# set '_is_diagnosis_revision' query param to trigger validation failure in dfv
# if not also 'revision' query param submitted:
sub _check_revision_info_supplied {
my $self = shift;
my $q = $self->query;
# return if no $q->param('_diagnosis_id') to compare to:
my $original_diagnosis_id = $q->param('_diagnosis_id') || return;
my $diagnosis_id = $q->param('diagnosis_id');
# if $diagnosis_id different to $original_diagnosis_id, set query param to
# trigger 'revision' form param requirement in dfv validation:
if ( $diagnosis_id != $original_diagnosis_id ) { # warn 'HERE';
# use Data::Dumper; my $p1 = $self->query->Vars; warn Dumper $p1;
# manually set _is_diagnosis_revision query param if not already set:
return if $q->param('_is_diagnosis_revision');
$q->param( _is_diagnosis_revision => 1 );
# my $p2 = $self->query->Vars; warn Dumper $p2;
}
}
=cut
#-------------------------------------------------------------------------------
sub _display_gross_description {
my ($self, $request_data) = @_; $self->_debug_path();
my $request_id = $self->param('id'); # already checked for existence
my $specimen_map = $request_data->{specimen_map};
my $specimen = $specimen_map->{$request_id}->{description}; # arrayref
for my $description (@$specimen) {
# required if description has 'fixed' or 'trephine' at end:
return 1 if grep $description =~ /$_\Z/, qw(fixed trephine);
}
}
#-------------------------------------------------------------------------------
sub _get_outstanding_tests {
my ($self, $data) = @_; $self->_debug_path();
# get test_status for each requested lab_test by section:
my $lab_test_data = $self->format_raw_lab_test_data($data); # hashref
my %outstanding;
while ( my ($section, $test_data) = each %$lab_test_data) {
# $test_data is arrayref:
for my $test(@$test_data) {
next if $test->{test_status} eq 'complete';
push @{ $outstanding{$section} }, $test->{test_name};
}
}
return \%outstanding;
}
#-------------------------------------------------------------------------------
# determines whether request is self-authorisable (can report & authorise together,
# or original reporter can authorise later), based on initial_screen & specimen;
# needs to be not already authorised, require authorisation stage, initial_screen
# matches an entry in config file, and any specimen restrictions complied with
# returns 'true' if self-authorisable:
sub _is_self_authorisable {
my ($self, $request_data) = @_; $self->_debug_path(); # $self->debug([ keys %$request_data ]);
# return 0 unless authorisation required:
return 0 unless $request_data->{status_options}->{authorised}
->{is_active} eq 'yes';
# return 0 if already authorised:
return 0 if $request_data->{history}->{authorised};
# get config info:
my $yaml = $self->get_yaml_file('self_authorisable') || return 0;
# get request initial screen, or return if not screened:
my $request_initial_screen
= $request_data->{data}->request_initial_screen || return 0;
my $screened_as = $request_initial_screen->screen->description;
# warn $screened_as;
# return 0 unless initial_screen in self-authorisable list:
my $yaml_entry = $yaml->{$screened_as} || return 0;
# warn 'here';
# return 'OK' unless further restriction on specimen type:
my $restriction_specimen = $yaml_entry->{specimen} || return 1;
# warn 'here';
# get requests.id:
my $request_id = $request_data->{data}->id;
# get request specimen(s) (as arrayref):
my $request_specimen
= $request_data->{specimen_map}->{$request_id}->{sample_code};
# check request has only 1 specimen:
return 0 unless scalar @$request_specimen == 1;
# if $yaml_specimen_info is a list:
if ( ref $restriction_specimen eq 'ARRAY' ) {
# return 'ok' if request specimen matches any of required types:
for my $specimen ( @$restriction_specimen ) {
return 1 if $request_specimen->[0] eq $specimen;
}
}
else { # restriction is on a single specimen type:
# return 'ok' if request specimen matches the required specimen type:
return 1 if $request_specimen->[0] eq $restriction_specimen;
}
# warn 'here';
# if we get this far, return default 'not_authorisable':
return 0;
}
#-------------------------------------------------------------------------------
sub _check_request_status {
my ($self, $request_data) = @_; $self->_debug_path();
# return to home page if record locked (direct url arrival) & not outreach:
if ( $request_data->{is_locked} && ! $self->stash->{is_outreach} ) {
$self->stash( redirection_target => 'search' );
return 0;
}
# check record is screened (and not called direct from url):
unless ( $request_data->{data}->status_option_id >= 2 ) { # 1 = 'new'
$self->flash( error => $self->messages('report')->{not_screened} );
$self->stash( redirection_target => 'screen' );
return 0;
}
# if authorisation request (from url via 'authorise'):
if ( $self->stash->{authorisation_request} ) {
# check it's been reported && current user != reporter (unless allowed):
unless ( $self->_check_authorisation_requirements($request_data) ) {
$self->stash( redirection_target => 'search' );
return 0;
}
}
# return 'ok' flag:
return 1;
}
#-------------------------------------------------------------------------------
sub _check_authorisation_requirements {
my ($self, $request_data) = @_; $self->_debug_path();
# check it's been reported:
unless ( $request_data->{data}->request_report ) {
$self->flash( error => $self->messages('report')->{not_reported} );
return 0;
}
# check current user not same as reporter (unless allowed):
my $reporter = $request_data->{history}->{reported}->user;
my $self_authorisable = $self->_is_self_authorisable($request_data);
if ( lc $reporter->username eq lc $self->authen->username
&& ! $self_authorisable ) {
$self->flash( error => $self->messages('report')->{no_self_auth} );
return 0;
}
# OK, return 1:
return 1;
}
#-------------------------------------------------------------------------------
sub _get_additional_tests_config {
my $self = shift; $self->_debug_path();
my $yaml = $self->get_yaml_file('additional_tests') || return 0;
return $yaml;
}
1;
