• Files
• Commits
• Log
• Graph
• Stats

package AnonymisePatient;

# 'base' class for Anonymise::LIMS & Anonymise::HILIS3 - never called directly

use Moose;
use Data::Dumper;
use Config::Auto;
use FindBin qw($RealBin); # warn $RealBin;

# methods/accessors for anonymise_patient():
# TODO: combine existing_nhs_numbers & new_nhs_numbers functions - don't need both
has existing_nhs_numbers => ( is => 'ro', isa => 'ArrayRef', required => 1, auto_deref => 1 );
has all_names            => ( is => 'ro', isa => 'HashRef',  lazy_build => 1 );
has new_nhs_numbers      => ( is => 'rw', isa => 'HashRef',  default => sub { {} } );

has $_  => ( is  => 'ro', isa => 'ArrayRef', lazy_build => 1 )
    foreach qw( surnames male_names female_names first_names );

__PACKAGE__->meta->make_immutable;

sub get_substitutes {
	my $self = shift;

    my @last_names  = @{ $self->surnames };
    my @first_names = @{ $self->first_names };
    my @boys_names  = @{ $self->male_names };
    my @girls_names = @{ $self->female_names };

    my %substitutes = (
        last_names   => \@last_names,
        first_names  => \@first_names,
        male_names   => \@boys_names,
        female_names => \@girls_names,
    );

    return \%substitutes;
}

sub _build_all_names {
    my $self = shift;
	
	my $path_to_app = $self->path_to_app; # warn $path_to_app;
	
    my $names_src = "$path_to_app/setup/hilis3_convert/names.pl";
    my $names = Config::Auto::parse($names_src, format => 'perl');
    # print Dumper $names;

    return $names;
}

sub _build_surnames {
    my $self = shift;

    my $names = $self->all_names;
    return $names->{surnames};
}

sub _build_male_names {
    my $self = shift;

    my $names = $self->all_names;
    return $names->{male_names};
}

sub _build_female_names {
    my $self = shift;

    my $names = $self->all_names;
    return $names->{female_names};
}

sub _build_first_names {
    my $self = shift;

    my @boys_names  = @{ $self->male_names };
    my @girls_names = @{ $self->female_names };

    return [ @boys_names, @girls_names ];
}

# need to return unique valid 10-digit nhs_number:
sub make_nhsno {
    my $self = shift;

	my $new_nhs_number;

	TRY: while (1) { # $try++;
		my $potential_nhs_number
			= join '', map { int rand 9 } 1 .. 10; # warn $new_nhs_number;

		# try again if invalid:
		$self->_check_nhsno($potential_nhs_number) || next TRY;
		
        # try again if not unique:
		next TRY if
			$self->new_nhs_numbers->{$potential_nhs_number} ||
				grep $potential_nhs_number == $_, $self->existing_nhs_numbers;
			
		$new_nhs_number = $potential_nhs_number;
		
		# exit loop:
		last TRY;
	} # warn Dumper $new_nhs_numbers;
	
	$self->new_nhs_numbers->{$new_nhs_number}++; 
	
	return $new_nhs_number;
}

sub _check_nhsno {
    my $self  = shift;
	my $nhsno = shift; # _dump(Dumper $nhsno);

	$nhsno =~ s/\s+//g;

	return unless length $nhsno == 10; # require 10 consecutive numbers only

	my $product;

	# sum of (each of the first nine digits * weighting factor):
	for (0 .. 8) { # 1st 9 digits of NHS no
		$product += ( substr($nhsno, $_, 1) * (10 - $_) );
	}

	# Divide $product by 11 and establish the remainder. Subtract the remainder from 11 to give
	# the check digit. If the result is 11 then a check digit of 0 is used.
	my $remainder = $product % 11 ? 11 - ($product % 11) : '0';

	# If the result is 10 then the NHS NUMBER is invalid. Check the remainder matches the check
	# digit. If it does not, the NHS NUMBER is invalid.
	return $remainder == substr($nhsno, 9, 1) && $remainder != '10'; # true if NHSNo correct
}

1;