source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPS01P5.m@ 841

Last change on this file since 841 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 8.5 KB
RevLine 
[613]1BPS01P5 ;BHAM ISC/BEE - BPS*1.0*5 POST INSTALL ROUTINE ;14-NOV-06
2 ;;1.0;E CLAIMS MGMT ENGINE;**5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ;
6EN ;BPS*1.0*5 - POST-INSTALL
7 N X,Y,%DT,ZTDESC,ZTSAVE,ZTIO,ZTDTH,ZTRTN
8 S X="N",%DT="ST"
9 D ^%DT
10 S ZTDTH=Y
11 S ZTIO=""
12 S ZTDESC="BPS*1.0*5 POST INSTALL"
13 S ZTSAVE("*")=""
14 S ZTRTN="EN1^BPS01P5"
15 D ^%ZTLOAD
16 Q
17 ;
18EN1 N DIFROM,TMPARR,XMDUZ,XMSUB,XMTEXT,XMY
19 ;
20 ;Perform Data Cleanup - Delete Values from Obsolete Fields
21 D 02 ;BPS CLAIMS
22 D 31 ;BPS CERTIFICATION
23 D 56 ;BPS PHARMACIES
24 D 57 ;BPS LOG OF TRANSACTIONS
25 D 58 ;BPS STATISTICS
26 D 59 ;BPS TRANSACTIONS
27 D 91 ;BPS NCPDP FIELD DEFS
28 D 99^BPS01P5A ;BPS SETUP
29 ;
30 ;Delete Obsolete Files
31 D DEL^BPS01P5A
32 ;
33 ;Convert BPSECX/BPSECP
34 D EN^BPS01P5A
35 ;
36 ; Update BPS Statistics
37 D STAT^BPS01P5B
38 ;
39 ; Move Submit Date/Time from submit queue to BPS Transaction
40 D SUBMIT^BPS01P5B
41 ;
42 ;Delete obsolete BPS NCPDP FIELD DEF records
43 D DEL91^BPS01P5C
44 ;
45 ;Delete fields from data dictionaries
46 D EN^BPS01P5B
47 ;
48 ;Delete entries from 'BPS NCPDP FIELD 420' with leading zeros.
49 D 420
50 ;
51 ;Clean up indexes
52 D IND
53 ;
54 ;Send mail to the user
55 S TMPARR(1)=""
56 S TMPARR(2)="The conversion of data from the ^BPSECP global to the BPS LOG file"
57 I $D(^BPSECP("LOG")) S TMPARR(3)="did not complete properly. Please log a Remedy Ticket"
58 E S TMPARR(3)="has successfully completed."
59 S XMSUB="BPS*1.0*5 installation has been completed"
60 S XMDUZ="E CLAIMS MGMT ENGINE PACKAGE"
61 S XMTEXT="TMPARR("
62 S XMY(DUZ)=""
63 S XMY("G.BPS OPECC")=""
64 D ^XMD
65 Q
66 ;
67 ;BPS CLAIMS (#9002313.02)
6802 N IEN,IEN02,IEN57,IEN92,NODE0,VPIEN
69 S IEN=0 F S IEN=$O(^BPSC(IEN)) Q:'IEN D
70 .N I,X
71 .;
72 .;Fix 'Transmitted On'
73 .S NODE0=$G(^BPSC(IEN,0))
74 .I $P(NODE0,U,5)="" D
75 ..S $P(NODE0,U,5)=$P(NODE0,U,6)
76 ..I $P(NODE0,U,5)]"" S ^BPSC("AE",$E($P(NODE0,U,5),1,30),IEN)=""
77 .;
78 .;Fix fields for Reversal Claims
79 .I $P($G(^BPSC(IEN,100)),U,3)="B2" D
80 ..S IEN57=$O(^BPSTL("AER",IEN,"")) Q:IEN57=""
81 ..;
82 ..;Electronic payer (.02)
83 ..S IEN92=$P($G(^BPSTL(IEN57,10,1,0)),U,3)
84 ..S:IEN92 $P(NODE0,U,2)=IEN92
85 ..;
86 ..;Original Claim IEN
87 ..S IEN02=$P($G(^BPSTL(IEN57,0)),U,4) Q:IEN02=""
88 ..;
89 ..;MEDICATION NUMBER (.03)/MEDICATION NAME (.04)
90 ..N MED S MED=$G(^BPSC(IEN,400,1,0))
91 ..S:$P(MED,U,3)="" $P(MED,U,3)=1
92 ..S:$P(MED,U,4)="" $P(MED,U,4)=$P($G(^BPSC(IEN02,400,1,0)),U,4)
93 ..S ^BPSC(IEN,400,1,0)=MED
94 ..K MED
95 ..;
96 ..;VA PLAN IEN (1.04)
97 ..S VPIEN=$P($G(^BPSC(IEN02,1)),U,4)
98 ..S:VPIEN]"" $P(^BPSC(IEN,1),U,4)=VPIEN
99 .;
100 .;Store '0' Node
101 .S ^BPSC(IEN,0)=NODE0
102 .;
103 .;'1' Node
104 .S X=$G(^BPSC(IEN,1))
105 .I $TR(X,U)]"" D
106 ..F I=2,3 S $P(X,U,I)="" ;Reset selected fields
107 ..S ^BPSC(IEN,1)=X
108 .;
109 .;'300' Node
110 .S X=$G(^BPSC(IEN,300))
111 .I $TR(X,U)]"" D
112 ..F I=8,15,16,17,18,19 S $P(X,U,I)="" ;Reset selected fields
113 ..S ^BPSC(IEN,300)=X
114 .;
115 .;'320' Node
116 .K ^BPSC(IEN,320)
117 .;
118 .;'498' Node
119 .K ^BPSC(IEN,498)
120 .;
121 .N IEN2
122 .S IEN2=0 F S IEN2=$O(^BPSC(IEN,400,IEN2)) Q:'IEN2 D
123 ..;
124 ..;'400;0' Node
125 ..S X=$G(^BPSC(IEN,400,IEN2,0))
126 ..I $TR(X,U)]"" D
127 ...S $P(X,U,2)=""
128 ...S ^BPSC(IEN,400,IEN2,0)=X
129 ..;
130 ..;'400;400' Node
131 ..S X=$G(^BPSC(IEN,400,IEN2,400))
132 ..I $TR(X,U)]"" D
133 ...F I=4,10,16,22 S $P(X,U,I)=""
134 ...S ^BPSC(IEN,400,IEN2,400)=X
135 ..;
136 ..;'400;420' Node
137 ..S X=$G(^BPSC(IEN,400,IEN2,420))
138 ..I $TR(X,U)]"" D
139 ...F I=25,28,32 S $P(X,U,I)=""
140 ...S ^BPSC(IEN,400,IEN2,420)=X
141 ..;
142 ..;'400;430' Node
143 ..S X=$G(^BPSC(IEN,400,IEN2,430))
144 ..I $TR(X,U)]"" D
145 ...F I=7,9,10 S $P(X,U,I)=""
146 ...S ^BPSC(IEN,400,IEN2,430)=X
147 ..;
148 ..;'400;440' Node
149 ..S X=$G(^BPSC(IEN,400,IEN2,440))
150 ..I $TR(X,U)]"" D
151 ...S $P(X,U)=""
152 ...S ^BPSC(IEN,400,IEN2,440)=X
153 ;
154 K IEN,IEN02,IEN57,IEN92,VPIEN
155 Q
156 ;
157 ;BPS CERTIFICATION (#9002313.31)
15831 N IEN
159 ;
160 S IEN=0 F S IEN=$O(^BPS(9002313.31,IEN)) Q:'IEN D
161 .N X
162 .S X=$G(^BPS(9002313.31,IEN,0))
163 .I $TR(X,U)]"" S $P(X,U,5)="",^BPS(9002313.31,IEN,0)=X ;Reset field
164 .S X=$G(^BPS(9002313.31,IEN,4))
165 .I $TR(X,U)]"" S $P(X,U)="",^BPS(9002313.31,IEN,4)=X ;Reset field
166 ;
167 K IEN
168 Q
169 ;
170 ;BPS PHARMACIES (#9002313.56)
17156 N IEN,IEN2
172 ;
173 S IEN=0 F S IEN=$O(^BPS(9002313.56,IEN)) Q:'IEN D
174 .N I,X
175 .;
176 .;'0' Node
177 .S X=$G(^BPS(9002313.56,IEN,0))
178 .I $TR(X,U)]"" D
179 ..F I=4:1:7 S $P(X,U,I)="" ;Reset selected fields
180 ..S ^BPS(9002313.56,IEN,0)=X
181 .;
182 .;CAID' Node (Reset MEDICAID # and DEFAULT CAID PROVIDER #)
183 .K ^BPS(9002313.56,IEN,"CAID")
184 .;
185 .;'INSURER/INSURER-ASSIGNED #' Node (Reset INSURER and INSURER-ASSIGNED #)
186 .K ^BPS(9002313.56,IEN,"INSURER-ASSIGNED #")
187 .;
188 .;'PRESCRIBER' Node (Reset PRESCRIBER)
189 .S IEN2=0 F S IEN2=$O(^BPS(9002313.56,IEN,"OPSITE",IEN2)) Q:'IEN2 D
190 ..K ^BPS(9002313.56,IEN,"OPSITE",IEN2,1) ;Reset PRESCRIBER information
191 ;
192 K IEN,IEN2
193 Q
194 ;
195 ;BPS LOG OF TRANSACTIONS (#9002313.57)
19657 N IEN
197 S IEN=0 F S IEN=$O(^BPSTL(IEN)) Q:'IEN D
198 .N I,X
199 .;
200 .;'0' Node
201 .S X=$G(^BPSTL(IEN,0))
202 .I $TR(X,U)]"" D
203 ..F I=7,12:1:16 S $P(X,U,I)="" ;Reset selected fields
204 ..S ^BPSTL(IEN,0)=X
205 .;
206 .;'1' Node
207 .S X=$G(^BPSTL(IEN,1))
208 .I $TR(X,U)]"" D
209 ..F I=3,5,6,14 S $P(X,U,I)="" ;Reset selected fields
210 ..S ^BPSTL(IEN,1)=X
211 .;
212 .;'2' Node
213 .N NRES,RES,ND2
214 .S ND2=$G(^BPSTL(IEN,2))
215 .S RES=$P(ND2,U,2,99)
216 .S RES=$TR(RES,"]") ;Translate ']' to NULL
217 .;
218 .;Translate '[Previously: ' to ';'
219 .S NRES=""
220 .F I=1:1:$L(RES,"[Previously: ") S NRES=NRES_$S(I>1:";",1:"")_$P(RES,"[Previously: ",I)
221 .;
222 .;Store changes
223 .S ^BPSTL(IEN,2)=$P(ND2,U)_U_NRES
224 .;
225 .;'3' Node
226 .K ^BPSTL(IEN,3)
227 .;
228 .;'4' Node
229 .S X=$G(^BPSTL(IEN,4))
230 .I $TR(X,U)]"" D
231 ..S $P(X,U,3)="" ;Reset PAPER REVERSAL
232 ..S ^BPSTL(IEN,4)=X
233 .;
234 .;'5' Node
235 .S X=$G(^BPSTL(IEN,5))
236 .I $TR(X,U)]"" D
237 ..S $P(X,U,6)="" ;Reset PRICE MANUALLY ENTERED
238 ..S ^BPSTL(IEN,5)=X
239 .;
240 .;'6' Node
241 .K ^BPSTL(IEN,6)
242 .;
243 .;'7' Node
244 .K ^BPSTL(IEN,7)
245 .;
246 .;'8' Node
247 .S X=$G(^BPSTL(IEN,8))
248 .I $TR(X,U)]"" D
249 ..S $P(X,U,2)="" ;Reset RETRY ON DIAL OUT
250 ..S ^BPSTL(IEN,8)=X
251 ;
252 K IEN
253 Q
254 ;
255 ;BPS STATISTICS (#9002313.58)
25658 N DIK,IEN,X
257 ;
258 ;Clear out the "B" index
259 K ^BPSECX("S","B")
260 ;
261 S IEN=0 F S IEN=$O(^BPSECX("S",IEN)) Q:'IEN D
262 .;
263 .;'M' Node
264 .K ^BPSECX("S",IEN,"M")
265 .;
266 .;'C' Node
267 .K ^BPSECX("S",IEN,"C")
268 .;
269 .;'CT' Node
270 .K ^BPSECX("S",IEN,"CT")
271 .;
272 .;'D' Node
273 .K ^BPSECX("S",IEN,"D")
274 .;
275 .;'CR' Node
276 .K ^BPSECX("S",IEN,"CR")
277 .;
278 .;'CR2' Node
279 .K ^BPSECX("S",IEN,"CR2")
280 .;
281 .;'CRN' Node
282 .K ^BPSECX("S",IEN,"CRN")
283 .;
284 .;'ABSBPOSV' Node
285 .K ^BPSECX("S",IEN,"ABSBPOSV")
286 .;
287 .;'V' Node
288 .K ^BPSECX("S",IEN,"V")
289 .;
290 .;Copy IEN into .01 field
291 .S X=$G(^BPSECX("S",IEN,0))
292 .S $P(X,U)=IEN,^BPSECX("S",IEN,0)=X
293 .S ^BPSECX("S","B",$E(IEN,1,30),IEN)=""
294 .;
295 .;Update File Header Field
296 .S $P(^BPSECX("S",0),U,3)=IEN
297 ;
298 K DIK,IEN,X
299 ;
300 Q
301 ;
302 ;BPS TRANSACTION (#9002313.59)
30359 N IEN
304 S IEN=0 F S IEN=$O(^BPST(IEN)) Q:'IEN D
305 .N I,X
306 .;
307 .;'0' Node
308 .S X=$G(^BPST(IEN,0))
309 .I $TR(X,U)]"" D
310 ..F I=7,12:1:16 S $P(X,U,I)="" ;Reset selected fields
311 ..S ^BPST(IEN,0)=X
312 .;
313 .;'1' Node
314 .S X=$G(^BPST(IEN,1))
315 .I $TR(X,U)]"" D
316 ..F I=3,5,6,14 S $P(X,U,I)="" ;Reset selected fields
317 ..S ^BPST(IEN,1)=X
318 .;
319 .;'2' Node
320 .N NRES,RES,ND2
321 .S ND2=$G(^BPST(IEN,2))
322 .S RES=$P(ND2,U,2,99)
323 .S RES=$TR(RES,"]") ;Translate ']' to NULL
324 .;
325 .;Translate '[Previously: ' to ';'
326 .S NRES=""
327 .F I=1:1:$L(RES,"[Previously: ") S NRES=NRES_$S(I>1:";",1:"")_$P(RES,"[Previously: ",I)
328 .;
329 .;Store changes
330 .S ^BPST(IEN,2)=$P(ND2,U)_U_NRES
331 .S $P(^BPST(IEN,2),U,2)=NRES
332 .;
333 .;'3' Node
334 .K ^BPST(IEN,3)
335 .;
336 .;'4' Node
337 .S X=$G(^BPST(IEN,4))
338 .I $TR(X,U)]"" D
339 ..S $P(X,U,3)="" ;Reset PAPER REVERSAL
340 ..S ^BPST(IEN,4)=X
341 .;
342 .;'5' Node
343 .S X=$G(^BPST(IEN,5))
344 .I $TR(X,U)]"" D
345 ..S $P(X,U,6)="" ;Reset PRICE MANUALLY ENTERED
346 ..S ^BPST(IEN,5)=X
347 .;
348 .;'6' Node
349 .K ^BPST(IEN,6)
350 .;
351 .;'7' Node
352 .K ^BPST(IEN,7)
353 .;
354 .;'8' Node
355 .S X=$G(^BPST(IEN,8))
356 .I $TR(X,U)]"" D
357 ..S $P(X,U,2)="" ;Reset RETRY ON DIAL OUT
358 ..S ^BPST(IEN,8)=X
359 ;
360 K IEN
361 Q
362 ;
363 ;BPS NCPDP FIELD DEFS (#9002313.91)
36491 N IEN
365 S IEN=0 F S IEN=$O(^BPSF(9002313.91,IEN)) Q:'IEN D
366 .N I,X
367 .;
368 .;'0' Node
369 .S X=$G(^BPSF(9002313.91,IEN,0))
370 .I $TR(X,U)]"" D
371 ..F I=2,5 S $P(X,U,I)="" ;Reset selected fields
372 ..S ^BPSF(9002313.91,IEN,0)=X
373 .;
374 .;Remove Format Code (Field 20)
375 .K ^BPSF(9002313.91,IEN,20)
376 ;
377 K IEN
378 Q
379 ;
380 ;Delete entries with leading zeros from BPS NCPDP FIELD 420 (#9002313.8242)
381420 N DIE,DA,DR,CD
382 S CD=0 F S CD=$O(^BPSF(9002313.8242,"B",CD)) Q:CD="" D
383 .I $E(CD,1)'="0" Q
384 .S DA=$O(^BPSF(9002313.8242,"B",CD,"")) Q:DA=""
385 .S DIE=9002313.8242,DR=".01////@"
386 .D ^DIE
387 Q
388 ;
389 ;Delete indexes
390IND K ^BPSC("D") ;9002313.02 - Billing Item PCN #
391 K ^BPSC("E") ;9002313.02 - Billing Item VCN #
392 K ^BPSTL("AI") ;9002313.57 - INSURER
393 K ^BPSTL("AR") ;9002313.57 - POSTED TO A/R
394 K ^BPSTL("AS") ;9002313.57 - NEEDS BILLING
395 K ^BPST("AR") ;9002313.59 - POSTED TO A/R
396 Q
Note: See TracBrowser for help on using the repository browser.