#CheckNPI.pm
package NpiChecker::CheckNPI;
use base 'Exporter';
our @EXPORT_OK = qw(checkme);
our $VERSION = '0.001001'; # 0.1.1
## Created by Paul Suppo
## Purpose to check an NPI for a valid check digit.
my ( ${CALC_CHECK_DIGIT}, ${CHECK_DIGIT}, ${DIGITS},
${DIGIT_1}, ${DIGIT_2}, ${DIGIT_3},
${DIGIT_4}, ${DIGIT_5}, ${DIGIT_6},
${DIGIT_7}, ${DIGIT_8}, ${DIGIT_9},
${NEXT_HIGH_NUMBER}, ${NPI}, ${PART1},
${PART10}, ${PART11}, ${PART12},
${PART13}, ${PART14}, ${PART15},
${PART16}, ${PART17}, ${PART18},
${PART19}, ${PART2}, ${PART20},
${PART3}, ${PART4}, ${PART5},
${PART6}, ${PART7}, ${PART8},
${PART9}, ${TOTAL_1}, ${TOTAL_1_MOD},
${TOTAL_2}, ${TOTAL_2_MOD}, ${TOTAL_3},
${TOTAL_DIGITS}
);
sub VERSION{
return "Version Number:$VERSION";
}
sub checkme {
my ($NPI)=@_;
$CHECK_DIGIT = substr( $NPI, -1 );
$DIGIT_1 = substr( $NPI, 0, 1 );
$DIGIT_2 = substr( $NPI, 1, 1 );
$DIGIT_3 = substr( $NPI, 2, 1 );
$DIGIT_4 = substr( $NPI, 3, 1 );
$DIGIT_5 = substr( $NPI, 4, 1 );
$DIGIT_6 = substr( $NPI, 5, 1 );
$DIGIT_7 = substr( $NPI, 6, 1 );
$DIGIT_8 = substr( $NPI, 7, 1 );
$DIGIT_9 = substr( $NPI, 8, 1 );
##Step 1: Double the value of alternate digits, beginning with the rightmost digit.
$DIGIT_9 = ( $DIGIT_9 * 2 );
$DIGIT_7 = ( $DIGIT_7 * 2 );
$DIGIT_5 = ( $DIGIT_5 * 2 );
$DIGIT_3 = ( $DIGIT_3 * 2 );
$DIGIT_1 = ( $DIGIT_1 * 2 );
#Step 2: Add constant 24, to account for the 80840 prefix that would be present on a card issuer identifier, plus the individual digits of products of doubling, plus unaffected digits.
$DIGITS =
"$DIGIT_1$DIGIT_2$DIGIT_3$DIGIT_4$DIGIT_5$DIGIT_6$DIGIT_7$DIGIT_8$DIGIT_9";
## Combine to a string and split each individual number
$PART1 = substr( $DIGITS, 0, 1 );
$PART2 = substr( $DIGITS, 1, 1 );
$PART3 = substr( $DIGITS, 2, 1 );
$PART4 = substr( $DIGITS, 3, 1 );
$PART5 = substr( $DIGITS, 4, 1 );
$PART6 = substr( $DIGITS, 5, 1 );
$PART7 = substr( $DIGITS, 6, 1 );
$PART8 = substr( $DIGITS, 7, 1 );
$PART9 = substr( $DIGITS, 8, 1 );
$PART10 = substr( $DIGITS, 9, 1 );
$PART11 = substr( $DIGITS, 10, 1 );
$PART12 = substr( $DIGITS, 11, 1 );
$PART13 = substr( $DIGITS, 12, 1 );
$PART14 = substr( $DIGITS, 13, 1 );
$PART15 = substr( $DIGITS, 14, 1 );
$PART16 = substr( $DIGITS, 15, 1 );
$PART17 = substr( $DIGITS, 16, 1 );
$PART18 = substr( $DIGITS, 17, 1 );
$PART19 = substr( $DIGITS, 18, 1 );
$PART20 = substr( $DIGITS, 19, 1 );
$TOTAL_DIGITS =
( 24
+ $PART1 + $PART2 + $PART3 + $PART4 + $PART5 + $PART6 + $PART7
+ $PART8 + $PART9 + $PART10 + $PART11 + $PART12 + $PART13 + $PART14
+ $PART15 + $PART16 + $PART17 + $PART18 + $PART19
+ $PART20 );
#Step 3: Subtract from next higher number ending in zero.
## if $TOTAL_DIGITS ends in 0
if ( substr( $TOTAL_DIGITS, -1 ) == 0 ) {
$NEXT_HIGH_NUMBER = $TOTAL_DIGITS;
} else {
## if $TOTAL_DIGITS DOES NOT end in 0
if ( $TOTAL_DIGITS >= 100 ) {
$TOTAL_1 = substr( $TOTAL_DIGITS, 0, 1 );
$TOTAL_2 = substr( $TOTAL_DIGITS, 1, 1 );
$TOTAL_3 = 0;
$TOTAL_2_MOD = ( $TOTAL_2 + 1 );
$NEXT_HIGH_NUMBER = "$TOTAL_1$TOTAL_2_MOD$TOTAL_3";
}
if ( $TOTAL_DIGITS < 100 ) {
$TOTAL_1 = substr( $TOTAL_DIGITS, 0, 1 );
$TOTAL_2 = 0;
$TOTAL_1_MOD = ( $TOTAL_1 + 1 );
$NEXT_HIGH_NUMBER = "$TOTAL_1_MOD$TOTAL_2";
}
}
$CALC_CHECK_DIGIT = ( $NEXT_HIGH_NUMBER - $TOTAL_DIGITS );
#Step 4: Check that the calculated check digit equals the NPI Check digit, if matches good NPI, if not then BAD
#print "$CALC_CHECK_DIGIT:$CHECK_DIGIT\n";
if ( $CALC_CHECK_DIGIT == $CHECK_DIGIT ) {
return "PASS";
} else {
return "FAIL";
}
};
1;
__END__
=pod
=head1 NAME
strictures - turn on strict and make all warnings fatal
=head1 SYNOPSIS
use NpiChecker::CheckNPI("checkme");
=head1 DESCRIPTION
The checkme routine of the CheckNPI module will take a HealthCare professional National Provider Identification number
and perform the Luan checkdigit algorthem to ensure that the check digit calculates and validates against the core NPI.
This module WILL NOT validate if the number is a valid assigned number or that the number is for a particular provider,
ONLY that the NPI is a valid NPI number per the check digit calculation.
This module will return either a "PASS" or "FAIL" which should be read by your main script as the status value of the check.
=head2 SYNOPSIS
The use of this module in a script should be implemented as:
my $result1=checkme(${NPI_TO_CHECK});
foreach ($result1)
{
print "Debug: My NPI Check Result is:$result1 When checking the NPI Number:${NPI_TO_CHECK}\n";
if ( $result1 =~ /PASS/ )
{
print "The NPI: ${NPI_TO_CHECK} passes the check digit routine.\n"
};
if ( $result1 =~ /FAIL/ )
{
print "The NPI: ${NPI_TO_CHECK} failed the check digit routine.\n"
};
=head2 Prerequisites
Outside of Perl itself, there are no prerequisites.
=head1 Installation
Installation is very simple, simply take this perl module package and 'plop' it into your directory structure where @INC will see it.
There is no configuration required and will work on all platforms as is.
=head2 KNOWN ISSUES
There are not any known issues at this time.
=head1 AUTHOR
pas - Paul A. Suppo, Jr. (cpan:PSUPPO)
=head1 COPYRIGHT
Copyright (c) 2014 Paul A. Suppo, Jr., all rights reserved.
=head1 LICENSE
This library is free software and may be distributed under the same terms
as perl itself.
=cut