RCDPEWL2 ;ALB/TMK/KML - ELECTRONIC EOB WORKLIST ACTIONS ;7/7/10 6:43pm
;;4.5;Accounts Receivable;**173,208,269,298,303,318**;Mar 20, 1995;Build 37
;;Per VA Directive 6402, this routine should not be modified.
; IA for call to OPTION^IBJTLA = 4121
; IA for call to ASK^IBRREL = 306
; IA call for EN1AR^IBECEA = 4047
; IA call for MAIN^IBOHPT1 = 4048
; IA for read access to ^IBM(361.1 = 4051
Q
;
VP(RCSCR,RCDAZ) ; View/Print EOB Detail data from file 361.1
; RCSCR = ien of entry in file 344.4
; RCDAZ = array subscripted by a sequential # and
; RCDAZ(n) = one of 3 formats
; ERA level adjustments
; ADJ^the ien of the adj in 344.42
; EOB exists in file 361.1:
; ien of line in 344.41^ien of 361.1
; EOB doesn't exist in 361.1:
; ien of line in 344.41^-1
;
N RCDA,%ZIS,ZTRTN,ZTSAVE,ZTDESC,POP
; Ask device
S %ZIS="QM" D ^%ZIS G:POP VPQ
I $D(IO("Q")) D G VPQ
. S ZTRTN="VPOUT^RCDPEWL2",ZTDESC="AR - Print EEOB Detail from Worklist"
. S ZTSAVE("RC*")=""
. D ^%ZTLOAD
. W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
. K ZTSK,IO("Q") D HOME^%ZIS
U IO
;
VPOUT ; Entrypoint for queued job
N Z,Z0,RCSTOP,RCPG,RCREF,RC3611,RCDASH,RCDT,RC1,RC3444,RCZ,RCZ0
;
K ^TMP("PRCA_EOB",$J),^TMP("PRCA_EOB1",$J)
S RCDT=DT,(RCSTOP,RCPG)=0,RC3444=RCSCR,RCDASH="",$P(RCDASH,"-",71)=""
I '$O(RCDAZ(0)) G VPQ
S RCZ=0 F S RCZ=$O(RCDAZ(RCZ)) Q:'RCZ D
. S RCREF=$P(RCDAZ(RCZ),U),RC3611=+$P(RCDAZ(RCZ),U,2)
. K ^TMP("PRCA_EOB1",$J,RC3611)
. ;
. I $E(RCREF,1,3)["ADJ" D Q
.. ;Display ERA level adj
.. S RCZ0=$G(^RCY(344.4,RCSCR,2,RC3611,0))
.. S ^TMP("PRCA_EOB",$J,"ADJ",1)="ERA LEVEL ADJUSTMENT #"_RC3611
.. S ^TMP("PRCA_EOB",$J,"ADJ",2)=" ADJUSTMENT REFERENCE #: "_$P(RCZ0,U)
.. S ^TMP("PRCA_EOB",$J,"ADJ",3)=" ADJUSTMENT REASON CODE: "_$P(RCZ0,U,2)
.. S ^TMP("PRCA_EOB",$J,"ADJ",4)=" ADJUSTMENT AMOUNT: "_$J(+$P(RCZ0,U,3),"",2)
.. S ^TMP("PRCA_EOB",$J,"ADJ",5)=RCDASH
. ;
. I $P(RCDAZ(RCZ),U,2)'>0 D Q
.. ;Display formatted raw data - no EOB data in 361.1
.. K ^TMP($J,"RC_SUMRAW")
.. D DISP^RCDPESR0("^RCY(344.4,"_RCSCR_",1,"_+RCDAZ(RCZ)_",1)","^TMP($J,""RC_SUMRAW"")",1,"^TMP(""PRCA_EOB"",$J,0)")
.. 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:"")
.. K ^TMP($J,"RC_SUMRAW")
.. S ^TMP("PRCA_EOB",$J,+$O(^TMP("PRCA_EOB",$J,""),-1)+1)=RCDASH
. ;
. K ^TMP("PRCA_EOB1",$J,RC3611)
. 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:"")
. D GETEOB^IBCECSA6(RC3611,2)
. I $O(^IBM(361.1,RC3611,"ERR",0)) D GETERR^RCDPEDS(RC3611,+$O(^TMP("PRCA_EOB",$J,RC3611," "),-1)) ; get filing errors
. S ^TMP("PRCA_EOB",$J,+$O(^TMP("PRCA_EOB",$J,""),-1)+1)=RCDASH
. ;
S RC3611="" F S RC3611=$O(^TMP("PRCA_EOB",$J,RC3611)) Q:RC3611=""!RCSTOP D
. S RC1=1
. S Z0=0 F S Z0=$O(^TMP("PRCA_EOB",$J,RC3611,Z0)) Q:'Z0 D Q:RCSTOP
.. I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !,"***TASK STOPPED BY USER***" Q
.. I 'RCPG!(($Y+5)>IOSL) D I RCSTOP Q
... D:RCPG ASK(.RCSTOP) I RCSTOP Q
... D RHDR(RCSCR,RCDT,.RCPG)
.. I RC1 W !!,$G(^TMP("PRCA_EOB1",$J,RC3611,1)) S RC1=0
.. W !,$G(^TMP("PRCA_EOB",$J,RC3611,Z0))
I 'RCSTOP,RCPG D ASK(.RCSTOP)
;
I $D(ZTQUEUED) S ZTREQ="@"
I '$D(ZTQUEUED) D ^%ZISC
;
VPQ K ^TMP("PRCA_EOB",$J),^TMP("PRCA_EOB1",$J)
S VALMBCK="R"
Q
;
TPJI ; Jump to Third Party Joint Inquiry for the claim
D FULL^VALM1
I $G(RCSCR("NOEDIT"))=2 D NOTAV G TPJIQ
M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
D OPTION^IBJTLA ; IA 4121
D RESTMP^RCDPEWL6
;
TPJIQ S VALMBCK="R"
Q
;
FAP ; Jump to Full Account Profile
D FULL^VALM1
;
I $G(RCSCR("NOEDIT"))=2 D NOTAV G FAPQ
;
M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
D EN^PRCAAPR("ALL"),RET K DTOUT
D RESTMP^RCDPEWL6
;
FAPQ S VALMBCK="R"
Q
;
RELHOLD ; Jump to Release Hold function
N DIR,X,Y,RCDA,RCSCR
D FULL^VALM1
;
I $G(RCSCR("NOEDIT"))=2 D NOTAV G RELHQ
;
M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
D ^IBRREL,RET ; IA = 306
D RESTMP^RCDPEWL6
;
RELHQ S VALMBCK="R"
Q
;
CMRPT ; Jump to claims matching report
N DIR,X,Y,RCIBY
D FULL^VALM1
;
I $G(RCSCR("NOEDIT"))=2 D NOTAV G CMQ
;
M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
D ^RCDPRTP,RET
D RESTMP^RCDPEWL6
;
CMQ S VALMBCK="R"
Q
;
CHGMNT ; Jump to charge maintenance
N DIR,X,Y,RCSCR
D FULL^VALM1
;
I $G(RCSCR("NOEDIT"))=2 D NOTAV G CHMQ
;
I $D(^XUSEC("PRCA EDI LOCKBOX CHARGES",DUZ)) D
. M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
. D EN1AR^IBECEA ; IA 4047
. D RESTMP^RCDPEWL6
E D
. 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
;
S VALMBCK="R"
CHMQ Q
;
LSTHLD ; Jump to list current/on hold charges
N DIR,X,Y,RCIBY
D FULL^VALM1
;
I $G(RCSCR("NOEDIT"))=2 D NOTAV G LHQ
;
M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
D MAIN^IBOHPT1,RET ; IA 4048
D RESTMP^RCDPEWL6
;
S VALMBCK="R"
LHQ Q
;
REEST ;EP - Protocol action - RCDPE EOB WORKLIST REESTABLISH
; Jump to re-establish bill
N PRC
D FULL^VALM1
I '$D(^XUSEC("RCDPEAR",DUZ)) D Q ; PRCA*4.5*318 Added security key check
. W !!,"This action can only be taken by users that have the RCDPEAR security key.",!
. D PAUSE^VALM1
. S VALMBCK="R"
;
I $G(RCSCR("NOEDIT"))=2 D NOTAV G REESTQ
;
M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
D ^PRCAWREA K DTOUT
D RESTMP^RCDPEWL6
D RET
;
REESTQ S VALMBCK="R"
Q
;
BILLCOM ; Jump to bill comment log
D FULL^VALM1
;
I $G(RCSCR("NOEDIT"))=2 D NOTAV G BILLCOMQ
;
M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
D ^PRCACM K DTOUT
D RET
D RESTMP^RCDPEWL6
;
BILLCOMQ S VALMBCK="R"
Q
;
ASK(RCSTOP) ;
I $E(IOST,1,2)'["C-" Q
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="E" W ! D ^DIR
I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
Q
;
RHDR(RCSCR,RCDT,RCPG) ;Prints EOB detail report heading
N Z
S Z=$G(^RCY(344.4,RCSCR,0))
I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
S RCPG=RCPG+1
W !,?15,"EDI LOCKBOX EEOB DETAIL FROM WORKLIST",?55,$$FMTE^XLFDT(RCDT,2),?70,"Page: ",RCPG
; HIPAA 5010 - TRACE # increased in length from 30 to 50 characters therefore it needs to be displayed on its own line
W !!,$E(" ERA NUMBER: "_RCSCR_$J("",25),1,25)_"ERA DATE: "_$$FMTE^XLFDT($P(Z,U,4)),!,"INS COMPANY: "_$P(Z,U,6)_"/"_$P(Z,U,3)
W !,"ERA TRACE #: "_$P(Z,U,2)
W !,$TR($J("",IOM)," ","=")
Q
;
RET ; Pause before returning to list
N DIR,X,Y
S DIR(0)="EA",DIR("A")="RETURN TO CONTINUE" W ! D ^DIR K DIR
Q
;
NOWAY ; Msg for unidentified bill
N DIR,X,Y
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
Q
;
NOWAY1 ; Msg for ERA level Adjustment
N DIR,X,Y
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
Q
;
SET1(RCIBY,RCDA,RCDA1,RC3444,RCREF) ; Set up variables for receipt/ERA
S RCDA1=+RCIBY("IBEOB"),RCDA=+$P(RCIBY("IBEOB"),U,2),RC3444=+$P(RCIBY("IBEOB"),U,3),RCREF=+$P(RCIBY("IBEOB"),U,4)
Q
;
CHKFILE ; If the user leaves the split line screen without filing - double check
; that they didn't want to file it.
N DIR,X,Y
D FULL^VALM1 W !!
I $G(^TMP("RCDPE_EOB_SPLIT_OK",$J)),$O(RCSPLIT(0)) D
. 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
. I Y=1 D FILESP^RCDPEWL8
K ^TMP($J,"RCDPE_SPLIT_FILE")
Q
;
EDITSP ; Action that edits the split lines
; RCLINE,RCSCR must already exist
N DA,RCEDIT,RCDONE,RCDEF,RCSAVE,RCSAVE1
D FULL^VALM1
;
I $G(RCSCR("NOEDIT"))=2 D NOTAV G EDITQ
;
D SEL(.RCEDIT)
G:'RCEDIT EDITQ
S RCDONE=0
M RCSAVE=RCSPLIT,RCSAVE1=RCDIR S RCDEF=$G(RCSPLIT(RCEDIT)),RCSPLIT=RCEDIT
D EDIT^RCDPEWL3(RCSCR,RCLINE,.RCDIR,.RCSPLIT,RCDEF,.RCDONE)
I '$D(RCSPLIT(RCSAVE)) K RCSPLIT M RCSPLIT=RCSAVE K RCDIR M RCDIR=RCSAVE1
D INIT^RCDPEWL3
EDITQ S VALMBCK="R"
Q
;
PREOB ; Print/View EOB detail
N RCDA,RCDAZ,Z,Z0
D FULL^VALM1
D SEL^RCDPEWL(.RCDA)
S RCDA=+$O(RCDA(0)),RCDA=$G(RCDA(RCDA))
I RCDA="" G PREOBQ
S RCDA=$P($G(^RCY(344.49,RCSCR,1,+RCDA,0)),U,9)
F RCDAZ=1:1:$L(RCDA,",") S RCDAZ(RCDAZ)=$P(RCDA,",",RCDAZ)
S Z=0 F S Z=$O(RCDAZ(Z)) Q:'Z D
. ;
. S Z0=RCDAZ(Z)
. I $E(Z0,1,3)="ADJ" D Q
.. I $G(^RCY(344.4,RCSCR,2,+$P(Z0,"ADJ",2),0))'="" S RCDAZ(Z)="ADJ^"_+$P(Z0,"ADJ",2)
. ;
. S Z0=$G(^RCY(344.4,RCSCR,1,+Z0,0))
. S RCDAZ(Z)=+Z0_U_$S($P(Z0,U,2):$P(Z0,U,2),1:-1) Q
;
D VP(RCSCR,.RCDAZ)
;
PREOBQ S VALMBCK="R"
Q
;
RESEARCH ; Invoke the research menu
;
K ^TMP($J,"RC_VALMBG")
S ^TMP($J,"RC_VALMBG")=$G(VALMBG)
D FULL^VALM1
I $G(RCSCR("NOEDIT"))=2 D NOTAV G RQ
;
D EN^VALM("RCDPE EOB RESEARCH")
;
RQ K ^TMP($J,"RC_VALMBG")
Q
;
SEL(RCEDIT) ;
N VALMY
D EN^VALM2($G(XQORNOD(0)),"S")
S RCEDIT=+$O(VALMY(0))
Q
;
EXIT ; Exits back to ERA menu actions from research
S VALMBCK="Q"
Q
;
WL(RCRCPT) ; Entrypoint to the ERA Worklist from Receipt Processing
;RCRCPT = ien of entry in file 344
N DIR,X,Y,Z
D FULL^VALM1
; if not at ERA summary level (344.4,.08), get a receipt match using the cross-reference at the ERA detail (RECEIPT (344.41, .25)
S Z=$S($O(^RCY(344.4,"AREC",RCRCPT,0)):+$O(^RCY(344.4,"AREC",RCRCPT,0)),1:+$O(^RCY(344.4,"H",RCRCPT,0)))
I 'Z D G WLQ
. S DIR("A")="THIS RECEIPT IS NOT ASSOCIATED WITH AN ERA RECORD - PRESS RETURN TO CONTINUE ",DIR(0)="EA" W ! D ^DIR K DIR
;
I '$D(^RCY(344.49,Z,0)) D G WLQ
. S DIR("A")="NO ERA WORKLIST SCRATCHPAD EXISTS FOR THIS ERA - PRESS RETURN TO CONTINUE ",DIR(0)="EA" W ! D ^DIR K DIR
;
D DISP^RCDPEWL(Z,2)
;
WLQ S VALMBCK="R"
Q
;
NOTAV ; Display not available msg
N DIR,X,Y
;
S DIR(0)="EA",DIR("A")="THIS ACTION NOT CURRENTLY AVAILABLE - PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
S VALMBCK="R"
Q
;
;PRCA*4.5*303 - Add jump to ECME Information from the ERA Worklist Research
; IA 1992 - BILL/CLAIMS file (#399)
; RCIENS exists before this code is called if coming from APAR
; RCERA, RCSCR are assumed to exist before this code is called
GOECME ; Select an EEOB and then jump to the [IBJT ECME RESP INFO SCREEN]
N RCDA,RCDAZ,RCDG,Z,Z0,IBIFN,DFN,RCAPAR
S RCAPAR=0
I '$D(RCSCR) S RCAPAR=1,(RCERA,RCSCR)=$P($G(RCIENS),U,1) ; From APAR RCSCR & RCERA not defined
G:($G(RCERA)="")!($G(RCSCR)="") GOEBQ
D FULL^VALM1
D SEL^RCDPEWL(.RCDA)
S RCDA=+$O(RCDA(0)),RCDA=$G(RCDA(RCDA))
I RCDA="" G GOEBQ
S RCDA=$P($G(^RCY(344.49,RCSCR,1,+RCDA,0)),U,9)
S IBIFN=$P($G(^RCY(344.4,RCERA,1,RCDA,0)),U,2) S:+IBIFN'=0 RCDG=$P($G(^IBM(361.1,IBIFN,0)),U,1)
I $G(RCDG)="" W !!,"Problem with Bill IEN: "_IBIFN_", ERA: "_RCERA_" Please report this issue." D PAUSE^VALM1 G GOEBQ
S DFN=$P($G(^DGCR(399,RCDG,0)),U,2)
I RCAPAR S IBIFN=RCDG
I '$$ISRX^IBCEF1(IBIFN) W !!,"Not available. This is not a Pharmacy Claim." D PAUSE^VALM1 G GOEBQ
I $$ECME^IBTRE(IBIFN)="" W !!,"Not available. This is a Pharmacy Claim, but not an ECME Claim." D PAUSE^VALM1 G GOEBQ
D EN^VALM("IBJT ECME RESP INFO")
;
GOEBQ S VALMBCK="R"
I RCAPAR K RCSCR,RCERA ; Clean up if we are in APAR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEWL2 11500 printed Sep 23, 2025@19:21:48 Page 2
RCDPEWL2 ;ALB/TMK/KML - ELECTRONIC EOB WORKLIST ACTIONS ;7/7/10 6:43pm
+1 ;;4.5;Accounts Receivable;**173,208,269,298,303,318**;Mar 20, 1995;Build 37
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ; IA for call to OPTION^IBJTLA = 4121
+4 ; IA for call to ASK^IBRREL = 306
+5 ; IA call for EN1AR^IBECEA = 4047
+6 ; IA call for MAIN^IBOHPT1 = 4048
+7 ; IA for read access to ^IBM(361.1 = 4051
+8 QUIT
+9 ;
VP(RCSCR,RCDAZ) ; View/Print EOB Detail data from file 361.1
+1 ; RCSCR = ien of entry in file 344.4
+2 ; RCDAZ = array subscripted by a sequential # and
+3 ; RCDAZ(n) = one of 3 formats
+4 ; ERA level adjustments
+5 ; ADJ^the ien of the adj in 344.42
+6 ; EOB exists in file 361.1:
+7 ; ien of line in 344.41^ien of 361.1
+8 ; EOB doesn't exist in 361.1:
+9 ; ien of line in 344.41^-1
+10 ;
+11 NEW RCDA,%ZIS,ZTRTN,ZTSAVE,ZTDESC,POP
+12 ; Ask device
+13 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO VPQ
+14 IF $DATA(IO("Q"))
Begin DoDot:1
+15 SET ZTRTN="VPOUT^RCDPEWL2"
SET ZTDESC="AR - Print EEOB Detail from Worklist"
+16 SET ZTSAVE("RC*")=""
+17 DO ^%ZTLOAD
+18 WRITE !!,$SELECT($DATA(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
+19 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO VPQ
+20 USE IO
+21 ;
VPOUT ; Entrypoint for queued job
+1 NEW Z,Z0,RCSTOP,RCPG,RCREF,RC3611,RCDASH,RCDT,RC1,RC3444,RCZ,RCZ0
+2 ;
+3 KILL ^TMP("PRCA_EOB",$JOB),^TMP("PRCA_EOB1",$JOB)
+4 SET RCDT=DT
SET (RCSTOP,RCPG)=0
SET RC3444=RCSCR
SET RCDASH=""
SET $PIECE(RCDASH,"-",71)=""
+5 IF '$ORDER(RCDAZ(0))
GOTO VPQ
+6 SET RCZ=0
FOR
SET RCZ=$ORDER(RCDAZ(RCZ))
if 'RCZ
QUIT
Begin DoDot:1
+7 SET RCREF=$PIECE(RCDAZ(RCZ),U)
SET RC3611=+$PIECE(RCDAZ(RCZ),U,2)
+8 KILL ^TMP("PRCA_EOB1",$JOB,RC3611)
+9 ;
+10 IF $EXTRACT(RCREF,1,3)["ADJ"
Begin DoDot:2
+11 ;Display ERA level adj
+12 SET RCZ0=$GET(^RCY(344.4,RCSCR,2,RC3611,0))
+13 SET ^TMP("PRCA_EOB",$JOB,"ADJ",1)="ERA LEVEL ADJUSTMENT #"_RC3611
+14 SET ^TMP("PRCA_EOB",$JOB,"ADJ",2)=" ADJUSTMENT REFERENCE #: "_$PIECE(RCZ0,U)
+15 SET ^TMP("PRCA_EOB",$JOB,"ADJ",3)=" ADJUSTMENT REASON CODE: "_$PIECE(RCZ0,U,2)
+16 SET ^TMP("PRCA_EOB",$JOB,"ADJ",4)=" ADJUSTMENT AMOUNT: "_$JUSTIFY(+$PIECE(RCZ0,U,3),"",2)
+17 SET ^TMP("PRCA_EOB",$JOB,"ADJ",5)=RCDASH
End DoDot:2
QUIT
+18 ;
+19 IF $PIECE(RCDAZ(RCZ),U,2)'>0
Begin DoDot:2
+20 ;Display formatted raw data - no EOB data in 361.1
+21 KILL ^TMP($JOB,"RC_SUMRAW")
+22 DO DISP^RCDPESR0("^RCY(344.4,"_RCSCR_",1,"_+RCDAZ(RCZ)_",1)","^TMP($J,""RC_SUMRAW"")",1,"^TMP(""PRCA_EOB"",$J,0)")
+23 SET ^TMP("PRCA_EOB1",$JOB,RC3611,1)="CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,+RCDAZ(RCZ))_"*** NOT IDENTIFIED IN A/R ****"_$SELECT($PIECE($GET(^RCY(344.4,RCSCR,1,+RCDAZ(RCZ),0)),U,14):" (REVERSAL)",1:"")
+24 KILL ^TMP($JOB,"RC_SUMRAW")
+25 SET ^TMP("PRCA_EOB",$JOB,+$ORDER(^TMP("PRCA_EOB",$JOB,""),-1)+1)=RCDASH
End DoDot:2
QUIT
+26 ;
+27 KILL ^TMP("PRCA_EOB1",$JOB,RC3611)
+28 SET ^TMP("PRCA_EOB1",$JOB,RC3611,1)="CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,+RCDAZ(RCZ))_$SELECT($PIECE($GET(^RCY(344.4,RCSCR,1,+RCDAZ(RCZ),0)),U,14):" (REVERSAL)",1:"")
+29 DO GETEOB^IBCECSA6(RC3611,2)
+30 ; get filing errors
IF $ORDER(^IBM(361.1,RC3611,"ERR",0))
DO GETERR^RCDPEDS(RC3611,+$ORDER(^TMP("PRCA_EOB",$JOB,RC3611," "),-1))
+31 SET ^TMP("PRCA_EOB",$JOB,+$ORDER(^TMP("PRCA_EOB",$JOB,""),-1)+1)=RCDASH
+32 ;
End DoDot:1
+33 SET RC3611=""
FOR
SET RC3611=$ORDER(^TMP("PRCA_EOB",$JOB,RC3611))
if RC3611=""!RCSTOP
QUIT
Begin DoDot:1
+34 SET RC1=1
+35 SET Z0=0
FOR
SET Z0=$ORDER(^TMP("PRCA_EOB",$JOB,RC3611,Z0))
if 'Z0
QUIT
Begin DoDot:2
+36 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (RCSTOP,ZTSTOP)=1
KILL ZTREQ
IF +$GET(RCPG)
WRITE !,"***TASK STOPPED BY USER***"
QUIT
+37 IF 'RCPG!(($Y+5)>IOSL)
Begin DoDot:3
+38 if RCPG
DO ASK(.RCSTOP)
IF RCSTOP
QUIT
+39 DO RHDR(RCSCR,RCDT,.RCPG)
End DoDot:3
IF RCSTOP
QUIT
+40 IF RC1
WRITE !!,$GET(^TMP("PRCA_EOB1",$JOB,RC3611,1))
SET RC1=0
+41 WRITE !,$GET(^TMP("PRCA_EOB",$JOB,RC3611,Z0))
End DoDot:2
if RCSTOP
QUIT
End DoDot:1
+42 IF 'RCSTOP
IF RCPG
DO ASK(.RCSTOP)
+43 ;
+44 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+45 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+46 ;
VPQ KILL ^TMP("PRCA_EOB",$JOB),^TMP("PRCA_EOB1",$JOB)
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
TPJI ; Jump to Third Party Joint Inquiry for the claim
+1 DO FULL^VALM1
+2 IF $GET(RCSCR("NOEDIT"))=2
DO NOTAV
GOTO TPJIQ
+3 MERGE ^TMP("RC_SAVE_TMP",$JOB)=^TMP($JOB)
+4 ; IA 4121
DO OPTION^IBJTLA
+5 DO RESTMP^RCDPEWL6
+6 ;
TPJIQ SET VALMBCK="R"
+1 QUIT
+2 ;
FAP ; Jump to Full Account Profile
+1 DO FULL^VALM1
+2 ;
+3 IF $GET(RCSCR("NOEDIT"))=2
DO NOTAV
GOTO FAPQ
+4 ;
+5 MERGE ^TMP("RC_SAVE_TMP",$JOB)=^TMP($JOB)
+6 DO EN^PRCAAPR("ALL")
DO RET
KILL DTOUT
+7 DO RESTMP^RCDPEWL6
+8 ;
FAPQ SET VALMBCK="R"
+1 QUIT
+2 ;
RELHOLD ; Jump to Release Hold function
+1 NEW DIR,X,Y,RCDA,RCSCR
+2 DO FULL^VALM1
+3 ;
+4 IF $GET(RCSCR("NOEDIT"))=2
DO NOTAV
GOTO RELHQ
+5 ;
+6 MERGE ^TMP("RC_SAVE_TMP",$JOB)=^TMP($JOB)
+7 ; IA = 306
DO ^IBRREL
DO RET
+8 DO RESTMP^RCDPEWL6
+9 ;
RELHQ SET VALMBCK="R"
+1 QUIT
+2 ;
CMRPT ; Jump to claims matching report
+1 NEW DIR,X,Y,RCIBY
+2 DO FULL^VALM1
+3 ;
+4 IF $GET(RCSCR("NOEDIT"))=2
DO NOTAV
GOTO CMQ
+5 ;
+6 MERGE ^TMP("RC_SAVE_TMP",$JOB)=^TMP($JOB)
+7 DO ^RCDPRTP
DO RET
+8 DO RESTMP^RCDPEWL6
+9 ;
CMQ SET VALMBCK="R"
+1 QUIT
+2 ;
CHGMNT ; Jump to charge maintenance
+1 NEW DIR,X,Y,RCSCR
+2 DO FULL^VALM1
+3 ;
+4 IF $GET(RCSCR("NOEDIT"))=2
DO NOTAV
GOTO CHMQ
+5 ;
+6 IF $DATA(^XUSEC("PRCA EDI LOCKBOX CHARGES",DUZ))
Begin DoDot:1
+7 MERGE ^TMP("RC_SAVE_TMP",$JOB)=^TMP($JOB)
+8 ; IA 4047
DO EN1AR^IBECEA
+9 DO RESTMP^RCDPEWL6
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 SET DIR(0)="EA"
SET DIR("A",1)="YOU DO NOT HAVE THE KEY NEEDED TO ACCESS THIS OPTION."
SET DIR("A")="PRESS RETURN TO CONTINUE "
WRITE !
DO ^DIR
KILL DIR
End DoDot:1
+12 ;
+13 SET VALMBCK="R"
CHMQ QUIT
+1 ;
LSTHLD ; Jump to list current/on hold charges
+1 NEW DIR,X,Y,RCIBY
+2 DO FULL^VALM1
+3 ;
+4 IF $GET(RCSCR("NOEDIT"))=2
DO NOTAV
GOTO LHQ
+5 ;
+6 MERGE ^TMP("RC_SAVE_TMP",$JOB)=^TMP($JOB)
+7 ; IA 4048
DO MAIN^IBOHPT1
DO RET
+8 DO RESTMP^RCDPEWL6
+9 ;
+10 SET VALMBCK="R"
LHQ QUIT
+1 ;
REEST ;EP - Protocol action - RCDPE EOB WORKLIST REESTABLISH
+1 ; Jump to re-establish bill
+2 NEW PRC
+3 DO FULL^VALM1
+4 ; PRCA*4.5*318 Added security key check
IF '$DATA(^XUSEC("RCDPEAR",DUZ))
Begin DoDot:1
+5 WRITE !!,"This action can only be taken by users that have the RCDPEAR security key.",!
+6 DO PAUSE^VALM1
+7 SET VALMBCK="R"
End DoDot:1
QUIT
+8 ;
+9 IF $GET(RCSCR("NOEDIT"))=2
DO NOTAV
GOTO REESTQ
+10 ;
+11 MERGE ^TMP("RC_SAVE_TMP",$JOB)=^TMP($JOB)
+12 DO ^PRCAWREA
KILL DTOUT
+13 DO RESTMP^RCDPEWL6
+14 DO RET
+15 ;
REESTQ SET VALMBCK="R"
+1 QUIT
+2 ;
BILLCOM ; Jump to bill comment log
+1 DO FULL^VALM1
+2 ;
+3 IF $GET(RCSCR("NOEDIT"))=2
DO NOTAV
GOTO BILLCOMQ
+4 ;
+5 MERGE ^TMP("RC_SAVE_TMP",$JOB)=^TMP($JOB)
+6 DO ^PRCACM
KILL DTOUT
+7 DO RET
+8 DO RESTMP^RCDPEWL6
+9 ;
BILLCOMQ SET VALMBCK="R"
+1 QUIT
+2 ;
ASK(RCSTOP) ;
+1 IF $EXTRACT(IOST,1,2)'["C-"
QUIT
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+3 SET DIR(0)="E"
WRITE !
DO ^DIR
+4 IF ($DATA(DIRUT))!($DATA(DUOUT))
SET RCSTOP=1
QUIT
+5 QUIT
+6 ;
RHDR(RCSCR,RCDT,RCPG) ;Prints EOB detail report heading
+1 NEW Z
+2 SET Z=$GET(^RCY(344.4,RCSCR,0))
+3 IF RCPG!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF,*13
+4 SET RCPG=RCPG+1
+5 WRITE !,?15,"EDI LOCKBOX EEOB DETAIL FROM WORKLIST",?55,$$FMTE^XLFDT(RCDT,2),?70,"Page: ",RCPG
+6 ; HIPAA 5010 - TRACE # increased in length from 30 to 50 characters therefore it needs to be displayed on its own line
+7 WRITE !!,$EXTRACT(" ERA NUMBER: "_RCSCR_$JUSTIFY("",25),1,25)_"ERA DATE: "_$$FMTE^XLFDT($PIECE(Z,U,4)),!,"INS COMPANY: "_$PIECE(Z,U,6)_"/"_$PIECE(Z,U,3)
+8 WRITE !,"ERA TRACE #: "_$PIECE(Z,U,2)
+9 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","=")
+10 QUIT
+11 ;
RET ; Pause before returning to list
+1 NEW DIR,X,Y
+2 SET DIR(0)="EA"
SET DIR("A")="RETURN TO CONTINUE"
WRITE !
DO ^DIR
KILL DIR
+3 QUIT
+4 ;
NOWAY ; Msg for unidentified bill
+1 NEW DIR,X,Y
+2 SET DIR(0)="EA"
SET DIR("A",1)="THIS BILL IS NOT IDENTIFIED IN YOUR A/R"
SET DIR("A")="THIS FUNCTION IS NOT AVAILABLE ... RETURN TO CONTINUE "
WRITE !
DO ^DIR
KILL DIR
+3 QUIT
+4 ;
NOWAY1 ; Msg for ERA level Adjustment
+1 NEW DIR,X,Y
+2 SET DIR(0)="EA"
SET DIR("A",1)="THIS IS AN ERA LEVEL ADJUSTMENT - NO DATA EXISTS FOR IT IN YOUR AR"
SET DIR("A")="PRESS ENTER TO CONTINUE"
WRITE !
DO ^DIR
KILL DIR
+3 QUIT
+4 ;
SET1(RCIBY,RCDA,RCDA1,RC3444,RCREF) ; Set up variables for receipt/ERA
+1 SET RCDA1=+RCIBY("IBEOB")
SET RCDA=+$PIECE(RCIBY("IBEOB"),U,2)
SET RC3444=+$PIECE(RCIBY("IBEOB"),U,3)
SET RCREF=+$PIECE(RCIBY("IBEOB"),U,4)
+2 QUIT
+3 ;
CHKFILE ; If the user leaves the split line screen without filing - double check
+1 ; that they didn't want to file it.
+2 NEW DIR,X,Y
+3 DO FULL^VALM1
WRITE !!
+4 IF $GET(^TMP("RCDPE_EOB_SPLIT_OK",$JOB))
IF $ORDER(RCSPLIT(0))
Begin DoDot:1
+5 SET DIR(0)="YA"
SET DIR("B")="NO"
SET DIR("A",1)="YOU HAVE NOT FILED THESE CHANGES"
SET DIR("A")="DO YOU WANT TO FILE THEM BEFORE YOU EXIT?: "
DO ^DIR
KILL DIR
+6 IF Y=1
DO FILESP^RCDPEWL8
End DoDot:1
+7 KILL ^TMP($JOB,"RCDPE_SPLIT_FILE")
+8 QUIT
+9 ;
EDITSP ; Action that edits the split lines
+1 ; RCLINE,RCSCR must already exist
+2 NEW DA,RCEDIT,RCDONE,RCDEF,RCSAVE,RCSAVE1
+3 DO FULL^VALM1
+4 ;
+5 IF $GET(RCSCR("NOEDIT"))=2
DO NOTAV
GOTO EDITQ
+6 ;
+7 DO SEL(.RCEDIT)
+8 if 'RCEDIT
GOTO EDITQ
+9 SET RCDONE=0
+10 MERGE RCSAVE=RCSPLIT,RCSAVE1=RCDIR
SET RCDEF=$GET(RCSPLIT(RCEDIT))
SET RCSPLIT=RCEDIT
+11 DO EDIT^RCDPEWL3(RCSCR,RCLINE,.RCDIR,.RCSPLIT,RCDEF,.RCDONE)
+12 IF '$DATA(RCSPLIT(RCSAVE))
KILL RCSPLIT
MERGE RCSPLIT=RCSAVE
KILL RCDIR
MERGE RCDIR=RCSAVE1
+13 DO INIT^RCDPEWL3
EDITQ SET VALMBCK="R"
+1 QUIT
+2 ;
PREOB ; Print/View EOB detail
+1 NEW RCDA,RCDAZ,Z,Z0
+2 DO FULL^VALM1
+3 DO SEL^RCDPEWL(.RCDA)
+4 SET RCDA=+$ORDER(RCDA(0))
SET RCDA=$GET(RCDA(RCDA))
+5 IF RCDA=""
GOTO PREOBQ
+6 SET RCDA=$PIECE($GET(^RCY(344.49,RCSCR,1,+RCDA,0)),U,9)
+7 FOR RCDAZ=1:1:$LENGTH(RCDA,",")
SET RCDAZ(RCDAZ)=$PIECE(RCDA,",",RCDAZ)
+8 SET Z=0
FOR
SET Z=$ORDER(RCDAZ(Z))
if 'Z
QUIT
Begin DoDot:1
+9 ;
+10 SET Z0=RCDAZ(Z)
+11 IF $EXTRACT(Z0,1,3)="ADJ"
Begin DoDot:2
+12 IF $GET(^RCY(344.4,RCSCR,2,+$PIECE(Z0,"ADJ",2),0))'=""
SET RCDAZ(Z)="ADJ^"_+$PIECE(Z0,"ADJ",2)
End DoDot:2
QUIT
+13 ;
+14 SET Z0=$GET(^RCY(344.4,RCSCR,1,+Z0,0))
+15 SET RCDAZ(Z)=+Z0_U_$SELECT($PIECE(Z0,U,2):$PIECE(Z0,U,2),1:-1)
QUIT
End DoDot:1
+16 ;
+17 DO VP(RCSCR,.RCDAZ)
+18 ;
PREOBQ SET VALMBCK="R"
+1 QUIT
+2 ;
RESEARCH ; Invoke the research menu
+1 ;
+2 KILL ^TMP($JOB,"RC_VALMBG")
+3 SET ^TMP($JOB,"RC_VALMBG")=$GET(VALMBG)
+4 DO FULL^VALM1
+5 IF $GET(RCSCR("NOEDIT"))=2
DO NOTAV
GOTO RQ
+6 ;
+7 DO EN^VALM("RCDPE EOB RESEARCH")
+8 ;
RQ KILL ^TMP($JOB,"RC_VALMBG")
+1 QUIT
+2 ;
SEL(RCEDIT) ;
+1 NEW VALMY
+2 DO EN^VALM2($GET(XQORNOD(0)),"S")
+3 SET RCEDIT=+$ORDER(VALMY(0))
+4 QUIT
+5 ;
EXIT ; Exits back to ERA menu actions from research
+1 SET VALMBCK="Q"
+2 QUIT
+3 ;
WL(RCRCPT) ; Entrypoint to the ERA Worklist from Receipt Processing
+1 ;RCRCPT = ien of entry in file 344
+2 NEW DIR,X,Y,Z
+3 DO FULL^VALM1
+4 ; if not at ERA summary level (344.4,.08), get a receipt match using the cross-reference at the ERA detail (RECEIPT (344.41, .25)
+5 SET Z=$SELECT($ORDER(^RCY(344.4,"AREC",RCRCPT,0)):+$ORDER(^RCY(344.4,"AREC",RCRCPT,0)),1:+$ORDER(^RCY(344.4,"H",RCRCPT,0)))
+6 IF 'Z
Begin DoDot:1
+7 SET DIR("A")="THIS RECEIPT IS NOT ASSOCIATED WITH AN ERA RECORD - PRESS RETURN TO CONTINUE "
SET DIR(0)="EA"
WRITE !
DO ^DIR
KILL DIR
End DoDot:1
GOTO WLQ
+8 ;
+9 IF '$DATA(^RCY(344.49,Z,0))
Begin DoDot:1
+10 SET DIR("A")="NO ERA WORKLIST SCRATCHPAD EXISTS FOR THIS ERA - PRESS RETURN TO CONTINUE "
SET DIR(0)="EA"
WRITE !
DO ^DIR
KILL DIR
End DoDot:1
GOTO WLQ
+11 ;
+12 DO DISP^RCDPEWL(Z,2)
+13 ;
WLQ SET VALMBCK="R"
+1 QUIT
+2 ;
NOTAV ; Display not available msg
+1 NEW DIR,X,Y
+2 ;
+3 SET DIR(0)="EA"
SET DIR("A")="THIS ACTION NOT CURRENTLY AVAILABLE - PRESS RETURN TO CONTINUE "
WRITE !
DO ^DIR
KILL DIR
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
+7 ;PRCA*4.5*303 - Add jump to ECME Information from the ERA Worklist Research
+8 ; IA 1992 - BILL/CLAIMS file (#399)
+9 ; RCIENS exists before this code is called if coming from APAR
+10 ; RCERA, RCSCR are assumed to exist before this code is called
GOECME ; Select an EEOB and then jump to the [IBJT ECME RESP INFO SCREEN]
+1 NEW RCDA,RCDAZ,RCDG,Z,Z0,IBIFN,DFN,RCAPAR
+2 SET RCAPAR=0
+3 ; From APAR RCSCR & RCERA not defined
IF '$DATA(RCSCR)
SET RCAPAR=1
SET (RCERA,RCSCR)=$PIECE($GET(RCIENS),U,1)
+4 if ($GET(RCERA)="")!($GET(RCSCR)="")
GOTO GOEBQ
+5 DO FULL^VALM1
+6 DO SEL^RCDPEWL(.RCDA)
+7 SET RCDA=+$ORDER(RCDA(0))
SET RCDA=$GET(RCDA(RCDA))
+8 IF RCDA=""
GOTO GOEBQ
+9 SET RCDA=$PIECE($GET(^RCY(344.49,RCSCR,1,+RCDA,0)),U,9)
+10 SET IBIFN=$PIECE($GET(^RCY(344.4,RCERA,1,RCDA,0)),U,2)
if +IBIFN'=0
SET RCDG=$PIECE($GET(^IBM(361.1,IBIFN,0)),U,1)
+11 IF $GET(RCDG)=""
WRITE !!,"Problem with Bill IEN: "_IBIFN_", ERA: "_RCERA_" Please report this issue."
DO PAUSE^VALM1
GOTO GOEBQ
+12 SET DFN=$PIECE($GET(^DGCR(399,RCDG,0)),U,2)
+13 IF RCAPAR
SET IBIFN=RCDG
+14 IF '$$ISRX^IBCEF1(IBIFN)
WRITE !!,"Not available. This is not a Pharmacy Claim."
DO PAUSE^VALM1
GOTO GOEBQ
+15 IF $$ECME^IBTRE(IBIFN)=""
WRITE !!,"Not available. This is a Pharmacy Claim, but not an ECME Claim."
DO PAUSE^VALM1
GOTO GOEBQ
+16 DO EN^VALM("IBJT ECME RESP INFO")
+17 ;
GOEBQ SET VALMBCK="R"
+1 ; Clean up if we are in APAR
IF RCAPAR
KILL RCSCR,RCERA
+2 QUIT
