source: FOIAVistA/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPS01P5A.m@ 1470

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

initial load of FOIAVistA 6/30/08 version
File size: 8.9 KB
Line 
1BPS01P5A ;BHAM ISC/BEE - Post-Install for BPS*1*5 (cont) ;13-DEC-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 ;
5 Q
6 ;
7 ; Called by the BPS*1.0*5 Post-Install routine BPS01P5.
8 ;
9 ; This routine will convert or delete the invalid usage of globals
10 ; ^BPSECX and ^BPSECP
11 ; It will also delete several ECME files that are now obsolete
12 ;
13 ; ^BPSECX cleanup - Here are the nodes and what should be done
14 ; "BPSOSRX" is the processing queue - Convert to XTMP and delete
15 ; "R" is the BPS Report Master database (obsolete) and will be
16 ; deleted by BPSO1P5
17 ; "S" is the BPS Statistics database and should not be deleted
18 ; "POS", "BPSOSQ3", and $J were for HL7 packet creation. They
19 ; do not need to be converted and can just be killed.
20 ;
21 ;
22 ; ^BPSECP cleanup - Here are the nodes and what should be done
23 ; "CHECKTIM" - Used for queuing BPSOSQ1. This is no longer
24 ; needed and can just be killed.
25 ; "LOG" - Convert to BPS Log file and then delete.
26 ;
27EN ;
28 ; Remove XTMP global used for logging errors
29 K ^XTMP("BPS01P5A")
30 ;
31 ; First convert ^BPSECP("BPSOSRX") into XTMP and delete it
32 M ^XTMP("BPS-PROC")=^BPSECP("BPSOSRX")
33 K ^BPSECP("BPSOSRX")
34 ; If the global has been created but the zero node is missing, set it
35 I $D(^XTMP("BPS-PROC")),'$D(^XTMP("BPS-PROC",0)) D
36 . N X,X1,X2
37 . S X1=DT,X2=30 D C^%DTC
38 . S ^XTMP("BPS-PROC",0)=X_U_DT_U_"ECME PROCESSING QUEUE"
39 ;
40 ; Second, kill off unneeded ^BPSECX nodes
41 ; Note that we need to loop because of the $J nodes.
42 N SUB
43 S SUB=""
44 F S SUB=$O(^BPSECX(SUB)) Q:SUB="" I SUB'="S",SUB'="RPT" K ^BPSECX(SUB)
45 ;
46 ; Third, kill ^BPSECP("CHECKTIM")
47 K ^BPSECP("CHECKTIM")
48 ;
49 ; Fourth, convert ^BPSECP("LOG")
50 ; Note that we are only converting the transaction log (pattern match .N1"."5N)
51 ; and purge logs (type=5). Other communication logs are being deleted.
52 N SLOT,TXTIEN,PURGE,LOGIEN,PDT
53 N TXTIEN,TM,TMP,TXT,TXT1,TXT2,PDTM
54 S SLOT=""
55 F S SLOT=$O(^BPSECP("LOG",SLOT)) Q:SLOT="" D
56 . ; Set PURGE equal to whether the SLOT if a Purge Log
57 . S PURGE=$P(SLOT,".",2)=5
58 . ; If not transaction log or purge log, delete it and go on
59 . I SLOT'?.N1"."5N,'PURGE K ^BPSECP("LOG",SLOT) Q
60 . ; Create/find LOG IEN
61 . S LOGIEN=$$LOG(SLOT)
62 . I LOGIEN=-1 Q
63 . S PDT="",PDTM=""
64 . I PURGE S PDT=$P(SLOT,".",1)
65 . S TXTIEN=0 F S TXTIEN=$O(^BPSECP("LOG",SLOT,TXTIEN)) Q:TXTIEN="" D
66 .. ; Get data
67 .. S X=$G(^BPSECP("LOG",SLOT,TXTIEN))
68 .. S TM=$P($$HTFM^XLFDT(+$H_","_$P(X,U,1)),".",2),TXT=$P(X,U,2),TXT1=$$UP(TXT)
69 .. ; If it is a transaction log, get the purge date
70 .. I 'PURGE D
71 ... I TXT1["BEFORE SUBMIT OF CLAIM" S TMP=$P($P(TXT1," - ",2)," BEFORE",1) I TMP?1"30"5N S PDT=TMP
72 ... I TXT1["BEFORE SUBMIT OF REVERSAL" S TMP=$P($P(TXT1," - ",2)," BEFORE",1) I TMP?1"30"5N S PDT=TMP
73 ... I TXT1["START OF CLAIM" S X=$P($P(TXT1,"START OF CLAIM - ",2),"@"),PDT=$$CDT(X,PDT)
74 ... I TXT1["LOG TIME STAMP" D
75 .... S X=$P(TXT1,"LOG TIME STAMP",2)
76 .... I $E(X,1)=" " S X=$E(X,2,999)
77 .... S X=$P($P(X," ",1,2),"@",1),PDT=$$CDT(X,PDT)
78 ... S TXT2=","_$E(TXT1,1,3)_","
79 ... I ",JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC,"[TXT2 S X=$P($P(TXT1," ",1,2),"@",1),PDT=$$CDT(X,PDT)
80 .. I PDT="" S ^XTMP("BPS01P5A",1,SLOT,TXTIEN)=TXT Q
81 .. S PDTM=PDT_"."_TM
82 .. D FILE1(LOGIEN,TXTIEN,PDTM,TXT)
83 . I PDTM="" S PDTM=$$NOW^XLFDT(),^XTMP("BPS01P5A",2,SLOT)=PDTM
84 . D FILE2(LOGIEN,PDTM)
85 . K ^BPSECP("LOG",SLOT)
86 ;
87 ; If XTMP("BPS01P5A") global created, add top node with purge date
88 I $D(^XTMP("BPS01P5A")) D
89 . N X,X1,X2
90 . S X1=DT,X2=60 D C^%DTC
91 . S ^XTMP("BPS01P5A",0)=X_U_DT_U_"BPS Log Conversion"
92 ;
93 ; Kill the top node of ^BPSECP if that is all there is left
94 I $D(^BPSECP("LOG"))=1 K ^BPSECP("LOG")
95 Q
96 ;
97LOG(X) ; Create or find slot in BPS LOG
98 N DIC,DLAYGO,Y
99 S DIC=9002313.12,DIC(0)="LBO",DLAYGO=DIC
100 D ^DIC
101 I Y=-1 S ^XTMP("BPS01P5A",3,X)=Y
102 Q +Y
103 ;
104FILE1(LOGIEN,TXTIEN,PDTM,TXT) ; Create multiple entry
105 N FN,FDA,MSG
106 S FN=9002313.1201
107 S FDA(FN,"+1,"_LOGIEN_",",.01)=PDTM
108 S FDA(FN,"+1,"_LOGIEN_",",1)=$TR($E(TXT,1,200),"^","~")
109 D UPDATE^DIE("","FDA","","MSG")
110 I $D(MSG) S ^XTMP("BPS01P5A",4,LOGIEN,TXTIEN)=PDTM_U_TXT M ^XTMP("BPS01P5A",4,LOGIEN,"MSG")=MSG
111 Q
112 ;
113FILE2(LOGIEN,PDTM) ; Update LAST UPDATE field with the last date
114 N FDA,MSG,FN
115 S FN=9002313.12
116 S FDA(FN,LOGIEN_",",.02)=PDTM
117 D FILE^DIE("","FDA","MSG")
118 I $D(MSG) S ^XTMP("BPS01P5A",5,LOGIEN)=PDTM M ^XTMP("BPS01P5A",5,LOGIEN,"MSG")=MSG
119 Q
120 ;
121CDT(X,PDT) ; Convert external date to internal
122 ; If date evaluates to -Y, use default date (PDT)
123 N %DT,Y
124 S %DT="" D ^%DT
125 I Y=-1 S Y=PDT
126 Q Y
127 ;
128UP(X) ; Convert text to uppercase
129 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
130 ;
131 ;DELETE OBSOLETE FILES
132 ; For BPSCOMB and BPSEI, we need to delete each node manually
133 ; to prevent global protection errors.
134 ;
135DEL N DIU,X
136 ;
137 ;Turn global protection off (SACC Exemption has been granted to use $ZU)
138 S X=$ZU(68,28,0)
139 ;
140 ;Remove BPS COMBINED INSURANCE (#9002313.1), which uses an unsubscripted global
141 ;reference to store the data
142 S DIU="^BPSCOMB(",DIU(0)="DS" D EN^DIU2
143 ;
144 ;Remove BPS INSURER (#9002313.4), which uses an unsubscripted global reference to store
145 ;the data
146 S DIU="^BPSEI(",DIU(0)="DS" D EN^DIU2
147 ;
148 ;Turn global protection back on
149 S X=$ZU(68,28,1)
150 ;
151 ;BPS DATA INPUT (#9002313.51)
152 S DIU="^BPS(9002313.51,",DIU(0)="DS" D EN^DIU2
153 ;
154 ;BPS ORIGIN OF INPUT (#9002313.516)
155 S DIU="^BPS(9002313.516,",DIU(0)="DS" D EN^DIU2
156 ;
157 ;BPS DIALOUT (#9002313.55)
158 S DIU="^BPS(9002313.55,",DIU(0)="DS" D EN^DIU2
159 ;
160 ;BPS INPUT USER PREF (#9002313.515)
161 S DIU="^BPS(9002313.515,",DIU(0)="DS" D EN^DIU2
162 ;
163 ;BPS INSURANCE RULES (#9002313.94)
164 S DIU="^BPSF(9002313.94,",DIU(0)="DS" D EN^DIU2
165 ;
166 ;BPS PRICING TABLES (#9002313.53)
167 S DIU="^BPS(9002313.53,",DIU(0)="DS" D EN^DIU2
168 ;
169 ;BPS REPORT MASTER (#9002313.61)
170 S DIU="^BPSECX(""RPT"",",DIU(0)="DS" D EN^DIU2
171 ;
172 ;BPS TRANSLATE (#9002313.81)
173 S DIU="^BPSF(9002313.81,",DIU(0)="DS" D EN^DIU2
174 ;
175 K DIU,X
176 ;
177 Q
178 ;
179 ;BPS SETUP (#9002313.99)
18099 N IEN
181 ;
182 S IEN=0 F S IEN=$O(^BPS(9002313.99,IEN)) Q:'IEN D
183 .;
184 .;'2' Node
185 .K ^BPS(9002313.99,IEN,2)
186 .;
187 .;'BPSOS6*' Node
188 .K ^BPS(9002313.99,IEN,"BPSOS6*")
189 .;
190 .;'BPSOSM1' Node
191 .K ^BPS(9002313.99,IEN,"BPSOSM1")
192 .;
193 .;'BPSOSR1' Node
194 .K ^BPS(9002313.99,IEN,"BPSOSR1")
195 .;
196 .;'BPSOSX' Node
197 .K ^BPS(9002313.99,IEN,"BPSOSX")
198 .;
199 .;'A/R INTERFACE' Node
200 .K ^BPS(9002313.99,IEN,"A/R INTERFACE")
201 .;
202 .;'BILLING' Node
203 .K ^BPS(9002313.99,IEN,"BILLING")
204 .;
205 .;'BILLING - NEW' Node
206 .K ^BPS(9002313.99,IEN,"BILLING - NEW")
207 .;
208 .;'BILLING LOG FILE' Node
209 .K ^BPS(9002313.99,IEN,"BILLING LOG FILE")
210 .;
211 .;'CREATING A/R' Node
212 .K ^BPS(9002313.99,IEN,"CREATING A/R")
213 .;
214 .;'DIAL-OUT DEFAULT' Node
215 .K ^BPS(9002313.99,IEN,"DIAL-OUT DEFAULT")
216 .;
217 .;'EOB-SCREEN' Node
218 .K ^BPS(9002313.99,IEN,"EOB-SCREEN")
219 .;
220 .;'FORMS - NCPDP' Node
221 .K ^BPS(9002313.99,IEN,"FORMS - NCPDP")
222 .;
223 .;'FORMS - PREBILL' Node
224 .K ^BPS(9002313.99,IEN,"FORMS - PREBILL")
225 .;
226 .;'INPUT' Node
227 .K ^BPS(9002313.99,IEN,"INPUT")
228 .;
229 .;'INS' Node
230 .K ^BPS(9002313.99,IEN,"INS")
231 .;
232 .;'INS BASE SCORES'
233 .K ^BPS(9002313.99,IEN,"INS BASE SCORES")
234 .;
235 .;'INS RULES' Node
236 .K ^BPS(9002313.99,IEN,"INS RULES")
237 .;
238 .;'NULL FILE' Node
239 .K ^BPS(9002313.99,IEN,"NULL FILE")
240 .;
241 .;'OUTSIDE LINE' Node
242 .K ^BPS(9002313.99,IEN,"OUTSIDE LINE")
243 .;
244 .;'POSTAGE' Node
245 .K ^BPS(9002313.99,IEN,"POSTAGE")
246 .;
247 .;'RX A/R TYPE' Node
248 .K ^BPS(9002313.99,IEN,"RX A/R TYPE")
249 .;
250 .;'RECEIPT' Node
251 .K ^BPS(9002313.99,IEN,"RECEIPT")
252 .;
253 .;'SPECIAL' Node
254 .K ^BPS(9002313.99,IEN,"SPECIAL")
255 .;
256 .;'STARTUP' Node
257 .K ^BPS(9002313.99,IEN,"STARTUP")
258 .;
259 .;'UNBILLABLE NDC #' Node
260 .K ^BPS(9002313.99,IEN,"UNBILLABLE NDC #")
261 .;
262 .;'UNBILLABLE DRUG NAME' Node
263 .K ^BPS(9002313.99,IEN,"UNBILLABLE DRUG NAME")
264 .;
265 .;'UNBILLABLE OTC' Node
266 .K ^BPS(9002313.99,IEN,"UNBILLABLE OTC")
267 .;
268 .;'WRITEOFF-SCREEN' Node
269 .K ^BPS(9002313.99,IEN,"WRITEOFF-SCREEN")
270 .;
271 .;'WRITEOFF-SCREEN ARTYPE' Node
272 .K ^BPS(9002313.99,IEN,"WRITEOFF-SCREEN ARTYPE")
273 .;
274 .;'WRITEOFF-SCREEN BATCH' Node
275 .K ^BPS(9002313.99,IEN,"WRITEOFF-SCREEN BATCH")
276 .;
277 .;'WRITEOFF-SCREEN CLINIC' Node
278 .K ^BPS(9002313.99,IEN,"WRITEOFF-SCREEN CLINIC")
279 .;
280 .;'WRITEOFF-SCREEN DIAG' Node
281 .K ^BPS(9002313.99,IEN,"WRITEOFF-SCREEN DIAG")
282 .;
283 .;'WRITEOFF-SCREEN INSURER' Node
284 .K ^BPS(9002313.99,IEN,"WRITEOFF-SCREEN INSURER")
285 .;
286 .;'WINNOW' Node
287 .N X
288 .S X=$P($G(^BPS(9002313.99,IEN,"WINNOW")),U)
289 .I X'=0,X'=1 S X=$P($G(^BPS(9002313.99,IEN,"WINNOW TESTING")),U),X=$S(X=1:1,1:0)
290 .S ^BPS(9002313.99,IEN,"WINNOW")=X_"^^365"
291 .K X
292 .;
293 .;'WINNOW TESTING' Node
294 .K ^BPS(9002313.99,IEN,"WINNOW TESTING")
295 .;
296 .;'WINNOW LOG' Node
297 .K ^BPS(9002313.99,IEN,"WINNOW LOG")
298 .;
299 .;'WORKERS COMP' Node
300 .K ^BPS(9002313.99,IEN,"WORKERS COMP")
301 .;
302 .;'WRITE OFF INSURER' Node
303 .K ^BPS(9002313.99,IEN,"WRITE OFF INSURER")
304 .;
305 .;'WRITE OFF SELF PAY' Node
306 .K ^BPS(9002313.99,IEN,"WRITE OFF SELF PAY")
307 .;
308 .;'NCPDP51' Node
309 .K ^BPS(9002313.99,IEN,"NCPDP51")
310 .;
311 .;'WINNOW LOGS' Node
312 .K ^BPS(9002313.99,IEN,"WINNOW LOGS")
313 ;
314 K IEN
315 ;
316 Q
Note: See TracBrowser for help on using the repository browser.