source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNEDEP.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 9.4 KB
Line 
1IBCNEDEP ;DAOU/ALA - Process Transaction Records ;17-JUN-2002
2 ;;2.0;INTEGRATED BILLING;**184,271,300**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; This program finds records needing HL7 msg creation
6 ; Periodically check for stop request for background task
7 ;
8 ; Variables
9 ; RETR = # retries allowed
10 ; HLMAX = Maximum # of HL7 msgs
11 ; MGRP = Msg Mailgroup
12 ; FAIL = # of days before failure
13 ; FMSG = Failure Mailman flag
14 ; TMSG = Timeout Mailman flag
15 ; FLDT = Failure date
16 ; FUTDT = Future transmission date
17 ; DFN = Patient IEN
18 ; PAYR = Payer IEN
19 ; DTCRT = Date Created
20 ; BUFF = Buffer File IEN
21 ; NRETR = # of retries accomplished
22 ; IHCNT = Count of successful HL7 msgs
23 ; QUERY = Type of msg
24 ; EXT = Which extract produced record
25 ; SRVDT = Service Date
26 ; IRIEN = Insurance Record IEN
27 ; NTRAN = # of transmissions accomplished
28 ; OVRIDE = Override Flag
29 ; BNDL = Bundle Verification Flag
30 ;
31EN ; Entry point
32 ;
33 ; Start processing of data
34 K ^TMP("HLS",$J),^TMP("IBQUERY",$J)
35 ; Initialize count for periodic TaskMan check
36 S IBCNETOT=0
37 ;
38 ; Get IB Site Parameters
39 S IBCNEP=$G(^IBE(350.9,1,51))
40 S RETR=+$P(IBCNEP,U,6),HLMAX=$P(IBCNEP,U,15),BNDL=$P(IBCNEP,U,23)
41 S:HLMAX="" HLMAX=99999999
42 S MGRP=$$MGRP^IBCNEUT5()
43 S FAIL=$P(IBCNEP,U,5),TMSG=$P(IBCNEP,U,7),FMSG=$P(IBCNEP,U,20)
44 S FLDT=$$FMADD^XLFDT(DT,-FAIL)
45 ; Statuses
46 ; 1 = Ready To Transmit
47 ; 2 = Transmitted
48 ; 4 = Hold
49 ; 6 = Retry
50 ;
51HLD ; Go through the 'Hold' statuses, see if ready to be 'retried'
52 S IEN=""
53 F S IEN=$O(^IBCN(365.1,"AC",4,IEN)) Q:IEN="" D Q:$G(ZTSTOP)
54 . ; Update count for periodic check
55 . S IBCNETOT=IBCNETOT+1
56 . ; Check for request to stop background job, periodically
57 . I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
58 . ;
59 . S FUTDT=$P($G(^IBCN(365.1,IEN,0)),U,9)
60 . ;
61 . ; If the future date is today, set status to 'Retry',
62 . ; DON'T clear future transmission date. (Need date to see if this is the first
63 . ; time that the payer asked us to resubmit this inquiry.)
64 . I FUTDT'>DT D SST^IBCNEUT2(IEN,6) ;D
65 . ;. NEW DA,DIE,DR
66 . ;. S DA=IEN,DIE="^IBCN(365.1,",DR=".09///@" D ^DIE
67 ;
68 ; Exit based on stop request
69 I $G(ZTSTOP) G EXIT
70 ;
71TMT ; If the status is 'Transmitted' - is this a 'Retry' or
72 ; 'Comm Failure'
73 S IEN=""
74 F S IEN=$O(^IBCN(365.1,"AC",2,IEN)) Q:IEN="" D Q:$G(ZTSTOP)
75 . ; Update count for periodic check
76 . S IBCNETOT=IBCNETOT+1
77 . ; Check for request to stop background job, periodically
78 . I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
79 . ;
80 . NEW TDATA,DTCRT,BUFF,DFN,PAYR,XMSUB,VERID
81 . S TDATA=$G(^IBCN(365.1,IEN,0))
82 . S DFN=$P(TDATA,U,2),PAYR=$P(TDATA,U,3)
83 . S DTCRT=$P(TDATA,U,6)\1,BUFF=$P(TDATA,U,5)
84 . S VERID=$P(TDATA,U,11)
85 . ;
86 . ; Check against the Failure Date
87 . I DTCRT>FLDT Q
88 . ;
89 . ; If retries are defined
90 . I RETR>0 D Q
91 .. ;
92 .. ; Send timeout mail msg
93 .. I PAYR'=$$FIND1^DIC(365.12,"","X","~NO PAYER") D TMRR^IBCNEDEQ
94 .. D SST^IBCNEUT2(IEN,6)
95 . ;
96 . ; If no retries defined, set to fail
97 . D SST^IBCNEUT2(IEN,5)
98 . ;
99 . ; For msg in the Response file set the status to
100 . ; 'Comm Failure'
101 . D RSTA^IBCNEUT7(IEN)
102 . ;
103 . ; Set Buffer symbol to 'B12' (Comm Failure)
104 . I BUFF'="" D BUFF^IBCNEUT2(BUFF,15)
105 . ;
106 . I PAYR=$$FIND1^DIC(365.12,"","X","~NO PAYER") Q
107 . ;
108 . ; Issue comm fail MailMan msg only for ver'ns
109 . I VERID="V" D CERR^IBCNEDEQ
110 ;
111 ; Exit for stop request
112 I $G(ZTSTOP) G EXIT
113 ;
114RET ; If status is 'Retry'
115 S IEN=""
116 F S IEN=$O(^IBCN(365.1,"AC",6,IEN)) Q:IEN="" D Q:$G(ZTSTOP)
117 . ; Update count for periodic check
118 . S IBCNETOT=IBCNETOT+1
119 . ; Check for request to stop background job, periodically
120 . I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
121 . ;
122 . NEW TDATA,NRETR,PAYR,BUFF,DFN,MSG,RIEN,HIEN,XMSUB,VERID
123 . S TDATA=$G(^IBCN(365.1,IEN,0))
124 . S NRETR=$P(TDATA,U,8),PAYR=$P(TDATA,U,3)
125 . S BUFF=$P(TDATA,U,5),DFN=$P(TDATA,U,2)
126 . S VERID=$P(TDATA,U,11)
127 . S NRETR=NRETR+1
128 . ;
129 . ; If retries are finished, set to fail
130 . I NRETR>RETR D Q
131 .. D SST^IBCNEUT2(IEN,5)
132 .. ;
133 .. ; Set Buffer symbol to 'B12' (Comm Failure)
134 .. I BUFF'="" D BUFF^IBCNEUT2(BUFF,15)
135 .. ;
136 .. ; For msg in the Response file set the status to
137 .. ; 'Comm Failure'
138 .. D RSTA^IBCNEUT7(IEN)
139 .. I PAYR=$$FIND1^DIC(365.12,"","X","~NO PAYER") Q
140 .. ;
141 .. I VERID="V" D CERE^IBCNEDEQ
142 . ; If generating retry, set IIV status to comm failure (5) for
143 . ; remaining related responses
144 . D RSTA^IBCNEUT7(IEN)
145 ;
146 ; Exit for stop request
147 I $G(ZTSTOP) G EXIT
148 ;
149FIN ; Prioritize requests for statuses 'Retry' and 'Ready to Transmit'
150 ;
151 ; Separate inquiries into verifications, identifications,
152 ; and "fishes" - VNUM = Priority of output
153 F STA=1,6 S IEN="" D
154 . F S IEN=$O(^IBCN(365.1,"AC",STA,IEN)) Q:IEN="" D
155 .. S IBDATA=$G(^IBCN(365.1,IEN,0)) Q:IBDATA=""
156 .. S QUERY=$P(IBDATA,U,11),DFN=$P(IBDATA,U,2),OVRIDE=$P(IBDATA,U,14)
157 .. S PAYR=$P(IBDATA,U,3)
158 .. I QUERY="V" S VNUM=3
159 .. I QUERY'="V" D
160 ... I PAYR=$$FIND1^DIC(365.12,,"X","~NO PAYER") S VNUM=5 Q
161 ... S VNUM=4
162 .. I OVRIDE'="" D
163 ... I PAYR=$$FIND1^DIC(365.12,,"X","~NO PAYER") S VNUM=2 Q
164 ... S VNUM=1
165 .. S ^TMP("IBQUERY",$J,VNUM,DFN,IEN)=""
166 ;
167LP ; Loop through priorities, process as either verifications
168 ; or identifications
169 S VNUM="",IHCNT=0
170 F S VNUM=$O(^TMP("IBQUERY",$J,VNUM)) Q:VNUM="" D Q:IHCNT=HLMAX!$G(ZTSTOP)!$G(QFL)=1
171 . I VNUM=1!(VNUM=3) D VER Q
172 . D ID
173 ;
174EXIT ; Finish
175 K BUFF,CNT,D,D0,DA,DFN,DI,DIC,DIE,DISYS,DQ,DR,DTCRT,EXT,FAIL,FLDT,FUTDT
176 K FRDT,FMSG,GT1,HCT,HIEN,HL,HLCDOM,HLCINS,HLCS,HLCSTCP,HLDOM,HLECH,%I,%H
177 K HLEID,HLFS,HLHDR,HLINST,HLIP,HLN,HLPARAM,HLPROD,HLQ,HLRESLT,XMSUB
178 K HLSAN,HLTYPE,HLX,IBCNEP,IBCNHLP,IEN,IN1,IRIEN,MDTM,MGRP,MSGID,TOT
179 K NRETR,NTRAN,OVRIDE,PAYR,PID,QFL,QUERY,RETR,RSIEN,SRVDT,STA,TRANSR,X
180 K ZMID,IHCNT,HLMAX,^TMP("IBQUERY",$J),Y,DOD,DGREL,TMSG,RSTYPE,OMSGID,QFL
181 K IBCNETOT,HLP,SUBID,VNUM,BNDL,IBDATA
182 Q
183 ;
184VER ; Initialize HL7 variables protocol for Verifications
185 S IBCNHLP="IBCNE IIV RQV OUT"
186 D INIT^IBCNEHLO
187 ;
188 S DFN=""
189 F S DFN=$O(^TMP("IBQUERY",$J,VNUM,DFN)) Q:DFN="" D Q:IHCNT=HLMAX!$G(ZTSTOP)
190 . ;
191 . ; If the INQUIRE SECONDARY INSURANCES flag is 'yes',
192 . ; bundle verifications together, send a continuation pointer
193 . I VNUM=3,BNDL D Q:QFL
194 .. S TOT=0,IEN="",QFL=0
195 .. F S IEN=$O(^TMP("IBQUERY",$J,VNUM,DFN,IEN)) Q:IEN="" S TOT=TOT+1
196 .. ;
197 .. ; If the total # of "bundled" verifications is
198 .. ; greater than the maximum # of HL7 allowed, quit
199 .. I (TOT+IHCNT)>HLMAX S QFL=1 Q
200 . ;
201 . S IEN="",OMSGID="",QFL=0,CNT=0
202 . F S IEN=$O(^TMP("IBQUERY",$J,VNUM,DFN,IEN)) Q:IEN="" D Q:IHCNT=HLMAX!$G(ZTSTOP)
203 .. ; Update count for periodic check
204 .. S IBCNETOT=IBCNETOT+1
205 .. ; Check for request to stop background job, periodically
206 .. I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
207 .. ;
208 .. D PROC I PID="" Q
209 .. ;
210 .. I BNDL S HLP("CONTPTR")=$G(OMSGID)
211 .. ; D GENERATE^HLMA(HLEID,"GM",1,.HLRESLT,"",.HLP)
212 .. D GENERATE^HLMA(IBCNHLP,"GM",1,.HLRESLT,"",.HLP)
213 .. K ^TMP("HLS",$J),HLP
214 .. ;
215 .. ; If not successful
216 .. I $P(HLRESLT,U,2)]"" D HLER^IBCNEDEQ Q
217 .. ; If successful
218 .. D SCC^IBCNEDEQ
219 .. I BNDL D
220 ... I CNT=1 S OMSGID=MSGID
221 ;
222 K HL,IN1,GT1,PID,DFN,^TMP($J,"HLS")
223 ;
224 ; Exit based on stop request
225 I $G(ZTSTOP) Q
226 ;
227 ; If the # of HL7 msgs generate equals the
228 ; maximum # of HL7 msgs allowed, quit
229 I IHCNT=HLMAX Q
230 ;
231 Q
232 ;
233ID ; Send Identification Msgs
234 ;
235 ; Initialize the HL7 variables based on the HL7 protocol
236 S IBCNHLP="IBCNE IIV RQI OUT"
237 D INIT^IBCNEHLO
238 ;
239 S DFN=""
240 F S DFN=$O(^TMP("IBQUERY",$J,VNUM,DFN)) Q:DFN="" D Q:IHCNT=HLMAX!$G(ZTSTOP)!QFL
241 . ; Update count for periodic check
242 . S IBCNETOT=IBCNETOT+1
243 . ; Check for request to stop background job, periodically
244 . I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
245 . ;
246 . S TOT=0,IEN="",CNT=0,OMSGID="",QFL=0
247 . ;
248 . ; Get the total # of identification msgs for a patient
249 . F S IEN=$O(^TMP("IBQUERY",$J,VNUM,DFN,IEN)) Q:IEN="" S TOT=TOT+1
250 . ;
251 . ; If the total # of identification msgs for this
252 . ; patient is greater than the maximum # of allowed
253 . ; HL7 msgs, stop processing until the next night
254 . I (TOT+IHCNT)>HLMAX S QFL=1 Q
255 . ;
256 . ; For each identification transaction generate an HL7 msg
257 . F S IEN=$O(^TMP("IBQUERY",$J,VNUM,DFN,IEN)) Q:IEN="" D Q:IHCNT=HLMAX
258 .. D PROC
259 .. ;
260 .. I VNUM=4 S HLP("CONTPTR")=$G(OMSGID)
261 .. ; D GENERATE^HLMA(HLEID,"GM",1,.HLRESLT,"",.HLP)
262 .. D GENERATE^HLMA(IBCNHLP,"GM",1,.HLRESLT,"",.HLP)
263 .. K ^TMP("HLS",$J),HLP
264 .. ;
265 .. ; If not successful
266 .. I $P(HLRESLT,U,2)]"" D HLER^IBCNEDEQ Q
267 .. ;
268 .. ; If successful
269 .. D SCC^IBCNEDEQ
270 .. I VNUM=4 D
271 ... I CNT=1 S OMSGID=MSGID
272 ;
273 Q
274 ;
275PROC ; Process TQ record
276 S TRANSR=$G(^IBCN(365.1,IEN,0))
277 S DFN=$P(TRANSR,U,2),PAYR=$P(TRANSR,U,3),BUFF=$P(TRANSR,U,5)
278 S QUERY=$P(TRANSR,U,11),EXT=$P(TRANSR,U,10),SRVDT=$P(TRANSR,U,12)
279 S IRIEN=$P(TRANSR,U,13),HCT=0,NTRAN=$P(TRANSR,U,7),NRETR=$P(TRANSR,U,8)
280 S SUBID=$P(TRANSR,U,16),OVRIDE=$P(TRANSR,U,14),STA=$P(TRANSR,U,4)
281 S FRDT=$P(TRANSR,U,17)
282 ;
283 ; Build the HL7 msg
284 S HCT=HCT+1,^TMP("HLS",$J,HCT)="PRD|NA"
285 D PID^IBCNEHLQ I PID=""!(PID?."*") Q
286 S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(PID,"*","")
287 D GT1^IBCNEHLQ I GT1'="",GT1'?."*" S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(GT1,"*","")
288 D IN1^IBCNEHLQ I IN1'="",IN1'?."*" D
289 . S HCT=HCT+1
290 . I VNUM=1 S ^TMP("HLS",$J,HCT)=$TR(IN1,"*","") Q
291 . I VNUM=2,'BNDL S ^TMP("HLS",$J,HCT)=$TR(IN1,"*","") Q
292 . S CNT=CNT+1
293 . S $P(IN1,HLFS,22)=TOT,$P(IN1,HLFS,21)=CNT
294 . S ^TMP("HLS",$J,HCT)=$TR(IN1,"*","")
295 Q
Note: See TracBrowser for help on using the repository browser.