PRCHUEI.m

PRCHUEI ;OI&T/LKG -Routine for testing ;1/21/22  12:04

 ;;5.1;IFCAP;**227**;Oct 20, 2000;Build 1

 ;Per VA Directive 6402, this routine should not be modified.

VALIDUEI(PRCSTR) ; Returns '1' if UEI is valid and '0' if not

 N PRCVALID S PRCVALID=0

 I PRCSTR'?12UN Q 0

 I $E(PRCSTR)="0" Q 0

 I PRCSTR["O" Q 0

 I PRCSTR["I" Q 0

 I $E(PRCSTR,12)=$$UEICHK(PRCSTR) S PRCVALID=1 ; Valid if checksums match

 Q PRCVALID

 ;

UEICHK(PRCROOT) ; Calculates checksum

 N PRCI,PRCJ,PRCLEN,PRCSUM,PRCVAL

 S PRCLEN=11 ; Consider the initial 11 characters of the GSA Unique Entity Identifier; the 12th character is the checksum digit to be calculated

 F PRCI=1:1 D  Q:PRCSUM?1N  ; Repeat the calculation until a single digit value has been calculated

 . S PRCSUM=0

 . F PRCJ=1:1:PRCLEN D  ; Go down the length of the string to extract each character for processing

 . . S PRCVAL=$E(PRCROOT,PRCJ) S:PRCI=1 PRCVAL=$A(PRCVAL) ; use the ASCII code value for characters in initial string but not sums

 . . S PRCVAL=(PRCVAL*PRCJ)#10 ; Calculate modulo 10 of product value times position

 . . S PRCSUM=PRCSUM+PRCVAL ; Sum up the modulo values

 . S PRCROOT=PRCSUM,PRCLEN=$L(PRCROOT) ; The sum is the new string to process

 Q PRCROOT ; Function returning the calculated checksum digit

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCHUEI   1278     printed  Apr 09, 2024@21:20:43                                                                                                                                                                                                     Page 2

PRCHUEI   ;OI&T/LKG -Routine for testing ;1/21/22  12:04

 +1       ;;5.1;IFCAP;**227**;Oct 20, 2000;Build 1

 +2       ;Per VA Directive 6402, this routine should not be modified.

VALIDUEI(PRCSTR) ; Returns '1' if UEI is valid and '0' if not

 +1        NEW PRCVALID

           SET PRCVALID=0

 +2        IF PRCSTR'?12UN

               QUIT 0

 +3        IF $EXTRACT(PRCSTR)="0"

               QUIT 0

 +4        IF PRCSTR["O"

               QUIT 0

 +5        IF PRCSTR["I"

               QUIT 0

 +6       ; Valid if checksums match

           IF $EXTRACT(PRCSTR,12)=$$UEICHK(PRCSTR)

               SET PRCVALID=1

 +7        QUIT PRCVALID

 +8       ;

UEICHK(PRCROOT) ; Calculates checksum

 +1        NEW PRCI,PRCJ,PRCLEN,PRCSUM,PRCVAL

 +2       ; Consider the initial 11 characters of the GSA Unique Entity Identifier; the 12th character is the checksum digit to be calculated

           SET PRCLEN=11

 +3       ; Repeat the calculation until a single digit value has been calculated

           FOR PRCI=1:1

               Begin DoDot:1

 +4                SET PRCSUM=0

 +5       ; Go down the length of the string to extract each character for processing

                   FOR PRCJ=1:1:PRCLEN

                       Begin DoDot:2

 +6       ; use the ASCII code value for characters in initial string but not sums

                           SET PRCVAL=$EXTRACT(PRCROOT,PRCJ)

                           if PRCI=1

                               SET PRCVAL=$ASCII(PRCVAL)

 +7       ; Calculate modulo 10 of product value times position

                           SET PRCVAL=(PRCVAL*PRCJ)#10

 +8       ; Sum up the modulo values

                           SET PRCSUM=PRCSUM+PRCVAL

                       End DoDot:2

 +9       ; The sum is the new string to process

                   SET PRCROOT=PRCSUM

                   SET PRCLEN=$LENGTH(PRCROOT)

               End DoDot:1

               if PRCSUM?1N

                   QUIT 

 +10      ; Function returning the calculated checksum digit

           QUIT PRCROOT