package Role::Patient;

use Moose::Role;
use Data::Dumper;

# get patient id :
sub get_patient_id {
    my $self = shift;
    my $vals = shift;

	my $dbh = $self->db->{dbix4};
	my $log_file = $self->log_file;
	
	my @h4 = qw(last_name first_name middle_name dob);
	my @h3 = qw(lname fname mname dob);
	
	# if $vals has an nhs_number:
	if ( my $nhs_number = $vals->{nhsno} ) {			
		# if nhs_number in list of resolved duplicates:
		if ( my $new_data = $self->resolved_nhsno_duplicates_map->{$nhs_number} ) {
			no warnings 'uninitialized'; # for all print statements:
			# return patient_id if already been here:
			if (my $patient_id = $self->nhs_number_map->{$nhs_number}) {
				my $sql = q!select last_name, first_name, middle_name, dob, gender, 
					nhs_number from patients where id = ?!;
				my $p = $dbh->query($sql, $patient_id)->hash;

				if ( (join '', map uc($_), @{$new_data}{@h3}) ne (join '', map uc($_), @{$p}{@h4}) ) {
					print $log_file 'have existing resolved nhsno mismatch for ' . $nhs_number . "\n";
					print $log_file join ',', map $p->{$_}, @h4; print $log_file "\n";
					print $log_file join ',', map $new_data->{$_}, @h3; print $log_file "\n";
				}
				return $patient_id; 
			}
			elsif ( (join '', map uc($_), @{$new_data}{@h3}) ne (join '', map uc($_), @{$vals}{@h3}) ) {
				print $log_file 'have new resolved nhsno mismatch for ' . $nhs_number . "\n";
				print $log_file join ',', map $vals->{$_}, @h3; print $log_file "\n";
				print $log_file join ',', map $new_data->{$_}, @h3; print $log_file "\n";
			}
			
			# set new params:
			$vals->{nhsno} = $nhs_number; # not stored as key in map_hashes
			while ( my ($param, $val) = each %$new_data ) {
				$vals->{$param} = $val;
			} # warn Dumper $vals;	
		}
		
		# first try to update any records with last_name, dob & unit_no match, but
		# WITHOUT nhsno (affects <100 of 45K recs):
		if ( $vals->{patno} && $vals->{dob} ) {
			my $sql = q!select p.id from patients p join patient_case pc on p.id =
				pc.patient_id where unit_number = ? and last_name = ? and dob = ?
				and nhs_number is null!;
			my $patient_id
				= $dbh->query( $sql, map $vals->{$_}, qw(patno lname dob) )->list;

			# update record (must be only 1) with nhs_number:
			if ($patient_id) {
				# check nhsno not already used - in which case need to flag for merge:
				if ($self->nhs_number_map->{$nhs_number}) {
					print $log_file "merge required on $vals->{lname} $vals->{fname}\n";
				}
				else { 
					$dbh->update('patients', {nhs_number => $nhs_number}, {id => $patient_id});
					print $log_file "updating $patient_id with $nhs_number for $vals->{dbid}\n";
					# cache & return it:
					$self->nhs_number_map->{$nhs_number} = $patient_id;					
				}
				return $patient_id;
			}
		}

		# update middle name if exists:
		if ( my $mname = $vals->{mname} ) { # already checked mname > 1 char
			my $sql = q!select p.id from patients p where nhs_number = ? and last_name = ?
				and first_name = ? and middle_name is null!;
			my $patient_id
				= $dbh->query( $sql, map $vals->{$_}, qw(nhsno lname fname) )->list;
			if ($patient_id) {
				print $log_file "updating $patient_id with $mname for $vals->{dbid}\n";
				$dbh->update('patients', {middle_name => $mname}, {id => $patient_id});
			}
		}
		
		# if not already seen this nhs_no, create new:
		if (! $self->nhs_number_map->{$nhs_number}) {
			my $patient_id = $self->_create_new_record($vals);		
			# now cache it:
			$self->nhs_number_map->{$nhs_number} = $patient_id;
		}
		# return patient_id:
		return $self->nhs_number_map->{$nhs_number};		
	}
	# else need to find best match or create new record:
	else {
		my $patient_id = $self->find_or_create_new_patient($vals);
		return $patient_id;
	}
}

# don't have an nhs_no, so find best match or create new patient & return LAST_INSERT_ID:
sub find_or_create_new_patient {
    my $self = shift;
    my $vals = shift;

    my $dbh = $self->db->{dbix4};

	my $log_file = $self->log_file;
	
	my $patient_id = 0;
	 
 	# ok, no nhs_number, see if we can find exact match on ALL pid params:	
	if ($vals->{dob} && $vals->{patno}) { # already know we have fname & lname
		{ # 1st see if we have a last_name, first_name & unit_no match with null dob:
			my $sql = q!select p.id from patients p join patient_case pc on p.id = pc.patient_id
				where unit_number = ? and last_name = ? and first_name = ? and dob is null!;
			$patient_id = $dbh->query( $sql, map $vals->{$_}, qw(patno lname fname) )->list;
			if ($patient_id) { # update dob:
				print $log_file "got $patient_id from matching details with null dob for $vals->{dbid}\n";
				$dbh->update('patients', { dob => $vals->{dob} }, {id => $patient_id});
				return $patient_id;
			}
		}

		my $middle_name =
			$vals->{mname} ?
				sprintf q!= %s!, $self->_quote_term($vals->{mname})
					: 'IS NULL';

		my $sql = sprintf q!
			SELECT p.id
			FROM patients p
				join patient_case pc on p.id = pc.patient_id
			WHERE
				last_name   = ? and
				first_name  = ? and
				middle_name  %s and
				dob         = ? and
				unit_number = ? and				
				nhs_number is null!, $middle_name; # warn $pid_sql;

		$patient_id
			= $dbh->query( $sql, map $vals->{$_}, qw(lname fname dob patno) )->list;
		if ($patient_id) {
			# print $log_file "got $patient_id from full matching details for $vals->{dbid}\n";
			return $patient_id;
		}			
	
		# next, try to get patient_id from existing combination of last_name,
		# dob & unit_no only (ie skip first_name):
		{
			my $sql = q!
				select p.id from patients p join patient_case pc on p.id = pc.patient_id
				where unit_number = ? and last_name = ? and dob = ?!;
		
			$patient_id
				= $dbh->query( $sql, map $vals->{$_}, qw(patno lname dob) )->list;
		   
			if ($patient_id) {
				print $log_file "got $patient_id from partial matching details for $vals->{dbid}\n";
				return $patient_id;
			}			
		}
	}

	# some known exceptions before we give up trying to find a match:
	if ($vals->{lname} eq 'CYCLACEL') { # cyclacels
		$patient_id = $dbh->query( q!select p.id from patients p where last_name = 
			'cyclacel' and first_name = ? and dob = ?!, $vals->{fname}, $vals->{dob})
		->list;
		return $patient_id if $patient_id;
	}
	elsif (grep $vals->{fname} eq $_, qw/LGI PIN/) { # HIV's
		$patient_id = $dbh->query( q!select p.id from patients p where last_name = ?
			and first_name = ?!, $vals->{lname}, $vals->{fname})->list;
		return $patient_id if $patient_id;		
	}
	
    # exhausted all attempts to match patient, so create new record & retrieve id:
	$patient_id = $self->_create_new_record($vals);
	# print $log_file "creating new record for $vals->{dbid}\n";
    return $patient_id;
}

sub find_or_create_new_patient_case {
    my $self = shift;
    my $data = shift;

    my $dbh = $self->db->{dbix4};

    my $case_id;

    {
    	# update any unknown hospital if patient_id & unit_number match:
		my $sql = q!SELECT pc.`id` FROM `patient_case` pc join referral_sources rs on
			pc.referral_source_id = rs.id WHERE pc.`patient_id` = ? AND
			pc.`unit_number` = ? AND rs.`organisation_code` = 'X99999'!; # unknown source

        $case_id = $dbh->query( $sql, $data->{patient_id}, $data->{unit_number} )->list;

		if ($case_id) {
			$dbh->update( 'patient_case', { referral_source_id => $data->{referral_source_id} },
				{id => $case_id} );
			# print $log_file "updating $case_id with ".$data->{referral_source_id}."\n";
		}

        return $case_id if $case_id;
	}

    {
        # update any unknown unit_numbers if patient_id & location_id match:
		my $sql = q!SELECT `id` FROM `patient_case` WHERE `patient_id` = ? AND
			`referral_source_id` = ? AND `unit_number` = 'UNKNOWN'!; # unknown source

        $case_id = $dbh->query($sql, $data->{patient_id}, $data->{referral_source_id})->list;

		if ($case_id) {
			$dbh->update( 'patient_case', { unit_number => $data->{unit_number} },
				{id => $case_id} );
			# print $log_file "updating $case_id with ".$data->{unit_number}."\n";
		}

        return $case_id if $case_id;
	}

    # failed to find matching case_id so create one:
    $dbh->insert('patient_case', $data);

    $case_id = $dbh->last_insert_id(undef, undef, 'patient_case', 'id');

    return $case_id;
}

sub get_case_id {
    my $self = shift;
    my $data = shift;

    my $sql = q!SELECT `id` FROM `patient_case` WHERE `patient_id` = ? AND
        `referral_source_id` = ? AND `unit_number` = ?!;

    my $case_id = $self->db->{dbix4}->query(
            $sql, @{$data}{ qw(patient_id referral_source_id unit_number) }
        )->list;

    return $case_id;
}

sub _create_new_record {
	my $self = shift;
	my $vals = shift;
	
	my $dbh = $self->db->{dbix4};
	
	# data for creating new patient (required):
    my %data = (
        last_name  => lc $vals->{lname},
        first_name => lc $vals->{fname},
        created_at => $vals->{pid_time},
		updated_at => $vals->{pid_time}, # or defaults to now()
    );

	# add data if exists:
	$data{middle_name} = lc $vals->{mname} if $vals->{mname};
	$data{dob} 	       = $vals->{dob}      if $vals->{dob};
    $data{gender}      = $vals->{sex}      if $vals->{sex};
    $data{nhs_number}  = $vals->{nhsno}    if $vals->{nhsno};
		
	$dbh->insert('patients', \%data); # warn Dumper \%data;
	my $patient_id = $dbh->last_insert_id(undef, undef, 'patients', 'id');
	return $patient_id;
}

sub _quote_term {
    my $self = shift;
    my $term = shift;

    return $self->db->{dbh3}->quote($term);
}

1;