- 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 Jan 18, 2025@02:46:54 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