AZHRDEMO.m

AZHRDEMO ;SANITIZE VA PATIENT FILE [ 04/25/90  9:21 AM ]

 ;MODIFIED ^AZHDDEMO ROUTINE; IHS/DRPMS/RAW 4/20/90

 ;Modified to translate Vowels only in name changes; RAW/DRPMS; 4/16/90

 ;Modified for cities within New Mexico RFD 8-3-88

 ;Modified to kill SSN indexes and change SSN to different number RFD 3-20-89

 ;Modified to translate the patient name RFD/CMB 3-21-89

 W !!,"You can't enter this routine at the top"

 Q 

START ;

 W !!,"All the Last Names of the Patient, both Parents, EOC, NOK"

 W !,"and Other Names will translated (Vowels Only)."

 W !,"First Names will be randomly selected from a table generated"

 W !,"from the VA Patient file, (10% of Total Patients)."

 W !,"Addresses and Cities will also be randomly selected from a"

 W !,"table generated.  The City table will be composed of all the"

 W !,"Communities within the State determined by the Site entered"

 W !,"in the RPMS SITE file."

 W !!,"This routine will sanitize ^DPT by replacing all names, other names,",!,"parents names and mailing addresses with randomly generated substitutes."

 W !,"Will also change the SSN stored in DPT and kill off all indexes set by the SSN data.",!

 W !!,"Do you want to CONTINUE? NO//" R ANS:60

 I ANS=""!(ANS="NO")!(ANS="N") G END

 D INIT

 S DFN=0 F  S DFN=$O(^DPT(DFN)) Q:DFN'=+DFN  D MAIN

 D END

 Q

INIT ;

 S (MF,SSNMOD,SSN)="",U="^"

 K ^DPT("BS"),^DPT("BS5"),^DPT("SSN"),^AZHRRAND

 S FROM="AEIOUY",TO="EAYUOI"

 D ^AZHRDEM1

 S STCOD=$P(^AUTTLOC(DUZ(2),0),U,14),ZIP=$P(^AUTTLOC(DUZ(2),0),U,15)

 Q

MAIN ;

 S MF=$P(^DPT(DFN,0),U,2) 

 D PNAME 

 D:$D(^DPT(DFN,.24)) PARENTS 

 D CTST D OTHNAME D SSN 

 D:$D(^DPT(DFN,.33)) EMERCON 

 D:$D(^DPT(DFN,.21)) NOK

 Q

PNAME ;EDIT OF PATIENTS NAME

 S AZHRDIC="^DPT("_DFN_",0)",K=1,J=1

 I MF="F" D FEMALEL

 I MF="M" D MALEL

 S DA=DFN,DIE="^DPT(",DR=".01///"_NAME D ^DIE

 W !!,NAME,?30,DFN

 Q

PARENTS ;

 S AZHRDIC="^DPT("_DFN_",.24)",K=1,J=3,FATHER="",MOTHER=""

 D MALEL S:MLN'="" FATHER=NAME

 D FEMALEL S:FLN'="" MOTHER=NAME

 S ^DPT(DFN,.24)=FATHER_"^^"_MOTHER

 W !,?5,FATHER,!,?5,MOTHER

 Q

CTST ;

 D ADDR

 S ^DPT(DFN,.11)=ADDR_"^^^"_CITY_"^"_STCOD_"^"_ZIP

 W !,?5,ADDR,!,?5,CITY," ,",STCOD," ",ZIP

 Q

OTHNAME ;

 S OTDFN=0 F L=0:0 S OTDFN=$O(^DPT(DFN,.01,OTDFN)) Q:OTDFN'=+OTDFN  S AZHRDIC="^DPT("_DFN_",.01,"_OTDFN_",0)",J=1,K=1 D:MF="F" FEMALEL D:MF="M" MALEL D OTHDIE

 Q

OTHDIE ;

 S DA=OTDFN,DIE="^DPT("_DFN_",.01,",DA(1)=DFN,DR=".01///"_NAME D ^DIE

 W !,?5,NAME

 Q

SSN ;TAG TO SANITIZE THE SSN OF PATIENT

 S SSN=$P(^DPT(DFN,0),U,9) Q:SSN=""

 S SSNMOD=SSN S SSN=$E(SSNMOD,1,3) F I=9:-1:4 S SSN=SSN_$E(SSNMOD,I,I)

 S DA=DFN,DIE="^DPT(",DR=".09///"_SSN D ^DIE

 W !,?5,SSN

 Q

EMERCON ;

 S AZHRDIC="^DPT("_DFN_",.33)",K=1,J=1

 D FEMALEL,ADDR Q:FLN=""

 S X(1)=NAME,X(3)=ADDR,X(6)=CITY,X(7)=STCOD,X(8)=ZIP

 W !,?5,NAME,!,?5,ADDR,!,?5,CITY," ,",STCOD," ",ZIP

 F I=1,3,6,7,8 S $P(^DPT(DFN,.33),U,I)=X(I)

 Q

NOK ;

 S AZHRDIC="^DPT("_DFN_",.21)",K=1,J=1

 D MALEL,ADDR Q:MLN=""

 S X(1)=NAME,X(3)=ADDR,X(6)=CITY,X(7)=STCOD,X(8)=ZIP

 W !,?5,NAME,!,?5,ADDR,!,?5,CITY," ,",STCOD," ",ZIP

 F I=1,3,6,7,8 S $P(^DPT(DFN,.21),U,I)=X(I)

 Q

FEMALEL ;

 S LN1=$P($P(@AZHRDIC,U,J),",",1)

 S FLN=$TR(LN1,FROM,TO)

 S X=^AZHRRAND("F",0)-1,FFN=^AZHRRAND("F",$R(X)+1)

 S NAME=FLN_","_FFN

 Q

MALEL ;

 S LN1=$P($P(@AZHRDIC,U,K),",",1)

 S MLN=$TR(LN1,FROM,TO)

 S X=^AZHRRAND("M",0)-1,MFN=^AZHRRAND("M",$R(X)+1)

 S NAME=MLN_","_MFN

 Q

ADDR ;

 S X=^AZHRRAND("A",0)-1,ADDR=^AZHRRAND("A",$R(X)+1)

 S X=^AZHRRAND("S",0)-1,CITY=^AZHRRAND("S",$R(X)+1)

 Q

END ;END OF ROUTINE

 K MF,SSN,SSNMOD,LN,LN1,FROM,TO,MOTHER,FATHER,DFN,OTDFN,CITY,ADDR,ANS,FFN,FLN,L,MFN,MLN,NAME,STCOD,X,AZHRDIC,I,J,K,ZIP

 K ^DPT("BS"),^DPT("BS5"),^DPT("SSN"),^AZHRRAND

 W !!,"End of routine to sanitize Demo database"

 Q

AZHRDEMO  ;SANITIZE VA PATIENT FILE [ 04/25/90  9:21 AM ]

 +1       ;MODIFIED ^AZHDDEMO ROUTINE; IHS/DRPMS/RAW 4/20/90

 +2       ;Modified to translate Vowels only in name changes; RAW/DRPMS; 4/16/90

 +3       ;Modified for cities within New Mexico RFD 8-3-88

 +4       ;Modified to kill SSN indexes and change SSN to different number RFD 3-20-89

 +5       ;Modified to translate the patient name RFD/CMB 3-21-89

 +6        WRITE !!,"You can't enter this routine at the top"

 +7        QUIT 

START     ;

 +1        WRITE !!,"All the Last Names of the Patient, both Parents, EOC, NOK"

 +2        WRITE !,"and Other Names will translated (Vowels Only)."

 +3        WRITE !,"First Names will be randomly selected from a table generated"

 +4        WRITE !,"from the VA Patient file, (10% of Total Patients)."

 +5        WRITE !,"Addresses and Cities will also be randomly selected from a"

 +6        WRITE !,"table generated.  The City table will be composed of all the"

 +7        WRITE !,"Communities within the State determined by the Site entered"

 +8        WRITE !,"in the RPMS SITE file."

 +9        WRITE !!,"This routine will sanitize ^DPT by replacing all names, other names,",!,"parents names and mailing addresses with randomly generated substitutes."

 +10       WRITE !,"Will also change the SSN stored in DPT and kill off all indexes set by the SSN data.",!

 +11       WRITE !!,"Do you want to CONTINUE? NO//"

           READ ANS:60

 +12       IF ANS=""!(ANS="NO")!(ANS="N")

               GOTO END

 +13       DO INIT

 +14       SET DFN=0

           FOR 

               SET DFN=$ORDER(^DPT(DFN))

               IF DFN'=+DFN

                   QUIT 

               DO MAIN

 +15       DO END

 +16       QUIT 

INIT      ;

 +1        SET (MF,SSNMOD,SSN)=""

           SET U="^"

 +2        KILL ^DPT("BS"),^DPT("BS5"),^DPT("SSN"),^AZHRRAND

 +3        SET FROM="AEIOUY"

           SET TO="EAYUOI"

 +4        DO ^AZHRDEM1

 +5        SET STCOD=$PIECE(^AUTTLOC(DUZ(2),0),U,14)

           SET ZIP=$PIECE(^AUTTLOC(DUZ(2),0),U,15)

 +6        QUIT 

MAIN      ;

 +1        SET MF=$PIECE(^DPT(DFN,0),U,2)

 +2        DO PNAME

 +3        IF $DATA(^DPT(DFN,.24))

               DO PARENTS

 +4        DO CTST

           DO OTHNAME

           DO SSN

 +5        IF $DATA(^DPT(DFN,.33))

               DO EMERCON

 +6        IF $DATA(^DPT(DFN,.21))

               DO NOK

 +7        QUIT 

PNAME     ;EDIT OF PATIENTS NAME

 +1        SET AZHRDIC="^DPT("_DFN_",0)"

           SET K=1

           SET J=1

 +2        IF MF="F"

               DO FEMALEL

 +3        IF MF="M"

               DO MALEL

 +4        SET DA=DFN

           SET DIE="^DPT("

           SET DR=".01///"_NAME

           DO ^DIE

 +5        WRITE !!,NAME,?30,DFN

 +6        QUIT 

PARENTS   ;

 +1        SET AZHRDIC="^DPT("_DFN_",.24)"

           SET K=1

           SET J=3

           SET FATHER=""

           SET MOTHER=""

 +2        DO MALEL

           IF MLN'=""

               SET FATHER=NAME

 +3        DO FEMALEL

           IF FLN'=""

               SET MOTHER=NAME

 +4        SET ^DPT(DFN,.24)=FATHER_"^^"_MOTHER

 +5        WRITE !,?5,FATHER,!,?5,MOTHER

 +6        QUIT 

CTST      ;

 +1        DO ADDR

 +2        SET ^DPT(DFN,.11)=ADDR_"^^^"_CITY_"^"_STCOD_"^"_ZIP

 +3        WRITE !,?5,ADDR,!,?5,CITY," ,",STCOD," ",ZIP

 +4        QUIT 

OTHNAME   ;

 +1        SET OTDFN=0

           FOR L=0:0

               SET OTDFN=$ORDER(^DPT(DFN,.01,OTDFN))

               IF OTDFN'=+OTDFN

                   QUIT 

               SET AZHRDIC="^DPT("_DFN_",.01,"_OTDFN_",0)"

               SET J=1

               SET K=1

               IF MF="F"

                   DO FEMALEL

               IF MF="M"

                   DO MALEL

               DO OTHDIE

 +2        QUIT 

OTHDIE    ;

 +1        SET DA=OTDFN

           SET DIE="^DPT("_DFN_",.01,"

           SET DA(1)=DFN

           SET DR=".01///"_NAME

           DO ^DIE

 +2        WRITE !,?5,NAME

 +3        QUIT 

SSN       ;TAG TO SANITIZE THE SSN OF PATIENT

 +1        SET SSN=$PIECE(^DPT(DFN,0),U,9)

           IF SSN=""

               QUIT 

 +2        SET SSNMOD=SSN

           SET SSN=$EXTRACT(SSNMOD,1,3)

           FOR I=9:-1:4

               SET SSN=SSN_$EXTRACT(SSNMOD,I,I)

 +3        SET DA=DFN

           SET DIE="^DPT("

           SET DR=".09///"_SSN

           DO ^DIE

 +4        WRITE !,?5,SSN

 +5        QUIT 

EMERCON   ;

 +1        SET AZHRDIC="^DPT("_DFN_",.33)"

           SET K=1

           SET J=1

 +2        DO FEMALEL

           DO ADDR

           IF FLN=""

               QUIT 

 +3        SET X(1)=NAME

           SET X(3)=ADDR

           SET X(6)=CITY

           SET X(7)=STCOD

           SET X(8)=ZIP

 +4        WRITE !,?5,NAME,!,?5,ADDR,!,?5,CITY," ,",STCOD," ",ZIP

 +5        FOR I=1,3,6,7,8

               SET $PIECE(^DPT(DFN,.33),U,I)=X(I)

 +6        QUIT 

NOK       ;

 +1        SET AZHRDIC="^DPT("_DFN_",.21)"

           SET K=1

           SET J=1

 +2        DO MALEL

           DO ADDR

           IF MLN=""

               QUIT 

 +3        SET X(1)=NAME

           SET X(3)=ADDR

           SET X(6)=CITY

           SET X(7)=STCOD

           SET X(8)=ZIP

 +4        WRITE !,?5,NAME,!,?5,ADDR,!,?5,CITY," ,",STCOD," ",ZIP

 +5        FOR I=1,3,6,7,8

               SET $PIECE(^DPT(DFN,.21),U,I)=X(I)

 +6        QUIT 

FEMALEL   ;

 +1        SET LN1=$PIECE($PIECE(@AZHRDIC,U,J),",",1)

 +2        SET FLN=$TRANSLATE(LN1,FROM,TO)

 +3        SET X=^AZHRRAND("F",0)-1

           SET FFN=^AZHRRAND("F",$RANDOM(X)+1)

 +4        SET NAME=FLN_","_FFN

 +5        QUIT 

MALEL     ;

 +1        SET LN1=$PIECE($PIECE(@AZHRDIC,U,K),",",1)

 +2        SET MLN=$TRANSLATE(LN1,FROM,TO)

 +3        SET X=^AZHRRAND("M",0)-1

           SET MFN=^AZHRRAND("M",$RANDOM(X)+1)

 +4        SET NAME=MLN_","_MFN

 +5        QUIT 

ADDR      ;

 +1        SET X=^AZHRRAND("A",0)-1

           SET ADDR=^AZHRRAND("A",$RANDOM(X)+1)

 +2        SET X=^AZHRRAND("S",0)-1

           SET CITY=^AZHRRAND("S",$RANDOM(X)+1)

 +3        QUIT 

END       ;END OF ROUTINE

 +1        KILL MF,SSN,SSNMOD,LN,LN1,FROM,TO,MOTHER,FATHER,DFN,OTDFN,CITY,ADDR,ANS,FFN,FLN,L,MFN,MLN,NAME,STCOD,X,AZHRDIC,I,J,K,ZIP

 +2        KILL ^DPT("BS"),^DPT("BS5"),^DPT("SSN"),^AZHRRAND

 +3        WRITE !!,"End of routine to sanitize Demo database"

 +4        QUIT