• Files
• Commits
• Log
• Graph
• Stats

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
}

#-------------------------------------------------------------------------------
# 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