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

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

initial load of FOIAVistA 6/30/08 version

File size: 7.7 KB
Line 
1IBCECOB2 ;ALB/CXW - IB COB MANAGEMENT SCREEN ;16-JUN-1999
2 ;;2.0;INTEGRATED BILLING;**137,155**;21-MAR-1994
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EDI ;history detail display
6 N IBIFN,IBDA
7 D SEL(.IBDA,1)
8 S IBDA=+$O(IBDA(0)),IBIFN=+$G(IBDA(IBDA))
9 D EDI1(IBIFN)
10 S VALMBCK="R"
11 Q
12 ;
13EDI1(IBIFN) ;
14 N DFN
15 Q:'IBIFN
16 S DFN=$P($G(^DGCR(399,IBIFN,0)),U,2)
17 D EN^VALM("IBJT EDI STATUS")
18 K:$D(IBFASTXT) IBFASTXT
19 Q
20 ;
21EDI2(IBIFN) ;
22 N DFN
23 Q:'IBIFN
24 S DFN=$P($G(^DGCR(399,IBIFN,0)),U,2)
25 D EN^VALM("IBJT EDI STATUS ALONE")
26 K:$D(IBFASTXT) IBFASTXT
27 Q
28 ;
29CSA ;claims status awaiting resolution
30 N IBDAX
31 D EN^IBCECSA
32 I $D(IBFASTXT) K IBFASTXT
33 S VALMBCK="R"
34 Q
35 ;
36RVEOB ;Review EOB
37 D FULL^VALM1 W !
38 N IBDA,IBIFN,IBCMT,IBSEL
39 D SEL(.IBDA,1)
40 S IBSEL=+$O(IBDA(0))
41 S IBDA=$G(IBDA(IBSEL))
42 S IBIFN=$P(IBDA,U),IBDA=$P(IBDA,U,3)
43 I 'IBIFN G VEOBQ
44 S IBCMT=$G(^TMP("IBCECOB1",$J,IBSEL))
45 I IBCMT'="" D EN^VALM("IBCEM MRA REVIEW")
46VEOBQ K ^TMP("IBCECOC",$J)
47 S VALMBCK="R"
48 Q
49 ;
50TPJI ;Third Party joint Inquiry
51 N IBDA,IBIFN
52 D SEL(.IBDA,1)
53 S IBDA=+$O(IBDA(0)),IBIFN=+$G(IBDA(IBDA))
54 I IBDA="" G TPJIQ
55 D TPJI1(IBIFN)
56TPJIQ S VALMBCK="R"
57 Q
58 ;
59TPJI1(IBIFN) ;
60 N DFN,IBNOTPJI
61 Q:'IBIFN
62 S DFN=$P($G(^DGCR(399,IBIFN,0)),U,2),IBNOTPJI=1
63 D EN^VALM("IBJT CLAIM INFO")
64 K:$D(IBFASTXT) IBFASTXT
65 Q
66 ;
67PBILL ;Print bill
68 N IBIFN,IBDA,IBRESUB
69 D SEL(.IBDA,1)
70 S IBDA=$O(IBDA(0)),IBIFN=+$G(IBDA(+IBDA))
71 I IBDA="" G PBOUT
72 S IBRESUB=$$RESUB^IBCECSA4(IBIFN,1,"P")
73 I IBRESUB'>0 W !,*7,"This is not a transmittable bill or review not needed" D PAUSE^VALM1 G PBOUT
74 I IBRESUB=2 D G PBOUT
75 . N IB364
76 . S IB364=+$P($G(IBDA(IBDA)),U,2)
77 . D PRINT1^IBCEM03(IBIFN,.IBDA,IB364)
78 D PBILL1(IBIFN)
79PBOUT S VALMBCK="R"
80 Q
81 ;
82PMRA ;Print MRA
83 N IBIFN,IBDA
84 D SEL(.IBDA,1)
85 S IBDA=$O(IBDA(0)),IBIFN=+$G(IBDA(+IBDA))
86 G:'IBIFN PRMQ
87 D MRA^IBCEMRAA(.IBIFN)
88PRMQ S VALMBCK="R"
89 Q
90PBILL1(IBIFN) ;
91 N IBAC1,IBAC,DFN
92 Q:'IBIFN
93 S DFN=$P($G(^DGCR(399,IBIFN,0)),U,2)
94 S IBAC=4,IBAC1=1
95 D 4^IBCB1
96 D FULL^VALM1,PAUSE^VALM1
97 Q
98 ;
99CANCEL ;Cancel bill
100 ; IBDA(IBDA)=IBIFN^IB364^ien of 361.1^user selection seq^user name~duz#
101 ;
102 N IBIFN,IBDA,IB364,IBEOBIFN
103 ;
104 ; Check for security key
105 I '$$KCHK^XUSRB("IB AUTHORIZE") D G CANCELQ
106 . D FULL^VALM1 S VALMBCK="R"
107 . W !!?5,"You don't hold the proper security key to access this function."
108 . W !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
109 . D PAUSE^VALM1
110 . Q
111 ;
112 D SEL(.IBDA,1)
113 S IBDA=$O(IBDA(0)),IBIFN=+$G(IBDA(+IBDA)),IB364=$P($G(IBDA(+IBDA)),U,2)
114 S IBEOBIFN=$P($G(IBDA(+IBDA)),U,3)
115 I IBDA D
116 . I '$$LOCK^IBCEU0(361.1,IBEOBIFN) Q
117 . D CANCEL^IBCEM3(.IBDA,IBIFN,IB364)
118 . D UNLOCK^IBCEU0(361.1,IBEOBIFN)
119 S VALMBCK="R"
120 I $G(IBDA)'="" D BLD^IBCECOB1
121CANCELQ Q
122 ;
123CLONE ; 'Copy/cancel bill' protocol action
124 N IBDA,IBQ,IBEOBIFN
125 ;
126 ; Check for security key
127 I '$$KCHK^XUSRB("IB AUTHORIZE") D G CLONEQ
128 . D FULL^VALM1 S VALMBCK="R"
129 . W !!?5,"You don't hold the proper security key to access this function."
130 . W !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
131 . D PAUSE^VALM1
132 . Q
133 ;
134 D SEL(.IBDA,1)
135 S IBDA=$O(IBDA(""))
136 I IBDA="" G CLONEQ
137 S IBEOBIFN=$P($G(IBDA(+IBDA)),U,3)
138 I '$$LOCK^IBCEU0(361.1,IBEOBIFN) G CLONEQ
139 D COPYCLON(+$G(IBDA(IBDA)),$P($G(IBDA(+IBDA)),U,2),.IBQ)
140 D UNLOCK^IBCEU0(361.1,IBEOBIFN)
141CLONEQ ;
142 S VALMBCK="R"
143 D:$G(IBQ)'="" BLD^IBCECOB1
144 Q
145 ;
146COPYCLON(IBIFN,IB364,IBQ) ; Generic entry point for clone a bill from EDI processing
147 ; IBIFN = original bill ien
148 ; IB364 = the ien of the transmission bill entry in file 364
149 ; IBQ = If bill is not cancelled, this is returned as null
150 ; - pass by reference -
151 ;
152 N IBQUIT,IBCCCC,IBHV,Y,IBCAN,IBCE,IBDA,IBCNCOPY
153 I '$$CANCKS^IBCEM3("CC",IBIFN) S IBQ="" G CCQ
154 ;
155 S IBCAN=2,IBCE("EDI")=1,Y=IBIFN,IBCCCC=0,IBHV("IBIFN")=IBIFN,IBHV("IBIFN1")="",IBCNCOPY=1
156 D ^IBCCC
157 S IBIFN=IBHV("IBIFN")
158 K IBCE("EDI") S IBQ=1
159 I $P($G(^DGCR(399,IBIFN,0)),U,13)'=7 S IBQ=""
160 I IBHV("IBIFN1") D
161 . N IBU
162 . S IBU="R"
163 . S IBNIEN=+IBHV("IBIFN1")
164 . I "23"'[$P($G(^DGCR(399,+IBHV("IBIFN1"),0)),U,13) D
165 .. W:'$G(IBCEAUTO) !,*7,"Please note: the new bill was not AUTHORIZED.",!,"It can only be accessed now via the normal, non-EDI functions.",!,"Status of new bill is ",$$EXPAND^IBTRE(399,.13,$P(^DGCR(399,IBHV("IBIFN1"),0),U,13)) S IBU="C"
166 . D UPDEDI^IBCEM(IB364,IBU)
167 ;
168 I '$G(IBCEAUTO) D PAUSE^VALM1
169CCQ Q
170 ;
171PRO ; Copy for secondary/tertiary bill
172 N VALMY,IBDA,Z,IBIFN,IBIFNH,IB364,IBCE
173 I '$P($G(^IBE(350.9,1,8)),U,12) D G PROQ
174 . D FULL^VALM1
175 . W !!?5,"MRA's may not be processed at this time."
176 . W !?5,"The IB site parameter ""Allow MRA Processing?"" is set to NO."
177 . D PAUSE^VALM1
178 . Q
179 D SEL(.IBDA,1)
180 S Z=$O(IBDA(0)),Z=$G(IBDA(+Z)) G:'Z PROQ
181 S IBIFN=$P(Z,U),IB364=$P(Z,U,2),IBDA=$P(Z,U,3),IBIFNH=IBIFN
182 I 'IBIFN G PROQ
183 I '$$LOCK^IBCEU0(361.1,IBDA) G PROQ
184 D COBCOPY(IBIFN,IB364,2,IBDA,"BLD^IBCECOB1")
185 D UNLOCK^IBCEU0(361.1,IBDA)
186PROQ S VALMBCK="R"
187 Q
188 ;
189COBCOPY(IBIFN,IB364,IBFROM,IBIEN,IBBLD) ; Generic entry point for EDI COB copy
190 ; IBIFN = original bill ien
191 ; IB364 = the ien of the transmission bill entry in file 364
192 ; IBFROM = 1 if called from CSA, 2 if called from COB/EOB processing
193 ; IBIEN = entry in 361 (IBFROM=1) or 361.1 (IBFROM=2) being processed
194 ; IBBLD = the name of the entrypoint that will rebuild the display
195 ;
196 N IBCBASK,IBCBCOPY,IBCAN,IBIFNH,IBNSTAT,IBOSTAT,IBPRCOB,IBSECHK,IBLMVAR,IBAC,IBMRAIEN,IBDA,IBAUTO
197 N IBCOB,IBCOBIL,IBCOBN,IBINS,IBINSN,IBINSOLD,IBMRAIO,IBMRAO,IBNMOLD,IBQUIT
198 S (IBCBASK,IBCBCOPY,IBCAN,IBAUTO)=1,(IBPRCOB,IBSECHK)=0,(IBMRAIEN,IBDA)=IBIEN
199 I 'IB364!'IBIFN W !,"Transmission record is missing for this bill" D PAUSE^VALM1 G COBCOPX
200 ;
201 S IBIFNH=IBIFN
202 I IBFROM=2 S IBPRCOB=1
203 ;
204 I $$PREOBTOT^IBCEU0(IBIFN)'>0 D G COBCOPX
205 . D FULL^VALM1
206 . W !!?5,"There is no patient responsibility for this claim."
207 . W !?5,"This claim may not be processed."
208 . D PAUSE^VALM1
209 . Q
210 ;
211 I $P($G(^IBM(361.1,IBDA,0)),U,16)="1.5" D G COBCOPX
212 . W !!,"This claim has already been processed as a secondary claim."
213 . W !,"You will need to complete the authorization process for this claim."
214 . D PAUSE^VALM1
215 . D AUTH
216 . Q
217 ;
218 ; Get out if no next payer
219 I '$P($G(^DGCR(399,IBIFN,"I"_($$COBN^IBCEF(IBIFN)+1))),U,1) D G COBCOPX
220 . W !,"There is no next payer for this bill"
221 . D PAUSE^VALM1
222 . Q
223 ;
224 D DSPRB^IBCCCB0(IBIFN) ; display related bills
225 S IBCE("EDI")=1
226 D CHKB^IBCCCB ; process COB, create secondary bill
227 S IBIFN=IBIFNH
228 I IBSECHK G COBCOPX
229 S IBV=1 D VIEW^IBCB2 ; display billing screens
230 D AUTH ; authorize bill
231COBCOPX ;
232 Q
233 ;
234AUTH ; procedure to authorize the claim and refresh the screen
235 K ^UTILITY($J) S IBAC=1,IBQUIT=0 D 3^IBCB1
236 I '$D(IOUON)!'$D(IORVON) D ENS^%ZISS
237 I $P($G(^IBM(361.1,IBMRAIEN,0)),U,16)=3 D UPDEDI^IBCEM(IB364,"Z")
238 I $G(IBBLD)'="" D @IBBLD
239 D PAUSE^VALM1
240AUTHX ;
241 Q
242 ;
243RES ;Resubmit bill by print
244 N IBDA,IBIFN,IB364
245 D SEL(.IBDA,1)
246 S IBDA=+$O(IBDA(0)),IBIFN=+$G(IBDA(+IBDA)),IB364=+$P($G(IBDA(IBDA)),U,2)
247 I 'IBIFN G RESQ
248 D PRINT1^IBCEM03(IBIFN,.IBDA,IB364)
249 D PAUSE^VALM1
250 I $G(IBDA)'="" D BLD^IBCECOB1
251RESQ S VALMBCK="R"
252 Q
253 ;
254EBI ;View an unauthorized transmitted bill
255 N IBFLG,IBDA,IBIFN,IB364,DFN
256 K ^TMP($J,"IBBILL")
257 D FULL^VALM1
258 ;
259 D SEL(.IBDA,1)
260 S IBDA=+$O(IBDA(""))
261 S IBIFN=+$G(IBDA(IBDA)),IB364=+$P($G(IBDA(IBDA)),U,2),DFN=$P($G(^DGCR(399,IBIFN,0)),U,2)
262 G:'IBIFN EDITQ
263 S IBV=1 D VIEW^IBCB2
264 I '$D(IOUON)!'$D(IORVON) D ENS^%ZISS
265 D BLD^IBCECOB1
266EDITQ S VALMBCK="R"
267 Q
268 ;
269SEL(IBDA,ONE) ; Select entry(s) from list
270 ; IBDA = array returned if selections made
271 ; IBDA(n)=ien of bill selected (file 399)
272 ; ONE = if set to 1, only one selection can be made at a time
273 N IB
274 K IBDA
275 D FULL^VALM1
276 D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
277 S IBDA=0 F S IBDA=$O(VALMY(IBDA)) Q:'IBDA S IBDA(IBDA)=$P($G(^TMP("IBCECOB",$J,+IBDA)),U,2,6)
278 Q
279 ;
280EXIT ; Exit out of COB
281 D FASTEXIT^IBCEFG4
282 I $G(IBFASTXT)=1 S IBFASTXT=5
283 Q
284 ;
Note: See TracBrowser for help on using the repository browser.