- 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 Feb 18, 2025@23:38:01 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.