source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEMRAA.m@ 1696

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

initial load of WorldVistAEHR
File size: 9.0 KB
Line 
1IBCEMRAA ;ALB/DSM - MEDICARE REMITTANCE ADVICE DETAIL-PART A ; 12/29/05 9:57am
2 ;;2.0;INTEGRATED BILLING;**155,323,349**;21-MAR-94;Build 46
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q ; must call an entry point
6 ;
7 ; This routine prints MRA Report for UB-04 (Part A) Form Type
8 ;
9MRA(IBIFN) ;;Module - Entry point to print ALL MRA reports, for a given IBIFN.
10 ; This entry point doesn't ask for a Bill Number, it must pass IBIFN as Input.
11 ; It will prompt the user for a device.
12 ;
13 ; Input IBIFN = ien of Bill Number (required)
14 ;
15 N IBQUIT,IBPGN S IBQUIT=0
16 D ENT1
17 Q ;MRA
18 ;
19ENT ; Menu Option Entry Point
20 N IBQUIT,IBEOB,IBIFN,FRMTYP,IBPGN
21 S IBQUIT=0
22 D GETBIL I IBQUIT Q ;ENT
23 ;
24ENT1 ; Prompt for a print device and print MRA Reports
25 D DEV^IBCEMRAX(IBIFN) I IBQUIT Q ; device handling ENT1
26 ;
27PROC ; This section must have IBIFN defined
28 ; This section is called as both a foreground and a background process,
29 ; so all write stmts need to consider printing in both cases.
30 N FRMTYP,IEN,IBZDATA,INPAT
31 S IBQUIT=$G(IBQUIT)
32 S FRMTYP=$$FT^IBCEF(IBIFN) ;Form Type
33 S INPAT=$$INPAT^IBCEF(IBIFN) ;Inpatient Flag
34 ;
35 ; Get Service Line Level Data from 837 Extract - Make the appropriate call
36 ; based on the Bill's Form Type 3=UB-04 ; 2=CMS-1500
37 D ;
38 . I FRMTYP=2 D F^IBCEF("N-HCFA 1500 SERVICE LINE (EDI)","IBZDATA",,IBIFN) Q
39 . D F^IBCEF("N-UB-04 SERVICE LINE (EDI)","IBZDATA",,IBIFN)
40 ;
41 ; For a given IBIFN, print all MRA's on file for that Bill
42 S IEN=0
43 F S IEN=$O(^IBM(361.1,"B",IBIFN,IEN)) Q:'IEN D I IBQUIT Q
44 . I $P($G(^IBM(361.1,IEN,0)),U,4)'=1 Q ;not an MRA
45 . D PRNTMRA ; print an MRA
46 ;
47 ; Force a form feed at end of a printer report
48 I $E(IOST,1,2)'["C-" W @IOF
49 ; Pause on screen before exiting
50 I 'IBQUIT,$E(IOST,1,2)["C-" W ! S DIR("A")="Press RETURN to continue: ",DIR(0)="EA" D ^DIR K DIR
51 ;
52 ; Quit if called from a background process (ZTQUEUED defined)
53 I $D(ZTQUEUED) S ZTREQ="@" Q ;PROC
54 D ^%ZISC ; handle device closing before exiting
55 Q ;PROC
56 ;
57PRNTMRA ; Print a single MRA
58 ; Input IEN - the ien# of EOB file (361.1); Required
59 S IBPGN=0
60 ; Print Part B - CMS-1500
61 I FRMTYP=2 D PRNT^IBCEMRAB Q ;PRNTMRA
62 ;
63 ; Print Part A - Institutional next
64 ; Claim Level
65 N RSNCD,NCVRCHRG,IBILL,IBILLU,IBCOINS,IBCTADJ,IBEOB,RMKS,IBFD,IBTD,IBDED,CLMADJ
66 I IBPGN>1 D PAUSE^IBCEMRAX I IBQUIT Q ;pause between EOB reports
67 D CLMDATA,CLMHDR I IBQUIT Q
68 D CLMPRNT
69 ;
70 ; Print Service Line Level Adjustments - check if exist
71 I $D(^IBM(361.1,IEN,15)) D I IBQUIT Q
72 . I ($Y+4)>IOSL D PAUSE^IBCEMRAX Q:IBQUIT W @IOF D CLMHDR
73 . D SRVHDR^IBCEMRAX,SRVDATA^IBCEMRAX
74 ;
75 ; Print Disclaimer
76 D DSCLMR^IBCEMRAX
77 Q ;PRTMRA
78 ;
79GETBIL ; Prompt the user for a Bill#. Get INIFN and IBEOB.
80 ;
81 N DIC,Y W !
82 ; Access Explanation Of Benefits File #361.1
83 ; Screen: only allow access to EOB's of Type = 1 (Medicare MRA)
84 S DIC="^IBM(361.1,",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,4)=1"
85 S DIC("W")="D EOBLST^IBCEMU1(Y)" ; modify generic lister
86 D ^DIC
87 I Y<1!$D(DTOUT)!$D(DUOUT) S IBQUIT=1 Q ; GETBIL
88 S IBIFN=+$P(Y,U,2) ; get index to Bill file (#399)
89 Q ;GETBIL
90 ;
91CLMDATA ; Get MRA Claim Level data of EOB file (#361.1)
92 N I,RCNT,GRPCD,GLVL,GLVLD,RLVL,RLVLD,RCDED,RCOINS,RCTADJ,RCNCVR,RCLMADJ,CLMLVL
93 F I=1:1:5 S @($P($T(TABLE+I),";",3))=$P($T(TABLE+I),";",4)
94 ;
95 ; Get Top Levels of EOB file (#361.1)
96 F I=0,1,3:1:6 S IBEOB(I)=$G(^IBM(361.1,IEN,I))
97 ;
98 ; Get Claim Level Remarks Code from appropriate levels of 361.1 based on
99 ; whether Bill is Outpatient or Inpatient.
100 D ;
101 . I INPAT S RMKS=IBEOB(5) Q ; Inpatient remarks code
102 . S RMKS=$P(IBEOB(3),U,3,7) ; Outpatient remarks code
103 ;
104 ; Get Group Level Data
105 ; RLVLD=reason_code^amount^quantity^reason text
106 ; CLMLVL=Claim Level Flag indicating where the displayed data is coming from
107 ; 1=Claim Level; 0=Line Level
108 ;
109 S (GLVL,RLVL,RCNT,NCVRCHRG,IBDED,IBCOINS,IBCTADJ,CLMADJ,CLMLVL)=0
110 F S GLVL=$O(^IBM(361.1,IEN,10,GLVL)) Q:'GLVL S GLVLD=^(GLVL,0) D ;
111 . S GRPCD=$P(GLVLD,U),RLVL=0
112 . F S RLVL=$O(^IBM(361.1,IEN,10,GLVL,1,RLVL)) Q:'RLVL S RLVLD=^(RLVL,0) D ;
113 . . S RSNCD=$P(RLVLD,U)
114 . . I GRPCD="PR",RSNCD="AAA" Q ;exception
115 . . I GRPCD="OA",RSNCD="AB3" Q ;exception
116 . . I GRPCD="LQ" Q ;exception
117 . . S RCNT=RCNT+1,RSNCD(RCNT)=RSNCD ;display
118 . . I RCLMADJ[(","_RSNCD_",") S CLMADJ=CLMADJ+$P(RLVLD,U,2),CLMLVL=1 ;Claim Adjustment
119 . . ; Get data from Claim Level: calculate Coinsurance, Contractual Adjustment,
120 . . ; Noncovered Charges and Deductible amounts
121 . . I GRPCD="PR",RCOINS[(","_RSNCD_",") S IBCOINS=$P(RLVLD,U,2),CLMLVL=1 Q
122 . . I GRPCD="PR",RCDED[(","_RSNCD_",") S IBDED=IBDED+$P(RLVLD,U,2),CLMLVL=1 Q
123 . . I GRPCD="CO" D ;
124 . . . I RCTADJ[(","_RSNCD_",") S IBCTADJ=IBCTADJ+$P(RLVLD,U,2),CLMLVL=1
125 . . . I RCNCVR'[(","_RSNCD_",") S NCVRCHRG=NCVRCHRG+$P(RLVLD,U,2),CLMLVL=1
126 ;
127 ; If no data was found at Claim Level, get data from Line Level
128 I 'CLMLVL D LINELVL^IBCEMRAX
129 S IBILL=$G(^DGCR(399,$P(IBEOB(0),U),0)),IBILLU=$G(^DGCR(399,$P(IBEOB(0),U),"U"))
130 S IBFD=$$FMTE^XLFDT($P(IBILLU,U),5),IBTD=$$FMTE^XLFDT($P(IBILLU,U,2),5)
131 ;
132 Q ;CLMDATA
133 ;
134CLMHDR ; Print Claim Level Header
135 S IBPGN=IBPGN+1
136 I IBPGN=1,$E(IOST,1,2)["C-" W @IOF ; refresh terminal screen on 1st hdr
137 ;
138 ; Rows 1 to 3
139 W !,?108,"Medicare-equivalent",!?110,"Remittance Advice",!
140 N PRVDR,LVL,STATE
141 ; Retrieve the Provider data from IB Site Parameters file - ^IBE(350.9)
142 S PRVDR=$G(^IBE(350.9,1,2))
143 ; ProviderName^AgentCashierAddress^City^State^Zip
144 ;
145 F LVL=1:1:5 S PRVDR(LVL)=$P(PRVDR,U,LVL)
146 ; PRVDR(1) Provider Name (Agent Cashier Mail Symbol)
147 ; PRVDR(2) Agent Cashier Street Address
148 ; PRVDR(3) Agent Cashier City
149 ; PRVDR(4) Agent Cashier State
150 ; PRVDR(5) Agent Cashier Zip
151 ;
152 ; resolve the State File Pointer in PRVDR(4) & get State Abbreviation
153 S STATE=$S(PRVDR(4)'="":$P($G(^DIC(5,PRVDR(4),0)),U,2),1:"")
154 ; Row 4 to 15
155 W !!!,"DEPT OF VETERANS AFFAIRS"
156 W !,PRVDR(2),?103,"PROVIDER #:",?117,$P($G(^IBE(350.9,1,1)),U,5) ;Tax ID
157 W !,PRVDR(1),?103,"PAGE #:",?117,$J(IBPGN,3)
158 W !,PRVDR(3),", ",STATE," ",PRVDR(5),?103,"DATE: ",?117,$$FMTE^XLFDT($P(IBEOB(0),U,6),5)
159 W !!,"PATIENT NAME",?24,"PATIENT CNTRL NUMBER",?48,"RC",?52,"REM",?58,"DRG#",?72,"DRG OUT AMT"
160 W ?86,"COINSURANCE",?100,"PAT REFUND",?115,"CONTRACT ADJ"
161 W !,"HIC NUMBER",?24,"ICN NUMBER",?48,"RC",?52,"REM",?58,"OUTCD CAPCD",?72,"DRG CAP AMT"
162 W ?86,"COVD CHGS",?100,"ESRD NET ADJ",?115,"PER DIEM RTE"
163 W !,"FROM DT THRU DT",?24,"NACHG HICHG TOB",?48,"RC",?52,"REM",?58,"PROF COMP",?72,"MSP PAYMT"
164 W ?86,"NCOVD CHGS",?100,"INTEREST",?115,"PROC CD AMT"
165 W !,"CLM STATUS",?24,"COST COVDY NCOVDY",?48,"RC",?52,"REM",?58,"DRG AMT",?72,"DEDUCTIBLES"
166 W ?86,"DENIED CHGS",?100,"CLAIM ADJ",?115,"NET REIMB",!
167 Q ;CLMHDR
168 ;
169CLMPRNT ; - Print Claim Level part of the Report
170 N PTNM,PTLEN,HIC
171 ; ROW 16
172 ; format and standardize patient name for display
173 S PTNM("FILE")=2,PTNM("IENS")=$P(IBILL,U,2),PTNM("FIELD")=.01,PTLEN=23
174 S PTNM=$$BLDNAME^XLFNAME(.PTNM,PTLEN)
175 I $P(IBEOB(6),U,1)'="" S PTNM=$E($P(IBEOB(6),U,1),1,PTLEN)
176 W !,PTNM
177 ; Account # (Bill #)
178 W ?24,$P($$SITE^VASITE,U,3),"-",$P(IBILL,U)
179 ; Reason Code,Remarks Code 1
180 W ?48,$G(RSNCD(1)),?52,$P(RMKS,U,1)
181 ; DRG Code Used
182 W ?58,$P(IBEOB(0),U,10)
183 ; Coinsurance, Contract Adjustment
184 W ?86,$J($G(IBCOINS),11,2),?115,$J($G(IBCTADJ),11,2)
185 ; ROW 17
186 ; HIC & ICN
187 S HIC=$S($P(IBEOB(6),U,2)'="":$P(IBEOB(6),U,2),$$WNRBILL^IBEFUNC(IBIFN,1):$P($G(^DGCR(399,$P(IBEOB(0),U),"I1")),U,2),1:$P($G(^DGCR(399,$P(IBEOB(0),U),"I2")),U,2))
188 W !,HIC,?24,$P(IBEOB(0),U,14)
189 ; Reason Code, Remarks Code 2
190 W ?48,$G(RSNCD(2)),?52,$P(RMKS,U,2)
191 ; covered charges
192 W ?86,$J($P(IBEOB(1),U,3),11,2)
193 ; Outpatient Reimbursement Rate
194 I 'INPAT W ?115,$J($P(IBEOB(3),U,1),11,2)
195 ; ROW 18
196 W !,IBFD,?12,IBTD
197 ; Type of Bill (=Location of Care_Bill Clasification_Frequency)
198 W ?38,$P(IBILL,U,24)_$P($G(^DGCR(399.1,$P(IBILL,U,25),0)),U,2)_$P(IBILL,U,26)
199 ; Reason Code,Remarks Code 3
200 W ?48,$G(RSNCD(3)),?52,$P(RMKS,U,3)
201 ; non-covered amount (Pt Responsibility)
202 W ?86,$J(NCVRCHRG,11,2)
203 ; Interest Amount
204 I $P(IBEOB(1),U,7) W ?100,$J($P(IBEOB(1),U,7),11,2)
205 ; Procedure code amount
206 W ?115,$J($P(IBEOB(3),U,2),11,2)
207 ; ROW 19
208 ; claim status
209 W !?6,$E($P(IBEOB(0),U,21),1,2)
210 ; M-Care Inp Cost Report Day Ct
211 W ?24,$P(IBEOB(4),U,14)
212 ; M-Care Inp Cov. Days/Visit Ct
213 W ?30,$P(IBEOB(4),U,1)
214 ; Medicare Non-Covered Days
215 W ?38,$P(IBEOB(4),U,19)
216 ; Reason Code,Remarks Code 4
217 W ?48,$G(RSNCD(4)),?52,$P(RMKS,U,4)
218 ; M-Care Inp Claim Drg Amt
219 W ?58,$J($P(IBEOB(4),U,3),11,2)
220 ; if Group Code is PR, print the sum of Reason Codes 1 and 66
221 W ?72,$J($G(IBDED),11,2)
222 ; Claim Adjustments
223 W ?100,$J($G(CLMADJ),10,2)
224 ; net reimburse
225 W ?115,$J($P(IBEOB(1),U,1),11,2)
226 ; Row 20
227 ; Reason Code,Remarks Code 5
228 W !?48,$G(RSNCD(5)),?52,$P(RMKS,U,5)
229 ;
230 Q ; CLMPRNT
231TABLE ;;variable;list of Reason Codes w/leading & trailing commas; description;
232 ;;RCDED;,1,66,;reason code to calc deductible amount;
233 ;;RCOINS;,2,;reason code to calc coinsurance amount;
234 ;;RCTADJ;,A2,;reason codes to calc contract adjustment amount;
235 ;;RCNCVR;,1,2,23,42,45,66,70,71,89,94,97,118,A1,A2,B3,B6,;reason codes excluded from calc of noncovered charges amount;
236 ;;RCLMADJ;,42,45,70,94,97,122,A1,;reason codes to calc claim adj
237 ;
Note: See TracBrowser for help on using the repository browser.