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