package LIMS::Controller::Outreach;
use Moose;
BEGIN { extends 'LIMS::Base' }
with (
'LIMS::Controller::Roles::Misc', # redirect_after_edit_success(), format_dfv_msg()
'LIMS::Controller::Roles::FormData', # get_data_from_dfv
'LIMS::Controller::Roles::DataFile', # slurp_file_contents()
'LIMS::Controller::Roles::DataImport', # parse_data_file(), check_datafile_integrity()
'LIMS::Controller::Roles::RecordHandler',
);
use namespace::clean -except => 'meta';
__PACKAGE__->meta->make_immutable(inline_constructor => 0);
use Data::Dumper;
use LIMS::Controller::Report;
# ------------------------------------------------------------------------------
# default() should never be called direct - redirect to start page:
sub default : StartRunmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->redirect( $self->query->url );
}
# ------------------------------------------------------------------------------
# outreach/=/x should never be called direct - forward to startrunmode:
sub load : Runmode {
return shift->forward('default');
}
# ------------------------------------------------------------------------------
sub demographics : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('edit_outreach_data');
my $request_id = $self->param('id')
|| return $self->error('no request_id passed to '.$self->get_current_runmode);
my $patient_id = $self->param('Id')
|| return $self->error('no patient_id passed to '.$self->get_current_runmode);
# can't use DFV check_rm() here as target is in another controller:
my $profile = $self->validate('outreach_demographics');
my $dfv = $self->validate_form_params($profile); # warn Dumper $dfv;
my $home = $self->query->url . '/report/outreach/' . $request_id;
if ($dfv->has_invalid || $dfv->has_missing) {
my $msg = $self->format_dfv_msg($dfv); # parse dfv template
$self->flash( error => $msg ); # warn Dumper $dfv->msgs;
return $self->redirect($home);
}
my $data = $dfv->valid;
# add patient_id:
$data->{patient_id} = $patient_id; # warn Dumper $data; return 1;
# param 'dispatch_to' is Outreach param - remove & update separately:
if ( my $dispatch_to = $data->{dispatch_to} ) {
my %args = (
patient_id => $patient_id,
dispatch_to => $dispatch_to,
);
my $rtn = $self->model('Outreach')->update_dispatch_detail(\%args);
return $self->error($rtn) if $rtn; # only return on error here
delete $data->{dispatch_to}; # or downstream model method blows up
}
my $rtn = $self->model('Patient')->update_patient_demographics($data);
return $rtn
? $self->error($rtn)
: $self->redirect_after_edit_success('/report/outreach/' . $request_id);
}
# ------------------------------------------------------------------------------
# DFV error return page for questionnaire():
sub questionnaire {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $errs = shift; $self->stash( errs => $errs );
my $menu_options = $self->model('Outreach')->get_menu_options;
my %h = ( menu_options => $menu_options ); # format required by outreach tt's
$self->tt_params( outreach => \%h );
return $self->tt_process('outreach/err_questionnaire.tt', $errs);
}
# ------------------------------------------------------------------------------
sub do_questionnaire : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('edit_outreach_data');
my $request_id = $self->param('id')
|| return $self->error('no id passed to '.$self->get_current_runmode);
my $dfv = $self->check_rm(
questionnaire => $self->validate('outreach_questionnaire')
); # don't return on error, update tables then handle error
my $data = $dfv->valid;
$data->{request_id} = $request_id; # warn Dumper $data;
# update questionnaire tables even if have missing fields:
my $rtn = $self->model('Outreach')->update_patient_questionnaire($data);
if ($rtn) { # if db error
return $self->error($rtn);
}
elsif ($self->dfv_error_page) { # only for info - still want db updates
return $self->dfv_error_page;
}
else {
my $msg = $self->messages('outreach')->{questionnaire_success};
$self->flash( info => $msg );
}
$self->redirect( $self->query->url . '/report/outreach/' . $request_id );
}
# ------------------------------------------------------------------------------
sub lab_results : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('edit_outreach_data');
my $request_id = $self->param('id')
|| return $self->error('no id passed to '.$self->get_current_runmode);
# can't use DFV check_rm() here as target is in another controller:
my $profiles = $self->validate('outreach_lab_results'); # profiles for all depts
my $dept = $self->query->param('department') # eg immunology
|| return $self->error("no hidden 'department' param passed to "
. $self->get_current_runmode); # or data validation methods fail
my $dfv = $self->validate_form_params($profiles->{$dept}); # warn Dumper $dfv;
my $data = $dfv->valid;
# add patient_id:
$data->{_request_id} = $request_id; # warn Dumper $data;
my $rtn = $self->model('Outreach')->update_lab_params($data);
return $self->error($rtn) if $rtn; # if db error
my $addr = '/report/outreach/' . $request_id;
if ($dfv->has_invalid || $dfv->has_missing) {
my $msg = $self->format_dfv_msg($dfv); # parse dfv template
$self->flash( error => $msg ); # warn Dumper $dfv->msgs;
return $self->redirect( $self->query->url . $addr );
}
else {
return $self->redirect_after_edit_success($addr);
}
}
# ------------------------------------------------------------------------------
# import flow data from text file:
sub import_datafile : Runmode { # code taken from C::Results::import_datafile()
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('edit_outreach_data');
my $request_id = $self->param('id')
|| return $self->error('no id passed to ' . $self->get_current_runmode);
my $filename = $self->query->param('datafile')
|| return $self->error('no filename passed to ' . $self->get_current_runmode);
# extract contents of datafile to object accessor:
my $data = $self->get_datafile_contents($filename);
$self->parse_data_file($data);
# check internal datafile refs (filename & patient ids) match
$self->_check_datafile_integrity() # sets flash message for redirect
|| return $self->redirect( $self->query->url . '/image/=/' . $request_id );
# get results from data file:
my $results = $self->_get_datafile_results() # sets flash message for redirect
|| return $self->redirect( $self->query->url . '/image/=/' . $request_id );
# get datafiles config:
my $datafile_cfg = $self->datafiles_config; # warn Dumper $datafile_cfg;
# get list of field names for table update:
my $cols = $datafile_cfg->{CMP}->{cols}; # warn Dumper $cols;
# create hash of col => result:
my %data; @data{@$cols} = @$results;
# add request_id & department:
$data{_request_id} = $request_id;
$data{department} = 'flow_cytometry'; # warn Dumper \%data;
my $rtn = $self->model('Outreach')->update_lab_params(\%data);
if ($rtn) { # if db error
return $self->error($rtn);
}
else {
$self->flash( info => $self->messages('outreach')->{data_import_success} );
return $self->redirect(
$self->query->url . '/report/outreach/' . $request_id );
}
}
# ------------------------------------------------------------------------------
sub edit_followup : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $errs = shift;
return $self->forbidden() unless $self->user_can('edit_outreach_data');
my $request_id = $self->param('id')
|| return $self->error('no request_id passed to '.$self->get_current_runmode);
{ # follow-up data:
my $data = $self->model('Outreach')->get_followup_data($request_id);
$self->tt_params( followup_data => $data );
}
{ # request_data:
my $data
= $self->model('Request')->get_patient_and_request_data($request_id);
$self->tt_params( request_data => $data );
}
{ # follow-up options:
my $options = $self->model('Outreach')->followup_options_map;
$self->tt_params( followup_options => $options );
}
$self->js_validation_profile('outreach_followup');
return $self->tt_process();
}
# ------------------------------------------------------------------------------
sub do_edit_followup : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('edit_outreach_data');
my $request_id = $self->param('id')
|| return $self->error('no request_id passed to '.$self->get_current_runmode);
my $dfv = $self->check_rm('edit_followup', $self->validate('outreach_followup') )
|| return $self->dfv_error_page;
my $data = $dfv->valid; # warn Dumper $data;
$data->{_request_id} = $request_id;
my $rtn = $self->model('Outreach')->update_followup($data);
return $rtn
? $self->error($rtn)
: $self->redirect_after_edit_success('/report/outreach/' . $request_id);
}
# ------------------------------------------------------------------------------
sub do_reports_issued : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('edit_outreach_data');
my $rm = '/local_worklist?function_name=outreach_reports_to_issue';
my $url = $self->query->url() . $rm;
my @request_ids = $self->query->param('request_id');
if (! @request_ids) {
$self->flash( warning => $self->messages('worklist')->{no_request_ids} );
$self->redirect($url);
}
else { # do update; return error if one occured:
my $rtn = $self->model('Outreach')->do_reports_issued(\@request_ids);
return $self->error($rtn) if $rtn;
}
return @request_ids > 1
? $self->redirect_after_edit_successes($rm)
: $self->redirect_after_edit_success($rm);
}
# ------------------------------------------------------------------------------
sub do_pack_dispatch : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('edit_outreach_data');
my @request_ids = $self->query->param('request_id');
unless (@request_ids) {
$self->flash( warning => $self->messages('worklist')->{no_request_ids} );
my $url = join '/', $self->query->url(),
'local_worklist?function_name=outreach_pack_dispatch';
return $self->redirect($url);
}
{ # do update; return error if one occured:
my $rtn = $self->model('Outreach')->do_pack_dispatch(\@request_ids);
return $self->error($rtn) if $rtn;
}
{ # get data for summary:
my $data = $self->model('Request')->requests_summary_data(\@request_ids);
$self->tt_params( requests => $data );
}
return $self->tt_process();
}
# ------------------------------------------------------------------------------
sub do_letter_dispatch : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $notification = $self->param('id'); # warn $notification;
my @request_ids = $self->query->param('request_id');
my %data = (
request_ids => \@request_ids,
notification => $notification,
); # warn Dumper \%data;
{ # do update; return error if one occured:
my $rtn = $self->model('Outreach')->do_letter_dispatch(\%data);
return $self->error($rtn) if $rtn;
}
{ # get data for summary:
my $data = $self->model('Request')->requests_summary_data(\@request_ids);
$self->tt_params( requests => $data );
}
return $self->tt_process();
}
# ------------------------------------------------------------------------------
sub report_labels : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $vars = $self->query->Vars();
my $to_datetime = sub { LIMS::Local::Utils::to_datetime_using_datecalc(@_) };
my $from = &$to_datetime($vars->{date_from});
my $to = &$to_datetime($vars->{date_to});
# require valid 'date_from' & 'date_to' params:
unless ($from && $to) {
$self->flash( error => $self->messages('outreach')->{missing_dates} );
return $self->redirect( $self->query->url .
'/local_worklist?function_name=outreach_report_labels' );
}
my $dates = { begin => $from, end => $to };
my $data = $self->model('Outreach')->get_authorised_cases_data($dates);
$self->tt_params(
requests => $data,
dates => $dates,
);
return $self->tt_process();
}
# ------------------------------------------------------------------------------
sub do_report_labels : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my @patient_ids = $self->query->param('patient_id');
my $labels = $self->model('Outreach')->report_labels(\@patient_ids);
$self->tt_params( addresses => $labels );
return $self->tt_process();
}
# ------------------------------------------------------------------------------
sub data_table : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $param = $self->param('id');
my $patient_id = $self->param('Id');
my $patient = $self->model('Patient')->get_patient($patient_id);
my $data = $self->model('Outreach')->get_chart_results($patient_id, $param);
# convert dates to datetime:
my $dt = sub { LIMS::Local::Utils::to_datetime_using_parsedate(@_) };
$_->{created_at} = &$dt($_->{created_at}) for @$data;
my $lab_param = $self->model('Outreach')->get_lab_param($param);
$self->tt_params(
data => $data,
param => $lab_param,
patient => $patient,
);
return $self->render_view($self->tt_template_name);
}
# ------------------------------------------------------------------------------
sub doubling_time : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $param = $self->param('id');
my $patient_id = $self->param('Id');
my $p = $self->query->Vars();
unless ( $p->{to} && $p->{from} ) { # need both
$self->tt_params( errs => 'require both A and B values' );
return $self->forward('data_table');
}
my $data = $self->model('Outreach')->get_chart_results($patient_id, $param);
# get 'to' and 'from' datasets from form loop count (minus 1 for array pos):
my $from = $data->[$p->{from} - 1]; # warn Dumper $from;
my $to = $data->[$p->{to} - 1]; # warn Dumper $to;
my $dt = sub { LIMS::Local::Utils::to_datetime_using_parsedate(@_) };
my $dt1 = &$dt($from->{created_at});
my $dt2 = &$dt( $to->{created_at});
# Td = (t2 - t1) * log(2) / log(q2 / q1) # doubling time calculation:
my $delta_days = $dt1->delta_days($dt2)->delta_days; # (t2 - t1) days
my ($q1, $q2) = ($from->{result}, $to->{result});
eval { # in case division by zero error
my $t = $delta_days * log(2) / log( $q2 / $q1 ); # warn $t;
my $d = DateTime::Duration->new( years => $t / 365 ); # to allow in_units('months')
$self->tt_params( duration => $d );
};
$self->tt_params( eval_err => $@ ) if $@;
$self->tt_params( q1 => $q1, q2 => $q2, delta_days => $delta_days );
# round duration value callback:
$self->tt_params( round => sub { LIMS::Local::Utils::round_value(@_) } );
return $self->forward('data_table');
}
# ------------------------------------------------------------------------------
sub alternate_address : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('edit_outreach_data');
my $request_id = $self->param('id')
|| return $self->error('no request_id passed to '.$self->get_current_runmode);
my $patient_id = $self->param('Id')
|| return $self->error('no patient_id passed to '.$self->get_current_runmode);
my $q = $self->query;
my $vars = $q->Vars();
# can't use DFV check_rm() here as target is in another controller:
my ($address, $post_code) = @$vars{qw(address post_code)}; # warn Dumper [$address, $post_code];
unless ($address && $post_code) {
$self->flash( error => $self->messages('outreach')->{alternate} );
return $self->redirect( $q->url . '/report/outreach/' . $request_id);
}
$vars->{patient_id} = $patient_id;
my $rtn = $self->model('Outreach')->update_alternate_address($vars);
return $rtn
? $self->error($rtn)
: $self->redirect_after_edit_success('/report/outreach/' . $request_id);
}
# ------------------------------------------------------------------------------
sub _get_datafile_results {
my $self = shift; $self->_debug_path();
my $result = $self->get_datafile_results(); # arrayref
if ( @$result ) {
return $result;
}
else {
$self->flash( error => $self->messages('results')->{empty_result} );
return 0;
}
}
#-------------------------------------------------------------------------------
# check internal datafile refs (filename & patient ids) match
# sets $self->param_mismatch() arrayref on error:
sub _check_datafile_integrity {
my $self = shift; $self->_debug_path();
# check_datafile_integrity() returns names of any errors:
if ( my $error_names = $self->check_datafile_integrity() ) {
my @errs = map $self->messages('results')->{$_}, @$error_names;
$self->flash( error => join '; ', @errs );
return 0;
}
return 1;
}
1;
