• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Model::Patient;

use Moose;
extends 'LIMS::Model::Base';
with (
	'LIMS::Model::Roles::SessionData', # provides $self->user_profile
	'LIMS::Model::Roles::HistoryAction', # do_request_history()
);
has error_codes_map => ( is => 'ro', isa => 'HashRef', lazy_build => 1 );
has form_data => ( is => 'rw', isa => 'HashRef', default => sub { {} } );

use namespace::clean -except => 'meta';

__PACKAGE__->meta->make_immutable;

use Rose::DB::Object::Util qw(:columns); # doesn't seem to be in use

use Data::Dumper;

#-------------------------------------------------------------------------------
# TODO: updating record with new data if matching nhs_number (unique index) - should reject
# now dies if empty nhs_number: "Cannot load LIMS::DB::Patient without a primary
# key (id) with a non-null value or another unique key with at least one non-null value."

sub create_new_patient {
    my $self = shift;
    my $data = shift; # $self->debug($data); return;

    my $patient_case = LIMS::DB::PatientCase->new;
    $self->_update_object_with_data({ object => $patient_case, data => $data });

    my $patient = LIMS::DB::Patient->new;
    $self->_update_object_with_data({ object => $patient, data => $data });

	# add created_at time:
	$patient->created_at($self->time_now);

=begin # causes error if nhs_number empty:
    # add patient object to patient_case object:
    $patient_case->patient($patient);

    # combined save:
    $patient_case->save; # warn $patient_case->id;
=cut

	my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;

#$self->set_rose_debug(1);
	$db->do_transaction( sub {
		$patient->save;

		my $patient_id = $patient->id
			|| die 'cannot retrieve patient_id in create_new_patient()';

		$patient_case->patient_id($patient_id);

		$patient_case->save;
	});
#$self->set_rose_debug(0);
	# warn [ $patient->id, $patient_case->id ];

	return $patient_case->id;
}

#-------------------------------------------------------------------------------
sub merge_patients {
	my $self = shift;
	my $data = shift; # $self->debug($data);

	# patient_case_id's, 'from' & 'to':
	my $from_id = $data->{from};    # arrayref (1 or more) - keep
	my ($to_id) = @{ $data->{to} }; # arrayref (1 item only) - deref

	my $db = $self->lims_db;

	# get list of all patient_cases having patient_case.id in 'from' patient_cases:
	my $patient_cases_from = $self->_get_patient_cases_from($from_id);

	# get data for 'to' patient_case:
	my $case_to = LIMS::DB::PatientCase->new(id => $to_id)->load;

	# find existing combination of new patient_id + old referral_source &
	# unit_number, or create new:
	my $merge = sub {
		CASE: for my $old_case (@$patient_cases_from) { # $self->debug($_)
			{ # now including orphaned patients so check for requests:
				my $ref = $old_case->request; # many-to-1 so array(ref)
				next CASE unless @$ref; # can just be deleted (later) if orphaned
			}
			# clone object so we don't clobber old vals before archiving:
			my $new_case = $old_case->clone;

			# replace patient_id with new 'to' value:
			$new_case->patient_id($case_to->patient_id);

			# replace unit_number with new 'to' value if required:
			if ($data->{scope} && $data->{scope} eq 'unit_no') {
				$new_case->unit_number($case_to->unit_number);
			}
			# remove patient_case PK (id) or get row re-loaded on load_or_insert():
			$new_case->id(undef);

			# retrieve existing or create new:
			$new_case->load_or_insert(); # warn $patient_case->id;

			# update requests table with new patient_case_id:
			my $i = LIMS::DB::Request::Manager->update_requests(
				set   => { patient_case_id => $new_case->id },
				where => [ patient_case_id => $old_case->id ],
			);
		}
		# can now delete old patient_cases + patients:
		$self->_archive_and_delete_patients($patient_cases_from, $case_to);
	};

	my $ok = $db->do_transaction($merge);

	# don't need return value unless error:
    return $ok ? 0 : 'merge_patients() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub get_patient {
	my $self = shift;
	my $patient_id = shift;

	my $patient = LIMS::DB::Patient->new(id => $patient_id)->load;

	return $patient;
}

#-------------------------------------------------------------------------------
sub get_patient_from_nhs_number {
	my ($self, $nhs_number) = @_;

	my $o = LIMS::DB::Patient->new(nhs_number => $nhs_number)->load_speculative;
	return $o;
}

#-------------------------------------------------------------------------------
sub get_patient_demographics {
	my ($self, $patient_id) = @_;

    my @args = ( with => 'patient_demographic' );
	my $patient = LIMS::DB::Patient->new(id => $patient_id)->load(@args);
	return $patient;
}

#-------------------------------------------------------------------------------
# used only by Merge::do_merge - can delete when changed to patient_case
sub get_patients {
	my ($self, $patient_ids) = @_; # arrayref

	my $patients
		= LIMS::DB::Patient::Manager->get_patients(query => [ id => $patient_ids ]);

	return $patients;
}

#-------------------------------------------------------------------------------
sub get_patient_from_request_id {
	my ($self, $request_id) = @_;

	my $o = LIMS::DB::Request->new(id => $request_id)
		->load(with => 'patient_case.patient');

	return $o->patient_case->patient;
}

#-------------------------------------------------------------------------------
sub get_similar_patients {
	my ($self, $patient) = @_;

	my %args = (
		query => [
			last_name    => $patient->last_name,
			first_name   => $patient->first_name,
			'patient.id' => { ne => $patient->id },
		],
		require_objects => [ qw(patient referral_source) ],
	);
#$self->set_rose_debug(1);
	my $patients = LIMS::DB::PatientCase::Manager->get_patient_cases(%args);
#$self->set_rose_debug(0);

	return $patients;
}

#-------------------------------------------------------------------------------
sub check_patient_nhs_number_count {
	my ($self, $nhs_number) = @_;

	my %args = (
		query => [ nhs_number => $nhs_number ],
	);

	my $count = LIMS::DB::Patient::Manager->get_patients_count(%args);
	return $count;
}

#-------------------------------------------------------------------------------
sub update_patient {
    my $self = shift;
    my $data = shift; # $self->debug($data); # hashref of form data

	# unlikely, but best to check:
	$data->{id} || die 'cannot retrieve patient_id in update_patient()';

    my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $i = 0; # successful updates counter

	my $update_patient = sub {
		# load existing data for patient:
		my $patient = LIMS::DB::Patient->new(id => $data->{id})->load;

		# freeze patient data in archive:
		my $archive = $self->_create_patient_archive($patient);
		# add error_code_id:
		$archive->error_code_id($data->{error_code_id});

        # if selected patient has >1 record but only 1 needs changing:
        if ($data->{this_record_only}) {
            $i = $self->_update_single_request($data);
        }
		# patient_id might be submitted by 'use this' radio button:
		elsif ( my $new_patient_id = $data->{use_patient_id} ) {
			$i = $self->_update_requests_with_new_patient_case($data);
			# need to set patient_id in $archive to new 'use_patient_id' value:
			$archive->patient_id($new_patient_id);
		}
		else {
			# update $patient object with new form data:
            my %args = ( object => $patient, data => $data );
			$self->_update_object_with_data(\%args);

			return unless $patient->dirty_columns; # warn 'have dirty_cols';

			$i = $patient->save(changes_only => 1) ? 1 : 0;	# $i gets memory address if scalar ?
		}

		# save archive (unless change to a single request):
		$archive->save unless $data->{this_record_only}; # && $data->{use_patient_id}
	};

#$self->set_rose_debug(1);
	my $ok = $db->do_transaction( $update_patient ); # warn Dumper [ $ok, $i, $db->error ];
#$self->set_rose_debug(0);

	# return hashref of db error (if any), or numerical value of success (updates count):
	return $ok
        ? { success => $i }
        : { error => 'update_patient() error - ' . $db->error };
}

# ------------------------------------------------------------------------------
sub update_patient_demographics {
	my ($self, $args) = @_; # warn Dumper $args;

	my $patient_id = $args->{patient_id};

    # format post-code:
    $args->{post_code} = LIMS::Local::Utils::format_postcode($args->{post_code})
        if $args->{post_code}; # otherwise returns '0'
	# tidy up address:
	$args->{address} = LIMS::Local::Utils::reformat_address($args->{address})
        if $args->{address}; # otherwise returns '0'
	# supply default gp.id if necessary (eg HMRN data entry):
    $args->{gp_id} ||= LIMS::DB::ReferralType->new(description => 'practitioner')
        ->load(with => 'unknown_referrer')->unknown_referrer->id;

	my $user_id = $self->user_profile->{id};

	my $o = LIMS::DB::PatientDemographic->new(patient_id => $patient_id);

	my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $update = sub {
		if ($o->load_speculative) {
			my $old = $o->clone->as_tree;

			# update object with new data:
			map {
				$o->$_($args->{$_})
			} grep $_ ne 'patient_id', keys %$args;
			$o->save(changes_only => 1);

			my $new = $o->clone->as_tree;
			my @changed = do {
				no warnings 'uninitialized';
				grep { $new->{$_} ne $old->{$_} } keys %$old;
			}; # warn Dumper \@new;

			for my $field (@changed) {
				# need to replace primary keys with foreign field entries:
				if ( $field eq 'gp_id' ) {
					my $id = $old->{$field};
					my $o = LIMS::DB::Referrer->new(id => $id)->load;
					$field = 'GP'; # rename for history file
					$old->{$field} = $o->name;
				}
				elsif ( $field eq 'practice_id' ) {
					my $id = $old->{$field};
					my $o = LIMS::DB::ReferralSource->new(id => $id)->load;
					$field = 'practice'; # rename for history file
					$old->{$field} = $o->display_name;
				}

                my $action = $old->{$field}
                    ? qq!updated '$field' from '$old->{$field}'!
                    : qq!added new $field!;

				my %data = (
					patient_id => $patient_id,
					user_id    => $user_id,
					action 	   => $action,
				);
				LIMS::DB::PatientDemographicHistory->new(%data)->save;
			}
		}
		else { # create new:
			map { $o->$_($args->{$_}) } keys %$args; # warn Dumper $args;
			$o->save;
		}
	};

	my $ok = $db->do_transaction($update);

	# don't need return value unless error:
    return $ok ? 0 : 'update_patient_demographics() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub update_patient_notes {
    my ($self, $args) = @_; # warn Dumper $args;

    my $patient_id = $args->{patient_id};
    my $form_param = $args->{detail}; # warn Dumper $form_param;

	my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;

    my $user_id = $self->user_profile->{id};
    my $action;

	my $update = sub {
        my $o = LIMS::DB::PatientNote->new(patient_id => $patient_id);

        if ( $o->load(speculative => 1) ) {
            if ($form_param) { # update:
                return 0 if $form_param eq $o->detail; # skip if no change
                $o->detail($form_param);
                $o->save;
                $action = 'updated patient notes';
            }
            else { # delete:
                $o->delete;
                $action = 'deleted patient notes';
            }
        }
        else {
            $o->detail($form_param);
            $o->save;
            $action = 'added new patient notes';
        }
		{ # log:
            my %data = (
                patient_id => $patient_id,
				user_id    => $user_id,
				action 	   => $action,
			);
            LIMS::DB::PatientDemographicHistory->new(%data)->save;
        }
    };

	my $ok = $db->do_transaction($update);

	# don't need return value unless error:
    return $ok ? 0 : 'update_patient_notes() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub _update_single_request {
    my ($self, $data) = @_; # warn Dumper $data; # $data is hashref

    # need to select or create new patient:
    my $patient_id = $data->{use_patient_id}; # optional - if selecting existing
    my $request_id = $data->{request_id};

    if (! $patient_id) {
        delete $data->{id}; # remove patient id to prevent re-loading
        my $patient = LIMS::DB::Patient->new();
        $self->_update_object_with_data({ object => $patient, data => $data });

        $patient->save; # warn Dumper $patient->as_tree;
        $patient_id = $patient->id;
    }

	my $req = LIMS::DB::Request->new(id => $request_id);
	$req->load(with => 'patient_case');

	# now retrieve, or create new, patient case with new patient id:
	my $case = do {
		my %data = map { $_ => $req->patient_case->$_ }
			qw(unit_number referral_source_id); # use existing
		$data{patient_id} = $patient_id; # add new patient id
		LIMS::DB::PatientCase->new(%data)->load_or_insert;
	};

	# now update request.patient_case_id to new one:
	$req->patient_case_id($case->id);
	$req->save(changes_only => 1) || return 0; # returns object if successful, or 0

	# ok to log this in request history as it's a record-specific change:
	$self->_do_single_record_update_request_history($data);
	# may need to _update_dependent_tables() ??
	return 1; # also equals no. of records updated
}

#-------------------------------------------------------------------------------
sub	_do_single_record_update_request_history {
	my ($self, $data) = @_; # warn Dumper ['data:', $data];

	# if 'use_patient_id', OK to use existing $data hashref, otherwise it's changed
	# so re-load patient using original patient id from query param (_record_id):
	my $patient = $data->{use_patient_id}
		? $data
		: LIMS::DB::Patient->new(id => $data->{_record_id})->load->as_tree;

	# ensure dob is stringified if DT object:
	$patient->{dob} = $patient->{dob}->ymd
		if ( ref $patient->{dob} eq 'DateTime' ); # warn Dumper ['patient:', $patient];

	my $action = sprintf 'updated patient data [%s]',
		join ' :: ', map $patient->{$_}, grep $patient->{$_},
			qw( last_name first_name dob gender nhs_number );

    $self->add_to_actions($action);
    { # for do_request_history, just needs _request_id:
        my %h = ( _request_id => $data->{request_id} );
        $self->form_data(\%h);
    }
	$self->do_request_history();
}

#-------------------------------------------------------------------------------
sub _update_requests_with_new_patient_case {
	my $self = shift;
	my $data = shift; # $self->debug($data); # form data

	my $old_patient_id = $data->{id};
	my $new_patient_id = $data->{use_patient_id};

	# get all patient_cases using old patient id:
	my $cases = LIMS::DB::PatientCase::Manager
		->get_patient_cases( query => [ patient_id => $old_patient_id ] );

	my $i;

	foreach my $case (@$cases) {
		# look for existing combination of existing ref_src_id/unit_no & new pat.id:
		my %args = (
			referral_source_id => $case->referral_source_id,
			unit_number 	   => $case->unit_number,
			patient_id 		   => $new_patient_id,
		);

		# load or create new patient_case:
		my $new_patient_case = LIMS::DB::PatientCase->new(%args)->load_or_insert;

		{ # update requests with new patient_case.id:
			my %args = (
				set   => { patient_case_id => $new_patient_case->id },
				where => [ patient_case_id => $case->id ],
			);
			$i = LIMS::DB::Request::Manager->update_requests(%args);
		}
	}

	{ # update dependent tables (patient_edits, patient_trial)
		my %args = (
			new_patient_id => $new_patient_id,
			old_patient_id => $old_patient_id,
		);

		$self->_update_dependent_tables(\%args);
	}

	# delete old patient_id from all tables:
	LIMS::DB::Patient->new(id => $old_patient_id)->delete(cascade => 1); # replaces need for:
	# LIMS::DB::PatientCase->new(id => $old_patient_case_id, db => $db)->delete;
	# LIMS::DB::Patient->new(id => $old_patient_id, db => $db)->delete;

	return $i;
}

=begin #-------------------------------------------------------------------------------
sub _update_requests_with_new_patient_case {
	my $self = shift;
	my $data = shift; # $self->debug($data); # form data

	# WRONG!!! - _record_id is patient.id !!!!!
	my $request = LIMS::DB::Request->new(id => $data->{_record_id})
		->load(with => 'patient_case');

	my ($i, $patient_case);

	# look for existing patient_case or create new:
	{
		my $new_patient_id = $data->{use_patient_id};

		my %args = (
			patient_id => $new_patient_id,
			referral_source_id => $request->patient_case->referral_source_id,
			unit_number => $request->patient_case->unit_number,
		);

		# load or create new patient_case:
		$patient_case = LIMS::DB::PatientCase->new(%args)->load_or_insert;
	}
	{ # change old patient_case_id to new patient_case_id for all requests:
		my $old_patient_case_id = $request->patient_case_id;

		my %args = (
			set   => { patient_case_id => $patient_case->id },
			where => [ patient_case_id => $old_patient_case_id ],
		);
		$i = LIMS::DB::Request::Manager->update_requests(%args);
	}
	{ # update patient_id in dependent tables (before cascade delete below):
		my $old_patient_case_id = $request->patient_case_id;

		my %args = (
			set   => { patient_id => $patient_case->id },
			where => [ patient_id => $old_patient_case_id ],
		);
		LIMS::DB::PatientTrial::Manager->update_patient_trials(%args);
		LIMS::DB::PatientEdit::Manager->update_patient_edits(%args);
	}
	{ # delete old patient_id from all tables:
		my $old_patient_id = $request->patient_case->patient_id;

		my %args = (
			id => $old_patient_id,
		);
		LIMS::DB::Patient->new(%args)->delete(cascade => 1); # replaces need for:
		# LIMS::DB::PatientCase->new(id => $old_patient_case_id, db => $db)->delete;
		# LIMS::DB::Patient->new(id => $old_patient_id, db => $db)->delete;
	}

	return $i;
}
=cut

#-------------------------------------------------------------------------------
sub delete_patient {
    my $self = shift;
    my $patient_id = shift;

	# return true if the row was deleted or did not exist, false otherwise
	my $result =
		LIMS::DB::Patient->new(id => $patient_id)->delete(cascade => 1);

    return $result; # will return true if success
}

#------------------------------------------------------------------------
# gets patients with & without requests for possible merge:
sub get_records_for_merge {
	my ($self, $search_constraints) = @_;

	# requests, reports, diagnoses, etc will not exist for orphaned patients:
	my @left_joins = qw(
		patient_case.request.referrer_department.referrer
		patient_case.request.request_report.diagnosis
		patient_case.request.status_option
	);

	my @args = (
		require_objects => [ 'patient_case.referral_source' ],
		multi_many_ok => 1,
		with_objects => \@left_joins,
		query => [ %$search_constraints	],
	);
	my $o = LIMS::DB::Patient::Manager->get_objects(@args);
	return $o;
}

#------------------------------------------------------------------------
sub patient_matches_count {
    my $self = shift;
    my $args = shift; # DEBUG $args;

    $args->{require_objects} = 'patient_case';

    my $i = LIMS::DB::Patient::Manager->get_patients_count(%$args);

    return $i;
}

#-------------------------------------------------------------------------------
sub patient_request_count {
	my $self       = shift;
	my $patient_id = shift;

	my %args = (
		query => [ 'patient_case.patient_id' => $patient_id ],
		require_objects => 'patient_case',
	);

	my $n = LIMS::DB::Request::Manager->get_requests_count(%args);

	return $n;

=begin # generated sql
SELECT
COUNT(DISTINCT t1.id)
FROM
  requests t1
	JOIN patient_case t2 ON (t1.patient_case_id = t2.id)
WHERE
  t2.patient_id = ?
=cut
}

#-------------------------------------------------------------------------------
sub _get_patient_cases_from {
	my ($self, $from_id) = @_; # warn Dumper $from_id;

	# get patient_id / unique patient_id's of 'from' patient_case(s):
	my @pid_from;
	{
		my $case_from = LIMS::DB::PatientCase::Manager
			->get_patient_cases( query => [ id => $from_id ] );
		my %pid_from = map { $_->patient_id => 1 } @$case_from; # ignore duplicates

		@pid_from = keys %pid_from;
	} # warn Dumper \@pid_from;

	# get list of all patient_cases associated with 'from' patient(s):
	my %args = (
		query => [ patient_id => \@pid_from ], # auto conversion to 'IN' if a list
		with_objects => 'request', # see whether patient_case has request, or is orphaned
		require_objects => 'patient',
	);
	my $patient_cases
		= LIMS::DB::PatientCase::Manager->get_patient_cases(%args);

	return $patient_cases;
}

#-------------------------------------------------------------------------------
sub _archive_and_delete_patients {
	my ($self, $patient_case, $case_to) = @_; # arrayref, string (integer)

	my $pid_to = $case_to->patient_id;

	# archive patient_data (if has associated request):
	CASE: for my $patient_case (@$patient_case) {
		{ # now including orphaned patients so check for requests:
			my $ref = $patient_case->request; # many-to-1 so array(ref)
			next CASE unless @$ref; # no need to archive if orphaned
		}
		# freeze patient data in archive:
		my $archive = $self->_create_patient_archive($patient_case->patient);

		# only archive it once (in case same patient occurs in >1 patient case):
		unless ( $self->_archive_exists($archive) ) {
			# change patient_id from old to new:
			$archive->{patient_id} = $pid_to;

			# add error_code_id:
			my $err_code_id = $self->error_codes_map->{'record merged'};
			$archive->error_code_id($err_code_id);

			$archive->save;
		}

		{ # update dependent tables (patient_edits, patient_trial)
			my %args = (
				new_patient_id => $pid_to,
				old_patient_id => $patient_case->patient_id,
			);

			$self->_update_dependent_tables(\%args);
		}
	}
	# delete patient_case & patient:
	# $patient_case->delete; # cascade => 1 & ON DELETE CASCADE in tbl def doesn't work
	$_->patient->delete(cascade => 1) for @$patient_case; # does the right thing!!
}

#-------------------------------------------------------------------------------
sub _update_dependent_tables {
	my $self = shift;
	my $args = shift; # warn Dumper $args;

    my @args_old = ( patient_id => $args->{old_patient_id} );
    my @args_new = ( patient_id => $args->{new_patient_id} );

    my %old2new = (
		set   => { patient_id => $args->{new_patient_id} },
		where => [ patient_id => $args->{old_patient_id} ],
	);

    # update any entries in patient_edits & patient_demographic_history tables:
    LIMS::DB::PatientEdit::Manager->update_objects(%old2new);
    LIMS::DB::PatientDemographicHistory::Manager->update_objects(%old2new);

	{ # update patient_notes table:
        my $old = LIMS::DB::PatientNote->new(@args_old)->load_speculative;
            # warn Dumper $old->as_tree if $old;
        my $new = LIMS::DB::PatientNote->new(@args_new)->load_speculative;
            # warn Dumper $new->as_tree if $new;
        if ($old && $new) { # combined old & new (old will be deleted downstream):
            my $str = join '; ', $old->detail, $new->detail; # warn $str;
            $new->detail($str);
            $new->save;
            $old->delete;
        }
        elsif ($old) { # have to use Manager to do this, even though only 1 record:
            LIMS::DB::PatientNote::Manager->update_objects(%old2new);
        }
    }
    # patient demographics (if new doesn't already exist):
    unless ( LIMS::DB::PatientDemographic->new(@args_new)->load_speculative ) {
        LIMS::DB::PatientDemographic::Manager->update_objects(%old2new);
    }
	{ # update any entries in patient_trial table:
		my $i = do {
            my %q = ( query => \@args_new );
            LIMS::DB::PatientTrial::Manager->get_patient_trials_count(%q);
        };
		# unless new patient.id already exists in patient_trial table:
		unless ($i) { # old record will be deleted in cascade below
			my $patient_trials = do {
                my %q = ( query => \@args_old );
				LIMS::DB::PatientTrial::Manager->get_patient_trials(%q);
            };
			foreach my $patient_trial (@$patient_trials) {
				# update patient_id:
				$patient_trial->patient_id($args->{new_patient_id});
				$patient_trial->save(changes_only => 1);
			}
		}
	}
}

#-------------------------------------------------------------------------------
sub _archive_exists {
	my ($self, $archive) = @_; # DB::PatientEdit object

	my %data = map {
		$_ => $archive->$_;
	} qw(last_name first_name middle_name dob nhs_number gender);

	my $count = LIMS::DB::PatientEdit::Manager
		->get_patient_edits_count( query => [ %data ] );

	return $count;
}

#-------------------------------------------------------------------------------
# takes data from form params and updates object with it - could move to superclass
sub _update_object_with_data {
    my $self = shift; # DEBUG $self;
    my $args = shift; # DEBUG $args;

    my $o    = $args->{object};
    my $data = $args->{data};

    my $changes = [];

    # get table col names:
    my @cols = $o->meta->column_names; # DEBUG \@cols;

    FIELD: foreach my $field ( @cols ) { # DEBUG [ 'PRE:', $field, $o->$field, $data->{$field} ];
        next FIELD if ( ! grep $field eq $_, keys %$data ); # only want form params (ie not id, time, etc)

        my $new_value = $data->{$field};

        # get col type - for new vs old comparison (ie '==' or 'eq'):
        my $col_type = $o->meta->column($field)->type; # DEBUG $type;

        { # localise for 'no warnings':
            no warnings 'uninitialized'; # possible empty fields
            next FIELD if
                $col_type eq 'integer' ? # determine col type for '==' or 'eq' comparator:
                    $o->$field == $new_value : # integer
                        lc $o->$field eq lc $new_value; # non-integer, lc both so case not considered
        }

        # collect details of change (field name, old value, new value):
        push @$changes, [ $field, $o->$field, $data->{$field} ]; # TODO - works but no use if date (get DT object!!)

        # set new value:
        $o->$field($new_value);
    }
}

#-------------------------------------------------------------------------------
sub _create_patient_archive {
	my ($self, $patient) = @_;

	# take existing patient data (not pk or timestamps) into %data hash:
	my %archive = map { $_ => $patient->$_ }
		grep { $patient->meta->column($_)->type !~ m(serial|timestamp) }
			$patient->meta->column_names;

	# patient_id = patient->id:
	$archive{patient_id} = $patient->id;
	# user_id from UserProfile (from $args to new):
	$archive{user_id} = $self->user_profile->{id};

	# create new patient object from %data:
	my $archive = LIMS::DB::PatientEdit->new(%archive);

	return $archive;
}

#-------------------------------------------------------------------------------
sub _build_error_codes_map {
	my $self = shift;

	my $error_codes = LIMS::DB::ErrorCode::Manager->get_error_codes;

	my %h = map { $_->description => $_->id	} @$error_codes;

	return \%h;
}

1;

__END__
=begin # old method
sub _new_patient {
    my $self = shift;
    my $data = shift; # DEBUG $data;

    my @patient_cols = LIMS::DB::Patient->meta->column_names; # DEBUG \@patient_cols;
    my @cases_cols   = LIMS::DB::PatientCase->meta->column_names; # DEBUG \@cases_cols;

    my %patient_data = map {
        $_ => $data->{$_};
    } grep $data->{$_}, @patient_cols; # DEBUG \%params;

    my %cases_data = map {
        $_ => $data->{$_};
    } grep $data->{$_}, @cases_cols; # DEBUG \%params;

    my $patient      = LIMS::DB::Patient->new(%patient_data);
    my $patient_case = LIMS::DB::PatientCase->new(%cases_data);

    # add patient object to patient_case:
    $patient_case->patient($patient);

    $patient_case->save;

    return $patient_case->id;
}
=cut

#-------------------------------------------------------------------------------
=begin # when edit_patient data submitted as patient case:
sub _update_patient {
    my $self = shift;
    my $data = shift; # DEBUG $data; # hashref of case_id & params

    my $case_id = $data->{case_id}
        || die 'no case_id passed to update_patient';

	$self->_do_name_cases($data);

    my $patient_case = LIMS::DB::PatientCase->new(id => $case_id)->load;
    $self->_update_object_with_data({ object => $patient_case, data => $data->{params} });

    my $patient_id = $patient_case->patient_id
        || die 'cannot retrieve patient_id in update_patient';

    my $patient = LIMS::DB::Patient->new(id => $patient_id)->load;
    $self->_update_object_with_data({ object => $patient, data => $data->{params} });

    # add patient object to patient_case object:
    $patient_case->patient($patient);

    # combined save:
    $patient_case->save;

    return $patient_case->db->error if $patient_case->db->error;
}
=cut


=begin # same as update_patient, but uses do_transaction:
sub _update_patient {
    my $self = shift;
    my $data = shift; # DEBUG $data;

    my $case_id = $data->{case_id};
    my $param   = $data->{params};

    my $db = LIMS::DB->new_or_cached;

    $db->do_transaction( sub {
        my $patient_case =
            LIMS::DB::PatientCase->new(
                db => $db,
                id => $case_id,
            )->load;

        my $patient_id = $patient_case->patient_id
            || die 'cannot retrieve patient_id in update_patient';

        # set patient_case.unit_number:
        $patient_case->unit_number($param->{unit_number});

        my $patient =
            LIMS::DB::Patient->new(
                db => $db,
                id => $patient_id,
            )->load;


        # get patient table cols:
        my @cols = $patient->meta->column_names; # DEBUG \@cols;

        # set patient table cols to form params:
        FIELD: foreach my $field ( @cols ) {
            my $value = $param->{$field} || next FIELD;
            $patient->$field($value);
        }

        # save patient:
        $patient->save;
        # save unit_number:
        $patient_case->save;

    });

    return 'update_patient() error - ' . $db->error if $db->error;
}
=cut