source: IHS-VA_UTILITIES-XB/trunk/XBSAN.m@ 1699

Last change on this file since 1699 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.
File size: 32.7 KB
Line 
1XBSAN ;IHS/ITSC/LAB/FJE;SANITIZE RPMS DATABASE; [ 01/29/2004 11:10 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 W !,"This routine sanitizes and deletes RPMS data. To use you must type: D START^XBSAN",!!
4 Q
5START ;
6 S (XBDUZ,XBDEL,XBPAT,XBPHR,XBBH,XBCHR,XBPOS,XB3PB,XBAR,XBLAB,XBMMDEL,XBAUDEL,XBNCDEL)=0
7 K ^XTMP("SAN")
8 S ^XTMP("SAN","LASTDFN")=0
9 W !,"This routine will first sanitize AND randomize the NEW PERSON file in the RPMS database."
10 S DIR(0)="Y",DIR("A")="Do you want to convert the new person data?",DIR("B")="N" KILL DA D ^DIR KILL DIR
11 S:Y=1 XBDUZ=1
12 W !,"This routine will then REMOVE/DELETE UNNEEDED PATIENT DATA in the RPMS database."
13 S DIR(0)="Y",DIR("A")="Do you want this data deleted?",DIR("B")="N" KILL DA D ^DIR KILL DIR
14 S:Y=1 XBDEL=1
15 W !!,"This routine will then sanitize the PATIENT FILES of a RPMS database."
16 S DIR(0)="Y",DIR("A")="Do you want to convert the patient data",DIR("B")="N" KILL DA D ^DIR KILL DIR
17 S:Y=1 XBPAT=1
18 W !!,"This routine will then sanitize the POLICY HOLDER FILE of a RPMS database."
19 S DIR(0)="Y",DIR("A")="Do you want to convert the POLICY HOLDER data?",DIR("B")="N" KILL DA D ^DIR KILL DIR
20 S:Y=1 XBPHR=1
21 W !!,"This routine will then delete SENSITIVE CHR DATA from a RPMS database."
22 S DIR(0)="Y",DIR("A")="Do you want to delete this CHR patient data?",DIR("B")="N" KILL DA D ^DIR KILL DIR
23 S:Y=1 XBCHR=1
24 W !!,"This routine will then delete SENSITIVE BH VERSION 3.0 COMPLIANT DATA from a RPMS database."
25 S DIR(0)="Y",DIR("A")="Do you want to delete this CHR patient data?",DIR("B")="N" KILL DA D ^DIR KILL DIR
26 S:Y=1 XBBH=1
27 W !,"This routine will then REMOVE/DELETE UNNEEDED POS DATA in the RPMS database."
28 S DIR(0)="Y",DIR("A")="Do you want this data deleted?",DIR("B")="N" KILL DA D ^DIR KILL DIR
29 S:Y=1 XBPOS=1
30 W !,"This routine will then REMOVE/DELETE UNNEEDED 3PB DATA in the RPMS database."
31 S DIR(0)="Y",DIR("A")="Do you want this data deleted?",DIR("B")="N" KILL DA D ^DIR KILL DIR
32 S:Y=1 XB3PB=1
33 W !,"This routine will then REMOVE/DELETE UNNEEDED AR DATA in the RPMS database."
34 S DIR(0)="Y",DIR("A")="Do you want this data deleted?",DIR("B")="N" KILL DA D ^DIR KILL DIR
35 S:Y=1 XBAR=1
36 W !,"This routine will then REMOVE/DELETE UNNEEDED LAB DATA in the RPMS database."
37 S DIR(0)="Y",DIR("A")="Do you want this data deleted?",DIR("B")="N" KILL DA D ^DIR KILL DIR
38 S:Y=1 XBLAB=1
39 W !,"This routine will then REMOVE/DELETE MAILMAN MESSAGES in the RPMS database."
40 S DIR(0)="Y",DIR("A")="Do you want this data deleted?",DIR("B")="N" KILL DA D ^DIR KILL DIR
41 S:Y=1 XBMMDEL=1
42 W !,"This routine will then REMOVE/DELETE AUDIT DATA in the RPMS database."
43 S DIR(0)="Y",DIR("A")="Do you want this data deleted?",DIR("B")="N" KILL DA D ^DIR KILL DIR
44 S:Y=1 XBAUDEL=1
45 W !,"This routine will then REMOVE/DELETE NAME COMPONENTS in the RPMS database."
46 S DIR(0)="Y",DIR("A")="Do you want this data deleted?",DIR("B")="N" KILL DA D ^DIR KILL DIR
47 S:Y=1 XBNCDEL=1
48 W !,"All failed fileman update data can be found in: ^XTMP(""SAN"",""FAILURE"", GLOBAL"
49 W !,"?? display usually means that there was a fileman update failure"
50 W !,"If a hard error like an UNDEFINED occurs during the Patient scrambling,"
51 W !," you can restart at the next patient by typing: RESTART^XBSAN "
52 W !,"This routine does not purge HL7, or ARMS data."
53 W !,"When finished...don't forget to manually address the above and RENAME Institutions",!!
54 W !!,"This routine is about to scramble the RPMS database."
55 S DIR(0)="Y",DIR("A")="Last chance: Do you want your RPMS data SANITIZED?",DIR("B")="N" KILL DA D ^DIR KILL DIR
56 Q:Y'=1
57 D ^XBKVAR
58 W !,"Collecting random names" D CLEAN
59 I XBDUZ W !,"SCRAMBLING FILE 200" D DUZ
60 I XBDEL W !,"DELETING PAT INFO" D PATDEL
61RESTART ;WILL RESTART PAT SCRAMBLE IF HARD ERROR OCCURS
62 I $G(^XTMP("SAN","LASTDFN"))>0 S ^XTMP("SAN","FAILURE","PATDFN",^XTMP("SAN","LASTDFN"))=""
63 I XBPAT W !,"SCRAMBLING PAT FILE" D PAT
64 I XBPHR W !,"SCRAMBLING POLICY FILE" D PHR
65 I XBCHR W !,"SCRAMBLING CHR FILE" D CHR
66 I XBBH W !,"DELETING BH INFO" D BH
67 I XBPOS W !,"DELETING POS INFO" D POSDEL
68 I XB3PB W !,"SCRAMBLING 3PB FILE" D TPB
69 I XBAR W !,"SCRAMBLING AR FILE" D AR
70 I XBLAB W !,"SCRAMBLING LAB FILES" D LAB
71 I XBMMDEL W !,"DELETING MAILMAN MESSAGES" D MMDEL
72 I XBAUDEL W !,"DELETING AUDIT DATA" D AUDEL
73 I XBNCDEL W !,"DELETING NAME COMPONENTS" D NCDEL
74 D PAT2
75 S ^XTMP("SAN","PROCESS","XBSAN")="FINISHED"
76 W !,"FINISHED"
77 D LISTE
78 D EOJ
79 Q
80 ;
81PAT D ^XBKVAR
82 S XBCHART=100000
83 S DFN=+$G(^XTMP("SAN","LASTDFN")) I DFN W !,"RESTARTING PATIENT SCRAMBLE AFTER "_DFN,!
84 F S DFN=$O(^DPT(DFN)) Q:DFN'=+DFN D PROCPAT
85 S ^XTMP("SAN","PROCESS","PAT")="FINISHED"
86 Q
87 ;
88PAT2 D ^XBKVAR
89 S XBCHART=100000
90 W !,"RETRYING FAILED PATIENTS",!
91 S DFN=0 F S DFN=$O(^XTMP("SAN","FAILURE","PATNAME",DFN)) Q:DFN'=+DFN D
92 .S Y=DFN D ^AUPNPAT
93 .S XBSCR=$S(AUPNSEX="M":3,1:2)
94 .D FNAME
95 .D LNAME
96 .S XBNAME=XBLNAME_","_XBFNAME
97 .S DA=DFN,DIE="^DPT(",DR=".01///"_XBNAME D ^DIE
98 .I $D(Y) S ^XTMP("SAN","FAILURE","PATNAME2",DFN)="" W !,$P(^DPT(DFN,0),U,1)," ",XBNAME
99 .D ^XBFMK
100 S ^XTMP("SAN","PROCESS","PAT")="FINISHED"
101 Q
102CHR ;
103 S X=0 F S X=$O(^BCHR(X)) Q:X'=+X K ^BCHR(X,51),^BCHR(X,61),^BCHR(X,71)
104 S ^XTMP("SAN","PROCESS","CHR")="FINISHED"
105 Q
106BH ;version 3.0 compliant only
107 S X=0 F S X=$O(^AMHREC(X)) Q:X'=+X K ^AMHREC(X,31),^AMHREC(X,81),^AMHREC(X,21)
108 S X=0 F S X=$O(^AMHPTXP(X)) Q:X'=+X K ^AMHPTXP(X,18)
109 S ^XTMP("SAN","PROCESS","BH")="FINISHED"
110 Q
111PHR ;
112 ;policy holders not pointing to a patient
113 S XBP=0 F S XBP=$O(^AUPN3PPH(XBP)) Q:XBP'=+XBP D
114 .Q:$P(^AUPN3PPH(XBP,0),U,2) ;already converted
115 .S XBS=$P(^AUPN3PPH(XBP,0),U,8) I XBS="" S XBS="M"
116 .S XBSCR=$S(XBS="M":3,1:2)
117 .D FNAME
118 .D LNAME
119 .S XBNAME=XBLNAME_","_XBFNAME
120 .D PHNR
121 .S XBPHN="555-777-"_XBPHN
122 .S DA=XBP,DIE="^AUPN3PPH(",DR=".01///"_XBNAME_";.14///"_XBPHN D ^DIE
123 .I $D(Y) S ^XTMP("SAN","FAILURE","POLICYPHONE",DFN)=""
124 .D ^XBFMK
125 .D SSNR
126 .S DA=XBP,DIE="^AUPN3PPH(",DR=".04///"_XBSSN D ^DIE
127 .I $D(Y) S ^XTMP("SAN","FAILURE","POLICYSSN",DFN)=""
128 .D ^XBFMK
129 .S X=^XTMP("SAN",$J,"ADL1") D R S XBADDR=^XTMP("SAN",$J,"ADL1",X)
130 .S $P(^AUPN3PPH(XBP,0),U,9)=XBADDR
131 .S XBD=$P(^AUPN3PPH(XBP,0),U,19) I XBD]"" S XBD=$$FMADD^XLFDT(XBD,-33)
132 .S DA=XBP,DIE="^AUPN3PPH(",DR=".19///"_XBD D ^DIE
133 .I $D(Y) S ^XTMP("SAN","FAILURE","POLICYDOB",DA)=""
134 .D ^XBFMK
135 S ^XTMP("SAN","PROCESS","POLICY")="FINISHED"
136 Q
137PROCPAT ;
138 S ^XTMP("SAN","LASTDFN")=DFN
139 I '(DFN#5000) W !,"."_DFN_"."
140 D ^XBFMK
141 S Y=DFN D ^AUPNPAT
142 D F201
143 D F203 ;subtract 33 days from dob
144 D F209
145 D F2111
146 D F2131
147 D F2132
148 D F2211
149 D F2212
150 D F2213
151 D F2219
152 D F22401
153 D F22402
154 D F22403
155 D OTHNAME
156 D TEN ;tribal enrollment number
157 D BRTH
158 D DTH
159 D PN
160 D EMPL
161 D NKR
162 D ECR
163 D XBCHART
164 D INSURE
165 D POLICY
166 Q
167EOJ ;
168 D EN^XBVK("XB")
169 K DFN,XBH,OTDFN,XBB,AUPNSEX,X,X2,XB3PB,XBAR,XBAUDEL
170 K DA,DIE,DIK,DIR,DR,DUZSSN,I,XBA,XBADDR,XBADL1
171 K XBBH,XBC,XBCHART,XBCHR,XBD,XBDAD,XBDEANUM,XBDEL,XBDFIRST,XBDLAST,XBDNAME
172 K XBDOB,XBDUZ,XBFIRST,XBFNAME,XBH,XBLAB,XBLNAME,XBMDFN,XBMMDEL,XBMOM
173 K XBNAME,XBNCDEL,XBNOK,XBNOKADL,XBP,XBPAT,XBPHN,XBPHR,XBPOS,XBS
174 K XBSCR,XBSEX,XBSSN,XBTEN,XBVAL,XBVANUM,XBX,Y,Z
175 W !,"If all data appears correct and you have chaecked failures, kill the ^XTMP(""SAN"") global",!!
176 Q
177NKR ;
178 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)=""
179 D ^XBFMK
180 Q
181ECR ;
182 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)=""
183 D ^XBFMK
184 Q
185EMPL ;employer .19
186 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)=""
187 D ^XBFMK
188 Q
189PN ;
190 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)=""
191 D ^XBFMK
192 Q
193TEN ;
194 S XBTEN="TN - "_DFN
195 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)=""
196 D ^XBFMK
197 Q
198BRTH ;
199 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)=""
200 D ^XBFMK
201 Q
202DTH ;
203 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)=""
204 D ^XBFMK
205 Q
206F201 ;
207 S XBSCR=$S(AUPNSEX="M":3,1:2)
208 D FNAME
209 D LNAME
210 S XBNAME=XBLNAME_","_XBFNAME
211 S DA=DFN,DIE="^DPT(",DR=".01///"_XBNAME D ^DIE
212 I $D(Y) S ^XTMP("SAN","FAILURE","PATNAME",DFN)=""
213 D ^XBFMK
214 Q
215FNAME ;
216 I XBSCR=3 S X=^XTMP("SAN",$J,"FIRSTM") D R S XBFNAME=^XTMP("SAN",$J,"FIRSTM",X) Q
217 S X=^XTMP("SAN",$J,"FIRSTF") D R S XBFNAME=^XTMP("SAN",$J,"FIRSTF",X)
218 Q
219LNAME ;
220 S X=^XTMP("SAN",$J,"LAST") D R S XBLNAME=^XTMP("SAN",$J,"LAST",X)
221 Q
222F203 ;dob
223 S XBDOB=$P(^DPT(DFN,0),U,3)
224 I XBDOB="" Q
225 S XBDOB=$$FMADD^XLFDT(XBDOB,-33)
226 S DIE="^DPT(",DA=DFN,DR=".03///"_XBDOB D ^DIE
227 I $D(Y) S ^XTMP("SAN","FAILURE","PATDOB",DFN)=""
228 D ^XBFMK
229 Q
230F2211 ;nok/emergency contact name
231 S XBSCR=2 D FNAME S XBNOK=XBLNAME_","_XBFNAME
232 I $P($G(^DPT(DFN,.21)),U,1)]"" D
233 .D ^XBFMK
234 .S DIE="^DPT(",DR=".211///"_XBNOK,DA=DFN D ^DIE
235 .I $D(Y) S ^XTMP("SAN","FAILURE","PATNOK",DFN)=""
236 .D ^XBFMK
237 I $P($G(^DPT(DFN,.33)),U,1)]"" D
238 .S DIE="^DPT(",DR=".331///"_XBNOK,DA=DFN D ^DIE
239 .I $D(Y) S ^XTMP("SAN","FAILURE","PATECN",DFN)=""
240 .D ^XBFMK
241 Q
242F2212 ;
243 D ^XBFMK
244 I $P($G(^DPT(DFN,.21)),U,2)]"" D
245 .S DA=DFN,DIE="^DPT(",DR=".212///MOTHER" D ^DIE
246 .I $D(Y) S ^XTMP("SAN","FAILURE","PATNOKMOTHER",DFN)=""
247 .D ^XBFMK
248 I $P($G(^DPT(DFN,.33)),U,2)]"" D
249 .S DA=DFN,DIE="^DPT(",DR=".332///"_"MOTHER" D ^DIE
250 .I $D(Y) S ^XTMP("SAN","FAILURE","PATECNMOTHER",DFN)=""
251 .D ^XBFMK
252 Q
253F22401 ;father's name
254 I $P($G(^DPT(DFN,.24)),U,1)="" Q
255 S XBSCR=3 D FNAME S XBDAD=XBLNAME_","_XBFNAME
256 S DIE="^DPT(",DR=".2401///"_XBDAD,DA=DFN D ^DIE
257 I $D(Y) S ^XTMP("SAN","FAILURE","PATFATHER",DFN)=""
258 D ^XBFMK
259 Q
260F22402 ;mother's name
261 S XBSCR=2 D FNAME S XBMOM=XBLNAME_","_XBFNAME
262 I $P($G(^DPT(DFN,.24)),U,2)="" Q
263 S DIE="^DPT(",DR=".2402///"_XBMOM,DA=DFN D ^DIE
264 I $D(Y) S ^XTMP("SAN","FAILURE","PATMOTHER",DFN)=""
265 D ^XBFMK
266 Q
267F22403 ;mother's maiden name
268 D LNAME
269 S XBMMN=XBLNAME_","_$P(XBMOM,",",2)
270 I $P($G(^DPT(DFN,.24)),U,3)="" Q
271 S DIE="^DPT(",DR=".2403///"_XBMMN,DA=DFN D ^DIE
272 I $D(Y) S ^XTMP("SAN","FAILURE","PATMOTHMAIDNAM",DFN)=""
273 D ^XBFMK
274 Q
275OTHNAME ;
276 S OTDFN=0 F S OTDFN=$O(^DPT(DFN,.01,OTDFN)) Q:OTDFN'=+OTDFN D
277 .D LNAME
278 .S XBNAME=XBLNAME_","_XBFNAME
279 .S DA=OTDFN,DIE="^DPT("_DFN_",.01,",DA(1)=DFN,DR=".01///"_XBNAME D ^DIE
280 .I $D(Y) S ^XTMP("SAN","FAILURE","PATOTHRNAME",DFN)=""
281 .D ^XBFMK
282 Q
283F2111 ;
284 I $P($G(^DPT(DFN,.11)),U,1)]"" D
285 .S X=^XTMP("SAN",$J,"ADL1") D R S XBADDR=^XTMP("SAN",$J,"ADL1",X)
286 .S DIE="^DPT(",DR=".111///"_XBADDR,DA=DFN D ^DIE
287 .I $D(Y) S ^XTMP("SAN","FAILURE","PATADDRESS",DFN)=""
288 .D ^XBFMK
289 .S $P(^DPT(DFN,.11),U,2)="" ;addr 2nd line
290 .S $P(^DPT(DFN,.11),U,3)="" ;addr 3rd line
291 Q
292F2213 ;
293 I $P($G(^DPT(DFN,.21)),U,3)]"" D
294 .S X=^XTMP("SAN",$J,"ADL1") D R S XBADDR=^XTMP("SAN",$J,"ADL1",X)
295 .S DIE="^DPT(",DR=".213///"_XBADDR,DA=DFN D ^DIE
296 .I $D(Y) S ^XTMP("SAN","FAILURE","PATADDRESSL11",DFN)=""
297 .D ^XBFMK
298 I $P($G(^DPT(DFN,.33)),U,3)]"" D
299 .S X=^XTMP("SAN",$J,"ADL1") D R S XBADDR=^XTMP("SAN",$J,"ADL1",X)
300 .S DIE="^DPT(",DR=".333.//"_XBADDR,DA=DFN D ^DIE
301 .I $D(Y) S ^XTMP("SAN","FAILURE","PATADDRESSL111",DFN)=""
302 .D ^XBFMK
303 Q
304POLICY ;
305 ;loop through policy holder
306 ;if has patient pointer use patient name and address and
307 D ^XBFMK
308 S XBP=$O(^AUPN3PPH("C",DFN,0))
309 I 'XBP K XBP Q
310 S XBTEN=$P($G(^DPT(DFN,.11)),U,1)
311 S DA=XBP,DIE="^AUPN3PPH(",DR=".01///"_XBNAME_";.04///"_XBSSN_";.09///"_XBTEN_";.11///@;.13///@;.14///@;.19///"_XBDOB D ^DIE
312 I $D(Y) S ^XTMP("SAN","FAILURE","PATPOLICY",DA)=""
313 D ^XBFMK
314 Q
315INSURE ;
316 D MCR,PI,MCD,RR
317 Q
318MCR ;
319 ;MEDICARE
320 Q:'$D(^AUPNMCR(DFN))
321 S X=^XTMP("SAN",$J,"DLAST") D R S XBDLAST=^XTMP("SAN",$J,"DLAST",X)
322 S X=^XTMP("SAN",$J,"DFIRST") D R S XBDFIRST=^XTMP("SAN",$J,"DFIRST",X)
323 S XBDLAST=XBDLAST_","_XBDFIRST
324 D SSNR
325 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
326 I $D(Y) S ^XTMP("SAN","FAILURE","PATMEDICARE",DFN)=""
327 D ^XBFMK
328 Q
329PI ;
330 Q:'$D(^AUPNPRVT(DFN))
331 Q:'$D(^AUPNPRVT(DFN,11))
332 S XBMDFN=0 F S XBMDFN=$O(^AUPNPRVT(DFN,11,XBMDFN)) Q:XBMDFN'=+XBMDFN D
333 .S $P(^AUPNPRVT(DFN,11,XBMDFN,0),U,2)=XBSSN
334 .S $P(^AUPNPRVT(DFN,11,XBMDFN,0),U,4)=XBNAME
335 .S $P(^AUPNPRVT(DFN,11,XBMDFN,0),U,12)=""
336 .S $P(^AUPNPRVT(DFN,11,XBMDFN,0),U,14)=""
337 Q
338 ;
339RR ;
340 Q:'$D(^AUPNRRE(DFN))
341 S X=^XTMP("SAN",$J,"DLAST") D R S XBDLAST=^XTMP("SAN",$J,"DLAST",X)
342 S X=^XTMP("SAN",$J,"DFIRST") D R S XBDFIRST=^XTMP("SAN",$J,"DFIRST",X)
343 S XBDLAST=XBDLAST_","_XBDFIRST
344 D SSNR
345 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
346 I $D(Y) S ^XTMP("SAN","FAILURE","PATRAILROAD",DFN)=""
347 D ^XBFMK
348 Q
349MCD ;
350 S XBMDFN=0 F S XBMDFN=$O(^AUPNMCD("B",DFN,XBMDFN)) Q:XBMDFN'=+XBMDFN D
351 .S X=^XTMP("SAN",$J,"DLAST") D R S XBDLAST=^XTMP("SAN",$J,"DLAST",X)
352 .S X=^XTMP("SAN",$J,"DFIRST") D R S XBDFIRST=^XTMP("SAN",$J,"DFIRST",X)
353 .S DIE="^AUPNMCD(",DA=XBMDFN,DR=".05///@;.12///@;.13///@" D ^DIE
354 .D ^XBFMK
355 .S XBDNAME=XBDLAST_","_XBDFIRST
356 .D SSNR
357 .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
358 .I $D(Y) S ^XTMP("SAN","FAILURE","PATMEDICAID",DA)=""
359 .D ^XBFMK
360 Q
361XBCHART ;
362 S XBH=0 F S XBH=$O(^AUPNPAT(DFN,41,XBH)) Q:XBH'=+XBH S XBCHART=XBCHART+1 D
363 .S DA=XBH,DIE="^AUPNPAT("_DFN_",41,",DA(1)=DFN,DR=".02///"_XBCHART D ^DIE
364 .I $D(Y) S ^XTMP("SAN","FAILURE","PATCHART",DFN)=""
365 .D ^XBFMK
366 Q
367F209 ;
368 I $P($G(^DPT(DFN,0)),U,9)="" Q
369 D SSNR
370 S DIE="^DPT(",DA=DFN,DR=".09///"_XBSSN D ^DIE
371 I $D(Y) S DA=DFN,DIE="^DPT(",DR=".09///@" D ^DIE
372 I $D(Y) S ^XTMP("SAN","FAILURE","PATSSN",DFN)=""
373 D ^XBFMK
374 Q
375F2219 ;nok phone
376 I $P($G(^DPT(DFN,.21)),U,9)]"" D PHNR D ;S $P(^DPT(DFN,.21),U,9)="555-888-"_XBPHN
377 .S XBPHN="555-888-"_XBPHN
378 .S DIE="^DPT(",DA=DFN,DR=".219///"_XBPHN D ^DIE
379 .I $D(Y) S ^XTMP("SAN","FAILURE","PATPHONE",DFN)=""
380 .D ^XBFMK
381 I $P($G(^DPT(DFN,.33)),U,9)]"" D PHNR D ;S $P(^DPT(DFN,.33),U,9)="555-888-"_XBPHN
382 .S XBPHN="555-888-"_XBPHN
383 .S DIE="^DPT(",DA=DFN,DR=".339///"_XBPHN D ^DIE
384 .I $D(Y) S ^XTMP("SAN","FAILURE","PATPHONE1",DFN)=""
385 .D ^XBFMK
386 Q
387F2131 ;
388 I $P($G(^DPT(DFN,.13)),U,1)]"" D PHNR D
389 .S XBPHN="555-555-"_XBPHN
390 .S DIE="^DPT(",DA=DFN,DR=".131///"_XBPHN D ^DIE
391 .I $D(Y) S ^XTMP("SAN","FAILURE","PATPHONE2",DFN)=""
392 .D ^XBFMK
393 Q
394F2132 ;
395 Q:$P($G(^DPT(DFN,.13)),U,2)="" ;no office phone
396 D PHNR S XBPHN="555-999-"_XBPHN
397 S DIE="^DPT(",DA=DFN,DR=".132///"_XBPHN D ^DIE
398 I $D(Y) S ^XTMP("SAN","FAILURE","PATPHONE3",DFN)=""
399 D ^XBFMK
400 Q
401 ;
402DELP ;delete patients with no visits
403 ;S XBCNT=0,XBP=0 F S XBP=$O(^DPT(XBP)) Q:XBP'=+XBP D
404 ;.Q:$D(^AUPNVSIT("AC",XBP))
405 ;.S DA=XBP,DIK="^DPT(" D ^DIK
406 ;.S DA=XBP,DIK="^AUPNPAT(" D ^DIK
407 ;.W DA,":" S XBCNT=XBCNT+1
408 ;.Q
409 ;W !,XBCNT
410 ;Q
411CLEAN ;
412 K ^XTMP("SAN",$J,"FIRSTM")
413 K ^XTMP("SAN",$J,"FIRSTF")
414 K ^XTMP("SAN",$J,"ADL1")
415 K ^XTMP("SAN",$J,"NOKADL")
416 K ^XTMP("SAN","FAILURE")
417 K ^XTMP("SAN",$J,"DLAST")
418 K ^XTMP("SAN",$J,"DFIRST")
419 K ^XTMP("SAN","PROCESS","DUZ")
420 K ^XTMP("SAN","DUZFAILURE")
421 D ^XBKVAR
422 S (XBC(1),XBC(2))=0,XBX=1 F S XBX=$O(^VA(200,XBX)) Q:+XBX=0 D
423 .S XBNAME=$P($G(^VA(200,XBX,0)),U,1)
424 .S XBLAST=$P(XBNAME,",",1) S:'$L(XBLAST) XBLAST="MOUSE"
425 .S XBFIRST=$P(XBNAME,",",2) S:'$L(XBFIRST) XBFIRST="MICKEY"_+XBX
426 .S XBC(1)=XBC(1)+1,^XTMP("SAN",$J,"DLAST")=XBC(1),^XTMP("SAN",$J,"DLAST",XBC(1))=XBLAST
427 .S XBC(2)=XBC(2)+1,^XTMP("SAN",$J,"DFIRST")=XBC(2),^XTMP("SAN",$J,"DFIRST",XBC(2))=XBFIRST
428 D ^XBKVAR
429 F I=1:1:5 S XBC(I)=0
430 S Y=0 F S Y=$O(^DPT(Y)) Q:+Y=0 D
431 .S XBVAL=$G(^DPT(Y,0))
432 .S XBNAME=$P(XBVAL,U,1)
433 .S XBLAST=$P(XBNAME,",",1)
434 .S XBFIRST=$P(XBNAME,",",2)
435 .S XBSEX=$P(XBVAL,U,2)
436 .S XBADL1=$P($G(^DPT(Y,.11)),U,1)
437 .S XBNOKADL=$P($G(^DPT(Y,.33)),U,3)
438SET .S XBC(1)=XBC(1)+1,^XTMP("SAN",$J,"LAST")=XBC(1),^XTMP("SAN",$J,"LAST",XBC(1))=XBLAST
439 .I $L(XBSEX) S:XBSEX="M" XBC(2)=XBC(2)+1,^XTMP("SAN",$J,"FIRSTM")=XBC(2),^XTMP("SAN",$J,"FIRSTM",XBC(2))=XBFIRST
440 .I $L(XBSEX) S:XBSEX="F" XBC(3)=XBC(3)+1,^XTMP("SAN",$J,"FIRSTF")=XBC(3),^XTMP("SAN",$J,"FIRSTF",XBC(3))=XBFIRST
441 .I $L(XBADL1) S XBC(5)=XBC(5)+1,^XTMP("SAN",$J,"ADL1")=XBC(5),^XTMP("SAN",$J,"ADL1",XBC(5))=XBADL1
442 .I $L(XBNOKADL) S XBC(5)=XBC(5)+1,^XTMP("SAN",$J,"ADL1")=XBC(5),^XTMP("SAN",$J,"ADL1",XBC(5))=XBNOKADL
443 Q
444R S X2=$R(X) I X2=0 G R
445 S X=X2
446 Q
447 ;
448DUZ ;SCRAMBLES USER NAMES
449 K ^XTMP("SAN","FAILURE","DUZ")
450 K ^XTMP("SAN","FAILURE","DUZA")
451DUZA D ^XBFMK
452 S XBX=1 F S XBX=$O(^VA(200,XBX)) Q:+XBX=0 D
453 .S X=^XTMP("SAN",$J,"DLAST") D R S XBLAST=^XTMP("SAN",$J,"DLAST",X)
454 .S X=^XTMP("SAN",$J,"DFIRST") D R S XBFIRST=^XTMP("SAN",$J,"DFIRST",X)
455 .D DUZSSN
456 .;W !,$P(^VA(200,XBX,0),"^",1)," ",XBLAST," ",XBFIRST,$P($G(^VA(200,XBX,1)),"^",9)," ",DUZSSN
457 .I DUZSSN S DA=XBX,DIE=200,DR=".01///"_XBLAST_","_XBFIRST_";9///"_DUZSSN D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","DUZ",XBX)=""
458 .I 'DUZSSN S DA=XBX,DIE=200,DR=".01///"_XBLAST_","_XBFIRST D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","DUZ",XBX)=""
459 .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)=""
460 .S XBVANUM=1000000+XBX
461 .S XBDEANUM=2000000+XBX
462 .S DA=XBX,DIE=200,DR=";53.2///"_XBDEANUM_";53.3///"_XBVANUM D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","DUZDEAVA",XBX)=""
463 .D ^XBFMK
464 S ^XTMP("SAN","PROCESS","DUZ")="FINISHED"
465 Q
466DUZSSN ;CHANGES SSN FOR USER FILE
467 S DUZSSN=$P($G(^VA(200,XBX,1)),"^",9)
468 I DUZSSN D DUZSSNR S DUZSSN=XBSSN
469 Q
470DUZSSNR ;FIND RANDOM SSN
471 F S XBSSN=$R(999999999) Q:XBSSN>100000000&(XBSSN<800000000)
472 I $D(^VA(200,"SSN",XBSSN)) G DUZSSNR
473 Q
474ALLSSN ;ADDS SSN TO EVERY PATIENT
475 D ^XBFMK
476 S XBX=0 F S XBX=$O(^DPT(XBX)) Q:+XBX=0 D
477 .Q:$L($P($G(^DPT(XBX,0)),"^",9))
478 .D SSNR
479 .S DA=XBX,DIE=2,DR=".09///"_XBSSN D ^DIE K DIE,DA
480 .D ^XBFMK
481 S ^XTMP("SAN","PROCESS","SSN-ALL")="FINISHED"
482 Q
483SSNR ;FIND RANDOM SSN
484 F S XBSSN=$R(999999999) Q:XBSSN>100000000&(XBSSN<800000000)
485 I $D(^DPT("SSN",XBSSN)) G SSNR
486 Q
487PHNR ;FIND RANDOM PHONE
488 F S XBPHN=$R(9999) Q:XBPHN>1000&(XBPHN<9999)
489 Q
490 ;
491PATDEL ;
492 S DFN=0 F S DFN=$O(^DPT(DFN)) Q:DFN'=+DFN D
493 .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
494 .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
495 .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
496 .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
497 .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
498 .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
499 .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
500 .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
501 .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
502 .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
503 .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
504 .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
505 .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
506 .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
507 .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
508 .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
509 .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
510 .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
511 .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
512 .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
513 .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
514 .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
515 .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
516 .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
517 .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
518 .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
519 .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
520 .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
521 .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
522 .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
523 .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
524 .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
525 .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
526 .F X=12:1:15 K ^AUPNPAT(DFN,X)
527 .K ^AUPNPAT(DFN,42)
528 S ^XTMP("SAN","PROCESS","PATDELETEDATA")="FINISHED"
529 Q
530POSDEL ;
531 S XBX=0 F S XBX=$O(^ABSPC(XBX)) Q:+XBX=0 D
532 .S DA=XBX,DIK="^ABSPC(" D ^DIK,^XBFMK
533 S XBX=0 F S XBX=$O(^ABSPR(XBX)) Q:+XBX=0 D
534 .S DA=XBX,DIK="^ABSPR(" D ^DIK,^XBFMK
535 S DA=1,DIE="ABSP(9002313.56,",DR=".01///OUTPATIENT SITE;.02///12345;.03///456789;.05///123456789;.06///987654"
536 D ^DIE S:$D(Y) ^XTMP("SAN","FAILURE","POSDELETE",DA)="" D ^XBFMK
537 K ^ABSP(9002313.56,1,"ADDR")
538 K ^ABSP(9002313.56,1,"INSURER-ASSIGNED #")
539 K ^ABSP(9002313.56,1,"OPSITE")
540 S ^XTMP("SAN","PROCESS","POSDEL")="FINNISHED"
541 Q
542AR ;
543 D ^XBFMK S U="^",XBA=0 F S XBA=$O(^BARBL(XBA)) Q:+XBA=0 D
544 .S XBB=0 F S XBB=$O(^BARBL(XBA,XBB)) Q:+XBB=0 D
545 ..I $P($G(^BARBL(XBA,XBB,0)),U,12)]"" S DA=XBB,DIE="90050.01",DUZ(2)=XBA,DR="12///@" D ^DIE,^XBFMK
546 ..I $P($G(^BARBL(XBA,XBB,1)),U,5)]"" D
547 ...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
548 ..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
549 ..I $P($G(^BARBL(XBA,XBB,1)),U,7)]"" D
550 ...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
551 ..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
552 ..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
553 ..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
554 ..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
555 ..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
556 ..S DUZ(2)=XBA K ^BARBL(DUZ(2),XBB,10),^BARBL(DUZ(2),XBB,5),^BARBL(DUZ(2),XBB,6)
557 ..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
558 ..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
559 S ^XTMP("SAN","PROCESS","AR-BILL")="FINISHED"
560 S XBA=0 F S XBA=$O(^BARCOL(XBA)) Q:+XBA=0 D
561 .S XBB=0 F S XBB=$O(^BARCOL(XBA,XBB)) Q:+XBB=0 K ^BARTR(XBA,XBB,10)
562 S ^XTMP("SAN","PROCESS","AR-TRAN")="FINISHED"
563 S XBA=0 F S XBA=$O(^BARCOL(XBA)) Q:+XBA=0 D
564 .S XBB=0 F S XBB=$O(^BARCOL(XBA,XBB)) Q:+XBB=0 D
565 ..S XBC=0 F S XBC=$O(^BARCOL(XBA,XBB,"1",XBC)) Q:+XBC=0 D
566 ...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
567 ...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
568 ...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
569 ...K ^BARCOL(XBA,XBB,"1",XBC,5)
570 S ^XTMP("SAN","PROCESS","AR-COLL")="FINISHED"
571 S XBA=0 F S XBA=$O(^BAREDI("I",XBA)) Q:+XBA=0 D
572 .S XBB=0 F S XBB=$O(^BAREDI("I",XBA,XBB)) Q:+XBB=0 D
573 ..S DIK="^BAREDI(""I"",XBA,",DA=XBB,DUZ(2)=XBA=XBA D ^DIK,^XBFMK
574 S ^XTMP("SAN","PROCESS","AR-EDIIMP")="FINISHED"
575 S XBA=0 F S XBA=$O(^BAREDI("C",XBA)) Q:+XBA=0 D
576 .S XBB=0 F S XBB=$O(^BAREDI("C",XBA,XBB)) Q:+XBB=0 D
577 ..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
578 S ^XTMP("SAN","PROCESS","AR-EDIC")="FINISHED"
579 S XBA=0 F S XBB=$O(^BAR835(XBA)) Q:+XBA=0 D
580 .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
581 S ^XTMP("SAN","PROCESS","AR-EDI835")="FINISHED"
582 Q
583TPB ;3RD PARTY BILLING
584 D ^XBFMK
585 S U="^",XBA=0 F S XBA=$O(^ABMDCLM(XBA)) Q:+XBA=0 D
586 .S XBB=0 F S XBB=$O(^ABMDCLM(XBA,XBB)) Q:+XBB=0 D
587 ..I $L($P($G(^ABMDCLM(XBA,XBB,8)),U,8)) D
588 ...S X=^XTMP("SAN",$J,"DLAST") D R S XBLAST=^XTMP("SAN",$J,"DLAST",X)
589 ...S X=^XTMP("SAN",$J,"DFIRST") D R S XBFIRST=^XTMP("SAN",$J,"DFIRST",X)
590 ...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
591 ..I $L($P($G(^ABMDCLM(XBA,XBB,8)),U,11)) D
592 ...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
593 ..I $L($P($G(^ABMDCLM(XBA,XBB,9)),U,12)) D
594 ...S X=^XTMP("SAN",$J,"DLAST") D R S XBLAST=^XTMP("SAN",$J,"DLAST",X)
595 ...S X=^XTMP("SAN",$J,"DFIRST") D R S XBFIRST=^XTMP("SAN",$J,"DFIRST",X)
596 ...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
597 S ^XTMP("SAN","PROCESS","3P-CLAIM")="FINISHED"
598 S XBA=0 F S XBA=$O(^ABMDBILL(XBA)) Q:+XBA=0 D
599 .S XBB=0 F S XBB=$O(^ABMDBILL(XBA,XBB)) Q:+XBB=0 D
600 ..I $L($P($G(^ABMDBILL(XBA,XBB,8)),U,8)) D
601 ...S X=^XTMP("SAN",$J,"DLAST") D R S XBLAST=^XTMP("SAN",$J,"DLAST",X)
602 ...S X=^XTMP("SAN",$J,"DFIRST") D R S XBFIRST=^XTMP("SAN",$J,"DFIRST",X)
603 ...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
604 ..I $L($P($G(^ABMDBILL(XBA,XBB,8)),U,11)) D
605 ...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
606 ..I $L($P($G(^ABMDBILL(XBA,XBB,9)),U,12)) D
607 ...S X=^XTMP("SAN",$J,"DLAST") D R S XBLAST=^XTMP("SAN",$J,"DLAST",X)
608 ...S X=^XTMP("SAN",$J,"DFIRST") D R S XBFIRST=^XTMP("SAN",$J,"DFIRST",X)
609 ...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
610 S ^XTMP("SAN","PROCESS","3P-BILL")="FINISHED"
611 Q
612LAB ;
613 S X=0 F S X=$O(^LR(X)) Q:X'=+X D
614 .S Y=0 F S Y=$O(^LR(X,"CH",Y)) Q:Y'=+Y D
615 ..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
616 .S Y=0 F S Y=$O(^LR(X,"MI",Y)) Q:Y'=+Y D
617 ..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
618 ..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
619 ..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
620 ..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
621 ..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
622 ..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
623 ..K ^LR(X,"MI",Y,99)
624 S X=0 F S X=$O(^LRO(69,X)) Q:X'=+X D
625 .I $D(^LRO(69,X,1,"AL")) K ^LRO(69,X,1,"AL")
626 .I $D(^LRO(69,X,1,"AP")) K ^LRO(69,X,1,"AP")
627 .I $D(^LRO(69,X,1,"AR")) K ^LRO(69,X,1,"AR")
628 S X=$P(^BLRTXLOG(0),U,1,2) K ^BLRTXLOG S ^BLRTXLOG(0)=X
629 S ^XTMP("SAN","PROCESS","LAB")="FINISHED"
630 D ^LROC
631 Q
632LISTE ;
633 W !,"Listed below are the nodes and number of records that did not"
634 W !,"update properly. At the end of the sanitization, the records"
635 W !,"for Patient Name failures are rerun. PATNAME2 nodes represent"
636 W !,"Patient Names that should be manually changed with fileman."
637 W !,"XTMP(""SAN"",""PROCESS"") nodes:"
638 W !,"XTMP(""SAN"",""FAILURE"") nodes:"
639 S X="" F S X=$O(^XTMP("SAN","FAILURE",X)) Q:X="" D
640 .S (Y,Z)=0 F S Y=$O(^XTMP("SAN","FAILURE",X,Y)) Q:+Y=0 D
641 ..S Z=Z+1
642 .W !,"Failure: "_X_" "_Z
643 W !,"FINISHED" Q
644LISTD ;
645 W !,"Listed below are the processes completed."
646 W !,"XTMP(""SAN"",""PROCESS"") nodes:"
647 S X="" F S X=$O(^XTMP("SAN","PROCESS",X)) Q:X="" D
648 .W !,"Process: "_X
649 W !,"FINISHED" Q
650MCDE ;
651 S DFN=0 F S DFN=$O(^AUPNMCD("B",DFN)) Q:+DFN=0 D
652 .S XBMDFN=0 F S XBMDFN=$O(^AUPNMCD("B",DFN,XBMDFN)) Q:XBMDFN'=+XBMDFN D
653 ..S X=^XTMP("SAN",$J,"DLAST") D R S XBDLAST=^XTMP("SAN",$J,"DLAST",X)
654 ..S X=^XTMP("SAN",$J,"DFIRST") D R S XBDFIRST=^XTMP("SAN",$J,"DFIRST",X)
655 ..S DIE="^AUPNMCD(",DA=XBMDFN,DR=".05///@;.12///@;.13///@" D ^DIE
656 ..I $D(Y) S ^XTMP("SAN","FAILURE","PATMCDEA",DA)=""
657 ..D ^XBFMK
658 ..S XBDNAME=XBDLAST_","_XBDFIRST
659 ..D SSNR
660 ..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
661 ..I $D(Y) S ^XTMP("SAN","FAILURE","PATMCDEB",DA)=""
662 ..D ^XBFMK
663 S ^XTMP("SAN","PROCESS","MCD")="FINISHED"
664 Q
665MMDEL ;DELETES MAILMAN MESSAGES
666 K ^XMB(3.9)
667 S ^XMB(3.9,0)="MESSAGE^3.9s^0^0"
668 Q
669AUDEL ;DELETES AUDIT FILE
670 K ^DIA
671 S ^DIA(0)="AUDIT^1.1|"
672 Q
673NCDEL ;DELETES NAME COMPONENTS FILE
674 K ^VA(20)
675 S ^VA(20,0)="NAME COMPONENTS^20IA^^"
676 Q
677STU ;SETS STUDENT NAMES
678 K ^XTMP("SAN","FAILURE","STU")
679 K ^XTMP("SAN","FAILURE","STUA")
680STUA D ^XBFMK
681 S XBX=50 F S XBX=$O(^VA(200,XBX)) Q:+XBX>76 D
682 .S XBLAST=$E("ABCDEFGHIJKLMNOPQRSTUVWXYZ",XBX-50,XBX-50)_"STUDENT"
683 .S XBFIRST="USER"
684 .S DA=XBX,DIE=200,DR=".01///"_XBLAST_","_XBFIRST D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","STU",XBX)=""
685 .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)=""
686 .S DA=XBX,DIE=200,DR="201///`29" D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","STUMENU",XBX)=""
687 .D ^XBFMK
688 W !,"FINISHED"
689 Q
690FJADD1 ;
691 S DFN=0 F S DFN=$O(^XTMP("SAN","FAILURE","PATADDRESS",DFN)) Q:+DFN=0 I $P($G(^DPT(DFN,.11)),U,1)]"" D
692 .S XBADDR=DFN_" SMITH STREET"
693 .S DIE="^DPT(",DR=".111///"_XBADDR,DA=DFN D ^DIE
694 .I $D(Y) S ^XTMP("SAN","FAILURE","PATADDRESSFJ",DFN)=""
695 .D ^XBFMK
696 .S $P(^DPT(DFN,.11),U,2)="" ;addr 2nd line
697 .S $P(^DPT(DFN,.11),U,3)="" ;addr 3rd line
698 Q
699A2213 ;
700 I $P($G(^DPT(DFN,.21)),U,3)]"" D
701 .S X=^XTMP("SAN",$J,"ADL1") D R S XBADDR=^XTMP("SAN",$J,"ADL1",X)
702 .S DIE="^DPT(",DR=".213///"_XBADDR,DA=DFN D ^DIE
703 .I $D(Y) S ^XTMP("SAN","FAILURE","PATADDRESSL11",DFN)=""
704 .D ^XBFMK
705 I $P($G(^DPT(DFN,.33)),U,3)]"" D
706 .S X=^XTMP("SAN",$J,"ADL1") D R S XBADDR=^XTMP("SAN",$J,"ADL1",X)
707 .S DIE="^DPT(",DR=".333.//"_XBADDR,DA=DFN D ^DIE
708 .I $D(Y) S ^XTMP("SAN","FAILURE","PATADDRESSL111",DFN)=""
709 .D ^XBFMK
710 Q
711A2219 ;nok phone
712 S DFN=0 F S DFN=$O(^XTMP("SAN","FAILURE","PATPHONE",DFN)) Q:+DFN=0 I $P($G(^DPT(DFN,.21)),U,9)]"" D
713 .S $P(^DPT(DFN,.21),U,9)="555-888-"_$E(DFN_"9999",1,4)
714 Q
715 S DFN=0 F S DFN=$O(^XTMP("SAN","FAILURE","PATPHONE1",DFN)) Q:+DFN=0 I $P($G(^DPT(DFN,.33)),U,9)]"" D
716 .S $P(^DPT(DFN,.33),U,9)="555-888-"_$E(DFN_"9999",1,4)
717 Q
Note: See TracBrowser for help on using the repository browser.