RCDPEWL7 ;ALB/TMK/KML - EDI LOCKBOX WORKLIST ERA DISPLAY SCREEN ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**208,222,269,276,298,304,318,321,326,332,349,432**;Mar 20, 1995;Build 16
;Per VA Directive 6402, this routine should not be modified.
Q
;
BLD(RCSORT) ; Build list with sort criteria
; RCSORT = the sort levels to use to display the data in ^ pieces
; piece 1 = the codes for the first level sort (sort code;null or -)
; piece 2 = the codes for the second level sort
; sort code is the type of data to sort by;- indicates reverse order
N Z,Z1,RCT,RCZ
S (RCT,VALMCNT)=0
I '$D(^TMP($J,"RCERA_LIST")) D
. S Z=0 F S Z=$O(^TMP("RCDPE-ERA_WLDX",$J,Z)) Q:'Z S RCZ=$P($G(^(Z)),U,2) D
.. I $$FILTER^RCDPEWLD(RCZ) S ^TMP($J,"RCERA_LIST",$$SL(RCZ,$P(RCSORT,U)),$$SL(RCZ,$P(RCSORT,U,2)),RCZ)=""
. K ^TMP("RCDPE-ERA_WLDX",$J),^TMP("RCDPE-ERA_WL",$J)
;
S Z=""
I RCSORT'["PN;-" D
. F S Z=$O(^TMP($J,"RCERA_LIST",Z)) Q:Z="" S Z1="" F S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1)) Q:Z1="" D EXTRACT(Z,Z1,.RCT)
;
I $P(RCSORT,U)["PN;-" D
. F S Z=$O(^TMP($J,"RCERA_LIST",Z),-1) Q:Z="" S Z1="" F S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1)) Q:Z1="" D EXTRACT(Z,Z1,.RCT)
;
I $P(RCSORT,U,2)["PN;-" D
. F S Z=$O(^TMP($J,"RCERA_LIST",Z)) Q:Z="" S Z1="" F S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1),-1) Q:Z1="" D EXTRACT(Z,Z1,.RCT)
;
I '$O(^TMP($J,"RCERA_LIST",0)) D SET("No ERAs left for your selection criteria")
K ^TMP($J,"RCERA_LIST")
S ^TMP("RCERA_PARAMS",$J,"SORT")=RCSORT
Q
;
; RCSRT1 = data value at 1st sort level
; RCSRT2 = data value at 2nd sort level
; RCT = running entry counter - returned if passed by ref
N AUTOCOMP,FIRST,MDT,RC0,RCARC,RCEFT,RCEXCEP,RCPOST,RCSTAT,RCZ,X,XX,Z,Z0 ;PRCA*4.5*318 Variable XX added
S RCZ=0 F S RCZ=$O(^TMP($J,"RCERA_LIST",RCSRT1,RCSRT2,RCZ)) Q:'RCZ D
. S RCT=RCT+1,RC0=$G(^RCY(344.4,RCZ,0))
. S RCEFT=+$O(^RCY(344.31,"AERA",RCZ,0))
. S MDT=$$MATCHDT^RCDPEWL7(RCEFT,"2D") ; PRCA*4.5*326 - Add date matched
. S RCEXCEP=$$XCEPT^RCDPEWLP(RCZ) ; prca*4.5*298 assignment of ERA exception flag
. S AUTOCOMP=$$STA(RCZ) ;PRCA*4.5*326
. S RCARC=$$WLF^RCDPEWLZ(RCZ)
. S RCSTAT=$S('RCEFT:U_$S($P(RC0,U,15)="CHK":"(CHECK PAYMENT EXPECTED)",$P(RC0,U,15)="NON":"(NO PAYMENT EXPECTED)",$P(RC0,U,9)=2:"(CHECK PAYMENT CHOSEN)",1:"N/A"),1:$$FMSSTAT^RCDPUREC(+$P($G(^RCY(344.31,RCEFT,0)),U,9)))
. S RCPOST=$S(RCEFT:"EFT RECEIPT STATUS: ",1:"")_$P(RCSTAT,U,2)
. ;prca*4.5*298 include Auto-Post Complete indicator and ERA exception flag in $SELECT statement
. S X=$E(RCT_$J("",5),1,5)_" "_$S(RCEXCEP]"":RCEXCEP,AUTOCOMP]"":AUTOCOMP,RCARC]"":RCARC,$D(^RCY(344.49,RCZ)):" ",1:"-")_$E($P(RC0,U)_$J("",10),1,10)_" "_$E($P(RC0,U,2)_$J("",50),1,50)
. D SET(X,RCT,RCZ)
. S X=$J("",43)_$J($$FMTE^XLFDT($P(RC0,U,7),"2D"),8)_$J("",2)_$J(+$P(RC0,U,5),12,2)
. S $E(X,73,80)=$$FMTE^XLFDT($P(RC0,U,7),"2D")
. D SET(X,RCT,RCZ)
. ; PRCA*4.5*326 Start changed block
. S X=$J("",8)_$E($P(RC0,U,6)_$J("",30),1,30)_" APPROX # EEOBs: "_+$$CTEEOB^RCDPEWLB(RCZ)
. D SET(X,RCT,RCZ)
. S X=$P(RC0,U,9),XX=$$EXTERNAL^DILFD(344.4,.09,"",$P(RC0,U,9))
. S XX=$S(X=1:"EFT MATCHED",X=2:"CHK MATCHED",X=3:"MATCH-0 PAY",XX=-1:"MATCH W/ERR",1:$P(XX," ",1))
. I X=2 S MDT=$$GET1^DIQ(344.4,RCZ_",",5.03,"I") I MDT'="" S MDT=$$FMTE^XLFDT(MDT,"2D")
. S:$$UNBAL^RCDPEAP1(RCZ) XX=XX_" - UNBALANCED"
. S X=$J("",8)_$E(XX_$J("",25),1,25)_" "_$E(MDT_$J("",8),1,8)
. S X=X_" "_RCPOST
. ; PRCA*4.5*326 End changed block
. D SET(X,RCT)
. D SET(" ",RCT)
;.; prca*4.5*298 per patch requirements, keep code related to
;. ; creating/maintaining batches but just remove from execution.
;. ;I $G(^TMP("RCERA_PARAMS",$J,"BATCHON")) D
;.. ;S Z=0 F S Z=$O(^RCY(344.49,RCZ,3,Z)) Q:'Z S Z0=$G(^(Z,0)) I Z0'="" D
;...; S X=$J("",12)_$E("- BATCH #"_$P(Z0,U)_$J("",4),1,13)_" "_$E($P(Z0,U,2)_$J("",30),1,30)_" "_$S('$P(Z0,U,3):"NOT ",1:"")_"READY TO POST"
;... ;D SET(X,RCT)
;
S VALMSG="Enter ?? for more actions and help" ; PRCA*4.5*326
;
Q
;
; BEGIN PRCA*4.5*326
STA(RCZ) ;Determine auto-post status and if marked for auto-post
; Input - RCZ = ERA ien
; Output - "" = UNPOSTED
; "A" = COMPLETE
; "P" = PARTIAL
; "M" = MARKED
N STA
;Get ERA auto-post status
S STA=$$GET1^DIQ(344.4,RCZ_",",4.02,"I")
;Not auto-post ERA
Q:STA="" ""
;Unposted but marked for autopost
I STA=0,$$GET1^DIQ(344.4,RCZ_",",4.04,"I")]"" Q "M"
;Unposted - EFT still not accepted
Q:STA=0 ""
;Complete
Q:STA=2 "A"
;Partial
N MATCH,SUB
S MATCH=0,SUB=0
F S SUB=$O(^RCY(344.4,RCZ,1,SUB)) Q:'SUB D Q:MATCH
.S MATCH=$$GET1^DIQ(344.41,SUB_","_RCZ,6,"I")
Q $S(MATCH:"M",1:"P")
; END PRCA*4.5*326
;
MATCHDT(RCEFT,FORMAT) ;EP
; Get the Date the ERA was matched
; Input: RCEFT - IEN for file 344.31
; FORMAT - (Optional) date format for second parameter of FMTE^XLFDT (Defaults to 2DZ)
; Returns: External date when the ERA was matched or ""
I '$G(RCEFT) Q ""
N IENS,XX
I $G(FORMAT)="" S FORMAT="2DZ"
S XX=$O(^RCY(344.31,RCEFT,4,"A"),-1) ; Get last Match Status History record
Q:XX="" ""
S IENS=XX_","_RCEFT_","
S XX=$$GET1^DIQ(344.314,IENS,.02,"I")
Q:XX="" ""
S XX=$$FMTE^XLFDT(XX,FORMAT)
Q XX
;
SL(Y,SORT) ; Returns data for sort level from entry Y in file 344.4
; SORT = the sort data in ';' delimited pieces
; pc 1 = code for sort data
; pc 2 = the order requested (- or null)
;
N RC0,DAT,SORT1,SORT2
S SORT1=$P(SORT,";"),SORT2=$P(SORT,";",2)
S RC0=$G(^RCY(344.4,Y,0)),DAT=" "
; No sort
I SORT="" G SLQ
; Amt paid
I SORT1="AP" D G SLQ
. S DAT=SORT2_+$P(RC0,U,5)
; ERA date pd
I SORT1="DP" D G SLQ
. S DAT=SORT2_($P(RC0,U,4)\1)
; Payer name
I SORT1="PN" D G SLQ
. S DAT=$$UP^RCDPEARL($P(RC0,U,6))
; ERA date received
I SORT1="DR" D G SLQ
. S DAT=SORT2_($P(RC0,U,7)\1)
;
SLQ Q $S(DAT'="":DAT,1:" ")
;
INIT ; Entry point for List template to build the display of ERAs
;
; Parameters for selecting ERAs to be included in the list are
; contained in the global ^TMP("RCERA_PARAMS",$J,parameter name)
;
N RCZ,RC0,RCT,RCTT,RCQUIT,RCDTFR,RCDTTO,DTOUT,DUOUT,DIR,X,Y,Z,Z1,RCPOST,RCEFT,RCINDX,QFLG
D CLEAN^VALM10
K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP($J,"RCERA_LIST")
;
S (RCT,RCTT,RCQUIT)=0
;
S RCDTFR=+$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U),RCDTTO=$S($P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U,2):$P(^("RCDT"),U,2),1:DT)
;
S RCINDX=$S(RCDTFR:RCDTFR-.00000001,1:0)
W !!,"SEARCHING, PLEASE STANDBY (PRESS '^' TO QUIT SEARCH)",!!
F S RCINDX=$O(^RCY(344.4,"AFD",RCINDX)) Q:'RCINDX!(RCINDX\1>RCDTTO)!RCQUIT S RCZ=0 F S RCZ=$O(^RCY(344.4,"AFD",RCINDX,RCZ)) Q:'RCZ D Q:RCQUIT
. S RCTT=RCTT+1
. I RCTT>19999 D Q:RCQUIT=1
. . S RCTT=0
. . D WAIT^DICD
. . D INITKB^XGF ; supported by DBIA 3173
. . S QFLG=$$READ^XGF(1,1)
. . Q:$G(DTOUT)
. . S:QFLG="^" RCQUIT=1 Q
. . I $D(DUOUT)!(Y=0) S RCQUIT=1 Q
. . D RESETKB^XGF
. ;
. S RC0=$G(^RCY(344.4,RCZ,0))
. I $$FILTER^RCDPEWLD(RCZ) S ^TMP($J,"RCERA_LIST",$$SL(RCZ,"DR"),$$SL(RCZ,""),RCZ)=""
;
; Output the list
I 'RCQUIT D
. D:$D(^TMP($J,"RCERA_LIST")) BLD("DR^N")
. ; If no ERAs found display the message below in the list area
. I '$O(^TMP("RCDPE-ERA_WL",$J,0)) D
. . S ^TMP("RCDPE-ERA_WL",$J,1,0)="THERE ARE NO ERAs MATCHING YOUR SELECTION CRITERIA"
. . S VALMCNT=1 ; PRCA*4.5*349 - VALMCNT set correctly to indicate 1 item instead of 2
I RCQUIT K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP($J,"RCERA_LIST") S VALMQUIT=""
Q
;
HDR ; Header for ERA Worklist (List user Current Screen View selections)
; Input: ^TMP("RCERA_PARAMS",$J)
; Output: VALMHDR
N X,XX,XX2
;
; PRCA*4.5*321 - Total re-write of header subroutine to add new filters and shorten lines etc.
; First header line. Date range and Pharmacy/Tricare/Medical
S X=$G(^TMP("RCERA_PARAMS",$J,"RCDT"))
S XX="DATE RANGE : "
I $P(X,U) D ;
. S XX=XX_$$FMTE^XLFDT($P(X,U),2)
. I $P(X,U,2) S XX=XX_"-"_$$FMTE^XLFDT($P(X,U,2),2)
E S XX=XX_"NONE SELECTED"
S X=$G(^TMP("RCERA_PARAMS",$J,"RCTYPE"))
S XX2="MED/PHARM/TRIC/CHAMPVA: " ; PRCA*4.5*332 ;PRCA*4.5*432 CHAMPVA
S XX2=XX2_$S(X="M":"MEDICAL ONLY",X="P":"PHARMACY ONLY",X="T":"TRICARE ONLY",X="C":"CHAMPVA ONLY",1:"ALL") ;PRCA*4.5*432 CHAMPVA
S XX=$$SETSTR^VALM1(XX2,XX,36,41) ;PRCA*4.5*432 40->36
S VALMHDR(1)=XX
;
; Second header line. Match/Unmatched and Auto-posting/Non Autoposting
S X=$G(^TMP("RCERA_PARAMS",$J,"RCMATCH"))
S XX="MATCH STATUS: "_$S(X="N":"NOT MATCHED",X="M":"MATCHED",1:"BOTH")
S X=$G(^TMP("RCERA_PARAMS",$J,"RCAUTOP"))
S XX2="AUTO-POSTING: "
S XX2=XX2_$S(X="A":"AUTO-POSTING ONLY",X="N":"NON AUTO-POSTING ONLY",1:"BOTH")
S XX=$$SETSTR^VALM1(XX2,XX,46,35)
; BEGIN PRCA*4.5*326
I X'="N" D
.S X=$G(^TMP("RCERA_PARAMS",$J,"RCAPSTA"))
.S XX2="AUTOP: "_$S(X="P":"PARTIAL",X="C":"COMPLETE",X="M":"MARKED",1:"ALL")
.S XX=$$SETSTR^VALM1(XX2,XX,27,15)
; END PRCA*4.5*326
S VALMHDR(2)=XX
;
; Third header line. Post status, payer name range and zero payment/payment
S X=$G(^TMP("RCERA_PARAMS",$J,"RCPOST"))
S XX="POST STATUS : "_$S(X="U":"UNPOSTED",X="P":"POSTED",1:"BOTH")
S X=$G(^TMP("RCERA_PARAMS",$J,"RCPAYR"))
I $P(X,U)="A"!(X="") D ;
. S XX2="ALL PAYERS"
E D ;
. S XX2=$P(X,U,2)_"-"_$P(X,U,3)
. I $L(XX2)>11 S XX2="RANGE"
S XX2="PAYERS: "_XX2
S XX=$$SETSTR^VALM1(XX2,XX,26,20)
S X=$G(^TMP("RCERA_PARAMS",$J,"RCPAYMNT"))
S XX2="PAYMENT TYPE: "
S XX2=XX2_$S(X="Z":"ZERO PAYMENTS ONLY",X="P":"PAYMENTS ONLY",1:"BOTH")
S XX=$$SETSTR^VALM1(XX2,XX,46,35)
S VALMHDR(3)=XX
;
S VALMHDR(4)="# ERA # Trace#"
Q
;
FNL ; -- Clean up list
K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP("RCERA_PARAMS",$J),^TMP($J,"RCERA_LIST")
Q
;
SET(X,RCSEQ,RCSEQ1) ; -- set arrays
; X = the data to set into the global
; RCSEQ = the selectable line #
; RCSEQ1 = the ien of the entry in file 344.4
S VALMCNT=VALMCNT+1,^TMP("RCDPE-ERA_WL",$J,VALMCNT,0)=X
I $G(RCSEQ) S ^TMP("RCDPE-ERA_WL",$J,"IDX",VALMCNT,RCSEQ)=$G(RCSEQ1)
I $G(RCSEQ1) S ^TMP("RCDPE-ERA_WLDX",$J,RCSEQ)=VALMCNT_U_RCSEQ1
Q
;
ENTERWL ; Enter the worklist with an ERA
D WL($$SEL())
D BLD($G(^TMP("RCERA_PARAMS",$J,"SORT")))
S VALMBCK="R"
Q
;
SEL() ; Select an ERA from the ERA list
N RCDA,VALMY
D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)),"S")
S RCERA=0
S RCDA=0 F S RCDA=$O(VALMY(RCDA)) Q:'RCDA S RCERA=+$P($G(^TMP("RCDPE-ERA_WLDX",$J,RCDA)),U,2)
;
Q RCERA
;
WL(RCERA) ; Enter worklist
;
; input - RCERA = ien of the ERA entry in file 344.4
;
N DA,DIE,DIR,DR,DTOUT,DUOUT,I,PREVENT,RC0,RCNOED,RCQUIT,RCSORT,RCEXC,RETCODES,STATE,TYPE,X,Y
Q:RCERA'>0
; PRCA*4.5*304 - Reentry if we cleared exceptions
WL1 ; retest to make sure this ERA does not have an exception
S TYPE=$S($$PAYTYPE(RCERA,"P"):"P",1:"M"),RCEXC=0 ; PRCA*4.5*321
; PRCA*4.5*304 - see if we have the ERA and go to WL1 to retest.
I ($$XCEPT^RCDPEWLP(RCERA)]"")&(TYPE="M") D EXCDENY^RCDPEWLP Q ;cannot process MEDICAL ERA if exception exists then fall back to Worklist.
; PRCA*4.5*304 - Removed the G:($G(RCERA)'="")&&($G(RCEXC)=1) WL1 from above so it falls back to the worklist instead of going forward to the "Select ERA"
; I ($$XCEPT^RCDPEWLP(RCERA)]"")&(TYPE="M") D EXCDENY^RCDPEWLP G:($G(RCERA)'="")&&($G(RCEXC)=1) WL1 Q
S (RCQUIT,RCNOED,PREVENT)=0,RC0=$G(^RCY(344.4,RCERA,0)),RCSORT=""
I $P(RC0,U,8) D
. I '$D(^RCY(344.49,RCERA,0)) D Q
.. S RCQUIT=1
.. W ! S DIR(0)="EA",DIR("A",1)="A SCRATCH PAD WAS NOT CREATED FOR THIS ERA BEFORE POSTING",DIR("A",2)="USE THE VIEW/PRINT ERA OPTION TO SEE ITS DETAIL",DIR("A")="Press ENTER to continue: " D ^DIR K DIR Q
. ;
. S RCNOED=+$P(RC0,U,8)
. S DIR(0)="EA",DIR("A",1)="THIS ERA ALREADY HAS A RECEIPT - YOU MAY ONLY VIEW ITS SCRATCH PAD",DIR("A")="Press ENTER to continue: "
. W ! D ^DIR K DIR W !
G:RCQUIT WLQ
G:RCNOED WLD ; already has a receipt so no need to check for older unposted EFTs
; function $$AGEDEFTS - search for any UNPOSTED EFTs older than 14 days (medical) or 30 days (pharmacy)
; return value of 0, 2, or 3 represent that entry into scratchpad can occur
S TYPE=$S(TYPE="P":"P",$$PAYTYPE(RCERA,"T"):"T",1:"M") ; PRCA*4.5*332
S RETCODES=$$AGEDEFTS^RCDPEWLP(RCERA,TYPE) ; PRCA*4.5*332
S PREVENT=0
F I=1:1 S STATE=$P(RETCODES,U,I) Q:STATE="" I $E(STATE,2)=TYPE,$E(STATE,1)=1 S PREVENT=1 ; PRCA*4.5*332
Q:PREVENT ; prevent user from entering scratchpad; there are older EFTs on the system that need to be worked.
WLD ;
D DISP^RCDPEWL(RCERA,RCNOED)
;
; prca*4.5*298 per patch requirements, keep code related to
; creating/maintaining batches but just remove from execution.
;I 'RCQUIT,$G(^TMP("RCBATCH_SELECTED",$J)) D
;. S DA(1)=RCERA,DA=+$G(^TMP("RCBATCH_SELECTED",$J)),DR=".05////0",DIE="^RCY(344.49,"_DA(1)_",3," D ^DIE
;. L -^RCY(344.49,DA(1),3,DA,0)
;. K ^TMP("RCBATCH_SELECTED",$J)
;E D
;L -^RCY(344.4,RCERA,0)
WLQ ;
L -^RCY(344.4,RCERA,0)
Q
;
PRERA ; View/Print ERA from ERA list menu
N RCSCR
S RCSCR=$$SEL()
I RCSCR>0 D PRERA^RCDPEWL0
S VALMBCK="R"
Q
;
BAT(RCERA) ; Select batch, if needed
; Returns 1 if batch selected OK or no batch needed
; RCERA = ien of entry in file 344.49
N RCINUSE,RCQUIT,RCADJ,RC0,RCOK,DIR,DTOUT,DUOUT,X,Y,Z
K ^TMP("RCBATCH_SELECTED",$J)
S RCOK=1
I '$O(^RCY(344.49,RCERA,3,0)) G BATQ
S RC0=$G(^RCY(344.4,RCERA,0))
S (RCQUIT,RCADJ)=0
I $$HASADJ^RCDPEWL8(RCERA) D
. S RCADJ=1
. S DIR("A",1)="THIS ERA HAS NEGATIVE ADJUSTMENTS THAT NEED TO BE DISTRIBUTED TO OTHER",DIR("A",2)="PAYMENTS ON THE ERA. YOU CANNOT SELECT ANY INDIVIDUAL BATCHES UNTIL",DIR("A",3)="THE DISTRIBUTIONS ARE COMPLETE."
. S DIR("A")="Press ENTER to continue: ",DIR(0)="EA" W ! D ^DIR K DIR
S RCINUSE=+$O(^RCY(344.49,"AINUSE",1,RCERA,0))
I RCINUSE D
. N OK,Z
. Q:RCADJ!$P(RC0,U,8)
. S OK=0 S Z=0 F S Z=$O(^RCY(344.49,RCERA,3,Z)) Q:'Z I '$P($G(^RCY(344.49,RCERA,3,Z,0)),U,5) S OK=1 Q
. I 'OK D Q
.. S DIR("A",1)="ALL BATCHES WITHIN THIS ERA ARE CURRENTLY IN USE - TRY AGAIN LATER",DIR("A")="Press ENTER to continue: ",DIR(0)="EA" W ! D ^DIR K DIR S RCQUIT=1,RCOK=0 Q
. W !!,"AT LEAST 1 BATCH WITHIN THIS ERA IS CURRENTLY IN USE",!,"AT THIS TIME, YOU CAN ONLY ACCESS INDIVIDUAL BATCHES",!
. D SELBAT^RCDPEWL8(RCERA,.RCQUIT)
. I RCQUIT S RCOK=0
E D
. Q:$P(RC0,U,8)!RCADJ ; Always require the entire ERA be used
. S DIR(0)="SA^E:(E)NTIRE ERA;B:(B)ATCH",DIR("A")="DO YOU WANT THE (E)NTIRE ERA OR JUST A (B)ATCH?: " W ! D ^DIR K DIR
. I $D(DTOUT)!$D(DUOUT) S RCQUIT=1,RCOK=0 Q
. I Y="E" D Q
.. S RCQUIT=1 F Z=1:1:2 L +^RCY(344.4,RCERA,0):5 I $T S RCQUIT=0 Q
.. I RCQUIT S RCOK=0,DIR(0)="EA",DIR("A",1)="ANOTHER USER IS CURRENTLY USING THIS ERA, TRY AGAIN LATER",DIR("A")="Press ENTER to continue: " W ! D ^DIR K DIR Q
. D SELBAT^RCDPEWL8(RCERA,.RCQUIT)
. I RCQUIT S RCOK=0
;
BATQ Q RCOK
;
PAYTYPE(IEN,TYPE) ; EP - New way to tell if a payer is pharamcy, Tricare or medical - Added for PRCA*4.5*321
; Input: IEN - Internal entry number of an ERA (#344.4)
; TYPE="P" - Pharmacy, "T" - Tricare, "M" - Medical, "C" - CHAMPVA
; ("M" is neither pharmacy nor Tricare nor CHAMPVA)
; Return: 1 - Payer on ERA matches the TYPE
; 0 - Payer on ERA does not match the type. Or can't find payer.
;
N FLAG,RETURN
S RETURN=0
I '$$PAYFLAGS(IEN,.FLAG) Q 0
I TYPE="P",FLAG("P") S RETURN=1
I TYPE="T",FLAG("T") S RETURN=1
I TYPE="C",FLAG("C") S RETURN=1 ;PRCA*4.5*432 CHAMPVA
I TYPE="M",'FLAG("P"),'FLAG("T"),'FLAG("C") S RETURN=1 ;PRCA*4.5*432 CHAMPVA
Q RETURN
;
PAYFLAGS(IEN,FLAG) ; EP - Return the pharmacy and tricare flags for an ERA
; Input: IEN - Internal entry number of an ERA (#344.4)
; Return: 1 - Payer found
; 0 - Can't find payer.
; Variable FLAG passed by reference to return values of the pharmacy, Tricare, and CHAMPVA flags.
;
N RCINS,RCPAYIEN,RCTIN,X
S RCTIN=$$GET1^DIQ(344.4,IEN_",",.03)
I RCTIN="" Q 0
S RCINS=$$GET1^DIQ(344.4,IEN_",",.06)
I RCINS="" Q 0
;
; Find a payer that matches both TIN and PAYER NAME from the ERA
S RCPAYIEN=""
S X=0
F S X=$O(^RCY(344.6,"C",RCTIN_" ",X)) Q:'X D Q:RCPAYIEN ;
. N PAYNAME
. S PAYNAME=$$GET1^DIQ(344.6,X_",",.01)
. I PAYNAME=RCINS S RCPAYIEN=X
I 'RCPAYIEN Q 0
;
S FLAG("P")=+$$GET1^DIQ(344.6,RCPAYIEN_",",.09,"I")
S FLAG("T")=+$$GET1^DIQ(344.6,RCPAYIEN_",",.1,"I")
S FLAG("C")=+$$GET1^DIQ(344.6,RCPAYIEN_",",.15,"I") ;PRCA*4.5*432 CHAMPVA
Q 1
;
; BEGIN PRCA*4.5*326
HELP ; list manager help
D FULL^VALM1
S VALMBCK="R"
W @IOF
W !,"ePay Electronic Remittance Advice Status"
W !!,"The following ERA Status indicators may appear to the left of ERA number:",!
;
W !," '-' = No scratchpad."
W !," 'x' = EXC exceptions exist."
W !," 'c' = No-pay ERA with auto-decrease CARCs."
W !," 'A' = Auto-post complete."
W !," 'P' = Auto-post partially completed."
W !," 'M' = Marked for Auto-post, waiting processing."
D PAUSE^VALM1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEWL7 17210 printed Dec 13, 2024@01:45:46 Page 2
RCDPEWL7 ;ALB/TMK/KML - EDI LOCKBOX WORKLIST ERA DISPLAY SCREEN ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**208,222,269,276,298,304,318,321,326,332,349,432**;Mar 20, 1995;Build 16
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
BLD(RCSORT) ; Build list with sort criteria
+1 ; RCSORT = the sort levels to use to display the data in ^ pieces
+2 ; piece 1 = the codes for the first level sort (sort code;null or -)
+3 ; piece 2 = the codes for the second level sort
+4 ; sort code is the type of data to sort by;- indicates reverse order
+5 NEW Z,Z1,RCT,RCZ
+6 SET (RCT,VALMCNT)=0
+7 IF '$DATA(^TMP($JOB,"RCERA_LIST"))
Begin DoDot:1
+8 SET Z=0
FOR
SET Z=$ORDER(^TMP("RCDPE-ERA_WLDX",$JOB,Z))
if 'Z
QUIT
SET RCZ=$PIECE($GET(^(Z)),U,2)
Begin DoDot:2
+9 IF $$FILTER^RCDPEWLD(RCZ)
SET ^TMP($JOB,"RCERA_LIST",$$SL(RCZ,$PIECE(RCSORT,U)),$$SL(RCZ,$PIECE(RCSORT,U,2)),RCZ)=""
End DoDot:2
+10 KILL ^TMP("RCDPE-ERA_WLDX",$JOB),^TMP("RCDPE-ERA_WL",$JOB)
End DoDot:1
+11 ;
+12 SET Z=""
+13 IF RCSORT'["PN;-"
Begin DoDot:1
+14 FOR
SET Z=$ORDER(^TMP($JOB,"RCERA_LIST",Z))
if Z=""
QUIT
SET Z1=""
FOR
SET Z1=$ORDER(^TMP($JOB,"RCERA_LIST",Z,Z1))
if Z1=""
QUIT
DO EXTRACT(Z,Z1,.RCT)
End DoDot:1
+15 ;
+16 IF $PIECE(RCSORT,U)["PN;-"
Begin DoDot:1
+17 FOR
SET Z=$ORDER(^TMP($JOB,"RCERA_LIST",Z),-1)
if Z=""
QUIT
SET Z1=""
FOR
SET Z1=$ORDER(^TMP($JOB,"RCERA_LIST",Z,Z1))
if Z1=""
QUIT
DO EXTRACT(Z,Z1,.RCT)
End DoDot:1
+18 ;
+19 IF $PIECE(RCSORT,U,2)["PN;-"
Begin DoDot:1
+20 FOR
SET Z=$ORDER(^TMP($JOB,"RCERA_LIST",Z))
if Z=""
QUIT
SET Z1=""
FOR
SET Z1=$ORDER(^TMP($JOB,"RCERA_LIST",Z,Z1),-1)
if Z1=""
QUIT
DO EXTRACT(Z,Z1,.RCT)
End DoDot:1
+21 ;
+22 IF '$ORDER(^TMP($JOB,"RCERA_LIST",0))
DO SET("No ERAs left for your selection criteria")
+23 KILL ^TMP($JOB,"RCERA_LIST")
+24 SET ^TMP("RCERA_PARAMS",$JOB,"SORT")=RCSORT
+25 QUIT
+26 ;
+1 ; RCSRT1 = data value at 1st sort level
+2 ; RCSRT2 = data value at 2nd sort level
+3 ; RCT = running entry counter - returned if passed by ref
+4 ;PRCA*4.5*318 Variable XX added
NEW AUTOCOMP,FIRST,MDT,RC0,RCARC,RCEFT,RCEXCEP,RCPOST,RCSTAT,RCZ,X,XX,Z,Z0
+5 SET RCZ=0
FOR
SET RCZ=$ORDER(^TMP($JOB,"RCERA_LIST",RCSRT1,RCSRT2,RCZ))
if 'RCZ
QUIT
Begin DoDot:1
+6 SET RCT=RCT+1
SET RC0=$GET(^RCY(344.4,RCZ,0))
+7 SET RCEFT=+$ORDER(^RCY(344.31,"AERA",RCZ,0))
+8 ; PRCA*4.5*326 - Add date matched
SET MDT=$$MATCHDT^RCDPEWL7(RCEFT,"2D")
+9 ; prca*4.5*298 assignment of ERA exception flag
SET RCEXCEP=$$XCEPT^RCDPEWLP(RCZ)
+10 ;PRCA*4.5*326
SET AUTOCOMP=$$STA(RCZ)
+11 SET RCARC=$$WLF^RCDPEWLZ(RCZ)
+12 SET RCSTAT=$SELECT('RCEFT:U_$SELECT($PIECE(RC0,U,15)="CHK":"(CHECK PAYMENT EXPECTED)",$PIECE(RC0,U,15)="NON":"(NO PAYMENT EXPECTED)",$PIECE(RC0,U,9)=2:"(CHECK PAYMENT CHOSEN)",1:"N/A"),1:$$FMSSTAT^RCDPUREC(+$PIECE($GET(^RCY(344.31,RCEFT
,0)),U,9)))
+13 SET RCPOST=$SELECT(RCEFT:"EFT RECEIPT STATUS: ",1:"")_$PIECE(RCSTAT,U,2)
+14 ;prca*4.5*298 include Auto-Post Complete indicator and ERA exception flag in $SELECT statement
+15 SET X=$EXTRACT(RCT_$JUSTIFY("",5),1,5)_" "_$SELECT(RCEXCEP]"":RCEXCEP,AUTOCOMP]"":AUTOCOMP,RCARC]"":RCARC,$DATA(^RCY(344.49,RCZ)):" ",1:"-")_$EXTRACT($PIECE(RC0,U)_$JUSTIFY("",10),1,10)_" "_$EXTRACT($PIECE(RC0,U,2)_$JUSTIFY("",50),1,5
0)
+16 DO SET(X,RCT,RCZ)
+17 SET X=$JUSTIFY("",43)_$JUSTIFY($$FMTE^XLFDT($PIECE(RC0,U,7),"2D"),8)_$JUSTIFY("",2)_$JUSTIFY(+$PIECE(RC0,U,5),12,2)
+18 SET $EXTRACT(X,73,80)=$$FMTE^XLFDT($PIECE(RC0,U,7),"2D")
+19 DO SET(X,RCT,RCZ)
+20 ; PRCA*4.5*326 Start changed block
+21 SET X=$JUSTIFY("",8)_$EXTRACT($PIECE(RC0,U,6)_$JUSTIFY("",30),1,30)_" APPROX # EEOBs: "_+$$CTEEOB^RCDPEWLB(RCZ)
+22 DO SET(X,RCT,RCZ)
+23 SET X=$PIECE(RC0,U,9)
SET XX=$$EXTERNAL^DILFD(344.4,.09,"",$PIECE(RC0,U,9))
+24 SET XX=$SELECT(X=1:"EFT MATCHED",X=2:"CHK MATCHED",X=3:"MATCH-0 PAY",XX=-1:"MATCH W/ERR",1:$PIECE(XX," ",1))
+25 IF X=2
SET MDT=$$GET1^DIQ(344.4,RCZ_",",5.03,"I")
IF MDT'=""
SET MDT=$$FMTE^XLFDT(MDT,"2D")
+26 if $$UNBAL^RCDPEAP1(RCZ)
SET XX=XX_" - UNBALANCED"
+27 SET X=$JUSTIFY("",8)_$EXTRACT(XX_$JUSTIFY("",25),1,25)_" "_$EXTRACT(MDT_$JUSTIFY("",8),1,8)
+28 SET X=X_" "_RCPOST
+29 ; PRCA*4.5*326 End changed block
+30 DO SET(X,RCT)
+31 DO SET(" ",RCT)
End DoDot:1
+32 ;.; prca*4.5*298 per patch requirements, keep code related to
+33 ;. ; creating/maintaining batches but just remove from execution.
+34 ;. ;I $G(^TMP("RCERA_PARAMS",$J,"BATCHON")) D
+35 ;.. ;S Z=0 F S Z=$O(^RCY(344.49,RCZ,3,Z)) Q:'Z S Z0=$G(^(Z,0)) I Z0'="" D
+36 ;...; S X=$J("",12)_$E("- BATCH #"_$P(Z0,U)_$J("",4),1,13)_" "_$E($P(Z0,U,2)_$J("",30),1,30)_" "_$S('$P(Z0,U,3):"NOT ",1:"")_"READY TO POST"
+37 ;... ;D SET(X,RCT)
+38 ;
+39 ; PRCA*4.5*326
SET VALMSG="Enter ?? for more actions and help"
+40 ;
+41 QUIT
+42 ;
+43 ; BEGIN PRCA*4.5*326
STA(RCZ) ;Determine auto-post status and if marked for auto-post
+1 ; Input - RCZ = ERA ien
+2 ; Output - "" = UNPOSTED
+3 ; "A" = COMPLETE
+4 ; "P" = PARTIAL
+5 ; "M" = MARKED
+6 NEW STA
+7 ;Get ERA auto-post status
+8 SET STA=$$GET1^DIQ(344.4,RCZ_",",4.02,"I")
+9 ;Not auto-post ERA
+10 if STA=""
QUIT ""
+11 ;Unposted but marked for autopost
+12 IF STA=0
IF $$GET1^DIQ(344.4,RCZ_",",4.04,"I")]""
QUIT "M"
+13 ;Unposted - EFT still not accepted
+14 if STA=0
QUIT ""
+15 ;Complete
+16 if STA=2
QUIT "A"
+17 ;Partial
+18 NEW MATCH,SUB
+19 SET MATCH=0
SET SUB=0
+20 FOR
SET SUB=$ORDER(^RCY(344.4,RCZ,1,SUB))
if 'SUB
QUIT
Begin DoDot:1
+21 SET MATCH=$$GET1^DIQ(344.41,SUB_","_RCZ,6,"I")
End DoDot:1
if MATCH
QUIT
+22 QUIT $SELECT(MATCH:"M",1:"P")
+23 ; END PRCA*4.5*326
+24 ;
MATCHDT(RCEFT,FORMAT) ;EP
+1 ; Get the Date the ERA was matched
+2 ; Input: RCEFT - IEN for file 344.31
+3 ; FORMAT - (Optional) date format for second parameter of FMTE^XLFDT (Defaults to 2DZ)
+4 ; Returns: External date when the ERA was matched or ""
+5 IF '$GET(RCEFT)
QUIT ""
+6 NEW IENS,XX
+7 IF $GET(FORMAT)=""
SET FORMAT="2DZ"
+8 ; Get last Match Status History record
SET XX=$ORDER(^RCY(344.31,RCEFT,4,"A"),-1)
+9 if XX=""
QUIT ""
+10 SET IENS=XX_","_RCEFT_","
+11 SET XX=$$GET1^DIQ(344.314,IENS,.02,"I")
+12 if XX=""
QUIT ""
+13 SET XX=$$FMTE^XLFDT(XX,FORMAT)
+14 QUIT XX
+15 ;
SL(Y,SORT) ; Returns data for sort level from entry Y in file 344.4
+1 ; SORT = the sort data in ';' delimited pieces
+2 ; pc 1 = code for sort data
+3 ; pc 2 = the order requested (- or null)
+4 ;
+5 NEW RC0,DAT,SORT1,SORT2
+6 SET SORT1=$PIECE(SORT,";")
SET SORT2=$PIECE(SORT,";",2)
+7 SET RC0=$GET(^RCY(344.4,Y,0))
SET DAT=" "
+8 ; No sort
+9 IF SORT=""
GOTO SLQ
+10 ; Amt paid
+11 IF SORT1="AP"
Begin DoDot:1
+12 SET DAT=SORT2_+$PIECE(RC0,U,5)
End DoDot:1
GOTO SLQ
+13 ; ERA date pd
+14 IF SORT1="DP"
Begin DoDot:1
+15 SET DAT=SORT2_($PIECE(RC0,U,4)\1)
End DoDot:1
GOTO SLQ
+16 ; Payer name
+17 IF SORT1="PN"
Begin DoDot:1
+18 SET DAT=$$UP^RCDPEARL($PIECE(RC0,U,6))
End DoDot:1
GOTO SLQ
+19 ; ERA date received
+20 IF SORT1="DR"
Begin DoDot:1
+21 SET DAT=SORT2_($PIECE(RC0,U,7)\1)
End DoDot:1
GOTO SLQ
+22 ;
SLQ QUIT $SELECT(DAT'="":DAT,1:" ")
+1 ;
INIT ; Entry point for List template to build the display of ERAs
+1 ;
+2 ; Parameters for selecting ERAs to be included in the list are
+3 ; contained in the global ^TMP("RCERA_PARAMS",$J,parameter name)
+4 ;
+5 NEW RCZ,RC0,RCT,RCTT,RCQUIT,RCDTFR,RCDTTO,DTOUT,DUOUT,DIR,X,Y,Z,Z1,RCPOST,RCEFT,RCINDX,QFLG
+6 DO CLEAN^VALM10
+7 KILL ^TMP("RCDPE-ERA_WL",$JOB),^TMP("RCDPE-ERA_WLDX",$JOB),^TMP($JOB,"RCERA_LIST")
+8 ;
+9 SET (RCT,RCTT,RCQUIT)=0
+10 ;
+11 SET RCDTFR=+$PIECE($GET(^TMP("RCERA_PARAMS",$JOB,"RCDT")),U)
SET RCDTTO=$SELECT($PIECE($GET(^TMP("RCERA_PARAMS",$JOB,"RCDT")),U,2):$PIECE(^("RCDT"),U,2),1:DT)
+12 ;
+13 SET RCINDX=$SELECT(RCDTFR:RCDTFR-.00000001,1:0)
+14 WRITE !!,"SEARCHING, PLEASE STANDBY (PRESS '^' TO QUIT SEARCH)",!!
+15 FOR
SET RCINDX=$ORDER(^RCY(344.4,"AFD",RCINDX))
if 'RCINDX!(RCINDX\1>RCDTTO)!RCQUIT
QUIT
SET RCZ=0
FOR
SET RCZ=$ORDER(^RCY(344.4,"AFD",RCINDX,RCZ))
if 'RCZ
QUIT
Begin DoDot:1
+16 SET RCTT=RCTT+1
+17 IF RCTT>19999
Begin DoDot:2
+18 SET RCTT=0
+19 DO WAIT^DICD
+20 ; supported by DBIA 3173
DO INITKB^XGF
+21 SET QFLG=$$READ^XGF(1,1)
+22 if $GET(DTOUT)
QUIT
+23 if QFLG="^"
SET RCQUIT=1
QUIT
+24 IF $DATA(DUOUT)!(Y=0)
SET RCQUIT=1
QUIT
+25 DO RESETKB^XGF
End DoDot:2
if RCQUIT=1
QUIT
+26 ;
+27 SET RC0=$GET(^RCY(344.4,RCZ,0))
+28 IF $$FILTER^RCDPEWLD(RCZ)
SET ^TMP($JOB,"RCERA_LIST",$$SL(RCZ,"DR"),$$SL(RCZ,""),RCZ)=""
End DoDot:1
if RCQUIT
QUIT
+29 ;
+30 ; Output the list
+31 IF 'RCQUIT
Begin DoDot:1
+32 if $DATA(^TMP($JOB,"RCERA_LIST"))
DO BLD("DR^N")
+33 ; If no ERAs found display the message below in the list area
+34 IF '$ORDER(^TMP("RCDPE-ERA_WL",$JOB,0))
Begin DoDot:2
+35 SET ^TMP("RCDPE-ERA_WL",$JOB,1,0)="THERE ARE NO ERAs MATCHING YOUR SELECTION CRITERIA"
+36 ; PRCA*4.5*349 - VALMCNT set correctly to indicate 1 item instead of 2
SET VALMCNT=1
End DoDot:2
End DoDot:1
+37 IF RCQUIT
KILL ^TMP("RCDPE-ERA_WL",$JOB),^TMP("RCDPE-ERA_WLDX",$JOB),^TMP($JOB,"RCERA_LIST")
SET VALMQUIT=""
+38 QUIT
+39 ;
HDR ; Header for ERA Worklist (List user Current Screen View selections)
+1 ; Input: ^TMP("RCERA_PARAMS",$J)
+2 ; Output: VALMHDR
+3 NEW X,XX,XX2
+4 ;
+5 ; PRCA*4.5*321 - Total re-write of header subroutine to add new filters and shorten lines etc.
+6 ; First header line. Date range and Pharmacy/Tricare/Medical
+7 SET X=$GET(^TMP("RCERA_PARAMS",$JOB,"RCDT"))
+8 SET XX="DATE RANGE : "
+9 ;
IF $PIECE(X,U)
Begin DoDot:1
+10 SET XX=XX_$$FMTE^XLFDT($PIECE(X,U),2)
+11 IF $PIECE(X,U,2)
SET XX=XX_"-"_$$FMTE^XLFDT($PIECE(X,U,2),2)
End DoDot:1
+12 IF '$TEST
SET XX=XX_"NONE SELECTED"
+13 SET X=$GET(^TMP("RCERA_PARAMS",$JOB,"RCTYPE"))
+14 ; PRCA*4.5*332 ;PRCA*4.5*432 CHAMPVA
SET XX2="MED/PHARM/TRIC/CHAMPVA: "
+15 ;PRCA*4.5*432 CHAMPVA
SET XX2=XX2_$SELECT(X="M":"MEDICAL ONLY",X="P":"PHARMACY ONLY",X="T":"TRICARE ONLY",X="C":"CHAMPVA ONLY",1:"ALL")
+16 ;PRCA*4.5*432 40->36
SET XX=$$SETSTR^VALM1(XX2,XX,36,41)
+17 SET VALMHDR(1)=XX
+18 ;
+19 ; Second header line. Match/Unmatched and Auto-posting/Non Autoposting
+20 SET X=$GET(^TMP("RCERA_PARAMS",$JOB,"RCMATCH"))
+21 SET XX="MATCH STATUS: "_$SELECT(X="N":"NOT MATCHED",X="M":"MATCHED",1:"BOTH")
+22 SET X=$GET(^TMP("RCERA_PARAMS",$JOB,"RCAUTOP"))
+23 SET XX2="AUTO-POSTING: "
+24 SET XX2=XX2_$SELECT(X="A":"AUTO-POSTING ONLY",X="N":"NON AUTO-POSTING ONLY",1:"BOTH")
+25 SET XX=$$SETSTR^VALM1(XX2,XX,46,35)
+26 ; BEGIN PRCA*4.5*326
+27 IF X'="N"
Begin DoDot:1
+28 SET X=$GET(^TMP("RCERA_PARAMS",$JOB,"RCAPSTA"))
+29 SET XX2="AUTOP: "_$SELECT(X="P":"PARTIAL",X="C":"COMPLETE",X="M":"MARKED",1:"ALL")
+30 SET XX=$$SETSTR^VALM1(XX2,XX,27,15)
End DoDot:1
+31 ; END PRCA*4.5*326
+32 SET VALMHDR(2)=XX
+33 ;
+34 ; Third header line. Post status, payer name range and zero payment/payment
+35 SET X=$GET(^TMP("RCERA_PARAMS",$JOB,"RCPOST"))
+36 SET XX="POST STATUS : "_$SELECT(X="U":"UNPOSTED",X="P":"POSTED",1:"BOTH")
+37 SET X=$GET(^TMP("RCERA_PARAMS",$JOB,"RCPAYR"))
+38 ;
IF $PIECE(X,U)="A"!(X="")
Begin DoDot:1
+39 SET XX2="ALL PAYERS"
End DoDot:1
+40 ;
IF '$TEST
Begin DoDot:1
+41 SET XX2=$PIECE(X,U,2)_"-"_$PIECE(X,U,3)
+42 IF $LENGTH(XX2)>11
SET XX2="RANGE"
End DoDot:1
+43 SET XX2="PAYERS: "_XX2
+44 SET XX=$$SETSTR^VALM1(XX2,XX,26,20)
+45 SET X=$GET(^TMP("RCERA_PARAMS",$JOB,"RCPAYMNT"))
+46 SET XX2="PAYMENT TYPE: "
+47 SET XX2=XX2_$SELECT(X="Z":"ZERO PAYMENTS ONLY",X="P":"PAYMENTS ONLY",1:"BOTH")
+48 SET XX=$$SETSTR^VALM1(XX2,XX,46,35)
+49 SET VALMHDR(3)=XX
+50 ;
+51 SET VALMHDR(4)="# ERA # Trace#"
+52 QUIT
+53 ;
FNL ; -- Clean up list
+1 KILL ^TMP("RCDPE-ERA_WL",$JOB),^TMP("RCDPE-ERA_WLDX",$JOB),^TMP("RCERA_PARAMS",$JOB),^TMP($JOB,"RCERA_LIST")
+2 QUIT
+3 ;
SET(X,RCSEQ,RCSEQ1) ; -- set arrays
+1 ; X = the data to set into the global
+2 ; RCSEQ = the selectable line #
+3 ; RCSEQ1 = the ien of the entry in file 344.4
+4 SET VALMCNT=VALMCNT+1
SET ^TMP("RCDPE-ERA_WL",$JOB,VALMCNT,0)=X
+5 IF $GET(RCSEQ)
SET ^TMP("RCDPE-ERA_WL",$JOB,"IDX",VALMCNT,RCSEQ)=$GET(RCSEQ1)
+6 IF $GET(RCSEQ1)
SET ^TMP("RCDPE-ERA_WLDX",$JOB,RCSEQ)=VALMCNT_U_RCSEQ1
+7 QUIT
+8 ;
ENTERWL ; Enter the worklist with an ERA
+1 DO WL($$SEL())
+2 DO BLD($GET(^TMP("RCERA_PARAMS",$JOB,"SORT")))
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
SEL() ; Select an ERA from the ERA list
+1 NEW RCDA,VALMY
+2 DO FULL^VALM1
+3 DO EN^VALM2($GET(XQORNOD(0)),"S")
+4 SET RCERA=0
+5 SET RCDA=0
FOR
SET RCDA=$ORDER(VALMY(RCDA))
if 'RCDA
QUIT
SET RCERA=+$PIECE($GET(^TMP("RCDPE-ERA_WLDX",$JOB,RCDA)),U,2)
+6 ;
+7 QUIT RCERA
+8 ;
WL(RCERA) ; Enter worklist
+1 ;
+2 ; input - RCERA = ien of the ERA entry in file 344.4
+3 ;
+4 NEW DA,DIE,DIR,DR,DTOUT,DUOUT,I,PREVENT,RC0,RCNOED,RCQUIT,RCSORT,RCEXC,RETCODES,STATE,TYPE,X,Y
+5 if RCERA'>0
QUIT
+6 ; PRCA*4.5*304 - Reentry if we cleared exceptions
WL1 ; retest to make sure this ERA does not have an exception
+1 ; PRCA*4.5*321
SET TYPE=$SELECT($$PAYTYPE(RCERA,"P"):"P",1:"M")
SET RCEXC=0
+2 ; PRCA*4.5*304 - see if we have the ERA and go to WL1 to retest.
+3 ;cannot process MEDICAL ERA if exception exists then fall back to Worklist.
IF ($$XCEPT^RCDPEWLP(RCERA)]"")&(TYPE="M")
DO EXCDENY^RCDPEWLP
QUIT
+4 ; PRCA*4.5*304 - Removed the G:($G(RCERA)'="")&&($G(RCEXC)=1) WL1 from above so it falls back to the worklist instead of going forward to the "Select ERA"
+5 ; I ($$XCEPT^RCDPEWLP(RCERA)]"")&(TYPE="M") D EXCDENY^RCDPEWLP G:($G(RCERA)'="")&&($G(RCEXC)=1) WL1 Q
+6 SET (RCQUIT,RCNOED,PREVENT)=0
SET RC0=$GET(^RCY(344.4,RCERA,0))
SET RCSORT=""
+7 IF $PIECE(RC0,U,8)
Begin DoDot:1
+8 IF '$DATA(^RCY(344.49,RCERA,0))
Begin DoDot:2
+9 SET RCQUIT=1
+10 WRITE !
SET DIR(0)="EA"
SET DIR("A",1)="A SCRATCH PAD WAS NOT CREATED FOR THIS ERA BEFORE POSTING"
SET DIR("A",2)="USE THE VIEW/PRINT ERA OPTION TO SEE ITS DETAIL"
SET DIR("A")="Press ENTER to continue: "
DO ^DIR
KILL DIR
QUIT
End DoDot:2
QUIT
+11 ;
+12 SET RCNOED=+$PIECE(RC0,U,8)
+13 SET DIR(0)="EA"
SET DIR("A",1)="THIS ERA ALREADY HAS A RECEIPT - YOU MAY ONLY VIEW ITS SCRATCH PAD"
SET DIR("A")="Press ENTER to continue: "
+14 WRITE !
DO ^DIR
KILL DIR
WRITE !
End DoDot:1
+15 if RCQUIT
GOTO WLQ
+16 ; already has a receipt so no need to check for older unposted EFTs
if RCNOED
GOTO WLD
+17 ; function $$AGEDEFTS - search for any UNPOSTED EFTs older than 14 days (medical) or 30 days (pharmacy)
+18 ; return value of 0, 2, or 3 represent that entry into scratchpad can occur
+19 ; PRCA*4.5*332
SET TYPE=$SELECT(TYPE="P":"P",$$PAYTYPE(RCERA,"T"):"T",1:"M")
+20 ; PRCA*4.5*332
SET RETCODES=$$AGEDEFTS^RCDPEWLP(RCERA,TYPE)
+21 SET PREVENT=0
+22 ; PRCA*4.5*332
FOR I=1:1
SET STATE=$PIECE(RETCODES,U,I)
if STATE=""
QUIT
IF $EXTRACT(STATE,2)=TYPE
IF $EXTRACT(STATE,1)=1
SET PREVENT=1
+23 ; prevent user from entering scratchpad; there are older EFTs on the system that need to be worked.
if PREVENT
QUIT
WLD ;
+1 DO DISP^RCDPEWL(RCERA,RCNOED)
+2 ;
+3 ; prca*4.5*298 per patch requirements, keep code related to
+4 ; creating/maintaining batches but just remove from execution.
+5 ;I 'RCQUIT,$G(^TMP("RCBATCH_SELECTED",$J)) D
+6 ;. S DA(1)=RCERA,DA=+$G(^TMP("RCBATCH_SELECTED",$J)),DR=".05////0",DIE="^RCY(344.49,"_DA(1)_",3," D ^DIE
+7 ;. L -^RCY(344.49,DA(1),3,DA,0)
+8 ;. K ^TMP("RCBATCH_SELECTED",$J)
+9 ;E D
+10 ;L -^RCY(344.4,RCERA,0)
WLQ ;
+1 LOCK -^RCY(344.4,RCERA,0)
+2 QUIT
+3 ;
PRERA ; View/Print ERA from ERA list menu
+1 NEW RCSCR
+2 SET RCSCR=$$SEL()
+3 IF RCSCR>0
DO PRERA^RCDPEWL0
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
BAT(RCERA) ; Select batch, if needed
+1 ; Returns 1 if batch selected OK or no batch needed
+2 ; RCERA = ien of entry in file 344.49
+3 NEW RCINUSE,RCQUIT,RCADJ,RC0,RCOK,DIR,DTOUT,DUOUT,X,Y,Z
+4 KILL ^TMP("RCBATCH_SELECTED",$JOB)
+5 SET RCOK=1
+6 IF '$ORDER(^RCY(344.49,RCERA,3,0))
GOTO BATQ
+7 SET RC0=$GET(^RCY(344.4,RCERA,0))
+8 SET (RCQUIT,RCADJ)=0
+9 IF $$HASADJ^RCDPEWL8(RCERA)
Begin DoDot:1
+10 SET RCADJ=1
+11 SET DIR("A",1)="THIS ERA HAS NEGATIVE ADJUSTMENTS THAT NEED TO BE DISTRIBUTED TO OTHER"
SET DIR("A",2)="PAYMENTS ON THE ERA. YOU CANNOT SELECT ANY INDIVIDUAL BATCHES UNTIL"
SET DIR("A",3)="THE DISTRIBUTIONS ARE COMPLETE."
+12 SET DIR("A")="Press ENTER to continue: "
SET DIR(0)="EA"
WRITE !
DO ^DIR
KILL DIR
End DoDot:1
+13 SET RCINUSE=+$ORDER(^RCY(344.49,"AINUSE",1,RCERA,0))
+14 IF RCINUSE
Begin DoDot:1
+15 NEW OK,Z
+16 if RCADJ!$PIECE(RC0,U,8)
QUIT
+17 SET OK=0
SET Z=0
FOR
SET Z=$ORDER(^RCY(344.49,RCERA,3,Z))
if 'Z
QUIT
IF '$PIECE($GET(^RCY(344.49,RCERA,3,Z,0)),U,5)
SET OK=1
QUIT
+18 IF 'OK
Begin DoDot:2
+19 SET DIR("A",1)="ALL BATCHES WITHIN THIS ERA ARE CURRENTLY IN USE - TRY AGAIN LATER"
SET DIR("A")="Press ENTER to continue: "
SET DIR(0)="EA"
WRITE !
DO ^DIR
KILL DIR
SET RCQUIT=1
SET RCOK=0
QUIT
End DoDot:2
QUIT
+20 WRITE !!,"AT LEAST 1 BATCH WITHIN THIS ERA IS CURRENTLY IN USE",!,"AT THIS TIME, YOU CAN ONLY ACCESS INDIVIDUAL BATCHES",!
+21 DO SELBAT^RCDPEWL8(RCERA,.RCQUIT)
+22 IF RCQUIT
SET RCOK=0
End DoDot:1
+23 IF '$TEST
Begin DoDot:1
+24 ; Always require the entire ERA be used
if $PIECE(RC0,U,8)!RCADJ
QUIT
+25 SET DIR(0)="SA^E:(E)NTIRE ERA;B:(B)ATCH"
SET DIR("A")="DO YOU WANT THE (E)NTIRE ERA OR JUST A (B)ATCH?: "
WRITE !
DO ^DIR
KILL DIR
+26 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RCQUIT=1
SET RCOK=0
QUIT
+27 IF Y="E"
Begin DoDot:2
+28 SET RCQUIT=1
FOR Z=1:1:2
LOCK +^RCY(344.4,RCERA,0):5
IF $TEST
SET RCQUIT=0
QUIT
+29 IF RCQUIT
SET RCOK=0
SET DIR(0)="EA"
SET DIR("A",1)="ANOTHER USER IS CURRENTLY USING THIS ERA, TRY AGAIN LATER"
SET DIR("A")="Press ENTER to continue: "
WRITE !
DO ^DIR
KILL DIR
QUIT
End DoDot:2
QUIT
+30 DO SELBAT^RCDPEWL8(RCERA,.RCQUIT)
+31 IF RCQUIT
SET RCOK=0
End DoDot:1
+32 ;
BATQ QUIT RCOK
+1 ;
PAYTYPE(IEN,TYPE) ; EP - New way to tell if a payer is pharamcy, Tricare or medical - Added for PRCA*4.5*321
+1 ; Input: IEN - Internal entry number of an ERA (#344.4)
+2 ; TYPE="P" - Pharmacy, "T" - Tricare, "M" - Medical, "C" - CHAMPVA
+3 ; ("M" is neither pharmacy nor Tricare nor CHAMPVA)
+4 ; Return: 1 - Payer on ERA matches the TYPE
+5 ; 0 - Payer on ERA does not match the type. Or can't find payer.
+6 ;
+7 NEW FLAG,RETURN
+8 SET RETURN=0
+9 IF '$$PAYFLAGS(IEN,.FLAG)
QUIT 0
+10 IF TYPE="P"
IF FLAG("P")
SET RETURN=1
+11 IF TYPE="T"
IF FLAG("T")
SET RETURN=1
+12 ;PRCA*4.5*432 CHAMPVA
IF TYPE="C"
IF FLAG("C")
SET RETURN=1
+13 ;PRCA*4.5*432 CHAMPVA
IF TYPE="M"
IF 'FLAG("P")
IF 'FLAG("T")
IF 'FLAG("C")
SET RETURN=1
+14 QUIT RETURN
+15 ;
PAYFLAGS(IEN,FLAG) ; EP - Return the pharmacy and tricare flags for an ERA
+1 ; Input: IEN - Internal entry number of an ERA (#344.4)
+2 ; Return: 1 - Payer found
+3 ; 0 - Can't find payer.
+4 ; Variable FLAG passed by reference to return values of the pharmacy, Tricare, and CHAMPVA flags.
+5 ;
+6 NEW RCINS,RCPAYIEN,RCTIN,X
+7 SET RCTIN=$$GET1^DIQ(344.4,IEN_",",.03)
+8 IF RCTIN=""
QUIT 0
+9 SET RCINS=$$GET1^DIQ(344.4,IEN_",",.06)
+10 IF RCINS=""
QUIT 0
+11 ;
+12 ; Find a payer that matches both TIN and PAYER NAME from the ERA
+13 SET RCPAYIEN=""
+14 SET X=0
+15 ;
FOR
SET X=$ORDER(^RCY(344.6,"C",RCTIN_" ",X))
if 'X
QUIT
Begin DoDot:1
+16 NEW PAYNAME
+17 SET PAYNAME=$$GET1^DIQ(344.6,X_",",.01)
+18 IF PAYNAME=RCINS
SET RCPAYIEN=X
End DoDot:1
if RCPAYIEN
QUIT
+19 IF 'RCPAYIEN
QUIT 0
+20 ;
+21 SET FLAG("P")=+$$GET1^DIQ(344.6,RCPAYIEN_",",.09,"I")
+22 SET FLAG("T")=+$$GET1^DIQ(344.6,RCPAYIEN_",",.1,"I")
+23 ;PRCA*4.5*432 CHAMPVA
SET FLAG("C")=+$$GET1^DIQ(344.6,RCPAYIEN_",",.15,"I")
+24 QUIT 1
+25 ;
+26 ; BEGIN PRCA*4.5*326
HELP ; list manager help
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 WRITE @IOF
+4 WRITE !,"ePay Electronic Remittance Advice Status"
+5 WRITE !!,"The following ERA Status indicators may appear to the left of ERA number:",!
+6 ;
+7 WRITE !," '-' = No scratchpad."
+8 WRITE !," 'x' = EXC exceptions exist."
+9 WRITE !," 'c' = No-pay ERA with auto-decrease CARCs."
+10 WRITE !," 'A' = Auto-post complete."
+11 WRITE !," 'P' = Auto-post partially completed."
+12 WRITE !," 'M' = Marked for Auto-post, waiting processing."
+13 DO PAUSE^VALM1
+14 QUIT
+15 ;
