source: IHS-VA_UTILITIES-XB/XBSAN.m@ 641

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
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.