package LIMS::Controller::Result;
use base 'LIMS::Base';
use Moose;
with (
'LIMS::Controller::Roles::DataMap',
'LIMS::Controller::Roles::DataFile',
'LIMS::Controller::Roles::DataImport',
'LIMS::Controller::Roles::FormData',
'LIMS::Controller::Roles::RecordHandler',
'LIMS::Controller::Roles::ResultHandler',
);
__PACKAGE__->meta->make_immutable(inline_constructor => 0);
# can't use __PACKAGE__->authz->authz_runmodes() - crashes on non-logged-in user
use Data::Dumper;
use Spreadsheet::WriteExcel::Simple;
#-------------------------------------------------------------------------------
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);
return $self->forbidden() unless $self->user_can('modify_results');
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);
# return to home page if record locked (direct url arrival) & not authorized:
if ( $request_data->{is_locked} && ! $self->user_can('modify_results') ) {
return $self->redirect( $self->query->url . '/search/=/' . $request_id );
}
# send $data to process_results_data() for template
# adds 'all_results' & 'results_summary_opts' to $request_data:
$self->process_raw_lab_test_data($request_data);
{ # datafiles - load sub to save db lookup if not required:
my $_self = $self; weaken $_self; # avoid circular ref inside callback
my $load_data_files = sub {
my $data_files = $_self->get_result_data_file($request_id);
return @$data_files ? 1 : 0;
};
$self->tt_params( have_data_files => $load_data_files );
}
# get some data maps:
my %data_map;
{ # lab test data type map:
my $lab_test_data_type_map = $self->lab_test_data_type_map;
$data_map{lab_test_data_type} = $lab_test_data_type_map;
}
{ # lab test result options map:
my $lab_test_result_options = $self->lab_test_result_options_map;
$data_map{data_options} = $lab_test_result_options;
}
{ # get list of tests requested - direct & via panels:
my $results = $request_data->{all_results};
my $requested_tests = $self->get_requested_tests($results);
$data_map{requested_tests} = $requested_tests;
}
{ # function to create drop-down from range eg (1..36)
my $menu_function = sub {
my $input = shift; # warn $input;
my ($low,$high) = $input =~ /(\d+)\-(\d+)/; # warn $low; warn $high;
return { low => $low, high => $high };
};
$self->tt_params( menu_function => $menu_function );
}
$self->tt_params( data_map => \%data_map );
# $self->_debug_path('timer');
return $self->render_view('result/default.tt', $request_data);
}
#-------------------------------------------------------------------------------
sub update : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('modify_results');
my $request_id = $self->param('id')
|| return $self->error('no id passed to ' . $self->get_current_runmode);
# required = 1 hidden field so should never fail, so send to error mode:
my $dfv = $self->check_rm('load', $self->validate('update_results') )
|| return $self->error('required hidden field(s) not supplied to rm '
. $self->get_current_runmode);
my $data = $dfv->valid(); # $self->debug($data);
# put request_id into $data:
$data->{_request_id} = $request_id; # $self->debug($data);
# auto-unlock record if it's a storage [dr]na request:
if ( $self->query->param('storage_auto_unlock') ) {
my $rtn = $self->model('Request')->auto_unlock($request_id);
return $self->error($rtn) if $rtn;
}
my $rtn = $self->model('Result')->update_lab_test_requests($data);
if ($rtn) {
return $self->error($rtn);
}
else {
$self->flash( info => $self->messages('action')->{edit_success});
return $self->redirect( $self->query->url . '/result/=/' . $request_id );
}
}
#-------------------------------------------------------------------------------
sub preview_datafile : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $request_id = $self->param('id')
|| return $self->error('no id passed to ' . $self->get_current_runmode);
# get data file from requests' images dir - in arrayref format:
my $data_file = $self->get_result_data_file($request_id);
# check there's only 1 data file (will need to revise when parsing multiple files):
if (! @$data_file || @$data_file > 1) {
my $msg = @$data_file ? 'xs_data_files' : 'no_data_file';
$self->flash( error => $self->messages('results')->{$msg} );
return $self->redirect( $self->query->url . '/image/=/' . $request_id );
}
# extract data from datafile into arrayref:
my $data = $self->get_datafile_contents($data_file->[0]); # deref @data_file
unless (@$data) {
$self->flash( error => $self->messages('results')->{empty_data} );
$self->redirect( $self->query->url . '/image/=/' . $request_id );
}
$self->tt_params(
request_id => $request_id,
data => $data,
file => @$data_file, # deref single arrayref
);
{ # provide callback function to load flow data PDF:
my $_self = $self; weaken $_self; # or get circular refs inside the callbacks
$self->tt_params(
flow_plot => sub {
my $file_type = shift; # warn $file_type; # eg PB_CMP.pdf
my %args = ( request_id => $request_id, file_type => $file_type );
my $f = $_self->get_file_by_filetype(\%args); # in C::Roles::DataFile
return $f; # components to construct url link
},
);
}
{ # extract contents of datafile to object accessor to test integrity:
$self->parse_data_file($data);
if ( my $errs = $self->_check_datafile_integrity ) {
my $msg = join '; ', @$errs;
$self->tt_params( errs => $msg );
}
else {
my $msg = $self->messages('results')->{data_matches};
$self->tt_params( msg => $msg );
}
}
return $self->tt_process;
}
#-------------------------------------------------------------------------------
sub import_datafile : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
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);
my $url = $self->query->url;
# check internal datafile refs (filename & patient ids) match
if ( my $errs = $self->_check_datafile_integrity ) { # already done in preview_datafile
$self->flash( error => join '; ', @$errs );
return $self->redirect( $url . '/image/=/' . $request_id );
}
else { # no point setting flash msg - already been verified & import sets success msg anyway
# $self->flash( info => $self->messages('results')->{data_matches} );
}
# get flow data (as arrayref) from datafile, or redirect (flash set in sub):
my $flow_data_result = $self->_get_flow_data_result()
|| return $self->redirect( $url . '/image/=/' . $request_id );
# create hash to hold data for db update:
my %results_data = ( request_id => $request_id );
# if lab_test sign_off required, need to get additional params:
if ( my $lab_test_data = $self->get_lab_test_data() ) { # warn Dumper $lab_test_data;
{ # check required lab-test been requested or return error msg:
my %args = (
lab_test_data => $lab_test_data,
request_id => $request_id,
);
unless ( $self->check_lab_test_requested(\%args) ) {
$self->_set_flash_msg('no_lab_test'); # set flash msg on failure
return $self->redirect( $url . '/result/=/' . $request_id );
}
}
# get 'acquired_by' user:
my $acquired_by = $self->get_analysis_user(); # no need to check, it's next
$lab_test_data->{acquired_by} = $acquired_by;
# get 'user_id' value:
my $user_id = $self->get_analysis_user_id($acquired_by)
|| $self->_set_flash_msg('no_userid'); # set flash msg on failure
# get 'date_acquired' value:
my $date_acquired = $self->get_date_acquired()
|| $self->_set_flash_msg('empty_acquired'); # set flash msg on failure
# check both params, or redirect (flash msg already set on either failure):
unless ($date_acquired && $user_id) {
return $self->redirect( $url . '/image/=/' . $request_id );
}
$lab_test_data->{date_acquired} = $date_acquired;
$lab_test_data->{acquisition_userid} = $user_id;
$results_data{lab_test_data} = $lab_test_data;
}
{ # request_report data:
my $report_data = $self->get_report_params(); # $self->debug($data);
$results_data{report_data} = $report_data;
}
{ # request_result_summaries data:
my $lab_section = $self->get_lab_section;
my $results_summary = join "\n", @$flow_data_result;
my %result_summary_data = (
lab_section => $lab_section,
results_summary => $results_summary,
); # $self->debug(\%result_summaries_data);
$results_data{result_summary_data} = \%result_summary_data;
}
my $rtn = $self->model('Result')->import_results(\%results_data);
if ($rtn) {
return $self->error($rtn);
}
else {
$self->flash( info => $self->messages('action')->{edit_success});
return $self->redirect( $url . '/report/=/' . $request_id );
}
}
# ------------------------------------------------------------------------------
sub accept_haem_data : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('modify_results');
my $lab_number = $self->param('id')
|| return $self->error('no lab_number passed to ' . $self->get_current_runmode);
my $function = $self->query->param('func'); # optional
my $request_id = $self->query->param('id'); # optional
my %args = (
lab_number => $lab_number,
request_id => $request_id,
);
my $rtn = $self->model('Result')->accept_haematology_data(\%args);
if ($rtn) { # indicates error
return $self->error($rtn);
}
else {
my $target = $function
? $function . '/=/' . $request_id # eg screen/=/1
: 'local_worklist?function_name=haem_data';
$self->flash( info => $self->messages('action')->{edit_success} );
return $self->redirect( join '/', $self->query->url, $target );
}
}
# ------------------------------------------------------------------------------
sub delete_haem_data : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('modify_results');
my $lab_number = $self->param('id')
|| return $self->error('no lab_number passed to ' . $self->get_current_runmode);
my $function = $self->query->param('func'); # optional
my $request_id = $self->query->param('id'); # optional
# need confirmation to delete record:
if ( $self->query->param('confirm_delete') ) { # warn $lab_number;
my %args = (
lab_number => $lab_number,
request_id => $request_id,
);
my $rtn = $self->model('Result')->delete_haematology_data(\%args);
return $self->error($rtn) if $rtn;
my $target = $function
? $function . '/=/' . $request_id # eg screen/=/1
: 'local_worklist?function_name=haem_data';
# set flash success & redirect:
$self->flash( info => $self->messages('action')->{delete_success} );
return $self->redirect( join '/', $self->query->url, $target );
}
else { # just return tt for confirmation:
return $self->tt_process();
}
}
#-------------------------------------------------------------------------------
sub notes : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $request_id = $self->param('id')
|| return $self->error('no id passed to ' . $self->get_current_runmode);
# don't need to validate, either have content or not:
my $profile = $self->validate('general_notes');
my $data = $self->get_data_from_dfv($profile); # $self->debug($data);
$data->{_request_id} = $request_id;
my $rtn = $self->model('Result')->general_notes($data);
if ($rtn) {
return $self->error($rtn);
}
else {
$self->flash( info => $self->messages('action')->{edit_success});
return $self->redirect( $self->query->url . '/result/=/' . $request_id );
}
}
#-------------------------------------------------------------------------------
sub data_entry : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('modify_results');
my $request_id = $self->param('id')
|| return $self->error('no id passed to ' . $self->get_current_runmode);
# required = 2 hidden fields so should never fail, so send to error mode:
my $dfv = $self->check_rm('load', $self->validate('results_data_entry') )
|| return $self->error('required hidden field(s) not supplied to rm '
. $self->get_current_runmode);
my $data = $dfv->valid(); # $self->debug($data);
$data->{_request_id} = $request_id;
{ # add test results data:
my $lab_test_results = $self->_get_test_results_data_map; # warn Dumper $lab_test_results;
$data->{lab_test_results} = $lab_test_results;
} # $self->debug($data);
# get (optional) config file for auto_reportable requests:
if ( my $cfg = $self->get_yaml_file('auto_reportable') ) {
$data->{auto_reportable_config} = $cfg;
}
{ # if config allows auto-completion of lab-test status:
$data->{test_status_complete}
= $self->cfg('settings')->{status_complete_on_result_entry};
}
my $rtn = $self->model('Result')->update_request_lab_test_results($data);
if ($rtn) {
return $self->error($rtn);
}
else {
$self->flash( info => $self->messages('results')->{update_success} );
return $self->redirect( $self->query->url . '/result/=/'.$request_id );
}
}
#-------------------------------------------------------------------------------
sub export_test_results : Runmode {
my $self = shift; $self->_debug_path();
my $lab_sections
= $self->model('LabSection')->get_lab_sections_with_test_results;
my $sub_categories = $self->model('Diagnosis')->get_diagnostic_categories;
$self->tt_params(
sections => $lab_sections,
sub_cats => $sub_categories,
);
return $self->tt_process();
}
#-------------------------------------------------------------------------------
sub do_export_test_results : Runmode {
my $self = shift; $self->_debug_path();
my %vars = $self->query->Vars(); # warn Dumper \%vars; # must be hash context
# category_id can be a list, need to 'unflatten' then convert to arrayref:
if ( $vars{category_id} ) {
my @ids = split "\0", $vars{category_id}; # var(s) joined by NULL character
$vars{category_id} = \@ids; # only works if vars is hash, not hashref
} # warn Dumper \%vars;
my $section_id = $vars{section_id} # need at least lab-section:
|| return $self->forward('export_test_results');
my $data = $self->model('Result')->get_section_lab_test_results(\%vars)
|| do {
$self->flash( info => $self->messages('results')->{no_test_results} );
return $self->forward('export_test_results');
};
my $xl = Spreadsheet::WriteExcel::Simple->new;
my $headers = $data->{headers};
$xl->write_bold_row($headers);
my $results = $data->{results};
$xl->write_row($_) for @$results;
my $section =
$self->model('LabSection')->get_lab_section($section_id)->section_name;
$section =~ s/\s/\-/g; # spaces => hyphens
my $formatter = DateTime::Format::Strptime->new( pattern => '%y%m%d-%H%M' );
my $filename = sprintf '%s-results-%s.xls',
lc $section, LIMS::Local::Utils::time_now({ formatter => $formatter });
# set header:
$self->header_props(
-type => 'application/excel',
-attachment => $filename,
-expires => 'now'
);
return $xl->data; # or $xl->save("filename.xls");
}
#-------------------------------------------------------------------------------
# check internal datafile refs (filename & patient ids) match
# return errs arrayref on error, or 0:
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;
return \@errs;
}
else {
return 0;
}
}
#-------------------------------------------------------------------------------
# data passed from form fields as lab_test_id_(\d)
sub _get_test_results_data_map {
my $self = shift; $self->_debug_path();
my $params = $self->query->Vars; # can't use $dfv->valid for dynamic params
my %map;
while ( my($param, $value) = each %$params ) { # warn $param;
# look for param lab_test_id_(\d):
my ($lab_test_id) = $param =~ /lab_test_id_(\d+)/; # don't do '|| next' here
next unless $lab_test_id; # warn $lab_test_id; warn $value;
$map{$lab_test_id} = $value;
} # $self->debug(\%map);
return \%map;
}
#-------------------------------------------------------------------------------
sub _get_flow_data_result {
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;
}
}
#-------------------------------------------------------------------------------
sub _set_flash_msg {
my $self = shift; $self->_debug_path();
my $msg = shift;
$self->flash( error => $self->messages('results')->{$msg} );
return 0; # IMPORTANT - return value is captured by caller
}
1;