source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBNCPEV.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: 9.2 KB
Line 
1IBNCPEV ;DALOI/SS - NCPDP BILLING EVENTS REPORT ;21-MAR-2006
2 ;;2.0;INTEGRATED BILLING;**342,363**;21-MAR-94;Build 35
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6RPT ;
7 ;
8 N IBPAT,IBRX,IBBDT,IBEDT,Y,IBM1,IBM2,IBM3,IBQ,IBSCR,IBPAGE,IBDTL,IBDIVS
9 N IBECME
10 D SETVARS^IBNCPEV1
11 Q:IBQ
12 D START
13 D ^%ZISC
14 I IBQ W !,"Cancelled"
15 Q
16 ;
17START ;
18 N REF,IBFROM,IBTO,IBI,IBN,IBRX1,IBFN,IBNDX,IB1ST,IBNUM,X,IBSC,IBNB
19 N Z,Z1
20 ;Constants
21 S IBSC="STATUS CHECK",IBNB="Not ECME billable: ",IBNDX="IBNCPDP-"
22 ;get the first date
23 S IBFROM=$O(^IBCNR(366.14,"B",IBBDT-1)) Q:+IBFROM=0
24 ;get the last date
25 S IBTO=$O(^IBCNR(366.14,"B",IBEDT+1),-1) Q:+IBTO=0
26 ;
27 S REF=$NA(^TMP($J,"IBNCPDPE"))
28 ;
29 K @REF
30 ;
31 I +$G(IBECME) S IBRX=$$GETRX^IBNCPEV1(IBECME,IBFROM,IBTO) I 'IBRX W !!,"No data found for the specified date range and ECME #" Q ; no match with ECME #
32 ;collect
33 N IBDTIEN,IBRXIEN,IBZ0,IBZ1,IBZ2,IBDFN,IBEVNT,IBP4
34 S IBI=IBFROM-1
35 F S IBI=$O(^IBCNR(366.14,"B",IBI)) Q:+IBI=0 Q:IBI>IBTO D
36 . S IBDTIEN=$O(^IBCNR(366.14,"B",IBI,0))
37 . S IBN=0 F S IBN=$O(^IBCNR(366.14,IBDTIEN,1,IBN)) Q:+IBN=0 D
38 . . S IBZ0=$G(^IBCNR(366.14,IBDTIEN,1,IBN,0))
39 . . ;if not "ALL" was selected IBDIVS>0 AND the division in #366.14 record is among those selected by the user
40 . . I IBDIVS>0,$$CHECKDIV^IBNCPEV1(+$P(IBZ0,U,9),.IBDIVS)=0 Q
41 . . S IBDFN=+$P(IBZ0,U,3)
42 . . Q:IBDFN=0
43 . . S IBEVNT=$$GET1^DIQ(366.141,IBN_","_IBDTIEN_",",.01)
44 . . S IBZ2=$G(^IBCNR(366.14,IBDTIEN,1,IBN,2))
45 . . S IBRXIEN=$P(IBZ2,U,12)
46 . . I IBRXIEN="" S IBRXIEN=$P(IBZ2,U,1)
47 . . I IBPAT,IBDFN'=IBPAT Q
48 . . I IBRX,IBRXIEN'=IBRX Q
49 . . I $$RXNUM(IBRXIEN)="" Q
50 . . I IBM2="E",IBEVNT[IBSC,'$P(IBZ0,U,7) Q
51 . . I IBM2="N",IBEVNT'[IBSC Q
52 . . I IBM2="N",IBEVNT[IBSC,$P(IBZ0,U,7) Q
53 . . I IBM3'="A",IBM3'=$$RXWMC^IBNCPRR(+IBRXIEN) Q
54 . . S @REF@(+IBRXIEN,+$P(IBZ2,U,3),IBDTIEN,IBN)=""
55 ;
56 I '$D(@REF) W !!,"No data found for the specified input criteria" Q
57 ;print
58 S IBNUM=0
59 U IO D HDR
60 S IBRX1="" F S IBRX1=$O(@REF@(IBRX1)) Q:IBRX1="" D Q:IBQ
61 .S IBFN="" F S IBFN=$O(@REF@(IBRX1,IBFN)) Q:IBFN="" D Q:IBQ
62 ..S IB1ST=1
63 ..S IBI="" F S IBI=$O(@REF@(IBRX1,IBFN,IBI)) Q:IBI="" D Q:IBQ
64 ...S IBN="" F S IBN=$O(@REF@(IBRX1,IBFN,IBI,IBN)) Q:IBN="" D Q:IBQ
65 ....N IBZ,IBD1,IBD2,IBD3,IBD4,IBINS,IBY
66 ....;load main
67 ....S IBZ=$G(^IBCNR(366.14,IBI,1,IBN,0))
68 ....;load IBD array
69 ....S IBD1=$G(^IBCNR(366.14,IBI,1,IBN,1))
70 ....S IBD2=$G(^IBCNR(366.14,IBI,1,IBN,2))
71 ....S IBD3=$G(^IBCNR(366.14,IBI,1,IBN,3))
72 ....S IBD4=$G(^IBCNR(366.14,IBI,1,IBN,4))
73 ....S IBY=0
74 ....;load insurance multiple
75 ....F S IBY=$O(^IBCNR(366.14,IBI,1,IBN,5,IBY)) Q:+IBY=0 D
76 .....S IBINS(IBY,0)=$G(^IBCNR(366.14,IBI,1,IBN,5,IBY,0))
77 .....S IBINS(IBY,1)=$G(^IBCNR(366.14,IBI,1,IBN,5,IBY,1))
78 .....S IBINS(IBY,2)=$G(^IBCNR(366.14,IBI,1,IBN,5,IBY,2))
79 .....S IBINS(IBY,3)=$G(^IBCNR(366.14,IBI,1,IBN,5,IBY,3))
80 ....;
81 ....I IB1ST D Q:IBQ
82 .....S IBNUM=IBNUM+1 I IBNUM>1 D ULINE("-") Q:IBQ
83 .....D CHKP Q:IBQ
84 .....W !,IBNUM," ",?4,$$RXNUM(IBRX1)," ",?12,IBFN," ",?16,$$DAT(+$P(IBD2,U,6)) ;RX# Fill# Fiil_date
85 .....W " ",?28,$E($$PAT(+$P(IBZ,U,3)),1,21)," ",?50,$E($$DRUG(+$P(IBZ,U,3),IBRX1),1,30)
86 .....S IB1ST=0
87 ....N IND S IND=6
88 ....D CHKP Q:IBQ
89 ....S IBEVNT=$$GET1^DIQ(366.141,IBN_","_IBI_",",.01)
90 ....W !,?IND,$$EVNT(IBEVNT)," ",?16,$$TIM($P(IBZ,U,5)),?31," Status:",$E($$STAT(IBEVNT,$P(IBZ,U,7)_U_$P(IBZ,U,8),$P(IBD3,U,7),$P(IBD3,U,1)),1,40)
91 ....Q:'IBDTL ; no details
92 ....I IBEVNT="BILL" D DBILL Q
93 ....I IBEVNT="REJECT" D DREJ Q
94 ....I IBEVNT["REVERSE" D DREV Q
95 ....I IBEVNT["SUBMIT" D DSUB Q
96 ....I IBEVNT["CLOSE" D DCLO Q
97 ....I IBEVNT["REOPEN" D REOPEN^IBNCPEV1 Q
98 ....I IBEVNT["RELEASE" D DREL Q
99 ....I IBEVNT[IBSC D DSTAT^IBNCPEV1(.IBD2,.IBD3,.IBD4,.IBINS) Q
100 ....I IBEVNT["BILL CANCELLED" D BCANC Q
101 I IBSCR,'IBQ W !,"End of report, press RETURN to continue." R X:DTIME
102 K @REF
103 Q
104 ;
105 ;provides STATUS information
106 ;
107STAT(X,RES,CR,IBIFN) ;
108 N IBSC
109 N IBNL
110 S IBSC="STATUS CHECK"
111 S IBNL="Plan not linked to the Payer"
112 I X[IBSC,RES[IBNB S RES="0^"_$P(RES,IBNB,2)
113 I X[IBSC,RES[IBNL S RES="0^Plan not linked" ; shorten too long line
114 I X[IBSC,'RES,RES["Non-Billable in CT" Q $P(RES,U,2)
115 I X[IBSC Q $S(RES:"",1:"non-")_"ECME Billable"_$S(RES:"",$P(RES,U,2)="":"",$P(RES,U,2)="NEEDS SC DETERMINATION":" NEEDS "_$$GETNOANS^IBNCPEV1(IBD4)_" DETERMINATION",1:", "_$P(RES,U,2))
116 I X="BILL",'RES,IBIFN Q "Bill "_$$BILL(IBIFN)_" created with ERRORs"
117 I X="BILL",'RES Q "Error: "_$P(RES,U,2)
118 I X="BILL" Q "Bill# "_$$BILL(+RES)_" created"
119 I X["REVERSE",$G(CR)=7,RES=1 Q "set N/B Reason: Rx deleted, no Bill to cancel."
120 I X["REVERSE" Q $S(RES=1:"success",RES>1:"Bill# "_$$BILL(+RES)_" cancelled",'RES:"ECME Claim reversed, no Bill to cancel",1:$P(RES,U,2))
121 I 'RES Q $P(RES,U,2)
122 Q "OK"
123 ;
124 ;BILL section
125 ;input params IBD*, IBZ, IBINS*
126DBILL ;
127 I '$P(IBZ,U,7),$L($P(IBZ,U,8)),$P(IBD3,U,1) D CHKP Q:IBQ W !?10,"ERROR DESCRIPTION: ",$P(IBZ,U,8)
128 D CHKP Q:IBQ
129 D SUBHDR
130 ;I $P(IBD1,U,5) D CHKP Q:IBQ W !?10,"MEDICAL CENTER DIVISION: ",$P($G(^DG(40.8,+$P(IBD1,U,5),0)),U)
131 I $P(IBD2,U,4) D CHKP Q:IBQ W !?10,"DRUG:",$$DRUGAPI^IBNCPEV1(+$P(IBD2,U,4),.01)
132 D CHKP Q:IBQ
133 W !,?10,"NDC:",$S($P(IBD2,U,5):$P(IBD2,U,5),1:"No"),", BILLED QTY:",$S($P(IBD2,U,8):$P(IBD2,U,8),1:"No"),", DAYS SUPPLY:",$S($P(IBD2,U,9):$P(IBD2,U,9),1:"No")
134 W !,?10,"BILLED:",$J($P(IBD3,U,2),0,2),", "
135 W "PAID:",$J($P(IBD3,U,5),0,2)
136 D CHKP Q:IBQ
137 W !?10,"PLAN:",$P($G(^IBA(355.3,+$P(IBD3,U,3),0)),U,3),", INSURANCE: ",$P($G(^DIC(36,+$G(^IBA(355.3,+$P(IBD3,U,3),0)),0)),U)
138 D CHKP Q:IBQ
139 D DISPUSR
140 Q
141 ;
142 ;reject section
143DREJ ;
144 D CHKP Q:IBQ
145 D SUBHDR
146 I +$P(IBD3,U,3) D CHKP Q:IBQ W !?10,"PLAN:",$P($G(^IBA(355.3,+$P(IBD3,U,3),0)),U,3),", INSURANCE: ",$P($G(^DIC(36,+$G(^IBA(355.3,+$P(IBD3,U,3),0)),0)),U)
147 D CLRS Q:IBQ
148 D CHKP Q:IBQ
149 D DISPUSR
150 Q
151 ;close
152DCLO ;
153 D DREJ
154 Q
155 ;submit
156DSUB ;
157 D CHKP Q:IBQ
158 D SUBHDR
159 I $L($P(IBD1,U,6)) D CHKP W !?10,"PAYER RESPONSE: ",$P(IBD1,U,6)
160 I $L($P(IBD3,U,3)) D CHKP Q:IBQ W !?10,"PLAN:",$P($G(^IBA(355.3,+$P(IBD3,U,3),0)),U,3),", INSURANCE: ",$P($G(^DIC(36,+$G(^IBA(355.3,+$P(IBD3,U,3),0)),0)),U)
161 D CHKP Q:IBQ
162 D DISPUSR
163 Q
164 ;release
165DREL ;
166 D DREJ
167 Q
168 ;reverse
169DREV ;
170 D CHKP Q:IBQ
171 D SUBHDR
172 I $L($P(IBD1,U,6)),$E($P(IBD1,U,6),1)'="A"&($E($P(IBD1,U,6),1)'="R") S $P(IBD1,U,6)="" ; only display accepted and rejected on REVERSALS
173 I $L($P(IBD1,U,6)) D CHKP W !?10,"PAYER RESPONSE: ",$P(IBD1,U,6)
174 I $L($P(IBD3,U,3)) D CHKP Q:IBQ W !?10,"PLAN:",$P($G(^IBA(355.3,+$P(IBD3,U,3),0)),U,3),", INSURANCE: ",$P($G(^DIC(36,+$G(^IBA(355.3,+$P(IBD3,U,3),0)),0)),U)
175 D CLRS Q:IBQ
176 D CHKP Q:IBQ
177 D DISPUSR
178 W !?10,"REVERSAL REASON:",$P(IBD1,U,7)
179 Q
180 ;
181BCANC ; bill cancellation generated by auto-reversal (duplicate bill)
182 D CHKP Q:IBQ
183 W !?10,"SYSTEM FOUND DUPLICATE BILL WHILE PROCESSING CLAIM"
184 D CHKP Q:IBQ
185 D DISPUSR
186 Q
187 ;
188 ;
189RELT(X) I X W ",",?45,"RELEASE DATE:",$$TIM(X)
190 Q
191CLRS ;
192 N TX,PP,RC
193 S TX="CLOSE REASON"
194 S PP="DROP TO PAPER"
195 S RC="RELEASE COPAY"
196 I $P(IBD3,U,7)'="" D CHKP Q:IBQ W !?10,TX,":",$$REASON^IBNCPDPU($P(IBD3,U,7)) W:$P(IBD3,U,8) ", ",PP W:$P(IBD3,U,9) ", ",RC
197 S TX="CLOSE COMMENT"
198 I $L($P(IBD3,U,6))>2 D CHKP Q:IBQ W !?10,"COMMENT:",$P(IBD3,U,6)
199 Q
200 ;
201HDR ;header
202 W @IOF S IBPAGE=IBPAGE+1 W ?72,"PAGE ",IBPAGE
203 W !,$$DISPTITL^IBNCPEV1(IBBDT,IBEDT,IBDTL,.IBDIVS)
204 W:IBDIVS'=0 !,$$DISPLDIV^IBNCPEV1(.IBDIVS)
205 W !?15
206 I IBM1="R" W "SINGLE PRESCRIPTION - ",$$RXNUM(IBRX)," "
207 I IBM1="P" W "SINGLE PATIENT - ",$P($G(^DPT(IBPAT,0)),U)," "
208 I IBM1="E" W "SINGLE ECME # - ",IBECME
209 I IBM2="E" W "ECME BILLABLE RX "
210 I IBM2="N" W "NON ECME BILLABLE RX "
211 I IBM3'="A",IBM1'="R" W $S(IBM3="M":"MAIL",IBM3="C":"CMOP",1:"WINDOW")_" PRESCRIPTIONS ONLY"
212 W !,?4," RX# FILL DATE PATIENT NAME",?55,"DRUG"
213 N I W ! F I=1:1:80 W "="
214 Q
215 ;
216ULINE(X) ;line
217 D CHKP Q:IBQ
218 N I W ! F I=1:1:80 W $G(X,"-")
219 Q
220CHKP ;Check for EOP
221 N Y
222 I $Y>(IOSL-4) D:IBSCR PAUSE Q:IBQ D HDR
223 Q
224DAT(X,Y) Q $$DAT1^IBOUTL(X,.Y)
225TIM(X) N IBT ;time
226 S IBT=$$DAT1^IBOUTL(X,1) I $L(IBT," ")<3 Q IBT
227 I $P(IBT," ",3)="pm" S IBT=$P(IBT," ",1,2)_"p" Q IBT
228 I $P(IBT," ",3)="am" S IBT=$P(IBT," ",1,2)_"a" Q IBT
229 Q IBT
230 ;
231USR(X) ;
232 I $D(^VA(200,+X,0)) Q $P(^(0),U)
233 Q X
234 ;
235PAT(DFN) ;
236 Q $P($G(^DPT(DFN,0),"?"),"^")
237BILL(BN) ;
238 Q $P($G(^DGCR(399,BN,0),"?"),"^")
239ARBILL(BN) ;
240 Q $P($G(^PRCA(430,BN,0),"?"),"^")
241 ;/*
242 ;Returns
243 ;return DRUG name (#50,.01)
244 ;IBDFN - IEN in PATIENT file #2
245 ;IBRX - IEN in PRESCRIPTION file #52
246DRUG(IBDFN,IBRX) ;
247 I +$G(IBDFN)=0 Q ""
248 N X1
249 K ^TMP($J,"IBNCPDP52")
250 D RX^PSO52API(IBDFN,"IBNCPDP52",IBRX,"",0)
251 S X1=+$G(^TMP($J,"IBNCPDP52",IBDFN,IBRX,6))
252 K ^TMP($J,"IBNCPDP52")
253 I X1=0 Q ""
254 Q $$DRUGNAM^IBNCPEV1(X1)
255 ;
256EVNT(X) ;Transl
257 I X="BILL" Q "BILLING"
258 I X="REVERSE" Q "REVERSAL"
259 I X="AUTO REVERSE" Q "REVERSAL(A)"
260 I X["RELEASE" Q "RELEASE"
261 I X["SUBMIT" Q "SUBMIT"
262 I X["CLOSE" Q "CLOSE"
263 I X[IBSC Q "FINISH" ;IBSC = "STATUS CHECK"
264 Q X
265 ;
266BOCD(X) ;Basis of Cost Determ
267 I +X=7 Q "USUAL & CUSTOMARY"
268 I +X=1 Q "AWP"
269 I +X=5 Q "COST CALCULATIONS"
270 Q X
271 ;
272PAUSE ;
273 N X U IO(0) W !,"Press RETURN to continue, '^' to exit:" R X:DTIME S:'$T X="^" S:X["^" IBQ=1
274 U IO
275 Q
276 ;
277SUBHDR ;
278 W !?10,"ECME# ",$P(IBD1,U,3),",",?25,"FILL DATE:",$$DAT($P(IBD2,U,6))
279 D RELT($P(IBD2,U,7))
280 Q
281DISPUSR ;
282 W !?10,"USER:",$$USR(+$P(IBD3,U,10))
283 Q
284 ;
285 ;/*
286 ;Returns RX number (external value: #52,.01)
287 ;IBRX - IEN in PRESCRIPTION file #52
288RXNUM(IBRX) ;*/
289 Q $$RXAPI1^IBNCPUT1(IBRX,.01,"E")
290 ;
291 ;IBNCPEV
Note: See TracBrowser for help on using the repository browser.