Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPEWL2

RCDPEWL2.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ; IA for call to OPTION^IBJTLA = 4121
  1. ; IA for call to ASK^IBRREL = 306
  1. ; IA call for EN1AR^IBECEA = 4047
  1. ; IA call for MAIN^IBOHPT1 = 4048
  1. ; IA for read access to ^IBM(361.1 = 4051
  1. Q
  1. ;
  1. VP(RCSCR,RCDAZ) ; View/Print EOB Detail data from file 361.1
  1. ; RCSCR = ien of entry in file 344.4
  1. ; RCDAZ = array subscripted by a sequential # and
  1. ; RCDAZ(n) = one of 3 formats
  1. ; ERA level adjustments
  1. ; ADJ^the ien of the adj in 344.42
  1. ; EOB exists in file 361.1:
  1. ; ien of line in 344.41^ien of 361.1
  1. ; EOB doesn't exist in 361.1:
  1. ; ien of line in 344.41^-1
  1. ;
  1. N RCDA,%ZIS,ZTRTN,ZTSAVE,ZTDESC,POP
  1. ; Ask device
  1. S %ZIS="QM" D ^%ZIS G:POP VPQ
  1. I $D(IO("Q")) D G VPQ
  1. . S ZTRTN="VPOUT^RCDPEWL2",ZTDESC="AR - Print EEOB Detail from Worklist"
  1. . S ZTSAVE("RC*")=""
  1. . D ^%ZTLOAD
  1. . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
  1. . K ZTSK,IO("Q") D HOME^%ZIS
  1. U IO
  1. ;
  1. VPOUT ; Entrypoint for queued job
  1. N Z,Z0,RCSTOP,RCPG,RCREF,RC3611,RCDASH,RCDT,RC1,RC3444,RCZ,RCZ0
  1. ;
  1. K ^TMP("PRCA_EOB",$J),^TMP("PRCA_EOB1",$J)
  1. S RCDT=DT,(RCSTOP,RCPG)=0,RC3444=RCSCR,RCDASH="",$P(RCDASH,"-",71)=""
  1. I '$O(RCDAZ(0)) G VPQ
  1. S RCZ=0 F S RCZ=$O(RCDAZ(RCZ)) Q:'RCZ D
  1. . S RCREF=$P(RCDAZ(RCZ),U),RC3611=+$P(RCDAZ(RCZ),U,2)
  1. . K ^TMP("PRCA_EOB1",$J,RC3611)
  1. . ;
  1. . I $E(RCREF,1,3)["ADJ" D Q
  1. .. ;Display ERA level adj
  1. .. S RCZ0=$G(^RCY(344.4,RCSCR,2,RC3611,0))
  1. .. S ^TMP("PRCA_EOB",$J,"ADJ",1)="ERA LEVEL ADJUSTMENT #"_RC3611
  1. .. S ^TMP("PRCA_EOB",$J,"ADJ",2)=" ADJUSTMENT REFERENCE #: "_$P(RCZ0,U)
  1. .. S ^TMP("PRCA_EOB",$J,"ADJ",3)=" ADJUSTMENT REASON CODE: "_$P(RCZ0,U,2)
  1. .. S ^TMP("PRCA_EOB",$J,"ADJ",4)=" ADJUSTMENT AMOUNT: "_$J(+$P(RCZ0,U,3),"",2)
  1. .. S ^TMP("PRCA_EOB",$J,"ADJ",5)=RCDASH
  1. . ;
  1. . I $P(RCDAZ(RCZ),U,2)'>0 D Q
  1. .. ;Display formatted raw data - no EOB data in 361.1
  1. .. K ^TMP($J,"RC_SUMRAW")
  1. .. D DISP^RCDPESR0("^RCY(344.4,"_RCSCR_",1,"_+RCDAZ(RCZ)_",1)","^TMP($J,""RC_SUMRAW"")",1,"^TMP(""PRCA_EOB"",$J,0)")
  1. .. 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:"")
  1. .. K ^TMP($J,"RC_SUMRAW")
  1. .. S ^TMP("PRCA_EOB",$J,+$O(^TMP("PRCA_EOB",$J,""),-1)+1)=RCDASH
  1. . ;
  1. . K ^TMP("PRCA_EOB1",$J,RC3611)
  1. . 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:"")
  1. . D GETEOB^IBCECSA6(RC3611,2)
  1. . I $O(^IBM(361.1,RC3611,"ERR",0)) D GETERR^RCDPEDS(RC3611,+$O(^TMP("PRCA_EOB",$J,RC3611," "),-1)) ; get filing errors
  1. . S ^TMP("PRCA_EOB",$J,+$O(^TMP("PRCA_EOB",$J,""),-1)+1)=RCDASH
  1. . ;
  1. S RC3611="" F S RC3611=$O(^TMP("PRCA_EOB",$J,RC3611)) Q:RC3611=""!RCSTOP D
  1. . S RC1=1
  1. . S Z0=0 F S Z0=$O(^TMP("PRCA_EOB",$J,RC3611,Z0)) Q:'Z0 D Q:RCSTOP
  1. .. I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !,"***TASK STOPPED BY USER***" Q
  1. .. I 'RCPG!(($Y+5)>IOSL) D I RCSTOP Q
  1. ... D:RCPG ASK(.RCSTOP) I RCSTOP Q
  1. ... D RHDR(RCSCR,RCDT,.RCPG)
  1. .. I RC1 W !!,$G(^TMP("PRCA_EOB1",$J,RC3611,1)) S RC1=0
  1. .. W !,$G(^TMP("PRCA_EOB",$J,RC3611,Z0))
  1. I 'RCSTOP,RCPG D ASK(.RCSTOP)
  1. ;
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. I '$D(ZTQUEUED) D ^%ZISC
  1. ;
  1. VPQ K ^TMP("PRCA_EOB",$J),^TMP("PRCA_EOB1",$J)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. TPJI ; Jump to Third Party Joint Inquiry for the claim
  1. D FULL^VALM1
  1. I $G(RCSCR("NOEDIT"))=2 D NOTAV G TPJIQ
  1. M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
  1. D OPTION^IBJTLA ; IA 4121
  1. D RESTMP^RCDPEWL6
  1. ;
  1. TPJIQ S VALMBCK="R"
  1. Q
  1. ;
  1. FAP ; Jump to Full Account Profile
  1. D FULL^VALM1
  1. ;
  1. I $G(RCSCR("NOEDIT"))=2 D NOTAV G FAPQ
  1. ;
  1. M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
  1. D EN^PRCAAPR("ALL"),RET K DTOUT
  1. D RESTMP^RCDPEWL6
  1. ;
  1. FAPQ S VALMBCK="R"
  1. Q
  1. ;
  1. RELHOLD ; Jump to Release Hold function
  1. N DIR,X,Y,RCDA,RCSCR
  1. D FULL^VALM1
  1. ;
  1. I $G(RCSCR("NOEDIT"))=2 D NOTAV G RELHQ
  1. ;
  1. M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
  1. D ^IBRREL,RET ; IA = 306
  1. D RESTMP^RCDPEWL6
  1. ;
  1. RELHQ S VALMBCK="R"
  1. Q
  1. ;
  1. CMRPT ; Jump to claims matching report
  1. N DIR,X,Y,RCIBY
  1. D FULL^VALM1
  1. ;
  1. I $G(RCSCR("NOEDIT"))=2 D NOTAV G CMQ
  1. ;
  1. M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
  1. D ^RCDPRTP,RET
  1. D RESTMP^RCDPEWL6
  1. ;
  1. CMQ S VALMBCK="R"
  1. Q
  1. ;
  1. CHGMNT ; Jump to charge maintenance
  1. N DIR,X,Y,RCSCR
  1. D FULL^VALM1
  1. ;
  1. I $G(RCSCR("NOEDIT"))=2 D NOTAV G CHMQ
  1. ;
  1. I $D(^XUSEC("PRCA EDI LOCKBOX CHARGES",DUZ)) D
  1. . M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
  1. . D EN1AR^IBECEA ; IA 4047
  1. . D RESTMP^RCDPEWL6
  1. E D
  1. . 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
  1. ;
  1. S VALMBCK="R"
  1. CHMQ Q
  1. ;
  1. LSTHLD ; Jump to list current/on hold charges
  1. N DIR,X,Y,RCIBY
  1. D FULL^VALM1
  1. ;
  1. I $G(RCSCR("NOEDIT"))=2 D NOTAV G LHQ
  1. ;
  1. M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
  1. D MAIN^IBOHPT1,RET ; IA 4048
  1. D RESTMP^RCDPEWL6
  1. ;
  1. S VALMBCK="R"
  1. LHQ Q
  1. ;
  1. REEST ;EP - Protocol action - RCDPE EOB WORKLIST REESTABLISH
  1. ; Jump to re-establish bill
  1. N PRC
  1. D FULL^VALM1
  1. I '$D(^XUSEC("RCDPEAR",DUZ)) D Q ; PRCA*4.5*318 Added security key check
  1. . W !!,"This action can only be taken by users that have the RCDPEAR security key.",!
  1. . D PAUSE^VALM1
  1. . S VALMBCK="R"
  1. ;
  1. I $G(RCSCR("NOEDIT"))=2 D NOTAV G REESTQ
  1. ;
  1. M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
  1. D ^PRCAWREA K DTOUT
  1. D RESTMP^RCDPEWL6
  1. D RET
  1. ;
  1. REESTQ S VALMBCK="R"
  1. Q
  1. ;
  1. BILLCOM ; Jump to bill comment log
  1. D FULL^VALM1
  1. ;
  1. I $G(RCSCR("NOEDIT"))=2 D NOTAV G BILLCOMQ
  1. ;
  1. M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
  1. D ^PRCACM K DTOUT
  1. D RET
  1. D RESTMP^RCDPEWL6
  1. ;
  1. BILLCOMQ S VALMBCK="R"
  1. Q
  1. ;
  1. ASK(RCSTOP) ;
  1. I $E(IOST,1,2)'["C-" Q
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1. S DIR(0)="E" W ! D ^DIR
  1. I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
  1. Q
  1. ;
  1. RHDR(RCSCR,RCDT,RCPG) ;Prints EOB detail report heading
  1. N Z
  1. S Z=$G(^RCY(344.4,RCSCR,0))
  1. I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
  1. S RCPG=RCPG+1
  1. W !,?15,"EDI LOCKBOX EEOB DETAIL FROM WORKLIST",?55,$$FMTE^XLFDT(RCDT,2),?70,"Page: ",RCPG
  1. ; HIPAA 5010 - TRACE # increased in length from 30 to 50 characters therefore it needs to be displayed on its own line
  1. 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)
  1. W !,"ERA TRACE #: "_$P(Z,U,2)
  1. W !,$TR($J("",IOM)," ","=")
  1. Q
  1. ;
  1. RET ; Pause before returning to list
  1. N DIR,X,Y
  1. S DIR(0)="EA",DIR("A")="RETURN TO CONTINUE" W ! D ^DIR K DIR
  1. Q
  1. ;
  1. NOWAY ; Msg for unidentified bill
  1. N DIR,X,Y
  1. 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
  1. Q
  1. ;
  1. NOWAY1 ; Msg for ERA level Adjustment
  1. N DIR,X,Y
  1. 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
  1. Q
  1. ;
  1. SET1(RCIBY,RCDA,RCDA1,RC3444,RCREF) ; Set up variables for receipt/ERA
  1. S RCDA1=+RCIBY("IBEOB"),RCDA=+$P(RCIBY("IBEOB"),U,2),RC3444=+$P(RCIBY("IBEOB"),U,3),RCREF=+$P(RCIBY("IBEOB"),U,4)
  1. Q
  1. ;
  1. CHKFILE ; If the user leaves the split line screen without filing - double check
  1. ; that they didn't want to file it.
  1. N DIR,X,Y
  1. D FULL^VALM1 W !!
  1. I $G(^TMP("RCDPE_EOB_SPLIT_OK",$J)),$O(RCSPLIT(0)) D
  1. . 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
  1. . I Y=1 D FILESP^RCDPEWL8
  1. K ^TMP($J,"RCDPE_SPLIT_FILE")
  1. Q
  1. ;
  1. EDITSP ; Action that edits the split lines
  1. ; RCLINE,RCSCR must already exist
  1. N DA,RCEDIT,RCDONE,RCDEF,RCSAVE,RCSAVE1
  1. D FULL^VALM1
  1. ;
  1. I $G(RCSCR("NOEDIT"))=2 D NOTAV G EDITQ
  1. ;
  1. D SEL(.RCEDIT)
  1. G:'RCEDIT EDITQ
  1. S RCDONE=0
  1. M RCSAVE=RCSPLIT,RCSAVE1=RCDIR S RCDEF=$G(RCSPLIT(RCEDIT)),RCSPLIT=RCEDIT
  1. D EDIT^RCDPEWL3(RCSCR,RCLINE,.RCDIR,.RCSPLIT,RCDEF,.RCDONE)
  1. I '$D(RCSPLIT(RCSAVE)) K RCSPLIT M RCSPLIT=RCSAVE K RCDIR M RCDIR=RCSAVE1
  1. D INIT^RCDPEWL3
  1. EDITQ S VALMBCK="R"
  1. Q
  1. ;
  1. PREOB ; Print/View EOB detail
  1. N RCDA,RCDAZ,Z,Z0
  1. D FULL^VALM1
  1. D SEL^RCDPEWL(.RCDA)
  1. S RCDA=+$O(RCDA(0)),RCDA=$G(RCDA(RCDA))
  1. I RCDA="" G PREOBQ
  1. S RCDA=$P($G(^RCY(344.49,RCSCR,1,+RCDA,0)),U,9)
  1. F RCDAZ=1:1:$L(RCDA,",") S RCDAZ(RCDAZ)=$P(RCDA,",",RCDAZ)
  1. S Z=0 F S Z=$O(RCDAZ(Z)) Q:'Z D
  1. . ;
  1. . S Z0=RCDAZ(Z)
  1. . I $E(Z0,1,3)="ADJ" D Q
  1. .. I $G(^RCY(344.4,RCSCR,2,+$P(Z0,"ADJ",2),0))'="" S RCDAZ(Z)="ADJ^"_+$P(Z0,"ADJ",2)
  1. . ;
  1. . S Z0=$G(^RCY(344.4,RCSCR,1,+Z0,0))
  1. . S RCDAZ(Z)=+Z0_U_$S($P(Z0,U,2):$P(Z0,U,2),1:-1) Q
  1. ;
  1. D VP(RCSCR,.RCDAZ)
  1. ;
  1. PREOBQ S VALMBCK="R"
  1. Q
  1. ;
  1. RESEARCH ; Invoke the research menu
  1. ;
  1. K ^TMP($J,"RC_VALMBG")
  1. S ^TMP($J,"RC_VALMBG")=$G(VALMBG)
  1. D FULL^VALM1
  1. I $G(RCSCR("NOEDIT"))=2 D NOTAV G RQ
  1. ;
  1. D EN^VALM("RCDPE EOB RESEARCH")
  1. ;
  1. RQ K ^TMP($J,"RC_VALMBG")
  1. Q
  1. ;
  1. SEL(RCEDIT) ;
  1. N VALMY
  1. D EN^VALM2($G(XQORNOD(0)),"S")
  1. S RCEDIT=+$O(VALMY(0))
  1. Q
  1. ;
  1. EXIT ; Exits back to ERA menu actions from research
  1. S VALMBCK="Q"
  1. Q
  1. ;
  1. WL(RCRCPT) ; Entrypoint to the ERA Worklist from Receipt Processing
  1. ;RCRCPT = ien of entry in file 344
  1. N DIR,X,Y,Z
  1. D FULL^VALM1
  1. ; 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)
  1. 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)))
  1. I 'Z D G WLQ
  1. . S DIR("A")="THIS RECEIPT IS NOT ASSOCIATED WITH AN ERA RECORD - PRESS RETURN TO CONTINUE ",DIR(0)="EA" W ! D ^DIR K DIR
  1. ;
  1. I '$D(^RCY(344.49,Z,0)) D G WLQ
  1. . S DIR("A")="NO ERA WORKLIST SCRATCHPAD EXISTS FOR THIS ERA - PRESS RETURN TO CONTINUE ",DIR(0)="EA" W ! D ^DIR K DIR
  1. ;
  1. D DISP^RCDPEWL(Z,2)
  1. ;
  1. WLQ S VALMBCK="R"
  1. Q
  1. ;
  1. NOTAV ; Display not available msg
  1. N DIR,X,Y
  1. ;
  1. S DIR(0)="EA",DIR("A")="THIS ACTION NOT CURRENTLY AVAILABLE - PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;PRCA*4.5*303 - Add jump to ECME Information from the ERA Worklist Research
  1. ; IA 1992 - BILL/CLAIMS file (#399)
  1. ; RCIENS exists before this code is called if coming from APAR
  1. ; RCERA, RCSCR are assumed to exist before this code is called
  1. GOECME ; Select an EEOB and then jump to the [IBJT ECME RESP INFO SCREEN]
  1. N RCDA,RCDAZ,RCDG,Z,Z0,IBIFN,DFN,RCAPAR
  1. S RCAPAR=0
  1. I '$D(RCSCR) S RCAPAR=1,(RCERA,RCSCR)=$P($G(RCIENS),U,1) ; From APAR RCSCR & RCERA not defined
  1. G:($G(RCERA)="")!($G(RCSCR)="") GOEBQ
  1. D FULL^VALM1
  1. D SEL^RCDPEWL(.RCDA)
  1. S RCDA=+$O(RCDA(0)),RCDA=$G(RCDA(RCDA))
  1. I RCDA="" G GOEBQ
  1. S RCDA=$P($G(^RCY(344.49,RCSCR,1,+RCDA,0)),U,9)
  1. 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)
  1. I $G(RCDG)="" W !!,"Problem with Bill IEN: "_IBIFN_", ERA: "_RCERA_" Please report this issue." D PAUSE^VALM1 G GOEBQ
  1. S DFN=$P($G(^DGCR(399,RCDG,0)),U,2)
  1. I RCAPAR S IBIFN=RCDG
  1. I '$$ISRX^IBCEF1(IBIFN) W !!,"Not available. This is not a Pharmacy Claim." D PAUSE^VALM1 G GOEBQ
  1. I $$ECME^IBTRE(IBIFN)="" W !!,"Not available. This is a Pharmacy Claim, but not an ECME Claim." D PAUSE^VALM1 G GOEBQ
  1. D EN^VALM("IBJT ECME RESP INFO")
  1. ;
  1. GOEBQ S VALMBCK="R"
  1. I RCAPAR K RCSCR,RCERA ; Clean up if we are in APAR
  1. Q