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

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

initial load of WorldVistAEHR

File size: 8.4 KB
Line 
1IBCEMU1 ;ALB/DSM - IB MRA Utility ;26-MAR-2003
2 ;;2.0;INTEGRATED BILLING;**135,155**;21-MAR-94
3 ;
4MRAUSR() ;; Function
5 ; Returns IEN (Internal Entry Number) from file #200 for
6 ; the Bill Authorizer of acceptable MRA secondary claims,
7 ; namely, AUTHORIZER,IB MRA
8 ;
9 ; Output: -1 if record not on file
10 ; IEN if record is on file
11 ;
12 N DIC,X,Y
13 S DIC(0)="MO",DIC="^VA(200,",X="AUTHORIZER,IB MRA"
14 ; call FM lookup utility
15 D ^DIC
16 ; if record is already on file, return IEN
17 ; else return -1
18 Q +Y
19 ;
20 ;
21MRA(IBIFN) ; Utility driver procedure - this is what gets called
22 I $$MRAEXIST(IBIFN) D PRINTMRA(IBIFN)
23MRAX ;
24 Q
25 ;
26 ;
27MRAEXIST(IBIFN) ; This function determines if any MRA exists for the
28 ; passed bill (IBIFN).
29 ;
30 ; This function is called from the IB package as well as the AR package.
31 ;
32 ; This function returns a true value (1) under the following
33 ; conditions:
34 ;
35 ; - The current payer sequence is secondary or tertiary for the bill
36 ; - Medicare WNR is a payer on the bill
37 ; - At least one MRA EOB is on file for the bill
38 ; - Medicare is primary, bill is 2nd/3rd
39 ; - or, Medicare is secondary, bill is 3rd
40 ;
41 NEW OK,IBCOB,PRIMBILL
42 S IBIFN=+$G(IBIFN)
43 S OK=0
44 I '$D(^DGCR(399,IBIFN,0)) G MRAEX ; Check for valid bill
45 S IBCOB=$$COBN^IBCEF(IBIFN) ; Current payer sequence
46 I IBCOB=1 G MRAEX ; Must be secondary or tert
47 I '$$MCRONBIL^IBEFUNC(IBIFN) G MRAEX ; Medicare not on bill
48 ;
49 ; If bill is secondary and Medicare is primary, then we know the bill#
50 I IBCOB=2,$$WNRBILL^IBEFUNC(IBIFN,1) S OK=$$CHK(IBIFN) G MRAEX
51 ;
52 ; Similarly if bill is tert and Medicare is 2nd, then we know the bill#
53 I IBCOB=3,$$WNRBILL^IBEFUNC(IBIFN,2) S OK=$$CHK(IBIFN) G MRAEX
54 ;
55 ; If bill is tert and Medicare is first, then we have to get the bill#
56 I IBCOB=3,$$WNRBILL^IBEFUNC(IBIFN,1) D G MRAEX
57 . S PRIMBILL=+$P($G(^DGCR(399,IBIFN,"M1")),U,5)
58 . I PRIMBILL S OK=$$CHK(PRIMBILL)
59 . Q
60 ;
61MRAEX ;
62 Q OK
63 ;
64CHK(IBIFN) ; This function returns 1 if there is at least 1 MRA EOB for
65 ; this bill# in file 361.1.
66 NEW OK,IEN
67 S (OK,IEN)=0
68 F S IEN=$O(^IBM(361.1,"B",+$G(IBIFN),IEN)) Q:'IEN D Q:OK
69 . I $P($G(^IBM(361.1,IEN,0)),U,4)=1 S OK=1 Q
70 . Q
71CHKX ;
72 Q OK
73 ;
74 ;
75PRINTMRA(IBIFN) ; This procedure is called when the user is printing bills
76 ; and we know that one or more MRA's exist for this bill. We ask the
77 ; user if the MRA(s) should be printed at this time too.
78 ;
79 NEW CNT,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
80 S IBIFN=+$G(IBIFN) I 'IBIFN G PRMRAX
81 S CNT=$$MRACNT(IBIFN) I 'CNT G PRMRAX
82 ;
83 S DIR(0)="YO",DIR("B")="YES"
84 S DIR("A",1)="There is an MRA associated with this bill."
85 S DIR("A")="Do you want to print this MRA now"
86 I CNT>1 D
87 . S DIR("A",1)="There are "_CNT_" MRA's associated with this bill."
88 . S DIR("A")="Do you want to print these MRA's now"
89 . Q
90 S DIR("?")="Please answer Yes or No. If you answer Yes, then you will be asked to supply the output device and all MRA's associated with this bill will then be printed."
91 W !!
92 D ^DIR K DIR
93 I 'Y G PRMRAX
94 ;
95 ; At this point, the user wants to print the MRA's
96 D MRA^IBCEMRAA(IBIFN)
97 ;
98PRMRAX ;
99 Q
100 ;
101 ;
102MRACNT(IBIFN) ; This function counts up the number of MRA EOB's in file
103 ; 361.1 for this bill#
104 NEW CNT,IEN
105 S (CNT,IEN)=0
106 F S IEN=$O(^IBM(361.1,"B",+$G(IBIFN),IEN)) Q:'IEN D
107 . I $P($G(^IBM(361.1,IEN,0)),U,4)'=1 Q
108 . S CNT=CNT+1
109 . Q
110MRACNTX ;
111 Q CNT
112 ;
113SPLTMRA(IBIFN) ; This function returns the number of Split MRA's for a
114 ; given bill#.
115 ;
116 NEW NUM,IEN
117 S (NUM,IEN)=0
118 F S IEN=$O(^IBM(361.1,"B",+$G(IBIFN),IEN)) Q:'IEN I $$SPLIT(IEN) S NUM=NUM+1
119SPLTX ;
120 Q NUM
121 ;
122SPLIT(IBEOB) ; This function returns whether or not the given EOB is a
123 ; split EOB as indicated in the claim level remark code.
124 ; Check the remittance advice remark codes looking for code MA15. This
125 ; code indicates that the claim has been separated to expedite
126 ; handling. This means that this is an incomplete EOB.
127 ;
128 NEW SPLIT,IBM3,IBM5,PCE,REMC
129 S SPLIT=0,IBEOB=+$G(IBEOB)
130 S IBM3=$G(^IBM(361.1,IBEOB,3))
131 S IBM5=$G(^IBM(361.1,IBEOB,5))
132 F PCE=3:1:7 S REMC=$P(IBM3,U,PCE) I REMC="MA15" S SPLIT=1 Q
133 I SPLIT G SPLITX
134 F PCE=1:1:5 S REMC=$P(IBM5,U,PCE) I REMC="MA15" S SPLIT=1 Q
135SPLITX ;
136 Q SPLIT
137 ;
138 ;
139EOBLST(IBEOB) ; Standard FileMan lister code for entries in the EOB file
140 ; Input parameter IBEOB is the IEN into file 361.1
141 ; This can be used by setting DIC("W")="D EOBLST^IBCEMU1(Y)" prior
142 ; to FileMan lister calls.
143 ;
144 NEW IBM,IBIFN,IB,PATNAME,INSCO,SEQ
145 NEW EOBDT,EOBTYP,CLMSTAT
146 S IBM=$G(^IBM(361.1,IBEOB,0))
147 S IBIFN=+IBM
148 S IB=$G(^DGCR(399,IBIFN,0))
149 S PATNAME=$P($G(^DPT(+$P(IB,U,2),0)),U,1)
150 S INSCO=" "_$$EXTERNAL^DILFD(361.1,.02,,$P(IBM,U,2))
151 S SEQ=$E($$EXTERNAL^DILFD(361.1,.15,,$P(IBM,U,15)),1,3)
152 S EOBDT=" "_$$FMTE^XLFDT($P($P(IBM,U,6),".",1),"2Z")
153 S EOBTYP=" "_$P("EOB^MRA",U,$P(IBM,U,4)+1)
154 S CLMSTAT=" "_$$EXTERNAL^DILFD(361.1,.13,"",$P(IBM,U,13))
155 W $E(PATNAME,1,19)," (",$E(SEQ),")",$E(INSCO,1,17),?56,EOBDT
156 W ?66,EOBTYP,?70,CLMSTAT
157EOBLSTX ;
158 Q
159 ;
160SEL(IBIFN,MRAONLY,IBDA) ; Function to display and allow user selection
161 ; of an EOB/MRA on file in 361.1 for the given bill.
162 ;
163 ; Input: IBIFN - internal bill number (required)
164 ; MRAONLY - 1 if only MRA EOB's should be included here
165 ; IBDA - list entry number of user selection (optional)
166 ;
167 ; Function Value: IEN to file 361.1 or nil if no selection made
168 ;
169 NEW IBEOB,EOBDATE,COUNT,IEN,IBM,INSCO,SEQ,EOBDT,EOBTYP,CLMSTAT,LIST
170 NEW J,A,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBM1
171 S IBEOB="",IBIFN=+$G(IBIFN),EOBDATE=0,COUNT=0,IBDA=+$G(IBDA)
172 F S EOBDATE=$O(^IBM(361.1,"ABD",IBIFN,EOBDATE)) Q:'EOBDATE D
173 . S IEN=0
174 . F S IEN=$O(^IBM(361.1,"ABD",IBIFN,EOBDATE,IEN)) Q:'IEN D
175 .. S IBM=$G(^IBM(361.1,IEN,0))
176 .. I $G(MRAONLY),'$P(IBM,U,4) Q ; mra only check
177 .. S INSCO=$$EXTERNAL^DILFD(361.1,.02,,$P(IBM,U,2))
178 .. S SEQ=$E($$EXTERNAL^DILFD(361.1,.15,,$P(IBM,U,15)),1)
179 .. S EOBDT=$$FMTE^XLFDT($P($P(IBM,U,6),".",1),"2Z")
180 .. S EOBTYP=$P("EOB^MRA",U,$P(IBM,U,4)+1)
181 .. S CLMSTAT=$$EXTERNAL^DILFD(361.1,.13,"",$P(IBM,U,13))
182 .. S COUNT=COUNT+1
183 .. S LIST(COUNT)=IEN_U_SEQ_U_INSCO_U_EOBDT_U_EOBTYP_U_CLMSTAT
184 .. Q
185 . Q
186 ;
187 I 'COUNT G SELX ; no mra/eob data found
188 ;
189 ; Display mra/eob data
190 S J="EOB's/MRA's"
191 I $G(MRAONLY) S J="MRA's"
192 I COUNT>1 W !!,"The selected bill has multiple ",J," on file. Please choose one."
193 W !!?7,"#",?11,"Seq",?17,"Insurance Company",?40,"EOB Date"
194 W ?51,"Type",?57,"Claim Status"
195 F J=1:1:COUNT S A=LIST(J) D
196 . W !?5,$J(J,3),?11,"(",$P(A,U,2),")",?17,$E($P(A,U,3),1,20)
197 . W ?40,$P(A,U,4),?51,$P(A,U,5),?57,$P(A,U,6)
198 . Q
199 ;
200 ; User Selection
201 W ! S DIR(0)="NO^1:"_COUNT,DIR("A")="Select an EOB/MRA"
202 I $G(MRAONLY) S DIR("A")="Select an MRA"
203 D ^DIR K DIR
204 I 'Y G SELX ; no selection made
205 S IBEOB=+$G(LIST(Y))
206 ;
207 ; At this point we need to update the scratch globals with this
208 ; EOB specific data
209 S IBM=$G(^IBM(361.1,IBEOB,0)) I IBM="" G SELX
210 S IBM1=$G(^IBM(361.1,IBEOB,1))
211 ;
212 I IBDA,$P($G(^TMP("IBCECOB",$J,IBDA)),U,2)=IBIFN D
213 . S $P(^TMP("IBCECOB",$J,IBDA),U,3)=$P(IBM,U,19) ; ptr 364
214 . S $P(^TMP("IBCECOB",$J,IBDA),U,4)=IBEOB ; 361.1 ien
215 . Q
216 ;
217 I IBDA,$D(^TMP("IBCECOB1",$J,IBDA)) D
218 . S $P(^TMP("IBCECOB1",$J,IBDA),U,10)=IBEOB ; 361.1 ien
219 . S $P(^TMP("IBCECOB1",$J,IBDA),U,13)=$P(IBM,U,6) ; eob paid date
220 . S $P(^TMP("IBCECOB1",$J,IBDA),U,15)=$P(IBM,U,19) ; ptr 364
221 . S $P(^TMP("IBCECOB1",$J,IBDA),U,16)=$P(IBM,U,15) ; ins seq
222 . S $P(^TMP("IBCECOB1",$J,IBDA),U,17)=$P(IBM1,U,1) ; payer paid amt
223 . Q
224SELX ;
225 Q IBEOB
226 ;
227 ;
228CHKSUM(IBARRAY) ; Incoming 835 checksum calculation
229 ; This function calculates the checksum of the raw 835 data from
230 ; the data in array IBARRAY. This is done to prevent duplicates.
231 ; Input parameter IBARRAY is the array reference where the data exists
232 ; at @IBARRAY@(n,0) where n is a sequential #
233 ; For file 364.2, IBARRAY = "^IBA(364.2,IBIEN,2)" where IBIEN = the ien
234 ; of the entry in file 364.2 being evaluated
235 ;
236 NEW Y,LN,DATA,IBREC,POS,EOBFLG
237 S Y=0,EOBFLG=0
238 S LN=0
239 F S LN=$O(@IBARRAY@(LN)) Q:'LN D
240 . S DATA=$$EXT($G(@IBARRAY@(LN,0))) Q:DATA=""
241 . S IBREC=$P(DATA,U,1)
242 . I IBREC="835EOB"!(IBREC="835ERA") S EOBFLG=1 Q ; set the EOB flag
243 . I IBREC<1 Q ; rec# too low
244 . I IBREC'<99 Q ; rec# too high
245 . F POS=1:1:$L(DATA) S Y=Y+($A(DATA,POS)*POS)
246 . Q
247 ;
248 I 'EOBFLG S Y=0 ; if this array is not an 835
249 Q Y
250 ;
251EXT(DATA) ; Extracts from the text in DATA if the text contains
252 ; "##RAW DATA: "
253 Q $S(DATA["##RAW DATA: ":$P(DATA,"##RAW DATA: ",2,99),1:DATA)
254 ;
Note: See TracBrowser for help on using the repository browser.