MPIFSPC ;SLC/ARS-MASTER PATIENT INDEX SYSTEM CHECK SUM RTN ;SEP 4, 1996
;;1.0; MASTER PATIENT INDEX VISTA ;**48**;30 Apr 99;Build 6
;MPICHECK
CHECKDG(NUM) ;Check Digit Calculation
;change to local array of MPI global.
;D EXIN **48 CHANGE TO FUNCTION CALL
;K I,J,LTH,MPID,MPIMAP,MPIT,TAB,VAL
N TMP
S TMP=$$EXIN(NUM)
Q TMP
READ ;
;
EXIN(NUM) ;**48 MADE THIS A FUNCTION CALL
N SUM,I,J,LTH,MPID,MPIMAP,MPIT,TAB,VAL
I $L(NUM)'=16 D
.; W !,"I WILL PAD TO 16!"
.S LTH=($L(NUM)+1) F I=LTH:1:16 S NUM="0"_NUM
F MPIT=1:1:6 D
.; For each check digit, compute a value
.F MPID=1:1:16 D
..S MPIMAP(MPIT,0,"MAP")=0
..S MPIMAP(MPIT,MPID)=$E(NUM,MPID),VAL=MPIMAP(MPIT,MPID)
..S SUM=(MPIMAP(MPIT,MPID)+(MPIMAP(MPIT,MPID-1,"MAP")))#10
..S MPIMAP(MPIT,MPID,"MAP")=$P($P(^MPIF(984.5,MPIT,SUM),"^",2),";",MPID)
.S TAB(MPIT)=MPIMAP(MPIT,16,"MAP")
.;Q
S SUM=""
F J=1:1:6 D
.S SUM=SUM_TAB(J)
Q SUM
;
;Before calculation of check digits the number must be
;expanded to sixteen digits by padding zeros to the
;left of the number.
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFSPC 1070 printed Dec 13, 2024@02:11:45 Page 2
MPIFSPC ;SLC/ARS-MASTER PATIENT INDEX SYSTEM CHECK SUM RTN ;SEP 4, 1996
+1 ;;1.0; MASTER PATIENT INDEX VISTA ;**48**;30 Apr 99;Build 6
+2 ;MPICHECK
CHECKDG(NUM) ;Check Digit Calculation
+1 ;change to local array of MPI global.
+2 ;D EXIN **48 CHANGE TO FUNCTION CALL
+3 ;K I,J,LTH,MPID,MPIMAP,MPIT,TAB,VAL
+4 NEW TMP
+5 SET TMP=$$EXIN(NUM)
+6 QUIT TMP
READ ;
+1 ;
EXIN(NUM) ;**48 MADE THIS A FUNCTION CALL
+1 NEW SUM,I,J,LTH,MPID,MPIMAP,MPIT,TAB,VAL
+2 IF $LENGTH(NUM)'=16
Begin DoDot:1
+3 ; W !,"I WILL PAD TO 16!"
+4 SET LTH=($LENGTH(NUM)+1)
FOR I=LTH:1:16
SET NUM="0"_NUM
End DoDot:1
+5 FOR MPIT=1:1:6
Begin DoDot:1
+6 ; For each check digit, compute a value
+7 FOR MPID=1:1:16
Begin DoDot:2
+8 SET MPIMAP(MPIT,0,"MAP")=0
+9 SET MPIMAP(MPIT,MPID)=$EXTRACT(NUM,MPID)
SET VAL=MPIMAP(MPIT,MPID)
+10 SET SUM=(MPIMAP(MPIT,MPID)+(MPIMAP(MPIT,MPID-1,"MAP")))#10
+11 SET MPIMAP(MPIT,MPID,"MAP")=$PIECE($PIECE(^MPIF(984.5,MPIT,SUM),"^",2),";",MPID)
End DoDot:2
+12 SET TAB(MPIT)=MPIMAP(MPIT,16,"MAP")
+13 ;Q
End DoDot:1
+14 SET SUM=""
+15 FOR J=1:1:6
Begin DoDot:1
+16 SET SUM=SUM_TAB(J)
End DoDot:1
+17 QUIT SUM
+18 ;
+19 ;Before calculation of check digits the number must be
+20 ;expanded to sixteen digits by padding zeros to the
+21 ;left of the number.
