package LIMS::Controller::Patient;
use Moose;
BEGIN { extends 'LIMS::Base'; }
with (
'LIMS::Controller::Roles::Misc',
);
__PACKAGE__->meta->make_immutable(inline_constructor => 0);
use LIMS::Local::PAS;
use LIMS::Local::Utils;
use Data::Dumper;
#-------------------------------------------------------------------------------
sub default : Startrunmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $errs = shift; $self->stash( errs => $errs ); # for debugging in tmpl
return $self->forbidden() unless $self->user_can('register');
$self->js_validation_profile('js_new_patient');
# if redirected from empty registration search, retrieve saved form
# params from session & load into query:
$self->_load_saved_form_params;
return $self->tt_process($errs);
}
#-------------------------------------------------------------------------------
sub add_new : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('register');
my $dfv = $self->check_rm( 'default', $self->validate('new_patient') )
|| return $self->dfv_error_page;
my $patient = $dfv->valid; # $self->debug( $patient );
# create dt object from patient year, month & day vals:
$patient->{dob} = LIMS::Local::Utils::to_datetime($patient);
# $self->debug( $patient );
# check new patient details for potential duplicates and/or PAS mismatches
# returns true if OK, otherwise sets appropriate tt_params for default.tt:
my $check_ok = $self->_check_new_patient($patient); # warn Dumper $check_ok;
unless ($check_ok) {
my $html = $self->tt_process('patient/default.tt');
return $self->fill_form($html);
}
# insert data to patients/patient_cases and return patient_cases.id (last_insert_id):
my $case_id = $self->model('Patient')->create_new_patient($patient)
|| return $self->error('no patient_case id value returned to '
. $self->get_current_runmode);
return $self->redirect( $self->query->url.'/request/add_new/'.$case_id );
}
#-------------------------------------------------------------------------------
sub add_new_location : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $patient_id = $self->param('id')
|| return $self->error('no patient id passed to '.$self->get_current_runmode);
my $dfv = $self->check_rm( 'select_patient', $self->validate('new_location') )
|| return $self->dfv_error_page;
my $data = $dfv->valid; # $self->debug($data);
my %patient_case_data = (
patient_id => $patient_id,
referral_source_id => $data->{referral_source_id},
unit_number => $data->{unit_number},
);
my $patient_case = $self->model('PatientCase')->new_patient_case(\%patient_case_data);
return $self->redirect( $self->query->url . '/request/add_new/' . $patient_case->id );
}
#-------------------------------------------------------------------------------
sub select_patient : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $errs = shift;
return $self->forbidden() unless $self->user_can('register');
my $patient_id = $self->param('id')
|| return $self->error('no patient id passed to '.$self->get_current_runmode);
$self->js_validation_profile('new_location');
my $patient_cases
= $self->model('PatientCase')->get_cases_by_patient_id($patient_id);
# do PAS lookup (if local patient):
my $pas_query = $self->_pas_query($patient_cases); # $self->debug($pas_query);
# flag for template so it can test $pas_query for arrayref (or string):
my $is_arrayref = sub { ref shift eq 'ARRAY' };
$self->tt_params(
cases => $patient_cases,
pas_query => $pas_query,
is_arrayref => $is_arrayref,
);
return $self->tt_process($errs);
}
#-------------------------------------------------------------------------------
sub edit_patient : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $errs = shift; # $self->stash(errs => $errs);
return $self->forbidden() unless $self->user_can('edit_pid');
my $patient_id = $self->param('id')
|| return $self->error('no id passed to '.$self->get_current_runmode);
# request_id (optionally) passed as 2nd token (or in form if resubmitted after dfv failure)
my $request_id = $self->param('Id') || $self->query->param('request_id') || '';
$self->js_validation_profile('js_edit_patient');
my $patient = $self->model('Patient')->get_patient($patient_id);
{ # PAS query:
# vars only supplied by PAS search if insufficient details supplied:
my $vars = $self->query->Vars(); # $self->debug($vars);
my $pas_query;
if (%$vars) {
$pas_query = [ $vars ]; # template expects array of hashrefs
}
else { # do PAS lookup (if local patient):
my $patient_cases
= $self->model('PatientCase')->get_cases_by_patient_id($patient_id);
$pas_query = $self->_pas_query($patient_cases);
$self->tt_params( pas_query => $pas_query ); # $self->debug($pas_query);
}
}
{ # error codes:
my $error_codes
= $self->model('ErrorCode')->get_error_code_assignment('patient');
$self->tt_params(
error_codes => $error_codes,
);
}
{ # get any similar patient entries:
my $cases
= $self->model('Patient')->get_similar_patients($patient);
my $similar_entries = $self->extract_patients_and_locations($cases);
$self->tt_params( similar_entries => $similar_entries );
}
{ # has patient id been used already (for delete function):
my $count = $self->model('Patient')->patient_request_count($patient_id);
$self->tt_params( count => $count );
}
{ # flag for template so it can test $pas_query for arrayref (or string):
my $is_arrayref = sub { ref shift eq 'ARRAY' };
$self->tt_params( is_arrayref => $is_arrayref );
}
$self->tt_params(
patient => $patient,
request_id => $request_id,
);
return $self->tt_process($errs);
}
#-------------------------------------------------------------------------------
# request to edit patient during registration process; sets hidden flag to alter
# redirect destination:
sub register_edit_patient : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
$self->tt_params( registration_edit => 1 ); # flag for tmpl
return $self->forward('edit_patient'); # use forward() so tt_template_name() works
}
#-------------------------------------------------------------------------------
sub edit_case : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('edit_pid');
my $case_id = $self->param('id')
|| return $self->error('no id passed to '.$self->get_current_runmode);
$self->js_validation_profile('patient_case');
my $case = $self->model('PatientCase')->retrieve_patient_data($case_id);
# has entry been used already (for delete function):
my $requests_count
= $self->model('Request')->get_patient_case_requests_count($case_id);
$self->tt_params(
case => $case,
count => $requests_count,
);
return $self->tt_process;
}
#-------------------------------------------------------------------------------
sub update_case : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('edit_pid');
my $case_id = $self->param('id')
|| return $self->error('no id passed to '.$self->get_current_runmode);
my $dfv = $self->check_rm( 'default', $self->validate('patient_case') )
|| return $self->dfv_error_page;
# get form params as hashref:
my $data = $dfv->valid;
my %args = (
data => $data,
case_id => $case_id,
);
my $rtn = $self->model('PatientCase')->update_patient_case(\%args);
return $rtn ?
$self->error($rtn) :
$self->redirect( $self->query->url . '/request/add_new/' . $case_id );
}
#-------------------------------------------------------------------------------
sub delete_case : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('delete_record');
my $q = $self->query;
my $case_id = $self->param('id')
|| return $self->error('no id passed to '.$self->get_current_runmode);
my $case = $self->model('PatientCase')->get_patient_case($case_id)
|| return $self->error(sprintf q!case id '%s' not found in %s!,
$case_id, $self->get_current_runmode);
# check not already been used (initial check done in edit_case):
if ( $self->model('Request')->get_patient_case_requests_count($case_id) ) {
$self->flash( error => $self->messages('registration')->{cannot_delete_case} );
return $self->redirect( $q->url . '/patient/edit_case/' . $case_id);
}
# need confirmation to delete record:
if ( $q->param('confirm_delete') ) {
my $redirect_url
= $q->url.'/patient/select_patient/'.$case->patient_id;
# successful delete (or no such record) returns true:
my $successful_delete = $self->model('PatientCase')->delete_patient_case($case_id);
return $successful_delete ?
$self->redirect( $redirect_url ) :
$self->error('Sorry - delete failed, I\'ve no idea why.');
}
# just return template with form:
else {
$self->tt_params( case => $case );
return $self->tt_process;
}
}
#-------------------------------------------------------------------------------
sub delete_patient : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('delete_record');
my $q = $self->query;
my $patient_id = $self->param('id')
|| return $self->error('no id passed to '.$self->get_current_runmode);
my $patient = $self->model('Patient')->get_patient($patient_id)
|| return $self->error(sprintf q!patient id '%s' not found in %s!,
$patient_id, $self->get_current_runmode);
# check patient not attached to other record(s) (initial check done in edit_patient):
if ( $self->model('Patient')->patient_request_count($patient_id) ) {
$self->flash( error => $self->messages('registration')->{cannot_delete_patient} );
return $self->redirect( $q->url . '/patient/edit_patient/' . $patient_id);
}
# need confirmation to delete record:
if ( $q->param('confirm_delete') ) {
# successful delete (or no such record) returns true:
my $successful_delete = $self->model('Patient')->delete_patient($patient_id);
return $successful_delete ?
$self->redirect( $q->url.'/register' ) :
$self->error('Sorry - delete failed, I\'ve no idea why.');
}
# just return template with form:
else {
$self->tt_params( patient => $patient );
return $self->tt_process;
}
}
#-------------------------------------------------------------------------------
sub update_patient : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden() unless $self->user_can('edit_pid');
my $q = $self->query;
my $patient_id = $self->param('id')
|| return $self->error('no id passed to '.$self->get_current_runmode);
# hidden field if edited from a request page:
my $request_id = $q->param('request_id');
# put $patient_id into params() for $self->validate('edit_patient') profile:
$self->query->param(_record_id => $patient_id);
my $dfv = $self->check_rm( 'edit_patient', $self->validate('edit_patient') );
# need to (re)set template flag(s) first if validation failed:
if (! $dfv) {
map { # warn $q->param($_);
$self->tt_params( $_ => $q->param($_) );
} grep $q->param($_), qw(registration_edit request_id);
return $self->dfv_error_page;
}
# get form params as hashref:
my $data = $dfv->valid; # $self->debug( $data );
# create DoB datetime object if day, month & year passed:
$data->{dob} = LIMS::Local::Utils::to_datetime($data);
# add patient.id to data so record updated if it's an edit:
$data->{id} = $patient_id;
my $rtn = $self->model('Patient')->update_patient($data);
# $rtn = { error => $db->error (if any); success => number of rows updated }
if ($rtn->{error}) {
return $self->error($rtn->{error});
}
else { # update succeeded:
my $messages = $self->messages('request_edit');
my $i = $rtn->{success}; # number of rows updated
my @flash = $i ? # success can be 0, or an INT
( info => sprintf $messages->{edit_success}, $i) :
( warning => $messages->{edit_failed} ) ;
$self->flash( @flash );
my $redirect = $q->param('registration_edit') ?
# redirect to registration page for $patient_id:
"/register/patient_search?patient_id=$patient_id" :
# redirect to specific request, or to general search page:
$request_id ? "/search/=/$request_id" : '/search';
return $self->redirect( $q->url . $redirect );
}
=begin
# get existing data for this patient:
my $old_data =
$self->model('PatientCase')->retrieve_patient_data($case_id);
# get list of patients table cols:
my @cols = $old_data->meta->column_names; # $self->debug(\@cols);
# test each col param against form data:
foreach ( @cols ) {
# skip empty fields:
next unless $new_data->{$_}; # $self->debug([$_, $old_data->meta->column($_)->type]);
next if
$old_data->meta->column($_)->type eq 'int' ?
$old_data->$_ == $new_data->{$_} :
lc $old_data->$_ eq lc $new_data->{$_};
# TODO: logging function for changed fields
# print $new_data->{$_};
}
=cut
}
# ------------------------------------------------------------------------------
sub patient_notes : 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 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);
# only one param passed:
my $str = $self->query->param('patient_notes');
my %args = (
patient_id => $patient_id,
details => $str,
);
my $rtn = $self->model('Patient')->update_patient_notes(\%args);
return $rtn
? $self->error($rtn)
: $self->redirect_after_edit_success('/search/=/' . $request_id);
}
#-------------------------------------------------------------------------------
# if redirected from empty registration search, retrieve saved form params from session & load into query:
sub _load_saved_form_params {
my $self = shift; $self->_debug_path;
my $patient_search_params = # will be empty if not arrived via empty registration search
$self->session->param('patient_search_params') || return;
foreach (keys %$patient_search_params) { # $self->debug($patient_search_params->{$_});
$self->query->param( $_ => $patient_search_params->{$_} );
}
# now clear patient_search_params hahref
$self->session->clear('patient_search_params');
}
# checks new patient data for potential duplicate or PAS mismatch,
# returns false if potential problem, otherwise true:
#-------------------------------------------------------------------------------
sub _check_new_patient {
my $self = shift; $self->_debug_path;
my $patient = shift;
# form flags to confirm & override checks:
my $pas_confirmed = $self->query->param('_pas_confirmed');
my $local_confirmed = $self->query->param('_local_confirmed');
# do pas query first - if pas OK then do local check - can only confirm
# local after pas, so local confirm can skip pas as well:
unless ($pas_confirmed || $local_confirmed) {
# $pas_query will be empty if not local patient, or no local
# prefix set, or no pas config:
if ( my $pas_query = $self->_pas_query($patient) ) { # warn Dumper $pas_query;
# ok if pas returns 'demographics verified' message:
unless ( $pas_query eq 'Patient demographics verified' ) {
$self->tt_params(
pas_query => $pas_query,
# flag for template so it can test $pas_query for arrayref:
is_arrayref => sub { ref shift eq 'ARRAY' },
);
return 0;
}
}
}
unless ($local_confirmed) {
# check for potential duplicate unit_number and/or nhs_number:
my $maybe_duplicate =
$self->model('PatientCase')->validate_patient_case($patient);
if (@$maybe_duplicate) { # warn 'maybe_duplicate';
$self->tt_params( maybe_duplicate => $maybe_duplicate );
return 0;
}
}
# OK, patient validated against PAS and local patient db:
return 1;
}
#-------------------------------------------------------------------------------
# returns true if 1 or more locations = local in patient_cases object:
sub _is_local_patient {
my $self = shift; $self->_debug_path;
my $patient_data = shift; # arrayref if PatientCase obj, or hashref of patient data
# get local prefix from settings or return if empty:
my $local_prefix = $self->cfg('settings')->{local_prefix}
|| return 0; # warn $local_prefix;
if (ref $patient_data eq 'HASH') {
my $ref_src_id = $patient_data->{referral_source_id};
my $location =
$self->model('ReferralSource')->get_referral_source($ref_src_id);
# returns true if organisation_code matches local prefix:
return $location->organisation_code =~ /\A($local_prefix)/;
}
else { # returns true if at least 1 organisation_code matches local prefix:
return grep {
$_->referral_source->organisation_code =~ /\A($local_prefix)/
} @$patient_data;
}
}
=begin nd
Function: _pas_query()
Called by <select_patient()> to check patient demographic data submitted either via
selection of previous patient match or directly through Validate button.
Uses <LIMS::Local::PAS> to query the PAS interface. Returns a ref to array of hashrefs
(if matching patient data found on PAS) or string containing error status
($c->config->{msg}) if not.
=cut
#-------------------------------------------------------------------------------
sub _pas_query {
my $self = shift; $self->_debug_path;
# $patient_data = arrayref if PatientCase object, or hashref if patient data
my $patient_data = shift;
# needs to be local patient for PAS lookup:
return unless $self->_is_local_patient($patient_data);
my @pas_config_settings = qw(pas_address pas_username pas_pwd);
my %pas_config = map {
$_ => $self->cfg('settings')->{$_};
} @pas_config_settings; # $self->debug(\%pas_config);
# need all required PAS config settings, or return:
return if grep ! $pas_config{$_}, @pas_config_settings;
# variable: $pas_excluded_names
# list of last_names excluded from PAS search (eg HIV's)
# my $pas_excluded_names = join '|', @{ $self->cfg('pas_excluded_names') };
# return if # skip PAS lookup if:
# last_name matches proscribed entry(s) in config->pas_excluded_names,
# $patient->{last_name} =~ /\A($pas_excluded_names)/ || # eg HIV's
# form carries 'pas_checked' flag:
# $params_ref->{pas_checked}; # already been there
my %patient;
if (ref $patient_data eq 'ARRAY') {
# extract 1st record (all same patient) from $patient_data:
my $patient_case = $patient_data->[0];
# create patient hashref for PAS query:
%patient = map {
$_ => $patient_case->patient->$_;
} $patient_case->patient->meta->column_names;
# get local unit_number(s) as arrayref from referral(s):
my $local_unit_numbers = $self->_get_local_unit_numbers($patient_data);
# include unit_numbers arrayref:
$patient{unit_number} = $local_unit_numbers; # $self->debug($local_unit_numbers);
# dob needs to be in yyyy-mm-dd format:
if ( my $dob = $patient_case->patient->dob) {
$patient{dob} = $dob->ymd; # $self->debug(\%patient);
}
# PAS considers FORENAME as first_name + middle_name:
$patient{first_name} = join ' ', map $patient_case->patient->$_,
grep $patient_case->patient->$_, qw(first_name middle_name);
}
elsif (ref $patient_data eq 'HASH') {
%patient = %$patient_data; $self->debug(%patient);
# TODO: dob needs to be ymd:
$patient{dob} = $patient{dob}->ymd if $patient{dob};
}
else {
return $self->error('_pas_query() called with unexpected $patient_data format');
}
my %args = (
patient => \%patient,
config => \%pas_config,
messages => $self->messages('demographics'),
);
my $pas = LIMS::Local::PAS->new(\%args);
return $pas->query; # ref to array of hashrefs or string
}
#-------------------------------------------------------------------------------
# parses $patient_cases array(ref) for local unit_numbers, as patient referral
# from multiple locations may include remote location unit_number(s) which match
# a (different) local patient but are not valid for local PAS lookup:
sub _get_local_unit_numbers {
my $self = shift; $self->_debug_path;
my $patient_cases = shift;
my $local_prefix = $self->cfg('settings')->{local_prefix};
# create hash of local unit_numbers (excluding default val):
my %local_unit_numbers =
map { $_->unit_number, 1 }
grep { # skip null (or default) unit_numbers:
$_->unit_number ne $_->meta->column('unit_number')->default,
}
grep {
$_->referral_source->organisation_code =~ /\A($local_prefix)/
} @$patient_cases; # $self->debug(\%local_unit_numbers);
# return arrayref to list of unique unit_numbers:
return [ sort keys %local_unit_numbers ];
}
1;
__END__
=begin # done in LIMS::Valiadate now
_validate_patient_data {
my $self = shift;
my $nhsno = $self->query->param('nhs_number');
# return profile as mixture of new_patient &
# patient_search_data validation profiles:
my $new_patient = $self->validate('new_patient');
my $patient_search = $self->validate('patient_search_data');
# add nhs_number constraint_method to patient_search_data:
$patient_search->{constraint_methods}->{nhs_number} = sub {
return LIMS::Local::Utils::check_nhsno( $nhsno );
};
my %profile = (
required => $new_patient->{required},
optional => $new_patient->{optional},
dependency_groups => $patient_search->{dependency_groups},
constraint_methods => $patient_search->{constraint_methods},
);
$profile{require_some} = {
patient_id => [ 1, qw(nhs_number unit_number) ],
}; # $self->debug(\%profile);
return \%profile;
}
=cut
#-------------------------------------------------------------------------------
=begin # direct entry from patient/select_patient.tt now
new_location : Runmode {
my $self = shift;
my $errs = shift;
my $patient_id = $self->param('id')
|| return $self->error('no id passed to '.$self->get_current_runmode);
$self->js_validation_profile('new_location');
my $patient = $self->model('Patient')->get_patient($patient_id);
$self->tt_params(
patient => $patient,
);
return $self->tt_process($errs);
}
=cut