Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCHUEI

PRCHUEI.m

Go to the documentation of this file.
  1. PRCHUEI ;OI&T/LKG -Routine for testing ;1/21/22 12:04
  1. ;;5.1;IFCAP;**227**;Oct 20, 2000;Build 1
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. VALIDUEI(PRCSTR) ; Returns '1' if UEI is valid and '0' if not
  1. N PRCVALID S PRCVALID=0
  1. I PRCSTR'?12UN Q 0
  1. I $E(PRCSTR)="0" Q 0
  1. I PRCSTR["O" Q 0
  1. I PRCSTR["I" Q 0
  1. I $E(PRCSTR,12)=$$UEICHK(PRCSTR) S PRCVALID=1 ; Valid if checksums match
  1. Q PRCVALID
  1. ;
  1. UEICHK(PRCROOT) ; Calculates checksum
  1. N PRCI,PRCJ,PRCLEN,PRCSUM,PRCVAL
  1. S PRCLEN=11 ; Consider the initial 11 characters of the GSA Unique Entity Identifier; the 12th character is the checksum digit to be calculated
  1. F PRCI=1:1 D Q:PRCSUM?1N ; Repeat the calculation until a single digit value has been calculated
  1. . S PRCSUM=0
  1. . F PRCJ=1:1:PRCLEN D ; Go down the length of the string to extract each character for processing
  1. . . S PRCVAL=$E(PRCROOT,PRCJ) S:PRCI=1 PRCVAL=$A(PRCVAL) ; use the ASCII code value for characters in initial string but not sums
  1. . . S PRCVAL=(PRCVAL*PRCJ)#10 ; Calculate modulo 10 of product value times position
  1. . . S PRCSUM=PRCSUM+PRCVAL ; Sum up the modulo values
  1. . S PRCROOT=PRCSUM,PRCLEN=$L(PRCROOT) ; The sum is the new string to process
  1. Q PRCROOT ; Function returning the calculated checksum digit