iSharkFly-Open
/
VistA-IHS-VA_UTILITIES-XB
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
VistA-IHS-VA_UTILITIES-XB/XBSANP.m

719 lines
33 KiB
Mathematica
Raw Permalink Blame History

XBSANP ;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
I XBSSN>698999999&(XBSSN<729000001) 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
Reference in New Issue View Git Blame Copy Permalink