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

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

initial load of FOIAVistA 6/30/08 version

File size: 9.5 KB
Line 
1IBCECSA6 ;ALB/CXW - VIEW EOB SCREEN ;01-OCT-1999
2 ;;2.0;INTEGRATED BILLING;**137,135,155**;21-MAR-1994
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5BLD ;build EOB data display
6 D GETEOB(IBCNT,0)
7 Q
8 ;
9GETEOB(IBCNT,IBSRC,IBFULL,IBJTIBLN) ; Get EOB data in display format
10 ; IBCNT = the ien of the entry in file 361.1
11 ; IBSRC = 1 if called from AR, 0 if List Manager format needed
12 ; = 2 if called from AR and header data is desired
13 ; If IBSRC > 0 ^TMP("PRCA_EOB",$J,IBCNT,n)=line n's text is ret'd
14 ; IBFULL = 1 if no check should be made to eliminate a fld whose value=0
15 ; IBJTIBLN = line number to start VALMCNT with (optional)
16 ; used by IBJTBA1
17 ;
18 N IBREC,IBTYP,CNT,IBREM
19 S IBFULL=$G(IBFULL),IBSRC=$G(IBSRC)
20 I IBSRC N VALMBG,VALMCNT
21 S VALMCNT=0,VALMBG=1,CNT=0
22 I $G(IBJTIBLN)>0 S VALMCNT=IBJTIBLN
23 S IBREC=$G(^IBM(361.1,IBCNT,0)),IBTYP=$P(IBREC,U,4)
24 I IBSRC K ^TMP("PRCA_EOB",$J,IBCNT)
25 ; Once we're displaying a single EOB, remove the multiple EOB header of
26 ; the View EOB screen that was set in HDR^IBCEOB2 - VALMHDR(4).
27 I 'IBSRC,$G(VALMHDR(4))'="" S VALMHDR(4)=""
28 D GEN,PAY,ARCP^IBCECSA7,CLVL,CLVLA,MIN^IBCECSA5,MOUT,LLVLA^IBCECSA7,RDATA^IBCECSA7
29 Q
30 ;
31SEL(IB,ONE) ;
32 N IBDA
33 D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
34 S IBDA=0 S IBDA=$O(VALMY(IBDA)) Q:'IBDA D
35 . S IB=$P($G(^TMP("IBCECSD",$J,IBDA)),U,2)
36 . S IBONE=1
37 Q
38 ;
39ACT ; Reposition display using actions
40 I '$G(IBONE) D SEL(.IBCNT,1) D BLD:$G(IBCNT)
41 S VALMBG=$G(^TMP("IBCECSD",$J,"X",+$G(IBACT))) S:'VALMBG VALMBG=1
42 S VALMBCK="R"
43 Q
44 ;
45SET(IBSRC,X,CNT,IBCNT) ;set list manager arrays
46 S VALMCNT=VALMCNT+1,IBSRC=$G(IBSRC)
47 ;
48 I IBSRC D Q
49 . S ^TMP("PRCA_EOB",$J,IBCNT,VALMCNT)=X
50 ;
51 S ^TMP("IBCECSD",$J,VALMCNT,0)=X
52 S ^TMP("IBCECSD",$J,"IDX",VALMCNT,CNT)=""
53 S ^TMP("IBCECSD",$J,CNT)=VALMCNT_U_IBCNT
54 Q
55 ;
56GEN ;
57 S IBSRC=$G(IBSRC) Q:IBSRC=1
58 N IBREC1,IBTMP,IBSPL
59 S IBSPL=+$O(^IBM(361.1,IBCNT,8,0)),IBSPL=(+$O(^(IBSPL))'=IBSPL)
60 S IB=$$SETSTR^VALM1("EOB GENERAL INFORMATION:","",1,50)
61 D SET(IBSRC,IB,CNT,IBCNT)
62 I 'IBSRC D
63 . D CNTRL^VALM10(VALMCNT,1,24,IORVON,IORVOFF)
64 . S ^TMP("IBCECSD",$J,"X",1)=VALMCNT
65 S IB=$$SETSTR^VALM1("Type : "_$S(IBTYP:"MEDICARE MRA",1:"NORMAL EOB")_$S(IBSPL:" (SPLIT IN A/R)",1:""),"",2,39)
66 S IB=$$SETSTR^VALM1("EOB Paid DT : "_$$DAT1^IBOUTL($P(IBREC,U,6),1),IB,41,38)
67 D SET(IBSRC,IB,CNT,IBCNT)
68 I IBSRC D
69 . S IB=$$SETSTR^VALM1($S(IBSRC:"Entry Dt/Tm :"_$$DAT1^IBOUTL($P(IBREC,U,5),1),1:""),"",2,39)
70 . S IBTMP=$P(IBREC,U,13)
71 . S IB=$$SETSTR^VALM1("Claim Status : "_$$EXTERNAL^DILFD(361.1,.13,"",IBTMP),IB,41,38)
72 . D SET(IBSRC,IB,CNT,IBCNT)
73 . S IBTMP=$P(IBREC,U,16)
74 . S IB=$$SETSTR^VALM1("Review Status: "_$$EXTERNAL^DILFD(361.1,.16,"",IBTMP),IB,41,38)
75 . D SET(IBSRC,IB,CNT,IBCNT)
76 . S IB=$$SETSTR^VALM1("Entered By : "_$P($G(^VA(200,+$P(IBREC,U,18),0)),U),"",2,39)
77 . S IBTMP=$P(IBREC,U,15)
78 . S IB=$$SETSTR^VALM1("Insurance Seq: "_$$EXTERNAL^DILFD(361.1,.15,"",IBTMP),IB,41,38)
79 . D SET(IBSRC,IB,CNT,IBCNT)
80 I 'IBSRC D
81 . S IB=$$SETSTR^VALM1($S($P(IBREC,U,17):"Manual Entry: YES",1:""),"",2,39)
82 . S IBTMP=$P(IBREC,U,13)
83 . S IB=$$SETSTR^VALM1("Claim Status : "_$$EXTERNAL^DILFD(361.1,.13,"",IBTMP),IB,41,38)
84 . D SET(IBSRC,IB,CNT,IBCNT)
85 . S IBTMP=$P(IBREC,U,15)
86 . S IB=$$SETSTR^VALM1("Insurance Seq: "_$$EXTERNAL^DILFD(361.1,.15,"",IBTMP),"",41,38)
87 . D SET(IBSRC,IB,CNT,IBCNT)
88 S IBREC1=$G(^IBM(361.1,IBCNT,100))
89 I $S($G(IBFULL):1,1:$P(IBREC1,U,4)'=""!($P(IBREC1,U,3)'="")) D
90 . S IB=$$SETSTR^VALM1("Last Edited : "_$$DAT1^IBOUTL($P(IBREC1,U,4),1),"",2,39)
91 . S IB=$$SETSTR^VALM1("Last Edit By : "_$P($G(^VA(200,+$P(IBREC1,U,3),0)),U),IB,41,38)
92 . D SET(IBSRC,IB,CNT,IBCNT)
93 ;
94 D INSINF^IBCECSA7(+IBREC,CNT,IBCNT)
95 ;
96 I $S($G(IBFULL):1,1:$P($G(^IBM(361.1,IBCNT,6)),U)'=""!($P($G(^IBM(361.1,IBCNT,6)),U,2)'="")) D
97 . S IB=$$SETSTR^VALM1("New Pat. Nm.: "_$P($G(^IBM(361.1,IBCNT,6)),U),"",2,39)
98 . S IB=$$SETSTR^VALM1("New Pat. Id : "_$P($G(^IBM(361.1,IBCNT,6)),U,2),IB,41,38)
99 . D SET(IBSRC,IB,CNT,IBCNT)
100 D:IBSRC SET(IBSRC,"",CNT,IBCNT)
101 Q
102 ;
103PAY ;
104 S IBSRC=$G(IBSRC) Q:IBSRC=1
105 N IBREC1,IBTMP
106 S IB=$$SETSTR^VALM1("PAYER INFORMATION:","",1,50)
107 D SET(IBSRC,IB,CNT,IBCNT)
108 I 'IBSRC D
109 . D CNTRL^VALM10(VALMCNT,1,18,IORVON,IORVOFF)
110 . S ^TMP("IBCECSD",$J,"X",2)=VALMCNT
111 S IB=$$SETSTR^VALM1("Payer Name : "_$P($G(^DIC(36,+$P(IBREC,U,2),0)),U),"",2,39)
112 S IB=$$SETSTR^VALM1("Payer Id : "_$P(IBREC,U,3),IB,41,38)
113 D SET(IBSRC,IB,CNT,IBCNT)
114 S IB=$$SETSTR^VALM1("ICN : "_$P(IBREC,U,14),"",2,39)
115 D SET(IBSRC,IB,CNT,IBCNT)
116 I $P(IBREC,U,9)'=""!($P(IBREC,U,8)'="") D
117 . S IB=$$SETSTR^VALM1("Cross Ovr ID : "_$P(IBREC,U,9),"",2,39)
118 . S IB=$$SETSTR^VALM1("Cross Ovr Nm: "_$P(IBREC,U,8),IB,41,38)
119 . D SET(IBSRC,IB,CNT,IBCNT)
120 D:IBSRC SET(IBSRC,"",CNT,IBCNT)
121 Q
122 ;
123CLVL ;
124 N IBREC1,IBTMP,IBRL
125 S IB=$$SETSTR^VALM1("CLAIM LEVEL PAY STATUS:","",1,50),IBSRC=$G(IBSRC)
126 D SET(IBSRC,IB,CNT,IBCNT)
127 I 'IBSRC D
128 . D CNTRL^VALM10(VALMCNT,1,23,IORVON,IORVOFF)
129 . S ^TMP("IBCECSD",$J,"X",3)=VALMCNT
130 I '$D(^IBM(361.1,IBCNT,2)),'$D(^IBM(361.1,IBCNT,1)) D SET(IBSRC," NONE",CNT,IBCNT) Q
131 S IB=$$SETSTR^VALM1("Tot Submitted Chrg: "_$$A10($P($G(^IBM(361.1,IBCNT,2)),U,4)),"",2,39)
132 S IBREC1=$G(^IBM(361.1,IBCNT,1))
133 S IB=$$SETSTR^VALM1("Covered Amt : "_$$A10($P(IBREC1,U,3)),IB,41,38)
134 D SET(IBSRC,IB,CNT,IBCNT)
135 S IB=$$SETSTR^VALM1("Payer Paid Amt : "_$$A10($P(IBREC1,U)),"",2,39)
136 S IB=$$SETSTR^VALM1("Patient Resp. Amt : "_$$A10($S(IBSRC:$P(IBREC1,U,2),$$FT^IBCEF(+IBREC)=3:$$PTRESPI^IBCECOB1(IBCNT),1:$P($G(^IBM(361.1,IBCNT,1)),"^",2))),IB,41,38)
137 D SET(IBSRC,IB,CNT,IBCNT)
138 S (IB,IBRL)=""
139 I $S(IBFULL:1,1:$P(IBREC1,U,4)) S IB=$$SETSTR^VALM1("Discount Amt : "_$$A10($P(IBREC1,U,4)),"",2,39),IBRL=1
140 I $S(IBFULL:1,1:$P(IBREC1,U,5)) S IB=$$SETSTR^VALM1("Per Day Limit Amt : "_$$A10($P(IBREC1,U,5)),IB,$S('IBRL:2,1:41),$S('IBRL:39,1:38)),IBRL=$S(IBRL:0,1:1) I IBRL=0 D SET(IBSRC,IB,CNT,IBCNT) S IB=""
141 I $S(IBFULL:1,1:$P(IBREC1,U,8)) S IB=$$SETSTR^VALM1("Tax Amt : "_$$A10($P(IBREC1,U,8)),IB,$S('IBRL:2,1:41),$S('IBRL:39,1:38)),IBRL=$S(IBRL:0,1:1) I IBRL=0 D SET(IBSRC,IB,CNT,IBCNT) S IB=""
142 I $S(IBFULL:1,1:$P(IBREC1,U,9)) S IB=$$SETSTR^VALM1("Tot Before Tax Amt: "_$$A10($P(IBREC1,U,9)),IB,$S('IBRL:2,1:41),$S('IBRL:39,1:38)),IBRL=$S(IBRL:0,1:1) I IBRL=0 D SET(IBSRC,IB,CNT,IBCNT) S IB=""
143 I $S(IBFULL:1,1:$P($G(^IBM(361.1,IBCNT,2)),U,3)) S IB=$$SETSTR^VALM1("Total Allowed Amt : "_$$A10($P($G(^IBM(361.1,IBCNT,2)),U,3)),IB,$S('IBRL:2,1:41),$S('IBRL:39,1:38)),IBRL=$S(IBRL:0,1:1) I IBRL=0 D SET(IBSRC,IB,CNT,IBCNT) S IB=""
144 I $S(IBFULL:1,1:$P($G(^IBM(361.1,IBCNT,2)),U,5)) S IB=$$SETSTR^VALM1("Negative Reimb Amt: "_$$A10($P($G(^IBM(361.1,IBCNT,2)),U,5)),IB,$S('IBRL:2,1:41),$S('IBRL:39,1:38)),IBRL=$S(IBRL:0,1:1) I IBRL=0 D SET(IBSRC,IB,CNT,IBCNT) S IB=""
145 I $G(IBSRC) I $S(IBFULL:1,1:$P(IBREC,U,12)) S IB=$$SETSTR^VALM1("Discharge Fraction: "_$$A10($P(IBREC,U,12)),IB,$S('IBRL:2,1:41),$S('IBRL:39,1:38)),IBRL=$S(IBRL:0,1:1) I IBRL=0 D SET(IBSRC,IB,CNT,IBCNT) S IB=""
146 I $S(IBFULL:1,1:$P(IBREC,U,10)) S IB=$$SETSTR^VALM1("DRG Code Used :"_$$RJ^XLFSTR($P(IBREC,U,10),11," "),IB,$S('IBRL:2,1:41),$S('IBRL:39,1:38)),IBRL=$S(IBRL:0,1:1) I IBRL=0 D SET(IBSRC,IB,CNT,IBCNT) S IB=""
147 I $S(IBFULL:1,1:$P(IBREC,U,11)) S IB=$$SETSTR^VALM1("DRG Weight Used :"_$$RJ^XLFSTR($P(IBREC,U,11),11," "),IB,$S('IBRL:2,1:41),$S('IBRL:39,1:38)),IBRL=$S(IBRL:0,1:1)
148 D:IBRL'="" SET(IBSRC,IB,CNT,IBCNT)
149 D:IBSRC SET(IBSRC,"",CNT,IBCNT)
150 Q
151 ;
152MOUT ;
153 N IBREC1,IBRL
154 S IBREC1=$G(^IBM(361.1,IBCNT,3)),IBSRC=$G(IBSRC)
155 I 'IBSRC,$$INPAT^IBCEF(+IBREC),$TR(IBREC1,"0^")="" Q
156 I IBREC1="" D:'$D(^IBM(361.1,IBCNT,4)) SET(IBSRC," NONE",CNT,IBCNT) D:'IBSRC SET(IBSRC,"",CNT,IBCNT),REMARK^IBCECSA5 Q
157 D SET(IBSRC," OUTPATIENT:",CNT,IBCNT)
158 S IBRL=""
159 I $S(IBFULL:1,1:$P(IBREC1,U)) S IB=$$SETSTR^VALM1("Reimburse Rate : "_$$P10($P(IBREC1,U)),"",$S('IBRL:4,1:40),$S('IBRL:41,1:38)),IBRL=$S(IBRL:0,1:1)
160 I $S(IBFULL:1,1:$P(IBREC1,U,2)) S IB=$$SETSTR^VALM1("HCPCS Pay Amt : "_$$A10($P(IBREC1,U,2)),IB,$S('IBRL:4,1:40),$S('IBRL:41,1:38)),IBRL=$S(IBRL:0,1:1)
161 D:IBRL=0 SET(IBSRC,IB,CNT,IBCNT)
162 I $S(IBFULL:1,1:$P(IBREC1,U,8)) S IB=$$SETSTR^VALM1("Esrd Paid Amt : "_$$A10($P(IBREC1,U,8)),"",$S('IBRL:4,1:40),$S('IBRL:41,1:38)),IBRL=$S(IBRL:0,1:1)
163 D:IBRL=0 SET(IBSRC,IB,CNT,IBCNT)
164 I $S(IBFULL:1,1:$P(IBREC1,U,9)) S IB=$$SETSTR^VALM1("Non-Pay Prof Comp : "_$$A10($P(IBREC1,U,9)),IB,$S('IBRL:4,1:40),$S('IBRL:41,1:38)),IBRL=$S(IBRL:0,1:1)
165 D:IBRL'="" SET(IBSRC,IB,CNT,IBCNT)
166 D REMARK^IBCECSA5
167 D SET(IBSRC,"",CNT,IBCNT)
168 Q
169 ;
170CLVLA ;
171 N IBREC,IBFLG,GR,RSN,Z
172 S IB=$$SETSTR^VALM1("CLAIM LEVEL ADJUSTMENTS:","",1,50),IBSRC=$G(IBSRC)
173 D SET(IBSRC,IB,CNT,IBCNT)
174 I 'IBSRC D
175 . D CNTRL^VALM10(VALMCNT,1,24,IORVON,IORVOFF)
176 . S ^TMP("IBCECSD",$J,"X",4)=VALMCNT
177 S (Y,IBFLG)=0 F S Y=$O(^IBM(361.1,IBCNT,10,Y)) Q:'Y D
178 . S IBREC=$G(^IBM(361.1,IBCNT,10,Y,0)),GR=$P(IBREC,U,1)
179 . I GR="OA",$P($G(^IBM(361.1,IBCNT,10,Y,1,0)),U,4)=1,$D(^IBM(361.1,IBCNT,10,Y,1,"B","AB3")) Q ; kludge
180 . S IBREC=$$EXTERNAL^DILFD(361.11,.01,"",GR),IBFLG=1
181 . D SET(IBSRC," GROUP CODE: "_IBREC,CNT,IBCNT)
182 . S Z=0 F S Z=$O(^IBM(361.1,IBCNT,10,Y,1,Z)) Q:'Z D
183 .. S IBREC=$G(^IBM(361.1,IBCNT,10,Y,1,Z,0)),RSN=$P(IBREC,U,1)
184 .. I GR="OA",RSN="AB3" Q ; kludge
185 .. S IB=$$SETSTR^VALM1("REASON CODE: "_RSN_" "_$P(IBREC,U,4),"",3,77)
186 .. D SET(IBSRC,IB,CNT,IBCNT)
187 .. S IB=$$SETSTR^VALM1("Amount: "_$$A10($P(IBREC,U,2)),"",3,40)
188 .. S IB=$$SETSTR^VALM1("Quantity: "_$P(IBREC,U,3),IB,41,38)
189 .. D SET(IBSRC,IB,CNT,IBCNT)
190 I 'IBFLG D SET(IBSRC," NONE",CNT,IBCNT)
191 D:IBSRC SET(IBSRC,"",CNT,IBCNT)
192 Q
193 ;
194A10(X) ; returns a dollar amount right justified to 10 characters
195 Q $$RJ^XLFSTR($FN(X,"",2),10," ")
196 ;
197P10(X) ; returns a % right just 10
198 ; X is a decimal between 0-1
199 Q $$RJ^XLFSTR((X*100)_"%",10," ")
200 ;
Note: See TracBrowser for help on using the repository browser.