- 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 ---[H[J[2J[HPRCHUEI 1278 printed Feb 18, 2025@23:37:45 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