source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEWL2.m@ 1375

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

initial load of WorldVistAEHR
File size: 9.1 KB
RevLine 
[613]1RCDPEWL2 ;ALB/TMK - ELECTRONIC EOB WORKLIST ACTIONS ;26-NOV-02
2 ;;4.5;Accounts Receivable;**173,208**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ; IA for call to OPTION^IBJTLA = 4121
5 ; IA for call to ASK^IBRREL = 306
6 ; IA call for EN1AR^IBECEA = 4047
7 ; IA call for MAIN^IBOHPT1 = 4048
8 ; IA for read access to ^IBM(361.1 = 4051
9 Q
10 ;
11VP(RCSCR,RCDAZ) ; View/Print EOB Detail data from file 361.1
12 ; RCSCR = ien of entry in file 344.4
13 ; RCDAZ = array subscripted by a sequential # and
14 ; RCDAZ(n) = one of 3 formats
15 ; ERA level adjustments
16 ; ADJ^the ien of the adj in 344.42
17 ; EOB exists in file 361.1:
18 ; ien of line in 344.41^ien of 361.1
19 ; EOB doesn't exist in 361.1:
20 ; ien of line in 344.41^-1
21 ;
22 N RCDA,%ZIS,ZTRTN,ZTSAVE,ZTDESC,POP
23 ; Ask device
24 S %ZIS="QM" D ^%ZIS G:POP VPQ
25 I $D(IO("Q")) D G VPQ
26 . S ZTRTN="VPOUT^RCDPEWL2",ZTDESC="AR - Print EEOB Detail from Worklist"
27 . S ZTSAVE("RC*")=""
28 . D ^%ZTLOAD
29 . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
30 . K ZTSK,IO("Q") D HOME^%ZIS
31 U IO
32 ;
33VPOUT ; Entrypoint for queued job
34 N Z,Z0,RCSTOP,RCPG,RCREF,RC3611,RCDASH,RCDT,RC1,RC3444,RCZ,RCZ0
35 ;
36 K ^TMP("PRCA_EOB",$J),^TMP("PRCA_EOB1",$J)
37 S RCDT=DT,(RCSTOP,RCPG)=0,RC3444=RCSCR,RCDASH="",$P(RCDASH,"-",71)=""
38 I '$O(RCDAZ(0)) G VPQ
39 S RCZ=0 F S RCZ=$O(RCDAZ(RCZ)) Q:'RCZ D
40 . S RCREF=$P(RCDAZ(RCZ),U),RC3611=+$P(RCDAZ(RCZ),U,2)
41 . K ^TMP("PRCA_EOB1",$J,RC3611)
42 . ;
43 . I $E(RCREF,1,3)["ADJ" D Q
44 .. ;Display ERA level adj
45 .. S RCZ0=$G(^RCY(344.4,RCSCR,2,RC3611,0))
46 .. S ^TMP("PRCA_EOB",$J,"ADJ",1)="ERA LEVEL ADJUSTMENT #"_RC3611
47 .. S ^TMP("PRCA_EOB",$J,"ADJ",2)=" ADJUSTMENT REFERENCE #: "_$P(RCZ0,U)
48 .. S ^TMP("PRCA_EOB",$J,"ADJ",3)=" ADJUSTMENT REASON CODE: "_$P(RCZ0,U,2)
49 .. S ^TMP("PRCA_EOB",$J,"ADJ",4)=" ADJUSTMENT AMOUNT: "_$J(+$P(RCZ0,U,3),"",2)
50 .. S ^TMP("PRCA_EOB",$J,"ADJ",5)=RCDASH
51 . ;
52 . I $P(RCDAZ(RCZ),U,2)'>0 D Q
53 .. ;Display formatted raw data - no EOB data in 361.1
54 .. K ^TMP($J,"RC_SUMRAW")
55 .. D DISP^RCDPESR0("^RCY(344.4,"_RCSCR_",1,"_+RCDAZ(RCZ)_",1)","^TMP($J,""RC_SUMRAW"")",1,"^TMP(""PRCA_EOB"",$J,0)")
56 .. S ^TMP("PRCA_EOB1",$J,RC3611,1)="CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,+RCDAZ(RCZ))_"*** NOT IDENTIFIED IN A/R ****"_$S($P($G(^RCY(344.4,RCSCR,1,+RCDAZ(RCZ),0)),U,14):" (REVERSAL)",1:"")
57 .. K ^TMP($J,"RC_SUMRAW")
58 .. S ^TMP("PRCA_EOB",$J,+$O(^TMP("PRCA_EOB",$J,""),-1)+1)=RCDASH
59 . ;
60 . K ^TMP("PRCA_EOB1",$J,RC3611)
61 . S ^TMP("PRCA_EOB1",$J,RC3611,1)="CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,+RCDAZ(RCZ))_$S($P($G(^RCY(344.4,RCSCR,1,+RCDAZ(RCZ),0)),U,14):" (REVERSAL)",1:"")
62 . D GETEOB^IBCECSA6(RC3611,2)
63 . I $O(^IBM(361.1,RC3611,"ERR",0)) D GETERR^RCDPEDS(RC3611,+$O(^TMP("PRCA_EOB",$J,RC3611," "),-1)) ; get filing errors
64 . S ^TMP("PRCA_EOB",$J,+$O(^TMP("PRCA_EOB",$J,""),-1)+1)=RCDASH
65 . ;
66 S RC3611="" F S RC3611=$O(^TMP("PRCA_EOB",$J,RC3611)) Q:RC3611=""!RCSTOP D
67 . S RC1=1
68 . S Z0=0 F S Z0=$O(^TMP("PRCA_EOB",$J,RC3611,Z0)) Q:'Z0 D Q:RCSTOP
69 .. I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !,"***TASK STOPPED BY USER***" Q
70 .. I 'RCPG!(($Y+5)>IOSL) D I RCSTOP Q
71 ... D:RCPG ASK(.RCSTOP) I RCSTOP Q
72 ... D RHDR(RCSCR,RCDT,.RCPG)
73 .. I RC1 W !!,$G(^TMP("PRCA_EOB1",$J,RC3611,1)) S RC1=0
74 .. W !,$G(^TMP("PRCA_EOB",$J,RC3611,Z0))
75 I 'RCSTOP,RCPG D ASK(.RCSTOP)
76 ;
77 I $D(ZTQUEUED) S ZTREQ="@"
78 I '$D(ZTQUEUED) D ^%ZISC
79 ;
80VPQ K ^TMP("PRCA_EOB",$J),^TMP("PRCA_EOB1",$J)
81 S VALMBCK="R"
82 Q
83 ;
84TPJI ; Jump to Third Party Joint Inquiry for the claim
85 D FULL^VALM1
86 I $G(RCSCR("NOEDIT"))=2 D NOTAV G TPJIQ
87 M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
88 D OPTION^IBJTLA ; IA 4121
89 D RESTMP^RCDPEWL6
90 ;
91TPJIQ S VALMBCK="R"
92 Q
93 ;
94FAP ; Jump to Full Account Profile
95 D FULL^VALM1
96 ;
97 I $G(RCSCR("NOEDIT"))=2 D NOTAV G FAPQ
98 ;
99 M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
100 D EN^PRCAAPR("ALL"),RET K DTOUT
101 D RESTMP^RCDPEWL6
102 ;
103FAPQ S VALMBCK="R"
104 Q
105 ;
106RELHOLD ; Jump to Release Hold function
107 N DIR,X,Y,RCDA,RCSCR
108 D FULL^VALM1
109 ;
110 I $G(RCSCR("NOEDIT"))=2 D NOTAV G RELHQ
111 ;
112 M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
113 D ^IBRREL,RET ; IA = 306
114 D RESTMP^RCDPEWL6
115 ;
116RELHQ S VALMBCK="R"
117 Q
118 ;
119CMRPT ; Jump to claims matching report
120 N DIR,X,Y,RCIBY
121 D FULL^VALM1
122 ;
123 I $G(RCSCR("NOEDIT"))=2 D NOTAV G CMQ
124 ;
125 M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
126 D ^RCDPRTP,RET
127 D RESTMP^RCDPEWL6
128 ;
129CMQ S VALMBCK="R"
130 Q
131 ;
132CHGMNT ; Jump to charge maintenance
133 N DIR,X,Y,RCSCR
134 D FULL^VALM1
135 ;
136 I $G(RCSCR("NOEDIT"))=2 D NOTAV G CHMQ
137 ;
138 I $D(^XUSEC("PRCA EDI LOCKBOX CHARGES",DUZ)) D
139 . M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
140 . D EN1AR^IBECEA ; IA 4047
141 . D RESTMP^RCDPEWL6
142 E D
143 . S DIR(0)="EA",DIR("A",1)="YOU DO NOT HAVE THE KEY NEEDED TO ACCESS THIS OPTION.",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
144 ;
145 S VALMBCK="R"
146CHMQ Q
147 ;
148LSTHLD ; Jump to list current/on hold charges
149 N DIR,X,Y,RCIBY
150 D FULL^VALM1
151 ;
152 I $G(RCSCR("NOEDIT"))=2 D NOTAV G LHQ
153 ;
154 M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
155 D MAIN^IBOHPT1,RET ; IA 4048
156 D RESTMP^RCDPEWL6
157 ;
158 S VALMBCK="R"
159LHQ Q
160 ;
161REEST ; Jump to re-establish bill
162 N PRC
163 D FULL^VALM1
164 ;
165 I $G(RCSCR("NOEDIT"))=2 D NOTAV G REESTQ
166 ;
167 M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
168 D ^PRCAWREA K DTOUT
169 D RESTMP^RCDPEWL6
170 D RET
171 ;
172REESTQ S VALMBCK="R"
173 Q
174 ;
175BILLCOM ; Jump to bill comment log
176 D FULL^VALM1
177 ;
178 I $G(RCSCR("NOEDIT"))=2 D NOTAV G BILLCOMQ
179 ;
180 M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
181 D ^PRCACM K DTOUT
182 D RET
183 D RESTMP^RCDPEWL6
184 ;
185BILLCOMQ S VALMBCK="R"
186 Q
187 ;
188ASK(RCSTOP) ;
189 I $E(IOST,1,2)'["C-" Q
190 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
191 S DIR(0)="E" W ! D ^DIR
192 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
193 Q
194 ;
195RHDR(RCSCR,RCDT,RCPG) ;Prints EOB detail report heading
196 N Z
197 S Z=$G(^RCY(344.4,RCSCR,0))
198 I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
199 S RCPG=RCPG+1
200 W !,?15,"EDI LOCKBOX EEOB DETAIL FROM WORKLIST",?55,$$FMTE^XLFDT(RCDT,2),?70,"Page: ",RCPG
201 W !!,$E(" ERA NUMBER: "_RCSCR_$J("",25),1,25)_$E("ERA TRACE #: "_$P(Z,U,2)_$J("",30),1,30)_"ERA DATE: "_$$FMTE^XLFDT($P(Z,U,4)),!,"INS COMPANY: "_$P(Z,U,6)_"/"_$P(Z,U,3)
202 W !,$TR($J("",IOM)," ","=")
203 Q
204 ;
205RET ; Pause before returning to list
206 N DIR,X,Y
207 S DIR(0)="EA",DIR("A")="RETURN TO CONTINUE" W ! D ^DIR K DIR
208 Q
209 ;
210NOWAY ; Msg for unidentified bill
211 N DIR,X,Y
212 S DIR(0)="EA",DIR("A",1)="THIS BILL IS NOT IDENTIFIED IN YOUR A/R",DIR("A")="THIS FUNCTION IS NOT AVAILABLE ... RETURN TO CONTINUE " W ! D ^DIR K DIR
213 Q
214 ;
215NOWAY1 ; Msg for ERA level Adjustment
216 N DIR,X,Y
217 S DIR(0)="EA",DIR("A",1)="THIS IS AN ERA LEVEL ADJUSTMENT - NO DATA EXISTS FOR IT IN YOUR AR",DIR("A")="PRESS ENTER TO CONTINUE" W ! D ^DIR K DIR
218 Q
219 ;
220SET1(RCIBY,RCDA,RCDA1,RC3444,RCREF) ; Set up variables for receipt/ERA
221 S RCDA1=+RCIBY("IBEOB"),RCDA=+$P(RCIBY("IBEOB"),U,2),RC3444=+$P(RCIBY("IBEOB"),U,3),RCREF=+$P(RCIBY("IBEOB"),U,4)
222 Q
223 ;
224CHKFILE ; If the user leaves the split line screen without filing - double check
225 ; that they didn't want to file it.
226 N DIR,X,Y
227 D FULL^VALM1 W !!
228 I $G(^TMP("RCDPE_EOB_SPLIT_OK",$J)),$O(RCSPLIT(0)) D
229 . S DIR(0)="YA",DIR("B")="NO",DIR("A",1)="YOU HAVE NOT FILED THESE CHANGES",DIR("A")="DO YOU WANT TO FILE THEM BEFORE YOU EXIT?: " D ^DIR K DIR
230 . I Y=1 D FILESP^RCDPEWL8
231 K ^TMP($J,"RCDPE_SPLIT_FILE")
232 Q
233 ;
234EDITSP ; Action that edits the split lines
235 ; RCLINE,RCSCR must already exist
236 N DA,RCEDIT,RCDONE,RCDEF,RCSAVE,RCSAVE1
237 D FULL^VALM1
238 ;
239 I $G(RCSCR("NOEDIT"))=2 D NOTAV G EDITQ
240 ;
241 D SEL(.RCEDIT)
242 G:'RCEDIT EDITQ
243 S RCDONE=0
244 M RCSAVE=RCSPLIT,RCSAVE1=RCDIR S RCDEF=$G(RCSPLIT(RCEDIT)),RCSPLIT=RCEDIT
245 D EDIT^RCDPEWL3(RCSCR,RCLINE,.RCDIR,.RCSPLIT,RCDEF,.RCDONE)
246 I '$D(RCSPLIT(RCSAVE)) K RCSPLIT M RCSPLIT=RCSAVE K RCDIR M RCDIR=RCSAVE1
247 D INIT^RCDPEWL3
248EDITQ S VALMBCK="R"
249 Q
250 ;
251PREOB ; Print/View EOB detail
252 N RCDA,RCDAZ,Z,Z0
253 D FULL^VALM1
254 D SEL^RCDPEWL(.RCDA)
255 S RCDA=+$O(RCDA(0)),RCDA=$G(RCDA(RCDA))
256 I RCDA="" G PREOBQ
257 S RCDA=$P($G(^RCY(344.49,RCSCR,1,+RCDA,0)),U,9)
258 F RCDAZ=1:1:$L(RCDA,",") S RCDAZ(RCDAZ)=$P(RCDA,",",RCDAZ)
259 S Z=0 F S Z=$O(RCDAZ(Z)) Q:'Z D
260 . ;
261 . S Z0=RCDAZ(Z)
262 . I $E(Z0,1,3)="ADJ" D Q
263 .. I $G(^RCY(344.4,RCSCR,2,+$P(Z0,"ADJ",2),0))'="" S RCDAZ(Z)="ADJ^"_+$P(Z0,"ADJ",2)
264 . ;
265 . S Z0=$G(^RCY(344.4,RCSCR,1,+Z0,0))
266 . S RCDAZ(Z)=+Z0_U_$S($P(Z0,U,2):$P(Z0,U,2),1:-1) Q
267 ;
268 D VP(RCSCR,.RCDAZ)
269 ;
270PREOBQ S VALMBCK="R"
271 Q
272 ;
273RESEARCH ; Invoke the research menu
274 ;
275 K ^TMP($J,"RC_VALMBG")
276 S ^TMP($J,"RC_VALMBG")=$G(VALMBG)
277 D FULL^VALM1
278 I $G(RCSCR("NOEDIT"))=2 D NOTAV G RQ
279 ;
280 D EN^VALM("RCDPE EOB RESEARCH")
281 ;
282RQ K ^TMP($J,"RC_VALMBG")
283 Q
284 ;
285SEL(RCEDIT) ;
286 N VALMY
287 D EN^VALM2($G(XQORNOD(0)),"S")
288 S RCEDIT=+$O(VALMY(0))
289 Q
290 ;
291EXIT ; Exits back to ERA menu actions from research
292 S VALMBCK="Q"
293 Q
294 ;
295WL(RCRCPT) ; Entrypoint to the ERA Worklist from Receipt Processing
296 ;RCRCPT = ien of entry in file 344
297 N DIR,X,Y,Z
298 D FULL^VALM1
299 S Z=+$O(^RCY(344.4,"AREC",RCRCPT,0))
300 I 'Z D G WLQ
301 . S DIR("A")="THIS RECEIPT IS NOT ASSOCIATED WITH AN ERA RECORD - PRESS RETURN TO CONTINUE ",DIR(0)="EA" W ! D ^DIR K DIR
302 ;
303 I '$D(^RCY(344.49,Z,0)) D G WLQ
304 . S DIR("A")="NO ERA WORKLIST SCRATCHPAD EXISTS FOR THIS ERA - PRESS RETURN TO CONTINUE ",DIR(0)="EA" W ! D ^DIR K DIR
305 ;
306 D DISP^RCDPEWL(Z,2)
307 ;
308WLQ S VALMBCK="R"
309 Q
310 ;
311NOTAV ; Display not available msg
312 N DIR,X,Y
313 ;
314 S DIR(0)="EA",DIR("A")="THIS ACTION NOT CURRENTLY AVAILABLE - PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
315 S VALMBCK="R"
316 Q
317 ;
Note: See TracBrowser for help on using the repository browser.