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
