XBSAN	;IHS/ITSC/LAB/FJE;SANITIZE RPMS DATABASE; [ 01/29/2004  11:10 AM ]
	;;4.0;XB;;Jul 20, 2009;Build 2
	W !,"This routine sanitizes and deletes RPMS data.  To use you must type:  D START^XBSAN",!!
	Q
START	;
	S (XBDUZ,XBDEL,XBPAT,XBPHR,XBBH,XBCHR,XBPOS,XB3PB,XBAR,XBLAB,XBMMDEL,XBAUDEL,XBNCDEL)=0
	K ^XTMP("SAN")
	S ^XTMP("SAN","LASTDFN")=0
	W !,"This routine will first sanitize AND randomize the NEW PERSON file in the RPMS database."
	S DIR(0)="Y",DIR("A")="Do you want to convert the new person data?",DIR("B")="N" KILL DA D ^DIR KILL DIR
	S:Y=1 XBDUZ=1
	W !,"This routine will then REMOVE/DELETE UNNEEDED PATIENT DATA in the RPMS database."
	S DIR(0)="Y",DIR("A")="Do you want this data deleted?",DIR("B")="N" KILL DA D ^DIR KILL DIR
	S:Y=1 XBDEL=1
	W !!,"This routine will then sanitize the PATIENT FILES of a RPMS database."
	S DIR(0)="Y",DIR("A")="Do you want to convert the patient data",DIR("B")="N" KILL DA D ^DIR KILL DIR
	S:Y=1 XBPAT=1
	W !!,"This routine will then sanitize the POLICY HOLDER FILE of a RPMS database."
	S DIR(0)="Y",DIR("A")="Do you want to convert the POLICY HOLDER data?",DIR("B")="N" KILL DA D ^DIR KILL DIR
	S:Y=1 XBPHR=1
	W !!,"This routine will then delete SENSITIVE CHR DATA from a RPMS database."
	S DIR(0)="Y",DIR("A")="Do you want to delete this CHR patient data?",DIR("B")="N" KILL DA D ^DIR KILL DIR
	S:Y=1 XBCHR=1
	W !!,"This routine will then delete SENSITIVE BH VERSION 3.0 COMPLIANT DATA from a RPMS database."
	S DIR(0)="Y",DIR("A")="Do you want to delete this CHR patient data?",DIR("B")="N" KILL DA D ^DIR KILL DIR
	S:Y=1 XBBH=1
	W !,"This routine will then REMOVE/DELETE UNNEEDED POS DATA in the RPMS database."
	S DIR(0)="Y",DIR("A")="Do you want this data deleted?",DIR("B")="N" KILL DA D ^DIR KILL DIR
	S:Y=1 XBPOS=1
	W !,"This routine will then REMOVE/DELETE UNNEEDED 3PB DATA in the RPMS database."
	S DIR(0)="Y",DIR("A")="Do you want this data deleted?",DIR("B")="N" KILL DA D ^DIR KILL DIR
	S:Y=1 XB3PB=1
	W !,"This routine will then REMOVE/DELETE UNNEEDED AR DATA in the RPMS database."
	S DIR(0)="Y",DIR("A")="Do you want this data deleted?",DIR("B")="N" KILL DA D ^DIR KILL DIR
	S:Y=1 XBAR=1
	W !,"This routine will then REMOVE/DELETE UNNEEDED LAB DATA in the RPMS database."
	S DIR(0)="Y",DIR("A")="Do you want this data deleted?",DIR("B")="N" KILL DA D ^DIR KILL DIR
	S:Y=1 XBLAB=1
	W !,"This routine will then REMOVE/DELETE MAILMAN MESSAGES in the RPMS database."
	S DIR(0)="Y",DIR("A")="Do you want this data deleted?",DIR("B")="N" KILL DA D ^DIR KILL DIR
	S:Y=1 XBMMDEL=1
	W !,"This routine will then REMOVE/DELETE AUDIT DATA in the RPMS database."
	S DIR(0)="Y",DIR("A")="Do you want this data deleted?",DIR("B")="N" KILL DA D ^DIR KILL DIR
	S:Y=1 XBAUDEL=1
	W !,"This routine will then REMOVE/DELETE NAME COMPONENTS in the RPMS database."
	S DIR(0)="Y",DIR("A")="Do you want this data deleted?",DIR("B")="N" KILL DA D ^DIR KILL DIR
	S:Y=1 XBNCDEL=1
	W !,"All failed fileman update data can be found in: ^XTMP(""SAN"",""FAILURE"", GLOBAL"
	W !,"?? display usually means that there was a fileman update failure"
	W !,"If a hard error like an UNDEFINED occurs during the Patient scrambling,"
	W !,"   you can restart at the next patient by typing:  RESTART^XBSAN    "
	W !,"This routine does not purge HL7, or ARMS data."
	W !,"When finished...don't forget to manually address the above and RENAME Institutions",!!
	W !!,"This routine is about to scramble the RPMS database."
	S DIR(0)="Y",DIR("A")="Last chance: Do you want your RPMS data SANITIZED?",DIR("B")="N" KILL DA D ^DIR KILL DIR
	Q:Y'=1
	D ^XBKVAR
	W !,"Collecting random names" D CLEAN
	I XBDUZ W !,"SCRAMBLING FILE 200" D DUZ
	I XBDEL W !,"DELETING PAT INFO" D PATDEL
RESTART	;WILL RESTART PAT SCRAMBLE IF HARD ERROR OCCURS
	I $G(^XTMP("SAN","LASTDFN"))>0 S ^XTMP("SAN","FAILURE","PATDFN",^XTMP("SAN","LASTDFN"))=""
	I XBPAT W !,"SCRAMBLING PAT FILE" D PAT
	I XBPHR W !,"SCRAMBLING POLICY FILE" D PHR
	I XBCHR W !,"SCRAMBLING CHR FILE" D CHR
	I XBBH W !,"DELETING BH INFO" D BH
	I XBPOS W !,"DELETING POS INFO" D POSDEL
	I XB3PB W !,"SCRAMBLING 3PB FILE" D TPB
	I XBAR W !,"SCRAMBLING AR FILE" D AR
	I XBLAB W !,"SCRAMBLING LAB FILES" D LAB
	I XBMMDEL W !,"DELETING MAILMAN MESSAGES" D MMDEL
	I XBAUDEL W !,"DELETING AUDIT DATA" D AUDEL
	I XBNCDEL W !,"DELETING NAME COMPONENTS" D NCDEL
	D PAT2
	S ^XTMP("SAN","PROCESS","XBSAN")="FINISHED"
	W !,"FINISHED"
	D LISTE
	D EOJ
	Q
	;
PAT	D ^XBKVAR
	S XBCHART=100000
	S DFN=+$G(^XTMP("SAN","LASTDFN")) I DFN W !,"RESTARTING PATIENT SCRAMBLE AFTER "_DFN,!
	F  S DFN=$O(^DPT(DFN)) Q:DFN'=+DFN  D PROCPAT
	S ^XTMP("SAN","PROCESS","PAT")="FINISHED"
	Q
	;
PAT2	D ^XBKVAR
	S XBCHART=100000
	W !,"RETRYING FAILED PATIENTS",!
	S DFN=0 F  S DFN=$O(^XTMP("SAN","FAILURE","PATNAME",DFN)) Q:DFN'=+DFN  D
	.S Y=DFN D ^AUPNPAT
	.S XBSCR=$S(AUPNSEX="M":3,1:2)
	.D FNAME
	.D LNAME
	.S XBNAME=XBLNAME_","_XBFNAME
	.S DA=DFN,DIE="^DPT(",DR=".01///"_XBNAME D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","PATNAME2",DFN)="" W !,$P(^DPT(DFN,0),U,1),"  ",XBNAME
	.D ^XBFMK
	S ^XTMP("SAN","PROCESS","PAT")="FINISHED"
	Q
CHR	;
	S X=0 F  S X=$O(^BCHR(X)) Q:X'=+X  K ^BCHR(X,51),^BCHR(X,61),^BCHR(X,71)
	S ^XTMP("SAN","PROCESS","CHR")="FINISHED"
	Q
BH	;version 3.0 compliant only
	S X=0 F  S X=$O(^AMHREC(X)) Q:X'=+X  K ^AMHREC(X,31),^AMHREC(X,81),^AMHREC(X,21)
	S X=0 F  S X=$O(^AMHPTXP(X)) Q:X'=+X  K ^AMHPTXP(X,18)
	S ^XTMP("SAN","PROCESS","BH")="FINISHED"
	Q
PHR	;
	;policy holders not pointing to a patient
	S XBP=0 F  S XBP=$O(^AUPN3PPH(XBP)) Q:XBP'=+XBP  D
	.Q:$P(^AUPN3PPH(XBP,0),U,2)  ;already converted
	.S XBS=$P(^AUPN3PPH(XBP,0),U,8) I XBS="" S XBS="M"
	.S XBSCR=$S(XBS="M":3,1:2)
	.D FNAME
	.D LNAME
	.S XBNAME=XBLNAME_","_XBFNAME
	.D PHNR
	.S XBPHN="555-777-"_XBPHN
	.S DA=XBP,DIE="^AUPN3PPH(",DR=".01///"_XBNAME_";.14///"_XBPHN D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","POLICYPHONE",DFN)=""
	.D ^XBFMK
	.D SSNR
	.S DA=XBP,DIE="^AUPN3PPH(",DR=".04///"_XBSSN D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","POLICYSSN",DFN)=""
	.D ^XBFMK
	.S X=^XTMP("SAN",$J,"ADL1") D R S XBADDR=^XTMP("SAN",$J,"ADL1",X)
	.S $P(^AUPN3PPH(XBP,0),U,9)=XBADDR
	.S XBD=$P(^AUPN3PPH(XBP,0),U,19) I XBD]"" S XBD=$$FMADD^XLFDT(XBD,-33)
	.S DA=XBP,DIE="^AUPN3PPH(",DR=".19///"_XBD D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","POLICYDOB",DA)=""
	.D ^XBFMK
	S ^XTMP("SAN","PROCESS","POLICY")="FINISHED"
	Q
PROCPAT	;
	S ^XTMP("SAN","LASTDFN")=DFN
	I '(DFN#5000) W !,"."_DFN_"."
	D ^XBFMK
	S Y=DFN D ^AUPNPAT
	D F201
	D F203 ;subtract 33 days from dob
	D F209
	D F2111
	D F2131
	D F2132
	D F2211
	D F2212
	D F2213
	D F2219
	D F22401
	D F22402
	D F22403
	D OTHNAME
	D TEN ;tribal enrollment number
	D BRTH
	D DTH
	D PN
	D EMPL
	D NKR
	D ECR
	D XBCHART
	D INSURE
	D POLICY
	Q
EOJ	;
	D EN^XBVK("XB")
	K DFN,XBH,OTDFN,XBB,AUPNSEX,X,X2,XB3PB,XBAR,XBAUDEL
	K DA,DIE,DIK,DIR,DR,DUZSSN,I,XBA,XBADDR,XBADL1
	K XBBH,XBC,XBCHART,XBCHR,XBD,XBDAD,XBDEANUM,XBDEL,XBDFIRST,XBDLAST,XBDNAME
	K XBDOB,XBDUZ,XBFIRST,XBFNAME,XBH,XBLAB,XBLNAME,XBMDFN,XBMMDEL,XBMOM
	K XBNAME,XBNCDEL,XBNOK,XBNOKADL,XBP,XBPAT,XBPHN,XBPHR,XBPOS,XBS
	K XBSCR,XBSEX,XBSSN,XBTEN,XBVAL,XBVANUM,XBX,Y,Z
	W !,"If all data appears correct and you have chaecked failures, kill the ^XTMP(""SAN"") global",!!
	Q
NKR	;
	I $P($G(^AUPNPAT(DFN,28)),U,2)]"" S DA=DFN,DIE="^AUPNPAT(",DR="2802///`"_$O(^AUTTRLSH("B","MOTHER",0)) D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","PATNKR",DFN)=""
	D ^XBFMK
	Q
ECR	;
	I $P($G(^AUPNPAT(DFN,31)),U,2)]"" S DA=DFN,DIE="^AUPNPAT(",DR="3102///`"_$O(^AUTTRLSH("B","MOTHER",0)) D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","PATECR",DFN)=""
	D ^XBFMK
	Q
EMPL	;employer .19
	I $P($G(^AUPNPAT(DFN,0)),U,19)]"" S DA=DFN,DIE="^AUPNPAT(",DR=".19///FIRST AMERICAN BANK" D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","PATEMP",DFN)=""
	D ^XBFMK
	Q
PN	;
	I $P($G(^AUPNPAT(DFN,0)),U,31)]"" S DA=DFN,DIE="^AUPNPAT(",DR=".31///"_$P(^DPT(DFN,0),U) D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","PATPN",DFN)=""
	D ^XBFMK
	Q
TEN	;
	S XBTEN="TN - "_DFN
	I $P($G(^AUPNPAT(DFN,0)),U,7)]"" S DA=DFN,DIE="^AUPNPAT(",DR=".07///"_XBTEN D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","PATTEN",DFN)=""
	D ^XBFMK
	Q
BRTH	;
	I $P($G(^AUPNPAT(DFN,11)),U,5)]"" S XBTEN=$E(DFN_"000000",1,7),DA=DFN,DIE="^AUPNPAT(",DR="1105///"_XBTEN D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","PATBIRTH",DFN)=""
	D ^XBFMK
	Q
DTH	;
	I $P($G(^AUPNPAT(DFN,11)),U,16)]"" S XBTEN=$E("D"_DFN_"00000",1,7),DA=DFN,DIE="^AUPNPAT(",DR="1105///"_XBTEN D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","PATDEATH",DFN)=""
	D ^XBFMK
	Q
F201	;
	S XBSCR=$S(AUPNSEX="M":3,1:2)
	D FNAME
	D LNAME
	S XBNAME=XBLNAME_","_XBFNAME
	S DA=DFN,DIE="^DPT(",DR=".01///"_XBNAME D ^DIE
	I $D(Y) S ^XTMP("SAN","FAILURE","PATNAME",DFN)=""
	D ^XBFMK
	Q
FNAME	;
	I XBSCR=3 S X=^XTMP("SAN",$J,"FIRSTM") D R S XBFNAME=^XTMP("SAN",$J,"FIRSTM",X) Q
	S X=^XTMP("SAN",$J,"FIRSTF") D R S XBFNAME=^XTMP("SAN",$J,"FIRSTF",X)
	Q
LNAME	;
	S X=^XTMP("SAN",$J,"LAST") D R S XBLNAME=^XTMP("SAN",$J,"LAST",X)
	Q
F203	;dob
	S XBDOB=$P(^DPT(DFN,0),U,3)
	I XBDOB="" Q
	S XBDOB=$$FMADD^XLFDT(XBDOB,-33)
	S DIE="^DPT(",DA=DFN,DR=".03///"_XBDOB D ^DIE
	I $D(Y) S ^XTMP("SAN","FAILURE","PATDOB",DFN)=""
	D ^XBFMK
	Q
F2211	;nok/emergency contact name
	S XBSCR=2 D FNAME S XBNOK=XBLNAME_","_XBFNAME
	I $P($G(^DPT(DFN,.21)),U,1)]"" D
	.D ^XBFMK
	.S DIE="^DPT(",DR=".211///"_XBNOK,DA=DFN D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","PATNOK",DFN)=""
	.D ^XBFMK
	I $P($G(^DPT(DFN,.33)),U,1)]"" D
	.S DIE="^DPT(",DR=".331///"_XBNOK,DA=DFN D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","PATECN",DFN)=""
	.D ^XBFMK
	Q
F2212	;
	D ^XBFMK
	I $P($G(^DPT(DFN,.21)),U,2)]"" D
	.S DA=DFN,DIE="^DPT(",DR=".212///MOTHER" D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","PATNOKMOTHER",DFN)=""
	.D ^XBFMK
	I $P($G(^DPT(DFN,.33)),U,2)]"" D
	.S DA=DFN,DIE="^DPT(",DR=".332///"_"MOTHER" D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","PATECNMOTHER",DFN)=""
	.D ^XBFMK
	Q
F22401	;father's name
	I $P($G(^DPT(DFN,.24)),U,1)="" Q
	S XBSCR=3 D FNAME S XBDAD=XBLNAME_","_XBFNAME
	S DIE="^DPT(",DR=".2401///"_XBDAD,DA=DFN D ^DIE
	I $D(Y) S ^XTMP("SAN","FAILURE","PATFATHER",DFN)=""
	D ^XBFMK
	Q
F22402	;mother's name
	S XBSCR=2 D FNAME S XBMOM=XBLNAME_","_XBFNAME
	I $P($G(^DPT(DFN,.24)),U,2)="" Q
	S DIE="^DPT(",DR=".2402///"_XBMOM,DA=DFN D ^DIE
	I $D(Y) S ^XTMP("SAN","FAILURE","PATMOTHER",DFN)=""
	D ^XBFMK
	Q
F22403	;mother's maiden name
	D LNAME
	S XBMMN=XBLNAME_","_$P(XBMOM,",",2)
	I $P($G(^DPT(DFN,.24)),U,3)="" Q
	S DIE="^DPT(",DR=".2403///"_XBMMN,DA=DFN D ^DIE
	I $D(Y) S ^XTMP("SAN","FAILURE","PATMOTHMAIDNAM",DFN)=""
	D ^XBFMK
	Q
OTHNAME	;
	S OTDFN=0 F  S OTDFN=$O(^DPT(DFN,.01,OTDFN)) Q:OTDFN'=+OTDFN  D
	.D LNAME
	.S XBNAME=XBLNAME_","_XBFNAME
	.S DA=OTDFN,DIE="^DPT("_DFN_",.01,",DA(1)=DFN,DR=".01///"_XBNAME D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","PATOTHRNAME",DFN)=""
	.D ^XBFMK
	Q
F2111	;
	I $P($G(^DPT(DFN,.11)),U,1)]"" D
	.S X=^XTMP("SAN",$J,"ADL1") D R S XBADDR=^XTMP("SAN",$J,"ADL1",X)
	.S DIE="^DPT(",DR=".111///"_XBADDR,DA=DFN D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","PATADDRESS",DFN)=""
	.D ^XBFMK
	.S $P(^DPT(DFN,.11),U,2)=""  ;addr 2nd line
	.S $P(^DPT(DFN,.11),U,3)=""  ;addr 3rd line
	Q
F2213	;
	I $P($G(^DPT(DFN,.21)),U,3)]"" D
	.S X=^XTMP("SAN",$J,"ADL1") D R S XBADDR=^XTMP("SAN",$J,"ADL1",X)
	.S DIE="^DPT(",DR=".213///"_XBADDR,DA=DFN D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","PATADDRESSL11",DFN)=""
	.D ^XBFMK
	I $P($G(^DPT(DFN,.33)),U,3)]"" D
	.S X=^XTMP("SAN",$J,"ADL1") D R S XBADDR=^XTMP("SAN",$J,"ADL1",X)
	.S DIE="^DPT(",DR=".333.//"_XBADDR,DA=DFN D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","PATADDRESSL111",DFN)=""
	.D ^XBFMK
	Q
POLICY	;
	;loop through policy holder
	;if has patient pointer use patient name and address and 
	D ^XBFMK
	S XBP=$O(^AUPN3PPH("C",DFN,0))
	I 'XBP K XBP Q
	S XBTEN=$P($G(^DPT(DFN,.11)),U,1)
	S DA=XBP,DIE="^AUPN3PPH(",DR=".01///"_XBNAME_";.04///"_XBSSN_";.09///"_XBTEN_";.11///@;.13///@;.14///@;.19///"_XBDOB D ^DIE
	I $D(Y) S ^XTMP("SAN","FAILURE","PATPOLICY",DA)=""
	D ^XBFMK
	Q
INSURE	;
	D MCR,PI,MCD,RR
	Q
MCR	;
	;MEDICARE
	Q:'$D(^AUPNMCR(DFN))
	S X=^XTMP("SAN",$J,"DLAST") D R S XBDLAST=^XTMP("SAN",$J,"DLAST",X)
	S X=^XTMP("SAN",$J,"DFIRST") D R S XBDFIRST=^XTMP("SAN",$J,"DFIRST",X)
	S XBDLAST=XBDLAST_","_XBDFIRST
	D SSNR
	S DIE="^AUPNMCR(",DA=DFN,DR=".03///"_XBSSN_";.14///"_XBDLAST_";2101///"_$P(^DPT(DFN,0),U,1)_";2102///"_$P(^DPT(DFN,0),U,3) D ^DIE
	I $D(Y) S ^XTMP("SAN","FAILURE","PATMEDICARE",DFN)=""
	D ^XBFMK
	        Q
PI	;
	Q:'$D(^AUPNPRVT(DFN))
	Q:'$D(^AUPNPRVT(DFN,11))
	S XBMDFN=0 F  S XBMDFN=$O(^AUPNPRVT(DFN,11,XBMDFN)) Q:XBMDFN'=+XBMDFN  D
	.S $P(^AUPNPRVT(DFN,11,XBMDFN,0),U,2)=XBSSN
	.S $P(^AUPNPRVT(DFN,11,XBMDFN,0),U,4)=XBNAME
	.S $P(^AUPNPRVT(DFN,11,XBMDFN,0),U,12)=""
	.S $P(^AUPNPRVT(DFN,11,XBMDFN,0),U,14)=""
	Q
	;
RR	;
	Q:'$D(^AUPNRRE(DFN))
	S X=^XTMP("SAN",$J,"DLAST") D R S XBDLAST=^XTMP("SAN",$J,"DLAST",X)
	S X=^XTMP("SAN",$J,"DFIRST") D R S XBDFIRST=^XTMP("SAN",$J,"DFIRST",X)
	S XBDLAST=XBDLAST_","_XBDFIRST
	D SSNR
	S DIE="^AUPNRRE(",DA=DFN,DR=".04///"_XBSSN_";.14///"_XBDLAST_";2101///"_$P(^DPT(DFN,0),U,1)_";2102///"_$P(^DPT(DFN,0),U,3) D ^DIE
	I $D(Y) S ^XTMP("SAN","FAILURE","PATRAILROAD",DFN)=""
	D ^XBFMK
	Q
MCD	;
	S XBMDFN=0 F  S XBMDFN=$O(^AUPNMCD("B",DFN,XBMDFN)) Q:XBMDFN'=+XBMDFN  D
	.S X=^XTMP("SAN",$J,"DLAST") D R S XBDLAST=^XTMP("SAN",$J,"DLAST",X)
	.S X=^XTMP("SAN",$J,"DFIRST") D R S XBDFIRST=^XTMP("SAN",$J,"DFIRST",X)
	.S DIE="^AUPNMCD(",DA=XBMDFN,DR=".05///@;.12///@;.13///@" D ^DIE
	.D ^XBFMK
	.S XBDNAME=XBDLAST_","_XBDFIRST
	.D SSNR
	.S DIE="^AUPNMCD(",DA=XBMDFN,DR=".03///"_XBSSN_";.14///"_XBDNAME_";2101///"_$P(^DPT(DFN,0),U,1)_";2102///"_$P(^DPT(DFN,0),U,3)_";.05///"_$P(^DPT(DFN,0),U,1) D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","PATMEDICAID",DA)=""
	.D ^XBFMK
	Q
XBCHART	;
	S XBH=0 F  S XBH=$O(^AUPNPAT(DFN,41,XBH)) Q:XBH'=+XBH  S XBCHART=XBCHART+1 D
	.S DA=XBH,DIE="^AUPNPAT("_DFN_",41,",DA(1)=DFN,DR=".02///"_XBCHART D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","PATCHART",DFN)=""
	.D ^XBFMK
	Q
F209	;
	I $P($G(^DPT(DFN,0)),U,9)="" Q
	D SSNR
	S DIE="^DPT(",DA=DFN,DR=".09///"_XBSSN D ^DIE
	I $D(Y) S DA=DFN,DIE="^DPT(",DR=".09///@" D ^DIE
	I $D(Y) S ^XTMP("SAN","FAILURE","PATSSN",DFN)=""
	D ^XBFMK
	Q
F2219	;nok phone
	I $P($G(^DPT(DFN,.21)),U,9)]"" D PHNR D  ;S $P(^DPT(DFN,.21),U,9)="555-888-"_XBPHN
	.S XBPHN="555-888-"_XBPHN
	.S DIE="^DPT(",DA=DFN,DR=".219///"_XBPHN D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","PATPHONE",DFN)=""
	.D ^XBFMK
	I $P($G(^DPT(DFN,.33)),U,9)]"" D PHNR D  ;S $P(^DPT(DFN,.33),U,9)="555-888-"_XBPHN
	.S XBPHN="555-888-"_XBPHN
	.S DIE="^DPT(",DA=DFN,DR=".339///"_XBPHN D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","PATPHONE1",DFN)=""
	.D ^XBFMK
	Q
F2131	;
	I $P($G(^DPT(DFN,.13)),U,1)]"" D PHNR D
	.S XBPHN="555-555-"_XBPHN
	.S DIE="^DPT(",DA=DFN,DR=".131///"_XBPHN D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","PATPHONE2",DFN)=""
	.D ^XBFMK
	Q
F2132	;
	Q:$P($G(^DPT(DFN,.13)),U,2)=""  ;no office phone
	D PHNR S XBPHN="555-999-"_XBPHN
	S DIE="^DPT(",DA=DFN,DR=".132///"_XBPHN D ^DIE
	I $D(Y) S ^XTMP("SAN","FAILURE","PATPHONE3",DFN)=""
	D ^XBFMK
	Q
	;
DELP	;delete patients with no visits
	;S XBCNT=0,XBP=0 F  S XBP=$O(^DPT(XBP)) Q:XBP'=+XBP  D
	;.Q:$D(^AUPNVSIT("AC",XBP))
	;.S DA=XBP,DIK="^DPT(" D ^DIK
	;.S DA=XBP,DIK="^AUPNPAT(" D ^DIK
	;.W DA,":" S XBCNT=XBCNT+1
	;.Q
	;W !,XBCNT
	;Q
CLEAN	;
	K ^XTMP("SAN",$J,"FIRSTM")
	K ^XTMP("SAN",$J,"FIRSTF")
	K ^XTMP("SAN",$J,"ADL1")
	K ^XTMP("SAN",$J,"NOKADL")
	K ^XTMP("SAN","FAILURE")
	K ^XTMP("SAN",$J,"DLAST")
	K ^XTMP("SAN",$J,"DFIRST")
	K ^XTMP("SAN","PROCESS","DUZ")
	K ^XTMP("SAN","DUZFAILURE")
	D ^XBKVAR
	S (XBC(1),XBC(2))=0,XBX=1 F  S XBX=$O(^VA(200,XBX)) Q:+XBX=0  D
	.S XBNAME=$P($G(^VA(200,XBX,0)),U,1)
	.S XBLAST=$P(XBNAME,",",1) S:'$L(XBLAST) XBLAST="MOUSE"
	.S XBFIRST=$P(XBNAME,",",2) S:'$L(XBFIRST) XBFIRST="MICKEY"_+XBX
	.S XBC(1)=XBC(1)+1,^XTMP("SAN",$J,"DLAST")=XBC(1),^XTMP("SAN",$J,"DLAST",XBC(1))=XBLAST
	.S XBC(2)=XBC(2)+1,^XTMP("SAN",$J,"DFIRST")=XBC(2),^XTMP("SAN",$J,"DFIRST",XBC(2))=XBFIRST
	D ^XBKVAR
	F I=1:1:5 S XBC(I)=0
	S Y=0 F  S Y=$O(^DPT(Y)) Q:+Y=0  D
	.S XBVAL=$G(^DPT(Y,0))
	.S XBNAME=$P(XBVAL,U,1)
	.S XBLAST=$P(XBNAME,",",1)
	.S XBFIRST=$P(XBNAME,",",2)
	.S XBSEX=$P(XBVAL,U,2)
	.S XBADL1=$P($G(^DPT(Y,.11)),U,1)
	.S XBNOKADL=$P($G(^DPT(Y,.33)),U,3)
SET	.S XBC(1)=XBC(1)+1,^XTMP("SAN",$J,"LAST")=XBC(1),^XTMP("SAN",$J,"LAST",XBC(1))=XBLAST
	.I $L(XBSEX) S:XBSEX="M" XBC(2)=XBC(2)+1,^XTMP("SAN",$J,"FIRSTM")=XBC(2),^XTMP("SAN",$J,"FIRSTM",XBC(2))=XBFIRST
	.I $L(XBSEX) S:XBSEX="F" XBC(3)=XBC(3)+1,^XTMP("SAN",$J,"FIRSTF")=XBC(3),^XTMP("SAN",$J,"FIRSTF",XBC(3))=XBFIRST
	.I $L(XBADL1) S XBC(5)=XBC(5)+1,^XTMP("SAN",$J,"ADL1")=XBC(5),^XTMP("SAN",$J,"ADL1",XBC(5))=XBADL1
	.I $L(XBNOKADL) S XBC(5)=XBC(5)+1,^XTMP("SAN",$J,"ADL1")=XBC(5),^XTMP("SAN",$J,"ADL1",XBC(5))=XBNOKADL
	Q
R	S X2=$R(X) I X2=0 G R
	S X=X2
	Q
	;
DUZ	;SCRAMBLES USER NAMES
	K ^XTMP("SAN","FAILURE","DUZ")
	K ^XTMP("SAN","FAILURE","DUZA")
DUZA	D ^XBFMK
	S XBX=1 F  S XBX=$O(^VA(200,XBX)) Q:+XBX=0  D
	.S X=^XTMP("SAN",$J,"DLAST") D R S XBLAST=^XTMP("SAN",$J,"DLAST",X)
	.S X=^XTMP("SAN",$J,"DFIRST") D R S XBFIRST=^XTMP("SAN",$J,"DFIRST",X)
	.D DUZSSN
	.;W !,$P(^VA(200,XBX,0),"^",1),"  ",XBLAST,"   ",XBFIRST,$P($G(^VA(200,XBX,1)),"^",9),"  ",DUZSSN
	.I DUZSSN S DA=XBX,DIE=200,DR=".01///"_XBLAST_","_XBFIRST_";9///"_DUZSSN D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","DUZ",XBX)=""
	.I 'DUZSSN S DA=XBX,DIE=200,DR=".01///"_XBLAST_","_XBFIRST D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","DUZ",XBX)=""
	.S DA=XBX,DIE=200,DR=";1///"_$E(XBLAST,1,3)_";13///"_$E(XBLAST,1,8) D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","DUZINITIALS",XBX)=""
	.S XBVANUM=1000000+XBX
	.S XBDEANUM=2000000+XBX
	.S DA=XBX,DIE=200,DR=";53.2///"_XBDEANUM_";53.3///"_XBVANUM D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","DUZDEAVA",XBX)=""
	.D ^XBFMK
	S ^XTMP("SAN","PROCESS","DUZ")="FINISHED"
	Q
DUZSSN	;CHANGES SSN FOR USER FILE
	S DUZSSN=$P($G(^VA(200,XBX,1)),"^",9)
	I DUZSSN D DUZSSNR S DUZSSN=XBSSN
	Q
DUZSSNR	;FIND RANDOM SSN
	F  S XBSSN=$R(999999999) Q:XBSSN>100000000&(XBSSN<800000000)
	I $D(^VA(200,"SSN",XBSSN)) G DUZSSNR
	Q
ALLSSN	;ADDS SSN TO EVERY PATIENT
	D ^XBFMK
	S XBX=0 F  S XBX=$O(^DPT(XBX)) Q:+XBX=0  D
	.Q:$L($P($G(^DPT(XBX,0)),"^",9))
	.D SSNR
	.S DA=XBX,DIE=2,DR=".09///"_XBSSN D ^DIE K DIE,DA
	.D ^XBFMK
	S ^XTMP("SAN","PROCESS","SSN-ALL")="FINISHED"
	Q
SSNR	;FIND RANDOM SSN
	F  S XBSSN=$R(999999999) Q:XBSSN>100000000&(XBSSN<800000000)
	I $D(^DPT("SSN",XBSSN)) G SSNR
	Q
PHNR	;FIND RANDOM PHONE
	F  S XBPHN=$R(9999) Q:XBPHN>1000&(XBPHN<9999)
	Q
	;
PATDEL	;
	S DFN=0 F  S DFN=$O(^DPT(DFN)) Q:DFN'=+DFN  D
	.I $P($G(^DPT(DFN,0)),U,10)]"" S DA=DFN,DIE=2,DR=".091///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL091",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.101)),U,1)]"" S DA=DFN,DIE=2,DR=".101///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL101",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.111)),U,1)]"" S DA=DFN,DIE=2,DR=".1181///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL1181",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.111)),U,2)]"" S DA=DFN,DIE=2,DR=".1182///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL1182",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.111)),U,3)]"" S DA=DFN,DIE=2,DR=".1183///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL1183",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.111)),U,4)]"" S DA=DFN,DIE=2,DR=".1184///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL1184",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.111)),U,5)]"" S DA=DFN,DIE=2,DR=".1185///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL1185",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.111)),U,6)]"" S DA=DFN,DIE=2,DR=".1186///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL1186",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.111)),U,7)]"" S DA=DFN,DIE=2,DR=".1187///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL1187",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.12)),U,1)]"" S DA=DFN,DIE=2,DR=".121///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL121",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.12)),U,2)]"" S DA=DFN,DIE=2,DR=".122///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL122",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.12)),U,3)]"" S DA=DFN,DIE=2,DR=".123///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL123",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.12)),U,4)]"" S DA=DFN,DIE=2,DR=".124///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL124",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.12)),U,5)]"" S DA=DFN,DIE=2,DR=".125///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL125",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.12)),U,6)]"" S DA=DFN,DIE=2,DR=".126///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL126",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.12)),U,7)]"" S DA=DFN,DIE=2,DR=".127///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL127",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.121)),U,1)]"" S DA=DFN,DIE=2,DR=".1211///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL1211",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.121)),U,2)]"" S DA=DFN,DIE=2,DR=".1212///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PAT1212",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.121)),U,3)]"" S DA=DFN,DIE=2,DR=".1213///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PAT1213",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.121)),U,4)]"" S DA=DFN,DIE=2,DR=".1214///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PAT1214",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.121)),U,5)]"" S DA=DFN,DIE=2,DR=".1215///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PAT1215",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.121)),U,6)]"" S DA=DFN,DIE=2,DR=".1216///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL1216",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.121)),U,7)]"" S DA=DFN,DIE=2,DR=".1217///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL1217",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.121)),U,8)]"" S DA=DFN,DIE=2,DR=".1218///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL1218",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.121)),U,10)]"" S DA=DFN,DIE=2,DR=".1219///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL1219",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.111)),U,1)]"" S DA=DFN,DIE=2,DR=".1181///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL1181",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.13)),U,3)]"" S DA=DFN,DIE=2,DR=".133///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL133",DFN)="" D ^XBFMK
	.I $P($G(^DPT(DFN,.13)),U,4)]"" S DA=DFN,DIE=2,DR=".134///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL134",DFN)="" D ^XBFMK
	.I $P($G(^AUPNPAT(DFN,3)),U,2)]"" S DA=DFN,DIE="AUPNPAT(",DR=".32///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL32",DFN)="" D ^XBFMK
	.I $P($G(^AUPNPAT(DFN,11)),U,18)]"" S DA=DFN,DIE="AUPNPAT(",DR="1118///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL1118",DFN)="" D ^XBFMK
	.I $P($G(^AUPNPAT(DFN,26)),U,2)]"" S DA=DFN,DIE="AUPNPAT(",DR="2602///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL2602",DFN)="" D ^XBFMK
	.I $P($G(^AUPNPAT(DFN,26)),U,5)]"" S DA=DFN,DIE="AUPNPAT(",DR="2605///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL2605",DFN)="" D ^XBFMK
	.I $P($G(^AUPNPAT(DFN,99999999)),U,1)]"" S DA=DFN,DIE="AUPNPAT(",DR="99999999///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","PATDEL99999999",DFN)="" D ^XBFMK
	.F X=12:1:15 K ^AUPNPAT(DFN,X)
	.K ^AUPNPAT(DFN,42)
	S ^XTMP("SAN","PROCESS","PATDELETEDATA")="FINISHED"
	Q
POSDEL	;
	S XBX=0 F  S XBX=$O(^ABSPC(XBX)) Q:+XBX=0  D
	.S DA=XBX,DIK="^ABSPC(" D ^DIK,^XBFMK
	S XBX=0 F  S XBX=$O(^ABSPR(XBX)) Q:+XBX=0  D
	.S DA=XBX,DIK="^ABSPR(" D ^DIK,^XBFMK
	S DA=1,DIE="ABSP(9002313.56,",DR=".01///OUTPATIENT SITE;.02///12345;.03///456789;.05///123456789;.06///987654"
	D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","POSDELETE",DA)="" D ^XBFMK
	K ^ABSP(9002313.56,1,"ADDR")
	K ^ABSP(9002313.56,1,"INSURER-ASSIGNED #")
	K ^ABSP(9002313.56,1,"OPSITE")
	S ^XTMP("SAN","PROCESS","POSDEL")="FINNISHED"
	Q
AR	;
	D ^XBFMK S U="^",XBA=0 F  S XBA=$O(^BARBL(XBA)) Q:+XBA=0  D
	.S XBB=0 F  S XBB=$O(^BARBL(XBA,XBB)) Q:+XBB=0  D
	..I $P($G(^BARBL(XBA,XBB,0)),U,12)]"" S DA=XBB,DIE="90050.01",DUZ(2)=XBA,DR="12///@" D ^DIE,^XBFMK
	..I $P($G(^BARBL(XBA,XBB,1)),U,5)]"" D
	...D SSNR S DA=XBB,DIE="90050.01",DUZ(2)=XBA,DR="105///"_XBSSN D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","AR105",DA)="" D ^XBFMK
	..I $P($G(^BARBL(XBA,XBB,1)),U,6)]"" S DA=XBB,DIE="90050.01",DUZ(2)=XBA,DR="106///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","AR106",DA)="" D ^XBFMK
	..I $P($G(^BARBL(XBA,XBB,1)),U,7)]"" D
	...D SSNR S XBTEN=$E(XBSSN,1,5),DA=XBB,DIE="90050.01",DUZ(2)=XBA,DR="107///"_XBTEN D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","AR107E",DA)="" D ^XBFMK
	..I $P($G(^BARBL(XBA,XBB,1)),U,16)]"" S DA=XBB,DIE="90050.01",DUZ(2)=XBA,DR="116///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","AR116",DA)="" D ^XBFMK
	..I $P($G(^BARBL(XBA,XBB,2)),U,3)]"" S DA=XBB,DIE="90050.01",DUZ(2)=XBA,DR="203///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","AR203",DA)="" D ^XBFMK
	..I $P($G(^BARBL(XBA,XBB,2)),U,4)]"" S DA=XBB,DIE="90050.01",DUZ(2)=XBA,DR="204///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","AR204",DA)="" D ^XBFMK
	..I $P($G(^BARBL(XBA,XBB,2)),U,16)]"" S DA=XBB,DIE="90050.01",DUZ(2)=XBA,DR="216///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","AR216",DA)="" D ^XBFMK
	..I $P($G(^BARBL(XBA,XBB,2)),U,17)]"" S DA=XBB,DIE="90050.01",DUZ(2)=XBA,DR="217///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","AR217",DA)="" D ^XBFMK
	..S DUZ(2)=XBA K ^BARBL(DUZ(2),XBB,10),^BARBL(DUZ(2),XBB,5),^BARBL(DUZ(2),XBB,6)
	..I $P($G(^BARBL(XBA,XBB,7)),U,1)]"" S DA=XBB,DIE="90050.01",DUZ(2)=XBA,DR="701///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","AR701",DA)="" D ^XBFMK
	..I $P($G(^BARBL(XBA,XBB,7)),U,2)]"" S DA=XBB,DIE="90050.01",DUZ(2)=XBA,DR="702///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","AR702",DA)="" D ^XBFMK
	S ^XTMP("SAN","PROCESS","AR-BILL")="FINISHED"
	S XBA=0 F  S XBA=$O(^BARCOL(XBA)) Q:+XBA=0  D
	.S XBB=0 F  S XBB=$O(^BARCOL(XBA,XBB)) Q:+XBB=0  K ^BARTR(XBA,XBB,10)
	S ^XTMP("SAN","PROCESS","AR-TRAN")="FINISHED"
	S XBA=0 F  S XBA=$O(^BARCOL(XBA)) Q:+XBA=0  D
	.S XBB=0 F  S XBB=$O(^BARCOL(XBA,XBB)) Q:+XBB=0  D
	..S XBC=0 F  S XBC=$O(^BARCOL(XBA,XBB,"1",XBC)) Q:+XBC=0  D
	...I $P($G(^BARCOL(XBA,XBB,1,XBC,0)),U,12)]"" S DIE="^BARCOL(XBA,XBB,1,",DA=XBC,DA(1)=XBB,DUZ(2)=XBA,DR="12///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","ARCOL12",DA)="" D ^XBFMK
	...I $P($G(^BARCOL(XBA,XBB,1,XBC,0)),U,13)]"" S DIE="^BARCOL(XBA,XBB,1,",DA=XBC,DA(1)=XBB,DUZ(2)=XBA,DR="13///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","ARCOL13",DA)="" D ^XBFMK
	...I $P($G(^BARCOL(XBA,XBB,1,XBC,0)),U,14)]"" S DIE="^BARCOL(XBA,XBB,1,",DA=XBC,DA(1)=XBB,DUZ(2)=XBA,DR="14///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","ARCOL14",DA)="" D ^XBFMK
	...K ^BARCOL(XBA,XBB,"1",XBC,5)
	S ^XTMP("SAN","PROCESS","AR-COLL")="FINISHED"
	S XBA=0 F  S XBA=$O(^BAREDI("I",XBA)) Q:+XBA=0  D
	.S XBB=0 F  S XBB=$O(^BAREDI("I",XBA,XBB)) Q:+XBB=0  D
	..S DIK="^BAREDI(""I"",XBA,",DA=XBB,DUZ(2)=XBA=XBA D ^DIK,^XBFMK
	S ^XTMP("SAN","PROCESS","AR-EDIIMP")="FINISHED"
	S XBA=0 F  S XBA=$O(^BAREDI("C",XBA)) Q:+XBA=0  D
	.S XBB=0 F  S XBB=$O(^BAREDI("C",XBA,XBB)) Q:+XBB=0  D
	..I $P($G(^BAREDI("C",XBA,XBB,0)),U,3)]"" S DIE="^BAREDI(""C"",XBA,XBB,",DA=XBB,DUZ(2)=XBA,DR=".03///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","BAREDI03",DA)="" D ^XBFMK
	S ^XTMP("SAN","PROCESS","AR-EDIC")="FINISHED"
	S XBA=0 F  S XBB=$O(^BAR835(XBA)) Q:+XBA=0  D
	.I $P($G(^BAR835(XBA,1)),U,1)]"" S DIE="^BAR835,",DA=XBA,DR=".11///@" D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","AR11",DA)="" D ^XBFMK
	S ^XTMP("SAN","PROCESS","AR-EDI835")="FINISHED"
	Q
TPB	;3RD PARTY BILLING
	D ^XBFMK
	S U="^",XBA=0 F  S XBA=$O(^ABMDCLM(XBA)) Q:+XBA=0  D
	.S XBB=0 F  S XBB=$O(^ABMDCLM(XBA,XBB)) Q:+XBB=0  D
	..I $L($P($G(^ABMDCLM(XBA,XBB,8)),U,8)) D
	...S X=^XTMP("SAN",$J,"DLAST") D R S XBLAST=^XTMP("SAN",$J,"DLAST",X)
	...S X=^XTMP("SAN",$J,"DFIRST") D R S XBFIRST=^XTMP("SAN",$J,"DFIRST",X)
	...S DA=XBB,DIE="9002274.3",DUZ(2)=XBA,DR=".88///"_XBLAST_","_XBFIRST D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","ABM88",DA)="" D ^XBFMK
	..I $L($P($G(^ABMDCLM(XBA,XBB,8)),U,11)) D
	...S DA=XBB,DIE="9002274.3",DUZ(2)=XBA,DR=".885///"_(100000+DA) D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","ABM885",DA)="" D ^XBFMK
	..I $L($P($G(^ABMDCLM(XBA,XBB,9)),U,12)) D
	...S X=^XTMP("SAN",$J,"DLAST") D R S XBLAST=^XTMP("SAN",$J,"DLAST",X)
	...S X=^XTMP("SAN",$J,"DFIRST") D R S XBFIRST=^XTMP("SAN",$J,"DFIRST",X)
	...S DA=XBB,DIE="9002274.3",DUZ(2)=XBA,DR=".912///"_XBLAST_","_XBFIRST D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","ABM912",DA)="" D ^XBFMK
	S ^XTMP("SAN","PROCESS","3P-CLAIM")="FINISHED"
	S XBA=0 F  S XBA=$O(^ABMDBILL(XBA)) Q:+XBA=0  D
	.S XBB=0 F  S XBB=$O(^ABMDBILL(XBA,XBB)) Q:+XBB=0  D
	..I $L($P($G(^ABMDBILL(XBA,XBB,8)),U,8)) D
	...S X=^XTMP("SAN",$J,"DLAST") D R S XBLAST=^XTMP("SAN",$J,"DLAST",X)
	...S X=^XTMP("SAN",$J,"DFIRST") D R S XBFIRST=^XTMP("SAN",$J,"DFIRST",X)
	...S DA=XBB,DIE="9002274.4",DUZ(2)=XBA,DR=".88///"_XBLAST_","_XBFIRST D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","ABM88",DA)="" D ^XBFMK
	..I $L($P($G(^ABMDBILL(XBA,XBB,8)),U,11)) D
	...S DA=XBB,DIE="9002274.4",DUZ(2)=XBA,DR=".885///"_(200000+DA) D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","ABM885",DA)="" D ^XBFMK
	..I $L($P($G(^ABMDBILL(XBA,XBB,9)),U,12)) D
	...S X=^XTMP("SAN",$J,"DLAST") D R S XBLAST=^XTMP("SAN",$J,"DLAST",X)
	...S X=^XTMP("SAN",$J,"DFIRST") D R S XBFIRST=^XTMP("SAN",$J,"DFIRST",X)
	...S DA=XBB,DIE="9002274.4",DUZ(2)=XBA,DR=".912///"_XBLAST_","_XBFIRST D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","ABM912",DA)="" D ^XBFMK
	S ^XTMP("SAN","PROCESS","3P-BILL")="FINISHED"
	Q
LAB	;
	S X=0 F  S X=$O(^LR(X)) Q:X'=+X  D
	.S Y=0 F  S Y=$O(^LR(X,"CH",Y)) Q:Y'=+Y  D
	..I $D(^LR(X,"CH",Y,1)) S Z=$P(^LR(X,"CH",Y,1,0),U,1,2) K ^LR(X,"CH",Y,1) S ^LR(X,"CH",Y,1,0)=Z
	.S Y=0 F  S Y=$O(^LR(X,"MI",Y)) Q:Y'=+Y  D
	..I $D(^LR(X,"MI",Y,4)) S Z=$P(^LR(X,"MI",Y,4,0),U,1,2) K ^LR(X,"MI",Y,4) S ^LR(X,"MI",Y,4,0)=Z
	..I $D(^LR(X,"MI",Y,19)) S Z=$P(^LR(X,"MI",Y,19,0),U,1,2) K ^LR(X,"MI",Y,19) S ^LR(X,"MI",Y,19,0)=Z
	..I $D(^LR(X,"MI",Y,20)) S Z=$P(^LR(X,"MI",Y,20,0),U,1,2) K ^LR(X,"MI",Y,20) S ^LR(X,"MI",Y,20,0)=Z
	..I $D(^LR(X,"MI",Y,21)) S Z=$P(^LR(X,"MI",Y,21,0),U,1,2) K ^LR(X,"MI",Y,21) S ^LR(X,"MI",Y,21,0)=Z
	..I $D(^LR(X,"MI",Y,22)) S Z=$P(^LR(X,"MI",Y,22,0),U,1,2) K ^LR(X,"MI",Y,22) S ^LR(X,"MI",Y,22,0)=Z
	..I $D(^LR(X,"MI",Y,23)) S Z=$P(^LR(X,"MI",Y,23,0),U,1,2) K ^LR(X,"MI",Y,23) S ^LR(X,"MI",Y,23,0)=Z
	..K ^LR(X,"MI",Y,99)
	S X=0 F  S X=$O(^LRO(69,X)) Q:X'=+X  D
	.I $D(^LRO(69,X,1,"AL")) K ^LRO(69,X,1,"AL")
	.I $D(^LRO(69,X,1,"AP")) K ^LRO(69,X,1,"AP")
	.I $D(^LRO(69,X,1,"AR")) K ^LRO(69,X,1,"AR")
	S X=$P(^BLRTXLOG(0),U,1,2) K ^BLRTXLOG S ^BLRTXLOG(0)=X
	S ^XTMP("SAN","PROCESS","LAB")="FINISHED"
	D ^LROC
	Q
LISTE	;
	W !,"Listed below are the nodes and number of records that did not"
	W !,"update properly.  At the end of the sanitization, the records"
	W !,"for Patient Name failures are rerun.  PATNAME2 nodes represent"
	W !,"Patient Names that should be manually changed with fileman."
	W !,"XTMP(""SAN"",""PROCESS"") nodes:"
	W !,"XTMP(""SAN"",""FAILURE"") nodes:"
	S X="" F  S X=$O(^XTMP("SAN","FAILURE",X)) Q:X=""  D
	.S (Y,Z)=0 F  S Y=$O(^XTMP("SAN","FAILURE",X,Y)) Q:+Y=0  D
	..S Z=Z+1
	.W !,"Failure:  "_X_"  "_Z
	W !,"FINISHED" Q
LISTD	;
	W !,"Listed below are the processes completed."
	W !,"XTMP(""SAN"",""PROCESS"") nodes:"
	S X="" F  S X=$O(^XTMP("SAN","PROCESS",X)) Q:X=""  D
	.W !,"Process:  "_X
	W !,"FINISHED" Q 
MCDE	;
	S DFN=0 F  S DFN=$O(^AUPNMCD("B",DFN)) Q:+DFN=0  D
	.S XBMDFN=0 F  S XBMDFN=$O(^AUPNMCD("B",DFN,XBMDFN)) Q:XBMDFN'=+XBMDFN  D
	..S X=^XTMP("SAN",$J,"DLAST") D R S XBDLAST=^XTMP("SAN",$J,"DLAST",X)
	..S X=^XTMP("SAN",$J,"DFIRST") D R S XBDFIRST=^XTMP("SAN",$J,"DFIRST",X)
	..S DIE="^AUPNMCD(",DA=XBMDFN,DR=".05///@;.12///@;.13///@" D ^DIE
	..I $D(Y) S ^XTMP("SAN","FAILURE","PATMCDEA",DA)=""
	..D ^XBFMK
	..S XBDNAME=XBDLAST_","_XBDFIRST
	..D SSNR
	..S DIE="^AUPNMCD(",DA=XBMDFN,DR=".03///"_XBSSN_";.14///"_XBDNAME_";2101///"_$P(^DPT(DFN,0),U,1)_";2102///"_$P(^DPT(DFN,0),U,3)_";.05///"_$P(^DPT(DFN,0),U,1) D ^DIE
	..I $D(Y) S ^XTMP("SAN","FAILURE","PATMCDEB",DA)=""
	..D ^XBFMK
	S ^XTMP("SAN","PROCESS","MCD")="FINISHED"
	Q 
MMDEL	;DELETES MAILMAN MESSAGES
	K ^XMB(3.9)
	S ^XMB(3.9,0)="MESSAGE^3.9s^0^0"
	Q
AUDEL	;DELETES AUDIT FILE
	K ^DIA
	S ^DIA(0)="AUDIT^1.1|"
	Q
NCDEL	;DELETES NAME COMPONENTS FILE
	K ^VA(20)
	S ^VA(20,0)="NAME COMPONENTS^20IA^^"
	Q
STU	;SETS STUDENT NAMES
	K ^XTMP("SAN","FAILURE","STU")
	K ^XTMP("SAN","FAILURE","STUA")
STUA	D ^XBFMK
	S XBX=50 F  S XBX=$O(^VA(200,XBX)) Q:+XBX>76  D
	.S XBLAST=$E("ABCDEFGHIJKLMNOPQRSTUVWXYZ",XBX-50,XBX-50)_"STUDENT"
	.S XBFIRST="USER"
	.S DA=XBX,DIE=200,DR=".01///"_XBLAST_","_XBFIRST D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","STU",XBX)=""
	.S DA=XBX,DIE=200,DR="1///"_$E(XBLAST,1,2)_"U;13///"_$E(XBLAST,1,8) D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","STUINITIALS",XBX)=""
	.S DA=XBX,DIE=200,DR="201///`29" D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","STUMENU",XBX)=""
	.D ^XBFMK
	W !,"FINISHED"
	Q
FJADD1	;
	S DFN=0 F  S DFN=$O(^XTMP("SAN","FAILURE","PATADDRESS",DFN)) Q:+DFN=0  I $P($G(^DPT(DFN,.11)),U,1)]"" D
	 .S XBADDR=DFN_" SMITH STREET"
	 .S DIE="^DPT(",DR=".111///"_XBADDR,DA=DFN D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","PATADDRESSFJ",DFN)=""
	.D ^XBFMK
	.S $P(^DPT(DFN,.11),U,2)=""  ;addr 2nd line
	.S $P(^DPT(DFN,.11),U,3)=""  ;addr 3rd line
	Q
A2213	;
	I $P($G(^DPT(DFN,.21)),U,3)]"" D
	.S X=^XTMP("SAN",$J,"ADL1") D R S XBADDR=^XTMP("SAN",$J,"ADL1",X)
	.S DIE="^DPT(",DR=".213///"_XBADDR,DA=DFN D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","PATADDRESSL11",DFN)=""
	.D ^XBFMK
	I $P($G(^DPT(DFN,.33)),U,3)]"" D
	.S X=^XTMP("SAN",$J,"ADL1") D R S XBADDR=^XTMP("SAN",$J,"ADL1",X)
	.S DIE="^DPT(",DR=".333.//"_XBADDR,DA=DFN D ^DIE
	.I $D(Y) S ^XTMP("SAN","FAILURE","PATADDRESSL111",DFN)=""
	.D ^XBFMK
	Q
A2219	;nok phone
	S DFN=0 F  S DFN=$O(^XTMP("SAN","FAILURE","PATPHONE",DFN)) Q:+DFN=0  I $P($G(^DPT(DFN,.21)),U,9)]"" D
	.S $P(^DPT(DFN,.21),U,9)="555-888-"_$E(DFN_"9999",1,4)
	 Q
	S DFN=0 F  S DFN=$O(^XTMP("SAN","FAILURE","PATPHONE1",DFN)) Q:+DFN=0  I $P($G(^DPT(DFN,.33)),U,9)]"" D
	.S $P(^DPT(DFN,.33),U,9)="555-888-"_$E(DFN_"9999",1,4)
	Q