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

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

initial load of FOIAVistA 6/30/08 version
File size: 9.3 KB
Line 
1IBCEPTR ;ALB/ESG - Test Claim Messages Report ;28-JAN-2005
2 ;;2.0;INTEGRATED BILLING;**296,320,348,349**;21-MAR-94;Build 46
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; eClaims Plus
6 ; Report on Test Claim Transmissions and Status Messages
7 ;
8EN ; Entry Point
9 NEW STOP,IBRMETH,IBRDATA
10 D SELECT I STOP G EXIT
11 D DEVICE
12EXIT ; Exit Point
13 Q
14 ;
15SELECT ; Determine which claim#'s or batch#'s to report on
16 NEW DIC,DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT,D
17 S STOP=0
18 W @IOF
19 W !!?23,"Test Claim EDI Transmission Report"
20 W !!?7,"This report will display EDI transmission data and returned status"
21 W !?7,"message data for selected test claims. You may select test claims"
22 W !?7,"by claim number or by batch number or you may search for claims that"
23 W !?7,"were transmitted within a date range.",!
24 S DIR(0)="SO^C:Claim;B:Batch;D:Date Range (Date Transmitted)"
25 S DIR("A")="Selection Method",DIR("B")="D"
26 D ^DIR K DIR
27 I $D(DIRUT) S STOP=1 G SELECTX
28 S IBRMETH=Y
29 I IBRMETH'="C",IBRMETH'="B",IBRMETH'="D" S STOP=1 G SELECTX
30 ;
31 K IBRDATA
32 I IBRMETH="C" D
33 . F D Q:Y'>0
34 .. W !
35 .. S DIC("A")="Test Claim: "
36 .. I $O(IBRDATA("")) S DIC("A")="Another Test Claim: "
37 .. S DIC("W")="D CLMLST^IBCEPTR(Y)"
38 .. S DIC=361.4,DIC(0)="AEMQ",D="B" D MIX^DIC1
39 .. Q:Y'>0
40 .. S IBRDATA(+Y)=""
41 .. Q
42 . Q
43 ;
44 I IBRMETH="B" D
45 . F D Q:Y'>0
46 .. W !
47 .. S DIC("A")="Test Batch: "
48 .. I $O(IBRDATA("")) S DIC("A")="Another Test Batch: "
49 .. S DIC("S")="I $P(^(0),U,14),$O(^IBM(361.4,""C"",+Y,0))"
50 .. S DIC=364.1,DIC(0)="AEMQ",D="B^C" D MIX^DIC1
51 .. Q:Y'>0
52 .. S IBRDATA(+Y)=""
53 .. Q
54 . Q
55 ;
56 I IBRMETH="D" D
57 . W !
58 . S DIR(0)="DAO^:"_DT_":AEX",DIR("A")=" Earliest Date Claims Transmitted: "
59 . D ^DIR K DIR
60 . I $D(DIRUT)!'Y Q
61 . S IBRDATA(1)=Y
62 . W !
63 . S DIR(0)="DAO^"_Y_":"_DT_":AEX",DIR("A")=" Latest Date Claims Transmitted: ",DIR("B")="Today"
64 . D ^DIR K DIR
65 . I $D(DIRUT)!'Y Q
66 . S IBRDATA(2)=Y
67 . Q
68 ;
69 I '$O(IBRDATA("")) S STOP=1 G SELECTX
70 I IBRMETH="D",'$G(IBRDATA(1)) S STOP=1 G SELECTX
71 I IBRMETH="D",'$G(IBRDATA(2)) S STOP=1 G SELECTX
72 ;
73SELECTX ;
74 Q
75 ;
76DEVICE ; standard device selection
77 NEW ZTRTN,ZTDESC,ZTSAVE,POP
78 W !!!,"This report is 80 characters wide.",!
79 S ZTRTN="COMPILE^IBCEPTR"
80 S ZTDESC="Test Claim EDI Transmission Report"
81 S ZTSAVE("IBRMETH")=""
82 S ZTSAVE("IBRDATA")=""
83 D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM")
84DEVX ;
85 Q
86 ;
87COMPILE ; compile the data into a scratch global
88 NEW RTN,EXTBCH,IBIFN,BCHIEN,TXDATM
89 S RTN="IBCEPTR"
90 KILL ^TMP($J,RTN) ; init scratch global
91 ;
92 I IBRMETH="C" D ; claim search
93 . S EXTBCH=0
94 . S IBIFN=0
95 . F S IBIFN=$O(IBRDATA(IBIFN)) Q:'IBIFN D STORE(IBIFN)
96 . Q
97 ;
98 I IBRMETH="B" D ; batch search
99 . S BCHIEN=0
100 . F S BCHIEN=$O(IBRDATA(BCHIEN)) Q:'BCHIEN D
101 .. S EXTBCH=$P($G(^IBA(364.1,BCHIEN,0)),U,1)
102 .. I EXTBCH="" S EXTBCH="~unknown"
103 .. S IBIFN=0
104 .. F S IBIFN=$O(^IBM(361.4,"C",BCHIEN,IBIFN)) Q:'IBIFN D STORE(IBIFN)
105 .. Q
106 . Q
107 ;
108 I IBRMETH="D" D ; date range search
109 . S EXTBCH=0
110 . S TXDATM=$O(^IBM(361.4,"ATD",IBRDATA(1)),-1)
111 . F S TXDATM=$O(^IBM(361.4,"ATD",TXDATM)) Q:'TXDATM Q:(TXDATM\1)>IBRDATA(2) D
112 .. S IBIFN=0
113 .. F S IBIFN=$O(^IBM(361.4,"ATD",TXDATM,IBIFN)) Q:'IBIFN D STORE(IBIFN)
114 .. Q
115 . Q
116 ;
117 D PRINT ; print the report
118 D ^%ZISC ; close the device
119 KILL ^TMP($J,RTN) ; clean up scratch global
120 I $D(ZTQUEUED) S ZTREQ="@" ; purge the task record
121COMPX ;
122 Q
123 ;
124STORE(IBIFN) ; Input = internal bill#; continue compilation
125 NEW IB0,CLAIM,IBRTXD0,TXIEN,SMIEN,DATA,TXDTM
126 S IB0=$G(^DGCR(399,IBIFN,0))
127 S CLAIM=$P(IB0,U,1) ; external claim#
128 I CLAIM="" S CLAIM="~unknown"
129 S IBRTXD0=99999999 ; initial value for earliest transmission date
130 ;
131 I IBRMETH="C" D ; claim search for transmission data (all)
132 . S TXIEN=0
133 . F S TXIEN=$O(^IBM(361.4,IBIFN,1,TXIEN)) Q:'TXIEN D STORETX(IBIFN,TXIEN)
134 . Q
135 ;
136 I IBRMETH="B" D ; batch search for transmission data ("C" x-ref)
137 . S TXIEN=0
138 . F S TXIEN=$O(^IBM(361.4,"C",BCHIEN,IBIFN,TXIEN)) Q:'TXIEN D STORETX(IBIFN,TXIEN)
139 . Q
140 ;
141 I IBRMETH="D" D ; date range search for transmission data ("ATD" xref)
142 . S TXIEN=0
143 . F S TXIEN=$O(^IBM(361.4,"ATD",TXDATM,IBIFN,TXIEN)) Q:'TXIEN D STORETX(IBIFN,TXIEN)
144 . Q
145 ;
146 ; loop thru all returned messages for claim
147 S SMIEN=0
148 F S SMIEN=$O(^IBM(361.4,IBIFN,2,SMIEN)) Q:'SMIEN D
149 . S DATA=$G(^IBM(361.4,IBIFN,2,SMIEN,0)) Q:DATA="" ; received msg data
150 . S TXDTM=$P(DATA,U,1) Q:'TXDTM ; msg rec'd date/time
151 . ;
152 . ; Batch only: if this status message was received before the
153 . ; earliest transmission for this batch, then don't include it
154 . I IBRMETH="B",TXDTM'>IBRTXD0 Q
155 . ;
156 . ; Date range search only: make sure the date/time the status message
157 . ; was received is inside the user specified date range for this report
158 . I IBRMETH="D",(TXDTM\1)<IBRDATA(1) Q ; rec'd too early
159 . I IBRMETH="D",(TXDTM\1)>IBRDATA(2) Q ; rec'd too late
160 . ;
161 . ; store it
162 . M ^TMP($J,RTN,EXTBCH,CLAIM,TXDTM,2,SMIEN)=^IBM(361.4,IBIFN,2,SMIEN)
163 . Q
164STOREX ;
165 Q
166 ;
167STORETX(IBIFN,TXIEN) ; store transmission info
168 NEW DATA,TXDTM
169 S DATA=$G(^IBM(361.4,IBIFN,1,TXIEN,0))
170 I DATA="" G STTXXX
171 S TXDTM=$P(DATA,U,1) ; transmit date/time
172 I 'TXDTM G STTXXX
173 I TXDTM<IBRTXD0 S IBRTXD0=TXDTM
174 ;
175 ; store it
176 M ^TMP($J,RTN,EXTBCH,CLAIM,TXDTM,1,TXIEN)=^IBM(361.4,IBIFN,1,TXIEN)
177STTXXX ;
178 Q
179 ;
180PRINT ; print the report to the specified device
181 NEW MAXCNT,CRT,PAGECNT,STOP,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
182 NEW BATCH,CLAIM,IBIFN,CLMD,TXD,TYPE,IEN
183 I IOST["C-" S MAXCNT=IOSL-3,CRT=1
184 E S MAXCNT=IOSL-6,CRT=0
185 S PAGECNT=0,STOP=0
186 ;
187 I '$D(^TMP($J,RTN)) D HEADER W !!!?5,"No Data Found"
188 ;
189 S BATCH=""
190 F S BATCH=$O(^TMP($J,RTN,BATCH)) Q:BATCH="" D Q:STOP
191 . D HEADER Q:STOP
192 . I BATCH'=0 W !!,"Batch#: ",BATCH
193 . S CLAIM=""
194 . F S CLAIM=$O(^TMP($J,RTN,BATCH,CLAIM)) Q:CLAIM="" D Q:STOP
195 .. I $Y+2>MAXCNT!'PAGECNT D HEADER Q:STOP
196 .. I BATCH=0 W !
197 .. W !,"Claim#: ",CLAIM
198 .. S IBIFN=+$O(^DGCR(399,"B",CLAIM,""))
199 .. I IBIFN S CLMD=$$BT(IBIFN) W ?18,$E($P(CLMD,U,3),1,20),?40,"(",$P(CLMD,U,1),")"
200 .. W !,$$RJ^XLFSTR("",80,"-")
201 .. ;
202 .. S TXD=0
203 .. F S TXD=$O(^TMP($J,RTN,BATCH,CLAIM,TXD)) Q:'TXD!STOP S TYPE=0 F S TYPE=$O(^TMP($J,RTN,BATCH,CLAIM,TXD,TYPE)) Q:'TYPE!STOP S IEN=0 F S IEN=$O(^TMP($J,RTN,BATCH,CLAIM,TXD,TYPE,IEN)) Q:'IEN!STOP D Q:STOP
204 ... I TYPE=1 D TXPRT
205 ... I TYPE=2 D SMPRT
206 ... Q
207 .. Q
208 . Q
209 ;
210 I STOP G PRINTX
211 I $Y+2>MAXCNT!'PAGECNT D HEADER I STOP G PRINTX
212 W !!?5,"*** End of Report ***"
213 I CRT,'$D(ZTQUEUED) S DIR(0)="E" D ^DIR K DIR
214PRINTX ;
215 Q
216 ;
217TXPRT ; print transmission information
218 NEW DATA,TXDTM,EXTBCH,TXBY,INSIEN,PAYER,PSEQ,INZ
219 S DATA=$G(^TMP($J,RTN,BATCH,CLAIM,TXD,TYPE,IEN,0)) I DATA="" G TXPRTX
220 S TXDTM=$$FMTE^XLFDT($P(DATA,U,1),"5Z")
221 S EXTBCH=$$EXTERNAL^DILFD(361.41,.02,,$P(DATA,U,2)) ; batch
222 S TXBY=$$EXTERNAL^DILFD(361.41,.03,,$P(DATA,U,3)) ; who tx
223 S INSIEN=+$$FINDINS^IBCEF1(IBIFN,$P(DATA,U,4)) ; insurance
224 S INZ=$$INSADD^IBCNSC02(INSIEN) ; ins name/addr
225 S PAYER=$P(INZ,U,1) ; ins name
226 S PSEQ=$TR($P(DATA,U,4),"123","PST") ; payer seq
227 ;
228 I $Y+2>MAXCNT!'PAGECNT D HEADER I STOP G TXPRTX
229 W !,"Transmission Information"
230 W !?1,TXDTM,?22,"Bch#",+$E(EXTBCH,4,99),?33,$E(TXBY,1,15),?50,$E(PAYER,1,20)," (",PSEQ,")"
231 ; display address info if not Medicare
232 I '$$MCRWNR^IBEFUNC(INSIEN) W !?50,$E($P(INZ,U,2),1,15),",",$E($P(INZ,U,3),1,11),",",$E($P(INZ,U,4),1,2)
233 W !
234TXPRTX ;
235 Q
236 ;
237SMPRT ; print returned status message information
238 NEW DATA,TXDTM,SEVERITY,Z
239 S DATA=$G(^TMP($J,RTN,BATCH,CLAIM,TXD,TYPE,IEN,0)) I DATA="" G SMPRTX
240 S TXDTM=$$FMTE^XLFDT($P(DATA,U,1),"5Z")
241 S SEVERITY=$$EXTERNAL^DILFD(361.42,.02,,$P(DATA,U,2)) ; msg severity
242 ;
243 I $Y+2>MAXCNT!'PAGECNT D HEADER I STOP G SMPRTX
244 W !,"Status Message Information"
245 W !?1,TXDTM,?22,SEVERITY,?65,"Msg#",$P(DATA,U,3)
246 S Z=0
247 F S Z=$O(^TMP($J,RTN,BATCH,CLAIM,TXD,TYPE,IEN,1,Z)) Q:'Z D Q:STOP
248 . I $Y+1>MAXCNT!'PAGECNT D HEADER Q:STOP
249 . W !?2,$G(^TMP($J,RTN,BATCH,CLAIM,TXD,TYPE,IEN,1,Z,0))
250 . Q
251 W !
252SMPRTX ;
253 Q
254 ;
255HEADER ; page break and header
256 NEW LIN,HDR,TAB
257 S STOP=0
258 I CRT,PAGECNT>0,'$D(ZTQUEUED) D I STOP G HEADX
259 . I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
260 . S DIR(0)="E" D ^DIR K DIR
261 . I 'Y S STOP=1 Q
262 . Q
263 ;
264 S PAGECNT=PAGECNT+1
265 W @IOF,!
266 ;
267 W "Test Claim EDI Transmission Report"
268 S HDR="Page: "_PAGECNT,TAB=80-$L(HDR)-1
269 W ?TAB,HDR
270 W !,"Selected ",$S(IBRMETH="B":"Batches",IBRMETH="C":"Claims",1:"Date Range")
271 S HDR=$$FMTE^XLFDT($$NOW^XLFDT,"1Z"),TAB=80-$L(HDR)-1
272 W ?TAB,HDR
273 W !,$$RJ^XLFSTR("",80,"=")
274 ;
275 ; check for a stop request
276 I $D(ZTQUEUED),$$S^%ZTLOAD() D G HEADX
277 . S (ZTSTOP,STOP)=1
278 . W !!!?5,"*** Report Halted by TaskManager Request ***"
279 . Q
280 ;
281HEADX ;
282 Q
283 ;
284BT(IBIFN) ; bill type and info
285 ; [1] TYPE (form type, charge type, inp/outp)
286 ; [2] claim#
287 ; [3] patient name
288 NEW TYPE,IB0,F,C,S S TYPE=""
289 S IB0=$G(^DGCR(399,+$G(IBIFN),0)) I IB0="" Q ""
290 S F=$P(IB0,U,19),F=$S(F=2:"1500",1:"UB04")
291 S C=$P(IB0,U,27),C=$S(C=1:"Inst",1:"Prof")
292 S S=$$INPAT^IBCEF(IBIFN),S=$S(S=1:"Inpat",1:"Outpat")
293 S TYPE=F_", "_C_", "_S
294 Q TYPE_U_$P(IB0,U,1)_U_$P($G(^DPT(+$P(IB0,U,2),0)),U,1)
295 ;
296CLMLST(IBIFN) ; DIC lister
297 NEW TYPE,LTD,N1,N2
298 S TYPE=$P($$BT(IBIFN),U,1)
299 S LTD=$$FMTE^XLFDT($P($G(^IBM(361.4,IBIFN,0)),U,2),"2Z")
300 S N1=+$P($G(^IBM(361.4,IBIFN,1,0)),U,4) ; # transmissions
301 S N2=+$P($G(^IBM(361.4,IBIFN,2,0)),U,4) ; # return messages
302 W " ",TYPE,?34," ",LTD,?45," ",N1," Transmission",$S(N1'=1:"s",1:"")
303 W ?63," ",N2," Message",$S(N2'=1:"s",1:"")
304CLMLSTX ;
305 Q
306 ;
Note: See TracBrowser for help on using the repository browser.