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;