<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#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 &gt;= 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 &lt; 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) &lt;psuppo@cpan.org&gt;

=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
</pre></body></html>