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