• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Model::Patient;

use Moose;
extends 'LIMS::Model::Base';
with 'LIMS::Model::Roles::SessionData'; # provides $self->user_profile
has error_codes_map => ( is => 'ro', isa => 'HashRef', lazy_build => 1 );
use namespace::clean -except => 'meta';

__PACKAGE__->meta->make_immutable;

use Rose::DB::Object::Util qw(:columns);
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_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 {
		foreach my $old_patient_case (@$patient_cases_from) { # $self->debug($_)
			# clone object so we don't clobber old vals before archiving:		
			my $new_patient_case = $old_patient_case->clone;
			
			# replace patient_id with new 'to' value:
			$new_patient_case->patient_id($case_to->patient_id);
			
			# replace unit_number with new 'to' value if required:
			if ($data->{scope} eq 'unit_no') {
				$new_patient_case->unit_number($case_to->unit_number);
			}
			# remove patient_case PK (id) or get row re-loaded on load_or_insert():
			$new_patient_case->id(undef); 
	
			# retrieve existing or create new:
			$new_patient_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_patient_case->id },
				where => [ patient_case_id => $old_patient_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;
}

#-------------------------------------------------------------------------------
# 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});

		# patient_id might be submitted by 'use this' radio button:
		if ( 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:
			$self->_update_object_with_data({ object => $patient, data => $data });
			
			return unless $patient->dirty_columns; # warn 'have dirty_cols';

			$i = $patient->save(changes_only => 1) ? 1 : 0;	# $i gets memory address if scalar ?		
		}
		
		$archive->save;
	};
	
#$self->set_rose_debug(1);
	$db->do_transaction( $update_patient );
#$self->set_rose_debug(0);

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

# ------------------------------------------------------------------------------
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});
	# tidy up address:
	$args->{address} = LIMS::Local::Utils::reformat_address($args->{address});
	
	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) {
				my $action  = qq!updated '$field' from '$old->{$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;
			$o->save;		
		}
        die 'rollback now';
	};
	
	my $ok = $db->do_transaction($update);
	
	# don't need return value unless error:
    return $ok ? 0 : 'update_patient_demographics() error - ' . $db->error;
}

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

#------------------------------------------------------------------------
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) = @_;
	
	# 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;
	}
	
	# 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
		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;
	
	foreach my $patient_case (@$patient_case) {
		# 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_case->patient->delete(cascade => 1); # does the right thing!!
	}
}

#-------------------------------------------------------------------------------
sub _update_dependent_tables {
	my $self = shift;
	my $args = shift;
	
	# update any entries in patient_edits table:
	LIMS::DB::PatientEdit::Manager->update_patient_edits(
		set   => { patient_id => $args->{new_patient_id} },
		where => [ patient_id => $args->{old_patient_id} ],
	);
		
	{ # update any entries in patient_trial table:
		my %args = ( query => [ patient_id => $args->{new_patient_id} ] );
		my $i = LIMS::DB::PatientTrial::Manager->get_patient_trials_count(%args);
		# unless new patient.id already exists in patient_trial table: 		
		unless ($i) { # old record will be deleted in cascade below
			my %args = ( query => [ patient_id => $args->{old_patient_id} ] );
			my $patient_trials
				= LIMS::DB::PatientTrial::Manager->get_patient_trials(%args);
			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