RCDPEWLP ;ALBANY/KML - EDI LOCKBOX ERA and EEOB WORKLIST procedures ; 4/28/22 7:39am
;;4.5;Accounts Receivable;**298,303,304,319,332,345,349,367,411**;Mar 20, 1995;Build 1
;Per VA Directive 6402, this routine should not be modified.
;
Q
;
; PRCA*4.5*298 - handle outstanding EFTs & ERAs with exceptions
; PRCA*4.5*411 - Check if prescription has a 'Delete' status which
; returns a null value to ^TMP("PSOR") array results
; in <undefined> error.
;
AGEDEFTS(ERADA,TYPE) ;function, Search medical or pharmacy aged EFTs that have not been posted
; ENTRY point for the Select ERA action on the ERA Worklist screen
; Input: ERADA - IEN in file 344.4
; TYPE - Medical, Pharmacy or Tricare (M,P, T)
; Returns:
; "1P" Error for aged, unposted pharmacy EFTs
; "2P" Warning for aged,unposted pharmacy EFTs
; "3P" Override exists for aged, unposted pharmacy EFTs
; "1M" Error for aged, unposted medical EFTs
; "2M" Warning for aged, unposted medical EFTs
; "3M" Override exists for aged, unposted medical EFTs
; "1T" Error for aged, unposted Tricare EFTs
; "2T" Warning for aged, unposted Tricare EFTs
; "3T" Override exists for aged, unposted Tricare EFTs
; 0 No error or warning conditions
; NOTE: may be more than one - "1P" or "2P" or "3P" or "3P^2M" or "3P^3M", etc.
;
;for action Select ERA:
; 1. If unposted payments (EFTs) associated with 3rd party Medical claims > than 14 days, display WARNING message for action
; Select ERA on the ERA WORKLIST, allow user to enter the worklist
; 2. If there are unposted payments (EFTs) associated with Pharmacy claims > 21 days, display a WARNING message
; on the ERA WORKLIST, enter worklist
; 3. If there are unposted payments (EFTs) associated with 3rd party Tricare claims
; > 14 calendar days, display WARNING message, enter worklist
; 4. If there are unposted payments (EFTs) associated with 3rd party medical, pharmacy or
; Tricare claims, aged > the number of days in site parameters, display error message
;additional criteria for item 3:
;create scratchpad if:
; 3a. medical ERA is 14 days or older
; 3b. pharmacy ERA is 21 days or older
; 3c. Tricare ERA is 14 days or older
; 3d. If override exists
;DO NOT create scratchpad if no override and:
; 3e. medical ERA received within 14 days and there are aged, unposted EFTs
; 3f. pharmacy ERA received within 21 days and there are aged, unposted EFTs
; 3g. Tricare ERA received within 14 days and there are aged, unposted EFTs
;
;Do not consider EFTs older than two months prior to national release
;Note: EFTs to be auto-posted to a receipt included in search for aged, unposted EFTs
N DATE,EFTDA,EFT0,RC3444,RC34431,SELERADT,UNPOST,X
S UNPOST=0
S RC3444=^RCY(344.4,ERADA,0)
I '$P(RC3444,U,5) G AEFTSQ ; skip ERAs with zero payment
S EFTDA=+$O(^RCY(344.31,"AERA",ERADA,0))
S:EFTDA RC34431=^RCY(344.31,EFTDA,0)
I 'EFTDA,$P(RC3444,U,9)=2 G AEFTSQ ; Ignore selected ERAs that are MATCHED TO PAPER CHECK
;
; skip unmatched ERAs with EXPECTED PAYMENT CODE "CHK"
I 'EFTDA,$P(RC3444,U,15)="CHK" G AEFTSQ
;
; Use FILE DATE/TIME (344.4, .07) of ERA if no EFT (unmatched ERA),
; else use DATE RECEIVED (344.31,.13) of EFT associated with ERA
S SELERADT=$S('EFTDA:$P($P(RC3444,U,7),"."),1:$P(RC34431,U,13))
;
I TYPE="P" D G AEFTSQ
. I $$FMDIFF^XLFDT(DT,SELERADT)>21 S UNPOST=0 Q ;ERA older than 21 days, enter scratchpad
. S UNPOST=$$GETEFTS(TYPE) ;NOT older than 21 days, get unposted, aged EFTs
;
I TYPE="M" D G AEFTSQ
. I $$FMDIFF^XLFDT(DT,SELERADT)>14 S UNPOST=0 Q ;ERA older than 14 days, enter scratchpad
. S UNPOST=$$GETEFTS(TYPE) ;NOT older than 14 days, get unposted, aged EFTs
;
I TYPE="T" D G AEFTSQ
. I $$FMDIFF^XLFDT(DT,SELERADT)>14 S UNPOST=0 Q ;ERA older than 14 days, enter scratchpad
. S UNPOST=$$GETEFTS(TYPE) ;NOT older than 14 days, get unposted, aged EFTs
;
AEFTSQ ; single exit for function
Q UNPOST
;
GETEFTS(TYPE,OPTION) ;function, EP from RCDPEUPO for Unposted EFT Override option
; Set up search criteria for unposted EFTs. If aged, unposted EFTs create warning/prevention messages
; TYPE: "M" (Medical ERA-EFT), "P" (Phamacy ERA-EFT), "T" (Tricare ERA-EFT), "A" (Medical, Pharmacy & Tricare)
;OPTION:
; null if Called by Select ERA action on ERA Worklist
; 1 if Called by RCDPE UNPOSTED EFT OVERRIDE option
; Returns: See output for AGEDEFTS
;
N ARRAY,DAYSLIMT,DTARRY,OUTCOME,OVERRIDE,STARTDT,STR,TRARRY,X
S OPTION=$G(OPTION)
I TYPE="A" D ; Retrieve all Aged Days limits
. S DAYSLIMT("M")=$$GET1^DIQ(344.61,1,.06) ; Medical
. S DAYSLIMT("P")=$$GET1^DIQ(344.61,1,.07) ; Pharmacy
. S DAYSLIMT("T")=$$GET1^DIQ(344.61,1,.13) ; Tricare
; Retrieve Aged Days limit for specified type
I '(TYPE="A") S DAYSLIMT(TYPE)=$$GET1^DIQ(344.61,1,$S(TYPE="M":.06,TYPE="P":.07,1:.13))
S STARTDT=$$CUTOFF
D EFTDET(STARTDT,TYPE,.DAYSLIMT,.TRARRY)
;
; Aged unposted EFTs exist. Create prevention message and if called within
; the Worklist (not Override option) plus msg. with list of TRACE #s
F X="M","P","T" D
. I $D(TRARRY("ERROR",X)) D
.. D CHECK^RCDPEUPO(X,.OVERRIDE) ; Determine if Override exists
.. I OVERRIDE S OUTCOME=$G(OUTCOME)_3_X_U Q
.. S OUTCOME=$G(OUTCOME)_1_X_U
.. ; do not display warning msg if error condition exists
.. K TRARRY("WARNING",X)
.. Q:OPTION Q:OVERRIDE
.. Q:(TYPE'="A"&(TYPE'=X)) ; Only show error messages for TYPE
.. M ARRAY=TRARRY("ERROR",X)
.. D FTRACE(.ARRAY,.STR),PREVMSG(X,.DAYSLIMT,.STR)
.. K ARRAY
;
F X="M","P","T" D
. I $D(TRARRY("WARNING",X)) D
.. S OUTCOME=$G(OUTCOME)_2_X_U
.. Q:OPTION ; Called by OVERRIDE option, no trace number list
.. Q:(TYPE'="A"&(TYPE'=X)) ; Only show warning messages for TYPE
.. M ARRAY=TRARRY("WARNING",X)
.. D FTRACE(.ARRAY,.STR),WARNMSG(X,.STR)
.. K ARRAY ; aged unposted EFTs > 21 days exist, generate warning message
;
S:'$D(OUTCOME) OUTCOME=0 ; no error or warnings
;
Q OUTCOME
;
CUTOFF() ; Returns EFT Cutoff date
; date is 2 months prior to install date of patch 298, ignore aged EFTS older than that
;PRCA*4.5*367 changed calculation of the cut-off date to 3 years ago to speed up the checking
; for old EFTs and to avoid EFTs matched to paper check with a receipt that
; was purged in the nightly process (MAN^RCDPUT)
Q $$FMADD^XLFDT(DT,((365*-3)-2),0,0)
;N RCX S RCX=+$P($G(^RCY(344.61,1,0)),U,9)
;S:RCX=0 RCX=DT
;Q $$FMADD^XLFDT(RCX,-61,0,0)
;
EFTDET(RECVDT,TYPE,DAYSLIMT,TRARRY) ; Gather EFT data, Only EFTs that are aged and unposted
;Input:
; RECVDT - start date in DATE RECEIVED cross-reference of file 344.3
; TYPE- "M" - (Medical ERA-EFT), "P" (Phamacy ERA-EFT), "T" (TRICARE ERA-EFT), "A" (Medical, Pharmacy and Tricare)
; DAYSLIMT - days EFT can age before post prevention rules apply
;Output:
; TRARRY - Array of trace numbers of the aged, unposted EFTs
;
N EFTDA
F S RECVDT=$O(^RCY(344.31,"ADR",RECVDT)) Q:'RECVDT D
. S EFTDA="" F S EFTDA=$O(^RCY(344.31,"ADR",RECVDT,EFTDA)) Q:'EFTDA D
.. D CHKEFT(RECVDT,EFTDA,TYPE,.DAYSLIMT,.TRARRY)
Q
;
CHKEFT(RECVDT,EFTDA,TYPE,DAYSLIMT,TRARRY) ; Check EFT for warnings/errors
;Input:
; RECVDT - Date Received
; EFTDA - IEN of EDI THIRD PARY EFT DETAIL
; TYPE - "M" (Medical ERA-EFT), "P" (Phamacy ERA-EFT), "T"(Tricare ERA-EFT), "A" (Medical, Pharmacy and Tricare)
; DAYSLIMT - days an EFT can age before post prevention rules apply
; TRARRY - Array with warning error info
;
N AGED,EFTTYPE,ERAREC,MSTATUS,RCMED,RCPHARM,RCTRIC,TRACE
Q:$G(^RCY(344.31,EFTDA,0))="" ; skip, no data
Q:+$$GET1^DIQ(344.31,EFTDA_",",.07,"I")=0 ; skip, zero payment amt.
;
; Ignore duplicate EFTs which have been removed
Q:$$GET1^DIQ(344.31,EFTDA_",",.18,"I") ;^DD(344.31,.18,0)="DATE/TIME DUPLICATE REMOVED
S ERAREC=+$$GET1^DIQ(344.31,EFTDA_",",.1,"I") ; Pointer to ERA record
I ERAREC,$$GET1^DIQ(344.4,ERAREC_",",.14,"I")=1 Q ; Ignore posted ERA-EFTs
;
; Exclude EFT matched to Paper EOB if receipt is processed
I 'ERAREC,$$GET1^DIQ(344.31,EFTDA_",",.08,"I") Q:$$PROC(EFTDA)
S MSTATUS=+$$GET1^DIQ(344.31,EFTDA_",",.08,"I") ; MATCH STATUS
S AGED=$$FMDIFF^XLFDT(DT,RECVDT) ; days aged for EFT
S TRACE=$$GET1^DIQ(344.31,EFTDA_",",.04,"I") ; TRACE #
S:TRACE="" TRACE="(No trace #)"
;
; PRCA*4.5*345 - Start modified code block - Don't show warning message for unmatched EFTs
S RCMED=$S(ERAREC:$$ISTYPE^RCDPEU1(344.4,ERAREC,"M"),1:$$ISTYPE^RCDPEU1(344.31,EFTDA,"M"))
S RCPHARM=$S(ERAREC:$$PHARM(ERAREC),1:$$ISTYPE^RCDPEU1(344.31,EFTDA,"P"))
S RCTRIC=$S(ERAREC:$$ISTYPE^RCDPEU1(344.4,ERAREC,"T"),1:$$ISTYPE^RCDPEU1(344.31,EFTDA,"T"))
;
I (TYPE="A")!(TYPE="P"),RCPHARM D Q
. ; Aged, unposted EFT gets error message, no scratchpad for the ERA
. I AGED>DAYSLIMT("P") S TRARRY("ERROR","P",TRACE)="ERA = "_ERAREC_U_MSTATUS Q
. ; Aged, unposted PHARMACY EFT display warning message when entering scratchpad with the ERA
. I '$D(TRARRY("ERROR")),AGED>21 S TRARRY("WARNING","P",TRACE)="ERA = "_ERAREC_U_MSTATUS
;
I (TYPE="A")!(TYPE="T"),RCTRIC D Q ; is payer type Tricare?
. ; Aged, unposted EFT gets error message, no scratchpad for the ERA
. I AGED>DAYSLIMT("T") S TRARRY("ERROR","T",TRACE)="ERA = "_ERAREC_U_MSTATUS Q
. ; Aged, unposted MEDICAL EFT display warning message when entering scratchpad with the ERA
. I '$D(TRARRY("ERROR")),AGED>14 S TRARRY("WARNING","T",TRACE)="ERA = "_ERAREC_U_MSTATUS
;
I (TYPE="A")!(TYPE="M"),'RCPHARM,RCMED D
. I AGED>DAYSLIMT("M") S TRARRY("ERROR","M",TRACE)="ERA = "_ERAREC_U_MSTATUS Q
. ; Aged, unposted MEDICAL EFT warning message when entering scratchpad with ERA
. I '$D(TRARRY("ERROR")),AGED>14 S TRARRY("WARNING","M",TRACE)="ERA = "_ERAREC_U_MSTATUS
; PRCA*4.5*345 - End modified code block
Q
;
PROC(EFTDA) ; Check if TR Receipt for an EFT linked to Paper EOB is processed
; Input: EFTDA - IEN for file 344.31
; Returns: 1 if TR receipt exists and is OPEN, 0 otherwise
N IEN344,RET S RET=0
; Find TR receipt and check if status is not CLOSED
S IEN344=$O(^RCY(344,"AEFT",EFTDA,0))
I IEN344,$$GET1^DIQ(344,IEN344_",",.14,"I")'=1 S RET=1
Q RET
;
FTRACE(TRARRY,STR) ; both args. passed by ref.
; TRARRY - trace numbers of aged, unposted EFTs
; returns: STR - array of trace numbers separated by commas for warning or error message
N CTR,LEN,TRACE,X
K STR S CTR=1,TRACE=""
F S TRACE=$O(TRARRY(TRACE)) Q:TRACE="" D
. S STR(CTR)=$G(STR(CTR)) ; Initialize
. I $L(STR(CTR))+$L(TRACE)>77 S CTR=CTR+1,STR(CTR)=TRACE Q
. S STR(CTR)=STR(CTR)_$S(STR(CTR)]"":",",1:"")_TRACE ; comma if needed
Q
;
WARNMSG(TYPE,STR) ; warning message when aged, unposted EFTs exist
; Input: TYPE - "M" - Medical, "P" - Pharmacy or "T" - Tricare
; STR - Array, subscripts are strings in "trace#, trace#," format
N DIR,LN,X,Y
S DIR(0)="EA"
S DIR("A",1)="WARNING: Unposted "_$S(TYPE="P":"pharmacy",TYPE="M":"medical",1:"TRICARE")
S DIR("A",1)=DIR("A",1)_" EFTs exist that are more than "_$S(TYPE="P":21,1:14)_" days old."
S DIR("A",2)=" "
S DIR("A",3)="Post the older payments first. The EFTs may be unmatched or matched."
S DIR("A",4)="Trace number(s) associated with unposted EFTs:"
S LN=4,X=0 F S X=$O(STR(X)) Q:'X S LN=LN+1,DIR("A",LN)=STR(X)
S LN=LN+1,DIR("A",LN)=" "
S DIR("A")="Press ENTER to continue: "
W !
D ^DIR
Q
;
PREVMSG(TYPE,DAYS,STR) ; Display Error message when aged, unposted EFTs exist
;Input:
; TYPE - "M":Medical, "P":Pharmacy, "T":Tricare
; DAYS - days EFT can age before post prevention rules apply
; STR - Array, each subscrpt is string of trace numbers in "trace#, trace#," format
;
N DIR,LN,X,Y
S DIR(0)="EA"
S DIR("A",1)="ERROR: Unposted "_$S(TYPE="P":"Pharmacy",TYPE="M":"Medical",1:"TRICARE")
S DIR("A",1)=DIR("A",1)_" EFTs exist that are more than "_DAYS(TYPE)_" days old. Scratchpad"
S DIR("A",2)="creation is not allowed for newer payments. Post older payments first."
S DIR("A",3)="The EFTs may be matched or unmatched."
S DIR("A",4)=" "
S DIR("A",5)="Trace number(s) associated with unposted EFTs:"
S LN=5,X=0 F S X=$O(STR(X)) Q:'X S LN=LN+1,DIR("A",LN)=" "_STR(X)
S LN=LN+1,DIR("A",LN)=" "
S DIR("A")="Press ENTER to continue: "
W !
D ^DIR
Q
;
EXCDENY ; PRCA*4.5*298
; access denied message for ERAs selected off ERA Worklist with exceptions
; PRCA*4.5*304 - undeclared parameters (from WL^RCDPEWL7): RCERA and RCEXC
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCDWLIEN,X,Y
S DIR(0)="YA"
S DIR("A",1)="ACCESS DENIED: Scratchpad creation is not allowed when third party"
S DIR("A",2)="medical exceptions exist. Fix Transmission Exceptions first and then Data"
S DIR("A",3)="Exceptions with the EXE EDI Lockbox 3rd Party Exceptions option which is"
S DIR("A",4)="located on the EDI Lockbox Main Menu."
S DIR("A",5)=" "
;PRCA*4.5*304 - Allow user to fix exceptions
S DIR("A")="Do you want to begin clearing Exceptions for this ERA (Y/N)?: "
S DIR("B")="Y"
W ! D ^DIR
;PRCA*4.5*304 - allow jump to work on Exceptions
; If 'yes' to work on exceptions?, set neeeded vars., default payer range is ALL (for now)
I Y=1 D S:$G(RCMBG)'="" VALMBG=RCMBG S:$G(RCDWLIEN)'="" RCERA=RCDWLIEN S RCEXC=1 K RCMBG
. S RCMBG=$G(VALMBG),RCDWLIEN=RCERA D EN^RCDPEX1
Q
;
EXCWARN(ERADA) ; prca*4.5*298 warning msg. if exception
; Input: ERADA - IEN in file 344.4
; Output: WARNING MESSAGE if exception exists on ERA
;
Q:$$PHARM(ERADA) ; Ignore pharmacy ERA
Q:$$XCEPT(ERADA)="" ; no exception
N DIR
S DIR(0)="EA"
S DIR("A",1)="WARNING: Fix Transmission Exceptions first and then Data Exceptions via"
S DIR("A",2)="the EXE EDI Lockbox 3rd Party Exceptions option which is located on the"
S DIR("A",3)="EDI Lockbox Main Menu."
S DIR("A",4)=" "
S DIR("A")="Press ENTER to continue: "
W !
D ^DIR
Q
;
XCEPT(ERADA) ; prca*4.5*298, return ERA exception state
; Input: ERADA - IEN in file 344.4
; Returns: "x" or null, "x": Exception for a claim in the ERA
N RES
S RES=$S($D(^RCY(344.4,"AEXC",1,ERADA)):"x",$D(^RCY(344.4,"AEXC",2,ERADA)):"x",$D(^RCY(344.4,"AEXC",99,ERADA)):"ERADA",1:"")
Q RES
;
PHARM(X1) ; prca*4.5*298, function, Pharmacy, or Medical ERA?
; X1 - IEN file 344.4
; Returns: 1: Pharmacy ERA, 0: Non-pharmacy ERA
Q $S($D(^RCY(344.4,X1,1,"ECME")):1,1:0)
;
GETPHARM(PRCAIEN,RCARRY) ;prca*4.5*298 return pharmacy data to show on EEOB items in scratchpad
; Input: PRCAIEN - IEN file 430
; Output: RCARRY - holds pharmacy data
; IA 6033 - read access file 362.4
; ICR 1878 - EN^PSOORDER call
N RC0,RCDFN,RXDATA,RXFILL,RXIEN
K RCARRY
Q:PRCAIEN=""
S RCDFN=$P(^PRCA(430,PRCAIEN,0),U,7)
S RC0=+$O(^IBA(362.4,"C",PRCAIEN,0)) Q:RC0=0
S RXDATA=$G(^IBA(362.4,RC0,0))
S RCARRY("DOS")=$$FMTE^XLFDT($P(RXDATA,U,3),"2Z")
S RCARRY("FILL")=+$P(RXDATA,U,10) ; Rx fill#
S RXIEN=+$P(RXDATA,U,5) ; Rx IEN in file 52
D EN^PSOORDER(RCDFN,RXIEN)
; PRCA*4.5*411 - Check if prescription was deleted.
I $D(^TMP("PSOR",$J,RXIEN,0)) D ;
. S RCARRY("RX")=$P(^TMP("PSOR",$J,RXIEN,0),U,5)
. I RCARRY("FILL")=0 D
. . S RCARRY("RELEASED STATUS")=$S($P(^TMP("PSOR",$J,RXIEN,0),U,13)]"":"Released",1:"Not Released") ; determine release status from Rx on the first fill (no refills)
. I RCARRY("FILL")>0 D
. . S RCARRY("RELEASED STATUS")=$S($P($G(^TMP("PSOR",$J,RXIEN,"REF",RCARRY("FILL"),0)),U,8)]"":"Released",1:"Not Released") ; ; determine release status from Rx refill # ;PRCA319 add $G()
E D ;
. S RCARRY("RX")="Rx Deleted"
. S RCARRY("RELEASED STATUS")="Not Found"
; PRCA*4.5*411 - End modified code block
Q
;
CV ; Change View action for ERA Worklist
D FULL^VALM1
D PARAMS^RCDPEWL0("CV")
D HDR^RCDPEWL7,INIT^RCDPEWL7
S VALMBCK="R",VALMBG=1
Q
;
NOEDIT ; no edit allowed, ERA designated for auto-posting
N DIR
S DIR(0)="EA",DIR("A",1)="This action is not available for Auto-Posted ERAs."
S DIR("A")="Press ENTER to continue: "
W ! D ^DIR W !
Q
;
VR(ERADA) ; EP from RCDPEWL4, RCDPEAA3
; handle auto-posted ERAs, Look at Receipt protocol for standard Worklist
; Input: ERADA - IEN from file 344.49 (and 344.4)
N RCDA,RCZ,RCZ0,EEOBREC
D SEL^RCDPEWL(.RCDA) ; Select EEOB off scratchpad
S RCZ=+$O(RCDA(0)),RCZ=+$G(RCDA(RCZ))
Q:'RCZ
S RCZ0=$G(^RCY(344.49,ERADA,1,RCZ,0))
S EEOBREC=$P($G(^RCY(344.4,ERADA,1,+$P(RCZ0,U,9),4)),U,3)
I EEOBREC']"" D NOVIEW Q
I '$D(^XUSEC("RCDPEPP",DUZ)) D Q ; PRCA*4.5*349 - Added AM worklist preview
. D EN^VALM("RCDPE EOB RECEIPT PREVIEW AM")
D EN^VALM("RCDPE AUTO EOB RECEIPT PREVIEW")
Q
;
NOVIEW ; selected EEOB cannot be viewed if no receipt number
N DIR
S DIR(0)="EA"
S DIR("A",1)="THIS ACTION IS NOT AVAILABLE SINCE THE EEOB HAS NOT BEEN AUTO-POSTED."
S DIR("A")="Press ENTER to continue: "
W ! D ^DIR W !
Q
;
INIT(ERADA,EEOBREC) ; List Template - RCDPE AUTO EOB RECEIPT PREVIEW entry point
; Display EEOBs that have been posted (receipt exists)
; Input:
; ERADA - IEN file 344.49 (and 344.4)
; EEOBREC - Selected EEOBs receipt
; Output: ^TMP("RCDPE_AP_EOB_PREVIEW",$J)
N RCPT,RCZ,Z,Z0,Z1,Z2,SEQ
K ^TMP("RCDPE_AP_EOB_PREVIEW",$J)
S VALMCNT=0,VALMBG=1
S SEQ(344.491)=0 F S SEQ(344.491)=$O(^RCY(344.49,ERADA,1,SEQ(344.491))) Q:'SEQ(344.491) D
. S SEQ(344.491,0)=$G(^RCY(344.49,ERADA,1,SEQ(344.491),0))
. I $P(SEQ(344.491,0),U)\1=+SEQ(344.491,0) S SEQ("claim#")=$P(SEQ(344.491,0),U,2)
. S RCPT=+$P($G(^RCY(344.4,ERADA,1,+$P(SEQ(344.491,0),U,9),4)),U,3),RCPT(RCPT)="" ; receipt array
. I $P($P(SEQ(344.491,0),U),".",2),$D(RCPT(EEOBREC)) D ; if the EEOB has same receipt# as selected EEOB it can be on the preview screen
.. S:$P(SEQ(344.491,0),U,2)="" $P(SEQ(344.491,0),U,2)=SEQ("claim#")
.. ;RCZ=0:zero payments, -1:negative bal., 1:lines for rcpt., 2:other lines
.. S RCZ=$S(+$P(SEQ(344.491,0),U,6)=0:0,+$P(SEQ(344.491,0),U,6)<0:-1,$P(SEQ(344.491,0),U,7):1,1:2)
.. S RCZ(RCZ,SEQ(344.491))=SEQ(344.491,0)
.. K RCPT
.. S SEQ(344.4911)=0 F S SEQ(344.4911)=$O(^RCY(344.49,ERADA,1,SEQ(344.491),1,SEQ(344.4911))) Q:'SEQ(344.4911) D
... S SEQ(344.4911,0)=$G(^RCY(344.49,ERADA,1,SEQ(344.491),1,SEQ(344.4911),0))
... I $P(SEQ(344.4911,0),U,5)=1 D ;(#.05) BACKGROUND ACTION [5S] - '1' FOR DECREASE ADJUSTMENT;
.... S RCZ(RCZ,SEQ(344.491),"ADJ",SEQ(344.4911))="Dec adj $"_$J(0-$P(SEQ(344.4911,0),U,3),"",2)_" pending - "
.... S RCZ(RCZ,SEQ(344.491),"ADJ",SEQ(344.4911),1)=$J("",4)_$P(SEQ(344.4911,0),U,9)
;
F RCZ=1,2,0,-1 D:$D(RCZ(RCZ))
. I RCZ=1 D SET("PAYMENTS (LINES FOR RECEIPT):")
. I RCZ=0,VALMCNT>0 D SET(" "),SET("ZERO DOLLAR PAYMENTS:")
. I RCZ=-1,VALMCNT>0 D SET(" "),SET("LINES WITH NEGATIVE BALANCES STILL NEEDING TO BE DISTRIBUTED:")
. S Z=0 F S Z=$O(RCZ(RCZ,Z)) Q:'Z D
.. S Z0=RCZ(RCZ,Z),X=""
.. S X=$$SETFLD^VALM1($P(Z0,U),X,"LINE #")
.. S X=$$SETFLD^VALM1($S($P(Z0,U,7):$$BN1^PRCAFN($P(Z0,U,7)),1:$S(RCZ=0:"",1:"[SUSPENSE]")_$S($P(Z0,U,2)["**ADJ"&'$P($P(Z0,U,2),"ADJ",2):"TOTALS MISMATCH ADJ",1:$P(Z0,U,2))),X,"ACCOUNT")
.. S X=$$SETFLD^VALM1($J(+$P(Z0,U,6),"",2),X,"AMOUNT")
.. D SET(X)
.. S Z1=0 F S Z1=$O(RCZ(RCZ,Z,"ADJ",Z1)) Q:'Z1 D
... D SET($J("",12)_$G(RCZ(RCZ,Z,"ADJ",Z1)))
... S Z2=0 F S Z2=$O(RCZ(RCZ,Z,"ADJ",Z1,Z2)) Q:'Z2 D SET($J("",12)_$G(RCZ(RCZ,Z,"ADJ",Z1,Z2)))
Q
;
SET(X) ;
S VALMCNT=VALMCNT+1,^TMP("RCDPE_AP_EOB_PREVIEW",$J,VALMCNT,0)=X
Q
;
HDR ;
D HDR^RCDPEWL Q
;
FNL ;
K ^TMP("RCDPE_AP_EOB_PREVIEW",$J) Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEWLP 19706 printed Sep 23, 2025@19:22 Page 2
RCDPEWLP ;ALBANY/KML - EDI LOCKBOX ERA and EEOB WORKLIST procedures ; 4/28/22 7:39am
+1 ;;4.5;Accounts Receivable;**298,303,304,319,332,345,349,367,411**;Mar 20, 1995;Build 1
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; PRCA*4.5*298 - handle outstanding EFTs & ERAs with exceptions
+7 ; PRCA*4.5*411 - Check if prescription has a 'Delete' status which
+8 ; returns a null value to ^TMP("PSOR") array results
+9 ; in <undefined> error.
+10 ;
AGEDEFTS(ERADA,TYPE) ;function, Search medical or pharmacy aged EFTs that have not been posted
+1 ; ENTRY point for the Select ERA action on the ERA Worklist screen
+2 ; Input: ERADA - IEN in file 344.4
+3 ; TYPE - Medical, Pharmacy or Tricare (M,P, T)
+4 ; Returns:
+5 ; "1P" Error for aged, unposted pharmacy EFTs
+6 ; "2P" Warning for aged,unposted pharmacy EFTs
+7 ; "3P" Override exists for aged, unposted pharmacy EFTs
+8 ; "1M" Error for aged, unposted medical EFTs
+9 ; "2M" Warning for aged, unposted medical EFTs
+10 ; "3M" Override exists for aged, unposted medical EFTs
+11 ; "1T" Error for aged, unposted Tricare EFTs
+12 ; "2T" Warning for aged, unposted Tricare EFTs
+13 ; "3T" Override exists for aged, unposted Tricare EFTs
+14 ; 0 No error or warning conditions
+15 ; NOTE: may be more than one - "1P" or "2P" or "3P" or "3P^2M" or "3P^3M", etc.
+16 ;
+17 ;for action Select ERA:
+18 ; 1. If unposted payments (EFTs) associated with 3rd party Medical claims > than 14 days, display WARNING message for action
+19 ; Select ERA on the ERA WORKLIST, allow user to enter the worklist
+20 ; 2. If there are unposted payments (EFTs) associated with Pharmacy claims > 21 days, display a WARNING message
+21 ; on the ERA WORKLIST, enter worklist
+22 ; 3. If there are unposted payments (EFTs) associated with 3rd party Tricare claims
+23 ; > 14 calendar days, display WARNING message, enter worklist
+24 ; 4. If there are unposted payments (EFTs) associated with 3rd party medical, pharmacy or
+25 ; Tricare claims, aged > the number of days in site parameters, display error message
+26 ;additional criteria for item 3:
+27 ;create scratchpad if:
+28 ; 3a. medical ERA is 14 days or older
+29 ; 3b. pharmacy ERA is 21 days or older
+30 ; 3c. Tricare ERA is 14 days or older
+31 ; 3d. If override exists
+32 ;DO NOT create scratchpad if no override and:
+33 ; 3e. medical ERA received within 14 days and there are aged, unposted EFTs
+34 ; 3f. pharmacy ERA received within 21 days and there are aged, unposted EFTs
+35 ; 3g. Tricare ERA received within 14 days and there are aged, unposted EFTs
+36 ;
+37 ;Do not consider EFTs older than two months prior to national release
+38 ;Note: EFTs to be auto-posted to a receipt included in search for aged, unposted EFTs
+39 NEW DATE,EFTDA,EFT0,RC3444,RC34431,SELERADT,UNPOST,X
+40 SET UNPOST=0
+41 SET RC3444=^RCY(344.4,ERADA,0)
+42 ; skip ERAs with zero payment
IF '$PIECE(RC3444,U,5)
GOTO AEFTSQ
+43 SET EFTDA=+$ORDER(^RCY(344.31,"AERA",ERADA,0))
+44 if EFTDA
SET RC34431=^RCY(344.31,EFTDA,0)
+45 ; Ignore selected ERAs that are MATCHED TO PAPER CHECK
IF 'EFTDA
IF $PIECE(RC3444,U,9)=2
GOTO AEFTSQ
+46 ;
+47 ; skip unmatched ERAs with EXPECTED PAYMENT CODE "CHK"
+48 IF 'EFTDA
IF $PIECE(RC3444,U,15)="CHK"
GOTO AEFTSQ
+49 ;
+50 ; Use FILE DATE/TIME (344.4, .07) of ERA if no EFT (unmatched ERA),
+51 ; else use DATE RECEIVED (344.31,.13) of EFT associated with ERA
+52 SET SELERADT=$SELECT('EFTDA:$PIECE($PIECE(RC3444,U,7),"."),1:$PIECE(RC34431,U,13))
+53 ;
+54 IF TYPE="P"
Begin DoDot:1
+55 ;ERA older than 21 days, enter scratchpad
IF $$FMDIFF^XLFDT(DT,SELERADT)>21
SET UNPOST=0
QUIT
+56 ;NOT older than 21 days, get unposted, aged EFTs
SET UNPOST=$$GETEFTS(TYPE)
End DoDot:1
GOTO AEFTSQ
+57 ;
+58 IF TYPE="M"
Begin DoDot:1
+59 ;ERA older than 14 days, enter scratchpad
IF $$FMDIFF^XLFDT(DT,SELERADT)>14
SET UNPOST=0
QUIT
+60 ;NOT older than 14 days, get unposted, aged EFTs
SET UNPOST=$$GETEFTS(TYPE)
End DoDot:1
GOTO AEFTSQ
+61 ;
+62 IF TYPE="T"
Begin DoDot:1
+63 ;ERA older than 14 days, enter scratchpad
IF $$FMDIFF^XLFDT(DT,SELERADT)>14
SET UNPOST=0
QUIT
+64 ;NOT older than 14 days, get unposted, aged EFTs
SET UNPOST=$$GETEFTS(TYPE)
End DoDot:1
GOTO AEFTSQ
+65 ;
AEFTSQ ; single exit for function
+1 QUIT UNPOST
+2 ;
GETEFTS(TYPE,OPTION) ;function, EP from RCDPEUPO for Unposted EFT Override option
+1 ; Set up search criteria for unposted EFTs. If aged, unposted EFTs create warning/prevention messages
+2 ; TYPE: "M" (Medical ERA-EFT), "P" (Phamacy ERA-EFT), "T" (Tricare ERA-EFT), "A" (Medical, Pharmacy & Tricare)
+3 ;OPTION:
+4 ; null if Called by Select ERA action on ERA Worklist
+5 ; 1 if Called by RCDPE UNPOSTED EFT OVERRIDE option
+6 ; Returns: See output for AGEDEFTS
+7 ;
+8 NEW ARRAY,DAYSLIMT,DTARRY,OUTCOME,OVERRIDE,STARTDT,STR,TRARRY,X
+9 SET OPTION=$GET(OPTION)
+10 ; Retrieve all Aged Days limits
IF TYPE="A"
Begin DoDot:1
+11 ; Medical
SET DAYSLIMT("M")=$$GET1^DIQ(344.61,1,.06)
+12 ; Pharmacy
SET DAYSLIMT("P")=$$GET1^DIQ(344.61,1,.07)
+13 ; Tricare
SET DAYSLIMT("T")=$$GET1^DIQ(344.61,1,.13)
End DoDot:1
+14 ; Retrieve Aged Days limit for specified type
+15 IF '(TYPE="A")
SET DAYSLIMT(TYPE)=$$GET1^DIQ(344.61,1,$SELECT(TYPE="M":.06,TYPE="P":.07,1:.13))
+16 SET STARTDT=$$CUTOFF
+17 DO EFTDET(STARTDT,TYPE,.DAYSLIMT,.TRARRY)
+18 ;
+19 ; Aged unposted EFTs exist. Create prevention message and if called within
+20 ; the Worklist (not Override option) plus msg. with list of TRACE #s
+21 FOR X="M","P","T"
Begin DoDot:1
+22 IF $DATA(TRARRY("ERROR",X))
Begin DoDot:2
+23 ; Determine if Override exists
DO CHECK^RCDPEUPO(X,.OVERRIDE)
+24 IF OVERRIDE
SET OUTCOME=$GET(OUTCOME)_3_X_U
QUIT
+25 SET OUTCOME=$GET(OUTCOME)_1_X_U
+26 ; do not display warning msg if error condition exists
+27 KILL TRARRY("WARNING",X)
+28 if OPTION
QUIT
if OVERRIDE
QUIT
+29 ; Only show error messages for TYPE
if (TYPE'="A"&(TYPE'=X))
QUIT
+30 MERGE ARRAY=TRARRY("ERROR",X)
+31 DO FTRACE(.ARRAY,.STR)
DO PREVMSG(X,.DAYSLIMT,.STR)
+32 KILL ARRAY
End DoDot:2
End DoDot:1
+33 ;
+34 FOR X="M","P","T"
Begin DoDot:1
+35 IF $DATA(TRARRY("WARNING",X))
Begin DoDot:2
+36 SET OUTCOME=$GET(OUTCOME)_2_X_U
+37 ; Called by OVERRIDE option, no trace number list
if OPTION
QUIT
+38 ; Only show warning messages for TYPE
if (TYPE'="A"&(TYPE'=X))
QUIT
+39 MERGE ARRAY=TRARRY("WARNING",X)
+40 DO FTRACE(.ARRAY,.STR)
DO WARNMSG(X,.STR)
+41 ; aged unposted EFTs > 21 days exist, generate warning message
KILL ARRAY
End DoDot:2
End DoDot:1
+42 ;
+43 ; no error or warnings
if '$DATA(OUTCOME)
SET OUTCOME=0
+44 ;
+45 QUIT OUTCOME
+46 ;
CUTOFF() ; Returns EFT Cutoff date
+1 ; date is 2 months prior to install date of patch 298, ignore aged EFTS older than that
+2 ;PRCA*4.5*367 changed calculation of the cut-off date to 3 years ago to speed up the checking
+3 ; for old EFTs and to avoid EFTs matched to paper check with a receipt that
+4 ; was purged in the nightly process (MAN^RCDPUT)
+5 QUIT $$FMADD^XLFDT(DT,((365*-3)-2),0,0)
+6 ;N RCX S RCX=+$P($G(^RCY(344.61,1,0)),U,9)
+7 ;S:RCX=0 RCX=DT
+8 ;Q $$FMADD^XLFDT(RCX,-61,0,0)
+9 ;
EFTDET(RECVDT,TYPE,DAYSLIMT,TRARRY) ; Gather EFT data, Only EFTs that are aged and unposted
+1 ;Input:
+2 ; RECVDT - start date in DATE RECEIVED cross-reference of file 344.3
+3 ; TYPE- "M" - (Medical ERA-EFT), "P" (Phamacy ERA-EFT), "T" (TRICARE ERA-EFT), "A" (Medical, Pharmacy and Tricare)
+4 ; DAYSLIMT - days EFT can age before post prevention rules apply
+5 ;Output:
+6 ; TRARRY - Array of trace numbers of the aged, unposted EFTs
+7 ;
+8 NEW EFTDA
+9 FOR
SET RECVDT=$ORDER(^RCY(344.31,"ADR",RECVDT))
if 'RECVDT
QUIT
Begin DoDot:1
+10 SET EFTDA=""
FOR
SET EFTDA=$ORDER(^RCY(344.31,"ADR",RECVDT,EFTDA))
if 'EFTDA
QUIT
Begin DoDot:2
+11 DO CHKEFT(RECVDT,EFTDA,TYPE,.DAYSLIMT,.TRARRY)
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
CHKEFT(RECVDT,EFTDA,TYPE,DAYSLIMT,TRARRY) ; Check EFT for warnings/errors
+1 ;Input:
+2 ; RECVDT - Date Received
+3 ; EFTDA - IEN of EDI THIRD PARY EFT DETAIL
+4 ; TYPE - "M" (Medical ERA-EFT), "P" (Phamacy ERA-EFT), "T"(Tricare ERA-EFT), "A" (Medical, Pharmacy and Tricare)
+5 ; DAYSLIMT - days an EFT can age before post prevention rules apply
+6 ; TRARRY - Array with warning error info
+7 ;
+8 NEW AGED,EFTTYPE,ERAREC,MSTATUS,RCMED,RCPHARM,RCTRIC,TRACE
+9 ; skip, no data
if $GET(^RCY(344.31,EFTDA,0))=""
QUIT
+10 ; skip, zero payment amt.
if +$$GET1^DIQ(344.31,EFTDA_",",.07,"I")=0
QUIT
+11 ;
+12 ; Ignore duplicate EFTs which have been removed
+13 ;^DD(344.31,.18,0)="DATE/TIME DUPLICATE REMOVED
if $$GET1^DIQ(344.31,EFTDA_",",.18,"I")
QUIT
+14 ; Pointer to ERA record
SET ERAREC=+$$GET1^DIQ(344.31,EFTDA_",",.1,"I")
+15 ; Ignore posted ERA-EFTs
IF ERAREC
IF $$GET1^DIQ(344.4,ERAREC_",",.14,"I")=1
QUIT
+16 ;
+17 ; Exclude EFT matched to Paper EOB if receipt is processed
+18 IF 'ERAREC
IF $$GET1^DIQ(344.31,EFTDA_",",.08,"I")
if $$PROC(EFTDA)
QUIT
+19 ; MATCH STATUS
SET MSTATUS=+$$GET1^DIQ(344.31,EFTDA_",",.08,"I")
+20 ; days aged for EFT
SET AGED=$$FMDIFF^XLFDT(DT,RECVDT)
+21 ; TRACE #
SET TRACE=$$GET1^DIQ(344.31,EFTDA_",",.04,"I")
+22 if TRACE=""
SET TRACE="(No trace #)"
+23 ;
+24 ; PRCA*4.5*345 - Start modified code block - Don't show warning message for unmatched EFTs
+25 SET RCMED=$SELECT(ERAREC:$$ISTYPE^RCDPEU1(344.4,ERAREC,"M"),1:$$ISTYPE^RCDPEU1(344.31,EFTDA,"M"))
+26 SET RCPHARM=$SELECT(ERAREC:$$PHARM(ERAREC),1:$$ISTYPE^RCDPEU1(344.31,EFTDA,"P"))
+27 SET RCTRIC=$SELECT(ERAREC:$$ISTYPE^RCDPEU1(344.4,ERAREC,"T"),1:$$ISTYPE^RCDPEU1(344.31,EFTDA,"T"))
+28 ;
+29 IF (TYPE="A")!(TYPE="P")
IF RCPHARM
Begin DoDot:1
+30 ; Aged, unposted EFT gets error message, no scratchpad for the ERA
+31 IF AGED>DAYSLIMT("P")
SET TRARRY("ERROR","P",TRACE)="ERA = "_ERAREC_U_MSTATUS
QUIT
+32 ; Aged, unposted PHARMACY EFT display warning message when entering scratchpad with the ERA
+33 IF '$DATA(TRARRY("ERROR"))
IF AGED>21
SET TRARRY("WARNING","P",TRACE)="ERA = "_ERAREC_U_MSTATUS
End DoDot:1
QUIT
+34 ;
+35 ; is payer type Tricare?
IF (TYPE="A")!(TYPE="T")
IF RCTRIC
Begin DoDot:1
+36 ; Aged, unposted EFT gets error message, no scratchpad for the ERA
+37 IF AGED>DAYSLIMT("T")
SET TRARRY("ERROR","T",TRACE)="ERA = "_ERAREC_U_MSTATUS
QUIT
+38 ; Aged, unposted MEDICAL EFT display warning message when entering scratchpad with the ERA
+39 IF '$DATA(TRARRY("ERROR"))
IF AGED>14
SET TRARRY("WARNING","T",TRACE)="ERA = "_ERAREC_U_MSTATUS
End DoDot:1
QUIT
+40 ;
+41 IF (TYPE="A")!(TYPE="M")
IF 'RCPHARM
IF RCMED
Begin DoDot:1
+42 IF AGED>DAYSLIMT("M")
SET TRARRY("ERROR","M",TRACE)="ERA = "_ERAREC_U_MSTATUS
QUIT
+43 ; Aged, unposted MEDICAL EFT warning message when entering scratchpad with ERA
+44 IF '$DATA(TRARRY("ERROR"))
IF AGED>14
SET TRARRY("WARNING","M",TRACE)="ERA = "_ERAREC_U_MSTATUS
End DoDot:1
+45 ; PRCA*4.5*345 - End modified code block
+46 QUIT
+47 ;
PROC(EFTDA) ; Check if TR Receipt for an EFT linked to Paper EOB is processed
+1 ; Input: EFTDA - IEN for file 344.31
+2 ; Returns: 1 if TR receipt exists and is OPEN, 0 otherwise
+3 NEW IEN344,RET
SET RET=0
+4 ; Find TR receipt and check if status is not CLOSED
+5 SET IEN344=$ORDER(^RCY(344,"AEFT",EFTDA,0))
+6 IF IEN344
IF $$GET1^DIQ(344,IEN344_",",.14,"I")'=1
SET RET=1
+7 QUIT RET
+8 ;
FTRACE(TRARRY,STR) ; both args. passed by ref.
+1 ; TRARRY - trace numbers of aged, unposted EFTs
+2 ; returns: STR - array of trace numbers separated by commas for warning or error message
+3 NEW CTR,LEN,TRACE,X
+4 KILL STR
SET CTR=1
SET TRACE=""
+5 FOR
SET TRACE=$ORDER(TRARRY(TRACE))
if TRACE=""
QUIT
Begin DoDot:1
+6 ; Initialize
SET STR(CTR)=$GET(STR(CTR))
+7 IF $LENGTH(STR(CTR))+$LENGTH(TRACE)>77
SET CTR=CTR+1
SET STR(CTR)=TRACE
QUIT
+8 ; comma if needed
SET STR(CTR)=STR(CTR)_$SELECT(STR(CTR)]"":",",1:"")_TRACE
End DoDot:1
+9 QUIT
+10 ;
WARNMSG(TYPE,STR) ; warning message when aged, unposted EFTs exist
+1 ; Input: TYPE - "M" - Medical, "P" - Pharmacy or "T" - Tricare
+2 ; STR - Array, subscripts are strings in "trace#, trace#," format
+3 NEW DIR,LN,X,Y
+4 SET DIR(0)="EA"
+5 SET DIR("A",1)="WARNING: Unposted "_$SELECT(TYPE="P":"pharmacy",TYPE="M":"medical",1:"TRICARE")
+6 SET DIR("A",1)=DIR("A",1)_" EFTs exist that are more than "_$SELECT(TYPE="P":21,1:14)_" days old."
+7 SET DIR("A",2)=" "
+8 SET DIR("A",3)="Post the older payments first. The EFTs may be unmatched or matched."
+9 SET DIR("A",4)="Trace number(s) associated with unposted EFTs:"
+10 SET LN=4
SET X=0
FOR
SET X=$ORDER(STR(X))
if 'X
QUIT
SET LN=LN+1
SET DIR("A",LN)=STR(X)
+11 SET LN=LN+1
SET DIR("A",LN)=" "
+12 SET DIR("A")="Press ENTER to continue: "
+13 WRITE !
+14 DO ^DIR
+15 QUIT
+16 ;
PREVMSG(TYPE,DAYS,STR) ; Display Error message when aged, unposted EFTs exist
+1 ;Input:
+2 ; TYPE - "M":Medical, "P":Pharmacy, "T":Tricare
+3 ; DAYS - days EFT can age before post prevention rules apply
+4 ; STR - Array, each subscrpt is string of trace numbers in "trace#, trace#," format
+5 ;
+6 NEW DIR,LN,X,Y
+7 SET DIR(0)="EA"
+8 SET DIR("A",1)="ERROR: Unposted "_$SELECT(TYPE="P":"Pharmacy",TYPE="M":"Medical",1:"TRICARE")
+9 SET DIR("A",1)=DIR("A",1)_" EFTs exist that are more than "_DAYS(TYPE)_" days old. Scratchpad"
+10 SET DIR("A",2)="creation is not allowed for newer payments. Post older payments first."
+11 SET DIR("A",3)="The EFTs may be matched or unmatched."
+12 SET DIR("A",4)=" "
+13 SET DIR("A",5)="Trace number(s) associated with unposted EFTs:"
+14 SET LN=5
SET X=0
FOR
SET X=$ORDER(STR(X))
if 'X
QUIT
SET LN=LN+1
SET DIR("A",LN)=" "_STR(X)
+15 SET LN=LN+1
SET DIR("A",LN)=" "
+16 SET DIR("A")="Press ENTER to continue: "
+17 WRITE !
+18 DO ^DIR
+19 QUIT
+20 ;
EXCDENY ; PRCA*4.5*298
+1 ; access denied message for ERAs selected off ERA Worklist with exceptions
+2 ; PRCA*4.5*304 - undeclared parameters (from WL^RCDPEWL7): RCERA and RCEXC
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCDWLIEN,X,Y
+4 SET DIR(0)="YA"
+5 SET DIR("A",1)="ACCESS DENIED: Scratchpad creation is not allowed when third party"
+6 SET DIR("A",2)="medical exceptions exist. Fix Transmission Exceptions first and then Data"
+7 SET DIR("A",3)="Exceptions with the EXE EDI Lockbox 3rd Party Exceptions option which is"
+8 SET DIR("A",4)="located on the EDI Lockbox Main Menu."
+9 SET DIR("A",5)=" "
+10 ;PRCA*4.5*304 - Allow user to fix exceptions
+11 SET DIR("A")="Do you want to begin clearing Exceptions for this ERA (Y/N)?: "
+12 SET DIR("B")="Y"
+13 WRITE !
DO ^DIR
+14 ;PRCA*4.5*304 - allow jump to work on Exceptions
+15 ; If 'yes' to work on exceptions?, set neeeded vars., default payer range is ALL (for now)
+16 IF Y=1
Begin DoDot:1
+17 SET RCMBG=$GET(VALMBG)
SET RCDWLIEN=RCERA
DO EN^RCDPEX1
End DoDot:1
if $GET(RCMBG)'=""
SET VALMBG=RCMBG
if $GET(RCDWLIEN)'=""
SET RCERA=RCDWLIEN
SET RCEXC=1
KILL RCMBG
+18 QUIT
+19 ;
EXCWARN(ERADA) ; prca*4.5*298 warning msg. if exception
+1 ; Input: ERADA - IEN in file 344.4
+2 ; Output: WARNING MESSAGE if exception exists on ERA
+3 ;
+4 ; Ignore pharmacy ERA
if $$PHARM(ERADA)
QUIT
+5 ; no exception
if $$XCEPT(ERADA)=""
QUIT
+6 NEW DIR
+7 SET DIR(0)="EA"
+8 SET DIR("A",1)="WARNING: Fix Transmission Exceptions first and then Data Exceptions via"
+9 SET DIR("A",2)="the EXE EDI Lockbox 3rd Party Exceptions option which is located on the"
+10 SET DIR("A",3)="EDI Lockbox Main Menu."
+11 SET DIR("A",4)=" "
+12 SET DIR("A")="Press ENTER to continue: "
+13 WRITE !
+14 DO ^DIR
+15 QUIT
+16 ;
XCEPT(ERADA) ; prca*4.5*298, return ERA exception state
+1 ; Input: ERADA - IEN in file 344.4
+2 ; Returns: "x" or null, "x": Exception for a claim in the ERA
+3 NEW RES
+4 SET RES=$SELECT($DATA(^RCY(344.4,"AEXC",1,ERADA)):"x",$DATA(^RCY(344.4,"AEXC",2,ERADA)):"x",$DATA(^RCY(344.4,"AEXC",99,ERADA)):"ERADA",1:"")
+5 QUIT RES
+6 ;
PHARM(X1) ; prca*4.5*298, function, Pharmacy, or Medical ERA?
+1 ; X1 - IEN file 344.4
+2 ; Returns: 1: Pharmacy ERA, 0: Non-pharmacy ERA
+3 QUIT $SELECT($DATA(^RCY(344.4,X1,1,"ECME")):1,1:0)
+4 ;
GETPHARM(PRCAIEN,RCARRY) ;prca*4.5*298 return pharmacy data to show on EEOB items in scratchpad
+1 ; Input: PRCAIEN - IEN file 430
+2 ; Output: RCARRY - holds pharmacy data
+3 ; IA 6033 - read access file 362.4
+4 ; ICR 1878 - EN^PSOORDER call
+5 NEW RC0,RCDFN,RXDATA,RXFILL,RXIEN
+6 KILL RCARRY
+7 if PRCAIEN=""
QUIT
+8 SET RCDFN=$PIECE(^PRCA(430,PRCAIEN,0),U,7)
+9 SET RC0=+$ORDER(^IBA(362.4,"C",PRCAIEN,0))
if RC0=0
QUIT
+10 SET RXDATA=$GET(^IBA(362.4,RC0,0))
+11 SET RCARRY("DOS")=$$FMTE^XLFDT($PIECE(RXDATA,U,3),"2Z")
+12 ; Rx fill#
SET RCARRY("FILL")=+$PIECE(RXDATA,U,10)
+13 ; Rx IEN in file 52
SET RXIEN=+$PIECE(RXDATA,U,5)
+14 DO EN^PSOORDER(RCDFN,RXIEN)
+15 ; PRCA*4.5*411 - Check if prescription was deleted.
+16 ;
IF $DATA(^TMP("PSOR",$JOB,RXIEN,0))
Begin DoDot:1
+17 SET RCARRY("RX")=$PIECE(^TMP("PSOR",$JOB,RXIEN,0),U,5)
+18 IF RCARRY("FILL")=0
Begin DoDot:2
+19 ; determine release status from Rx on the first fill (no refills)
SET RCARRY("RELEASED STATUS")=$SELECT($PIECE(^TMP("PSOR",$JOB,RXIEN,0),U,13)]"":"Released",1:"Not Released")
End DoDot:2
+20 IF RCARRY("FILL")>0
Begin DoDot:2
+21 ; ; determine release status from Rx refill # ;PRCA319 add $G()
SET RCARRY("RELEASED STATUS")=$SELECT($PIECE($GET(^TMP("PSOR",$JOB,RXIEN,"REF",RCARRY("FILL"),0)),U,8)]"":"Released",1:"Not Released")
End DoDot:2
End DoDot:1
+22 ;
IF '$TEST
Begin DoDot:1
+23 SET RCARRY("RX")="Rx Deleted"
+24 SET RCARRY("RELEASED STATUS")="Not Found"
End DoDot:1
+25 ; PRCA*4.5*411 - End modified code block
+26 QUIT
+27 ;
CV ; Change View action for ERA Worklist
+1 DO FULL^VALM1
+2 DO PARAMS^RCDPEWL0("CV")
+3 DO HDR^RCDPEWL7
DO INIT^RCDPEWL7
+4 SET VALMBCK="R"
SET VALMBG=1
+5 QUIT
+6 ;
NOEDIT ; no edit allowed, ERA designated for auto-posting
+1 NEW DIR
+2 SET DIR(0)="EA"
SET DIR("A",1)="This action is not available for Auto-Posted ERAs."
+3 SET DIR("A")="Press ENTER to continue: "
+4 WRITE !
DO ^DIR
WRITE !
+5 QUIT
+6 ;
VR(ERADA) ; EP from RCDPEWL4, RCDPEAA3
+1 ; handle auto-posted ERAs, Look at Receipt protocol for standard Worklist
+2 ; Input: ERADA - IEN from file 344.49 (and 344.4)
+3 NEW RCDA,RCZ,RCZ0,EEOBREC
+4 ; Select EEOB off scratchpad
DO SEL^RCDPEWL(.RCDA)
+5 SET RCZ=+$ORDER(RCDA(0))
SET RCZ=+$GET(RCDA(RCZ))
+6 if 'RCZ
QUIT
+7 SET RCZ0=$GET(^RCY(344.49,ERADA,1,RCZ,0))
+8 SET EEOBREC=$PIECE($GET(^RCY(344.4,ERADA,1,+$PIECE(RCZ0,U,9),4)),U,3)
+9 IF EEOBREC']""
DO NOVIEW
QUIT
+10 ; PRCA*4.5*349 - Added AM worklist preview
IF '$DATA(^XUSEC("RCDPEPP",DUZ))
Begin DoDot:1
+11 DO EN^VALM("RCDPE EOB RECEIPT PREVIEW AM")
End DoDot:1
QUIT
+12 DO EN^VALM("RCDPE AUTO EOB RECEIPT PREVIEW")
+13 QUIT
+14 ;
NOVIEW ; selected EEOB cannot be viewed if no receipt number
+1 NEW DIR
+2 SET DIR(0)="EA"
+3 SET DIR("A",1)="THIS ACTION IS NOT AVAILABLE SINCE THE EEOB HAS NOT BEEN AUTO-POSTED."
+4 SET DIR("A")="Press ENTER to continue: "
+5 WRITE !
DO ^DIR
WRITE !
+6 QUIT
+7 ;
INIT(ERADA,EEOBREC) ; List Template - RCDPE AUTO EOB RECEIPT PREVIEW entry point
+1 ; Display EEOBs that have been posted (receipt exists)
+2 ; Input:
+3 ; ERADA - IEN file 344.49 (and 344.4)
+4 ; EEOBREC - Selected EEOBs receipt
+5 ; Output: ^TMP("RCDPE_AP_EOB_PREVIEW",$J)
+6 NEW RCPT,RCZ,Z,Z0,Z1,Z2,SEQ
+7 KILL ^TMP("RCDPE_AP_EOB_PREVIEW",$JOB)
+8 SET VALMCNT=0
SET VALMBG=1
+9 SET SEQ(344.491)=0
FOR
SET SEQ(344.491)=$ORDER(^RCY(344.49,ERADA,1,SEQ(344.491)))
if 'SEQ(344.491)
QUIT
Begin DoDot:1
+10 SET SEQ(344.491,0)=$GET(^RCY(344.49,ERADA,1,SEQ(344.491),0))
+11 IF $PIECE(SEQ(344.491,0),U)\1=+SEQ(344.491,0)
SET SEQ("claim#")=$PIECE(SEQ(344.491,0),U,2)
+12 ; receipt array
SET RCPT=+$PIECE($GET(^RCY(344.4,ERADA,1,+$PIECE(SEQ(344.491,0),U,9),4)),U,3)
SET RCPT(RCPT)=""
+13 ; if the EEOB has same receipt# as selected EEOB it can be on the preview screen
IF $PIECE($PIECE(SEQ(344.491,0),U),".",2)
IF $DATA(RCPT(EEOBREC))
Begin DoDot:2
+14 if $PIECE(SEQ(344.491,0),U,2)=""
SET $PIECE(SEQ(344.491,0),U,2)=SEQ("claim#")
+15 ;RCZ=0:zero payments, -1:negative bal., 1:lines for rcpt., 2:other lines
+16 SET RCZ=$SELECT(+$PIECE(SEQ(344.491,0),U,6)=0:0,+$PIECE(SEQ(344.491,0),U,6)<0:-1,$PIECE(SEQ(344.491,0),U,7):1,1:2)
+17 SET RCZ(RCZ,SEQ(344.491))=SEQ(344.491,0)
+18 KILL RCPT
+19 SET SEQ(344.4911)=0
FOR
SET SEQ(344.4911)=$ORDER(^RCY(344.49,ERADA,1,SEQ(344.491),1,SEQ(344.4911)))
if 'SEQ(344.4911)
QUIT
Begin DoDot:3
+20 SET SEQ(344.4911,0)=$GET(^RCY(344.49,ERADA,1,SEQ(344.491),1,SEQ(344.4911),0))
+21 ;(#.05) BACKGROUND ACTION [5S] - '1' FOR DECREASE ADJUSTMENT;
IF $PIECE(SEQ(344.4911,0),U,5)=1
Begin DoDot:4
+22 SET RCZ(RCZ,SEQ(344.491),"ADJ",SEQ(344.4911))="Dec adj $"_$JUSTIFY(0-$PIECE(SEQ(344.4911,0),U,3),"",2)_" pending - "
+23 SET RCZ(RCZ,SEQ(344.491),"ADJ",SEQ(344.4911),1)=$JUSTIFY("",4)_$PIECE(SEQ(344.4911,0),U,9)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+24 ;
+25 FOR RCZ=1,2,0,-1
if $DATA(RCZ(RCZ))
Begin DoDot:1
+26 IF RCZ=1
DO SET("PAYMENTS (LINES FOR RECEIPT):")
+27 IF RCZ=0
IF VALMCNT>0
DO SET(" ")
DO SET("ZERO DOLLAR PAYMENTS:")
+28 IF RCZ=-1
IF VALMCNT>0
DO SET(" ")
DO SET("LINES WITH NEGATIVE BALANCES STILL NEEDING TO BE DISTRIBUTED:")
+29 SET Z=0
FOR
SET Z=$ORDER(RCZ(RCZ,Z))
if 'Z
QUIT
Begin DoDot:2
+30 SET Z0=RCZ(RCZ,Z)
SET X=""
+31 SET X=$$SETFLD^VALM1($PIECE(Z0,U),X,"LINE #")
+32 SET X=$$SETFLD^VALM1($SELECT($PIECE(Z0,U,7):$$BN1^PRCAFN($PIECE(Z0,U,7)),1:$SELECT(RCZ=0:"",1:"[SUSPENSE]")_$SELECT($PIECE(Z0,U,2)["**ADJ"&'$PIECE($PIECE(Z0,U,2),"ADJ",2):"TOTALS MISMATCH ADJ",1:$PIECE(Z0,U,2))),X,"ACCOUNT")
+33 SET X=$$SETFLD^VALM1($JUSTIFY(+$PIECE(Z0,U,6),"",2),X,"AMOUNT")
+34 DO SET(X)
+35 SET Z1=0
FOR
SET Z1=$ORDER(RCZ(RCZ,Z,"ADJ",Z1))
if 'Z1
QUIT
Begin DoDot:3
+36 DO SET($JUSTIFY("",12)_$GET(RCZ(RCZ,Z,"ADJ",Z1)))
+37 SET Z2=0
FOR
SET Z2=$ORDER(RCZ(RCZ,Z,"ADJ",Z1,Z2))
if 'Z2
QUIT
DO SET($JUSTIFY("",12)_$GET(RCZ(RCZ,Z,"ADJ",Z1,Z2)))
End DoDot:3
End DoDot:2
End DoDot:1
+38 QUIT
+39 ;
SET(X) ;
+1 SET VALMCNT=VALMCNT+1
SET ^TMP("RCDPE_AP_EOB_PREVIEW",$JOB,VALMCNT,0)=X
+2 QUIT
+3 ;
HDR ;
+1 DO HDR^RCDPEWL
QUIT
+2 ;
FNL ;
+1 KILL ^TMP("RCDPE_AP_EOB_PREVIEW",$JOB)
QUIT
+2 ;
