RCDPEWL ;ALB/TMK/KML - ELECTRONIC EOB MESSAGE WORKLIST ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**173,208,269,298,317,318,326,349,367**;Mar 20, 1995;Build 11
;Per VA Directive 6402, this routine should not be modified.
; IA for read access to ^IBM(361.1 = 4051
;
EN ; Main entry point
N RCFASTXT,DA,DIC,X,Y,RCERA,RCNOED,RCQUIT ;PRCA*4.5*317 Added RCQUIT
D FULL^VALM1
;
S DIR(0)="SA^L:LIST;S:SPECIFIC"
S DIR("A")="Do you want a (L)IST of ERAs or a (S)PECIFIC one?: "
S DIR("?",1)="Enter LIST to see a list of ERAs."
S DIR("?")="Enter SPECIFIC to see a selected ERA."
S DIR("B")="LIST"
W !
D ^DIR
K DIR
Q:$D(DTOUT)!$D(DUOUT)
I Y="S" D Q
. S DIC="^RCY(344.4,",DIC(0)="AEMQ"
. D ^DIC
. I Y>0 D WL^RCDPEWL7(+Y)
;
; Calling Preferred View API in Menu Option Mode
D PARAMS^RCDPEWL0("MO")
Q:$G(RCQUIT)
D EN^VALM("RCDPE WORKLIST ERA LIST")
Q
;
DISP(RCERA,RCNOED) ; Entry to worklist from receipt processing
; RCERA = ien of entry in file 344.49
; RCNOED = 1 if receipt exists/no editing allowed
; = 2 if no edit and called from receipt processing
; ; prca*4.5*298 - added AUTOPOST input argument
; AUTOPOST = "" if ERA is non-autopost
; = 0 if auto-posted ERA is in UNPOSTED status
; = 1 if auto-posted ERA is in PARTIAL posted status
; = 2 if auto-posted ERA is in COMPLETE status
;
N DUOUT,DTOUT,DIC,DIK,X,Y,DIR,RCQUIT,DA,DIE,DR,RCSCR,RC0,RC5,RCDAT,RCTRACE,RCUNM
;
S RCSCR("NOEDIT")=+$G(RCNOED)
S RCQUIT=0,RC0=$G(^RCY(344.4,RCERA,0)),RC5=$G(^RCY(344.4,RCERA,5))
S RCTRACE=$P(RC0,"^",2) ; PRCA*4.5*367 - Trace Number
I 'RCSCR("NOEDIT"),'$O(^RCY(344.49,"B",RCERA,0)) D G:RCQUIT DISPQ
. ;allow additional selections
. S DIR("A",1)="No worklist scratchpad entry exists for this ERA."
. S DIR("A")="(C)reate scratchpad, (V)iew ERA details or (E)xit:"
. S DIR(0)="SAO^C:CREATE SCRATCHPAD;V:VIEW ERA DETAILS;E:EXIT"
. W ! D ^DIR K DIR
. I (Y'="V")&(Y'="C")&(Y'="E") S RCERA=-1,RCQUIT=1 Q
. I Y="V" S RCSCR=RCERA D PRERA1^RCDPEWL0 S RCERA=-1,RCQUIT=1 Q
. I Y="E" S RCERA=-1,RCQUIT=1 Q
. ; prca*4.5*298 Y is = "C" therefore perform the pre-existing scratchpad creation/editing algorithm
. I $P(RC0,U,15)'="" W !!,"PAYMENT METHOD CODE REPORTED: "_$P(RC0,U,15),!
. I $P(RC0,U,15)="" W !!,"NO PAYMENT METHOD CODE REPORTED",!
. I $P(RC0,U,9)=0,$P(RC5,U,2)="" D Q:RCQUIT
.. S RCQUIT=0,RCUNM=0
.. I +$P(RC0,U,5)=0,"ACH"'[(U_$P(RC0,U,15)_U) D Q:RCQUIT!RCUNM
... S DIR("A",1)="This ERA has no payment associated with it and can be marked as",DIR("A",2)="'MATCH-0 PAYMENT' to remove it from the ERA AGING REPORT if no paper check or",DIR("A",3)="EFT is expected to be received for this ERA"
... S DIR("?")="Do NOT respond YES here unless you are sure there will be no EFT or paper",DIR("?",1)=" check to be received for this 0-PAYMENT ERA"
... S DIR("A")="Do you want to do this?: "
... S DIR(0)="YA"
... D ^DIR K DIR
... I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
... I Y'=1 Q
... S DIE="^RCY(344.4,",DR=".09////3;.14////3",DA=RCERA D ^DIE S RCUNM=1
.. ; PRCA*4.5*367 - Skip prompt for check number if the ERA is for a TDA
.. I 'RCUNM,$$HACERA^RCDPEU(RCERA) D
... W !!,"This ERA does NOT have a matching EFT"
... W !,"ERA #",RCERA," (TRACE #"_RCTRACE_") matched to TDA ",RCTRACE
... S DIR("A")="Has the TDA been received by FMS?: ",DIR("B")="YES"
... S DIR(0)="YA" D ^DIR K DIR
... I $D(DTOUT)!$D(DUOUT)!'Y S RCQUIT=1 Q
... ;
... ; Null check number field but file date matched and USER
... S DIE="^RCY(344.4,",DA=RCERA
... S DR=".13////@;.09////5;5.03///"_$$DT^XLFDT()_";5.04///"_$G(DUZ)
... D ^DIE
.. E I 'RCUNM D
... S DIR("A",1)="This ERA does NOT have a matching EFT",DIR("A")="Enter the number of the paper check you received for this ERA: ",DIR(0)="344.01,.07A"
... I $P(RC5,U,2)'="" S DIR("B")=$P(RC5,U,2)
... I $G(DIR("B"))="",$P(RC0,U,2)'="" S DIR("B")=$P(RC0,U,2)
... W ! D ^DIR K DIR
... I $D(DTOUT)!$D(DUOUT)!(Y="") D S RCQUIT=1 Q
.... S DIR(0)="EA",DIR("A",1)="There must be either a paper check or an EFT for this ERA",DIR("A")="PRESS RETURN TO CONTINUE " W !! D ^DIR K DIR
... S RCDAT("CHECK#")=Y
... S DIR(0)="344.01,.1O",DIR("B")=$$FMTE^XLFDT($P(RC0,U,4),2)
... W ! D ^DIR K DIR
... I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
... S RCDAT("CHECKDT")=Y
... S DIR(0)="344.01,.08O"
... W ! D ^DIR K DIR
... I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
... S RCDAT("BANK")=Y
... S DIR("A",1)="ERA #"_RCERA_" (TRACE #:"_$P(RC0,U,2)_") matched to paper check "_RCDAT("CHECK#"),DIR("A")="Is this correct?: ",DIR(0)="YA",DIR("B")="YES" W ! D ^DIR K DIR
... I Y'=1 S RCQUIT=1 Q
... S DIE="^RCY(344.4,",DA=RCERA
... ; PRCA*4.5*326 - Add date matched and user for check match
... S DR=".13////"_RCDAT("CHECK#")_";.09////2;5.03///"_$$DT^XLFDT()_";5.04///"_$G(DUZ)
... D ^DIE
;
S RCSCR=+$O(^RCY(344.49,"B",RCERA,0))
I 'RCSCR D ; Build the entry in file 344.49
. I RCSCR("NOEDIT") D Q
.. S DIR("A")="NO worklist entry exists for this ERA - PRESS RETURN TO CONTINUE ",DIR(0)="EA" W ! D ^DIR K DIR
. ;
. S RCSCR=+$$ADDREC(RCERA,.RCDAT)
. I RCSCR D Q:'RCSCR
.. F X=1:1:6 L +^RCY(344.4,RCSCR):5 Q:$T I X=6 D Q
... S DA=RCSCR,DIK="^RCY(344.49," D ^DIK S RCSCR=0
... S DIR(0)="EA",DIR("A",1)="Another user has locked this entry - NEW RECORD NOT CREATED",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
.. Q:'RCSCR
.. ; prca*4.5*298 per patch requirements, keep code related to
.. ; creating/maintaining batches but just remove from execution.
.. ;D SETBATCH^RCDPEWLB(RCSCR) ; prca*4.5*298
.. D ADDLINES^RCDPEWLA(RCSCR)
.. K ^TMP($J,"BATCHES")
;
I RCSCR D G:'RCSCR DISPQ
. ; prca*4.5*298 per patch requirements, keep code related to
. ; creating/maintaining batches but just remove from execution.
. ;Q:'$$BAT^RCDPEWL7(RCSCR)
. ;I 'RCSCR("NOEDIT"),'$G(^TMP("RCBATCH_SELECTED",$J)) L +^RCY(344.4,RCSCR):5 I '$T W !!,"Another user is currently editing this entry",! S DIR(0)="E" D ^DIR K DIR S RCSCR=0 Q
. I 'RCSCR("NOEDIT") L +^RCY(344.4,RCSCR):5 I '$T W !!,"Another user is currently editing this entry",! S DIR(0)="E" D ^DIR K DIR S RCSCR=0 Q
. D EN^VALM("RCDPE EOB WORKLIST")
;
DISPQ L -^RCY(344.4,+$G(RCERA))
Q
;
INIT ; -- set up initial variables
N RCQUIT,RCREV
S VALMCNT=0,VALMBG=1
S RCQUIT=0
; PRCA*4.5*298: Removed functionality for retrieving/storing user preferences in file #344.49
; and replaced with the use of parameters handled by PARAMS^RCDPEWLA.
D PARAMS^RCDPEWLA("MO") I $G(RCQUIT) S VALMQUIT=1 Q
D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM")))
Q
;
CV ; Change View Action for EEOB Worklist
D FULL^VALM1
D PARAMS^RCDPEWLA("CV")
D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM"))),HDR
S VALMBCK="R",VALMBG=1
Q
;
ADDREC(RCERA,RCDAT) ; Add a record to file 344.49
; RCERA = ien of file 344.4
; RCDAT = array containing additional data to add to new entry
;
N DIC,DLAYGO,X,Y,DO,DD,RCY,DINUM
S RCY=0,DIC("DR")=""
S DIC(0)="L",DLAYGO=344.49,(DINUM,X)=RCERA,DIC="^RCY(344.49,"
I $G(RCDAT("CHECK#"))'="" S DIC("DR")=".04////"_RCDAT("CHECK#")_";"
I $G(RCDAT("CHECKDT"))'="" S DIC("DR")=DIC("DR")_".05////"_RCDAT("CHECKDT")_";"
I $G(RCDAT("BANK"))'="" S DIC("DR")=DIC("DR")_".06////"_RCDAT("BANK")_";"
K DD,DO D FILE^DICN K DIC
I Y>0 S RCY=+Y
Q RCY
;
HDR ; Creates header lines for the selected ERA display
; PRCA*4.5*349 - Reorganized NEW list & added XX temp. variable
N I,RCARC,RCEEOBPU,RCSORTBY,RC,RC4,RC5,X,XX,Z ; PRCA*4.5*326 - RCARC added
S RCSORTBY=$G(^TMP($J,"RC_SORTPARM")) ; PRCA*4.5*349 - Moved to top of subroutine
S RCEEOBPU=$G(^TMP($J,"RC_EEOBPOST")) ; PRCA*4.5*349 - Moved to top of subroutine
F I=1:1:6 S VALMHDR(I)="" ; PRCA*4.5*349 - Add a line to the header
I '$G(RCSCR) S VALMQUIT=1 Q
S RC=$G(^RCY(344.4,+RCSCR,0)),RC5=$G(^RCY(344.4,+RCSCR,5))
S RC4=$G(^RCY(344.4,+RCSCR,4)) ;prca*4.5*298
; PRCA*4.5*349 - Begin Modified Code Block - Reorder header information
S VALMHDR(1)="ERA Entry #: "_$P(RC,U)
S $E(VALMHDR(1),43)="Total Amount Paid: "_$J(+$P(RC,U,5),"",2)
S XX=$S(RCSORTBY="F":"ZERO-PAYMENTS FIRST",RCSORTBY="L":"ZERO-PAYMENTS LAST",1:"NO SORT ORDER")
S VALMHDR(2)="Payment Order: "_XX
S XX=$S(RCEEOBPU="P":"POSTED EEOBs ONLY",RCEEOBPU="U":"UNPOSTED EEOBs ONLY",1:"ALL EEOBS")
S $E(VALMHDR(2),39)="Disp Auto-Posted ERAs: "_XX
; PRCA*4.5*349 - End Modified Code Block
S Z=+$O(^RCY(344.31,"AERA",+RCSCR,0))
I Z S VALMHDR(3)="EFT #/TRACE #: "_$$GET1^DIQ(344.31,Z_",",.01,"E")_"/"_$E($P(RC,U,2),1,40) ; PRCA*4.5*326
I 'Z,$P(RC5,U,2)'="" S VALMHDR(3)="PAPER CHECK #: "_$P(RC5,U,2)
S VALMHDR(4)=$P(RC,U,6)_"/"_$P(RC,U,3) ; PRCA*4.5*349 - Give all of fourth line to payer name/id
; prca*4.5*298 per patch requirements, keep code related to creating/maintaining
; batches but just remove from execution.
;I $G(^TMP("RCBATCH_SELECTED",$J)) D
;. N Z,Z0
;. S Z=+$G(^TMP("RCBATCH_SELECTED",$J)),Z0=$G(^RCY(344.49,RCSCR,3,Z,0))
;. S RCT=RCT+1,VALMHDR(RCT)="BATCH: "_Z_" "_$P(Z0,U,2)_" "_$$EXTERNAL^DILFD(344.493,.03,"",$P(Z0,U,3))
I $G(RCSCR("NOEDIT")) D
. S VALMHDR(5)="*** RECEIPT(S) ALREADY CREATED *** ("_$$RECEIPTS(RCSCR)_")" ; PRCA*4.5*349 - Shift down a line
I $P(RC4,U,2)]"" D ;AUTO-POST STATUS (344.4, 4.02); if not null, then the selected ERA is designated for auto-post
. ; Setting the Auto-Post info in the header
. N AUTOPSTS
. S AUTOPSTS="Auto-Post Status: "_$S($P(RC4,U,2)=0:"Unposted",$P(RC4,U,2)=1:"Partial",1:"Complete")
. S AUTOPSTS=AUTOPSTS_" Auto-Post Date: "_$S($P(RC4,U,2)>0:$$FMTE^XLFDT($P(RC4,U)),1:"") ; PRCA*4.5*318
. S VALMHDR(6)=AUTOPSTS ; PRCA*4.5*349 - Shift down a line
; BEGIN PRCA*4,.5*326
; Check for auto-decrease CARCs if this is a denial ERA
I $$GET1^DIQ(344.4,+RCSCR,.15)="NON" D
.N RCARC
.S RCARC=$$WLH^RCDPEWLZ(+RCSCR)
.S:RCARC]"" VALMHDR(5)=RCARC ; PRCA*4.5*349 - Shift down a line
; ENd PRCA*4,.5*326
; Displaying Current View (PRCA*4.5*298)
; PRCA*4.5*349 - Moved to top of routine and restructured
Q
;
FNL ; -- Clean up list
K ^TMP("RCDPE-EOB_WLDX",$J),^TMP("RCDPE-EOB_WL",$J),^TMP($J,"RC_SORTPARM"),^TMP($J,"RC_BILL")
D CLEAN^VALM10,CLEAR^VALM1
K RCFASTXT
Q
;
SEL(RCDA) ; Select entry from worklist scratch pad screen
; RCDA = array returned if selections made
; RCDA(n)=ien of entry(s) in file 344.41
; where n = the line # selected
K RCDA
N VALMY
D EN^VALM2($G(XQORNOD(0)),"S")
S RCDA=0 F S RCDA=$O(VALMY(RCDA)) Q:'RCDA S RCDA(RCDA)=$P($G(^TMP("RCDPE-EOB_WLDX",$J,RCDA)),U,2,5)
Q
;
NOEDIT ; Display no edit allowed if receipt exists
N DIR,X,Y
S DIR(0)="EA",DIR("A",1)="This action is NOT available since the ERA already has a receipt."
S DIR("A")="PRESS RETURN TO CONTINUE "
W ! D ^DIR K DIR W !
Q
;
NOBATCH ; Display action not allowed if working at batch level not the ERA level
N DIR,X,Y
S DIR(0)="EA",DIR("A",1)="This action is NOT valid when in a batch within the ERA."
S DIR("A")="PRESS RETURN TO CONTINUE "
W ! D ^DIR K DIR W !
Q
;
RECEIPTS(RCSCR) ; get list of receipts for the ERA
; Input: RCSCR: ERA File (#344.4) IEN
; Output: "" - No Receipt / REC# - One Receipt / REC#A-REC#Z - Range of Receipts
N X,RECEIPT,CTR,RC0
K ARRAY,STR
S X=0,CTR=1,(STR,RECEIPT)=""
F S X=$O(^RCY(344.4,RCSCR,1,"RECEIPT",X)) Q:'X D
. S:X RECEIPT=$P($G(^RCY(344,X,0)),U) ; get external form of receipt
. I RECEIPT]"" S ARRAY(RECEIPT)=""
; array of receipts does not exist so this could be a non auto-posted ERA; so only 1 receipt will be assigned; retrieve at 344.4, .08
I '$D(ARRAY),$$GET1^DIQ(344.4,RCSCR,.08)'="" S ARRAY($$GET1^DIQ(344.4,RCSCR,.08))=""
;
I $O(ARRAY($O(ARRAY(""))))'="" D
. S STR=$O(ARRAY(""))_"-"_$O(ARRAY(""),-1)
E D
. S STR=$O(ARRAY(""))
Q STR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEWL 11980 printed Sep 23, 2025@19:21:45 Page 2
RCDPEWL ;ALB/TMK/KML - ELECTRONIC EOB MESSAGE WORKLIST ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**173,208,269,298,317,318,326,349,367**;Mar 20, 1995;Build 11
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ; IA for read access to ^IBM(361.1 = 4051
+4 ;
EN ; Main entry point
+1 ;PRCA*4.5*317 Added RCQUIT
NEW RCFASTXT,DA,DIC,X,Y,RCERA,RCNOED,RCQUIT
+2 DO FULL^VALM1
+3 ;
+4 SET DIR(0)="SA^L:LIST;S:SPECIFIC"
+5 SET DIR("A")="Do you want a (L)IST of ERAs or a (S)PECIFIC one?: "
+6 SET DIR("?",1)="Enter LIST to see a list of ERAs."
+7 SET DIR("?")="Enter SPECIFIC to see a selected ERA."
+8 SET DIR("B")="LIST"
+9 WRITE !
+10 DO ^DIR
+11 KILL DIR
+12 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+13 IF Y="S"
Begin DoDot:1
+14 SET DIC="^RCY(344.4,"
SET DIC(0)="AEMQ"
+15 DO ^DIC
+16 IF Y>0
DO WL^RCDPEWL7(+Y)
End DoDot:1
QUIT
+17 ;
+18 ; Calling Preferred View API in Menu Option Mode
+19 DO PARAMS^RCDPEWL0("MO")
+20 if $GET(RCQUIT)
QUIT
+21 DO EN^VALM("RCDPE WORKLIST ERA LIST")
+22 QUIT
+23 ;
DISP(RCERA,RCNOED) ; Entry to worklist from receipt processing
+1 ; RCERA = ien of entry in file 344.49
+2 ; RCNOED = 1 if receipt exists/no editing allowed
+3 ; = 2 if no edit and called from receipt processing
+4 ; ; prca*4.5*298 - added AUTOPOST input argument
+5 ; AUTOPOST = "" if ERA is non-autopost
+6 ; = 0 if auto-posted ERA is in UNPOSTED status
+7 ; = 1 if auto-posted ERA is in PARTIAL posted status
+8 ; = 2 if auto-posted ERA is in COMPLETE status
+9 ;
+10 NEW DUOUT,DTOUT,DIC,DIK,X,Y,DIR,RCQUIT,DA,DIE,DR,RCSCR,RC0,RC5,RCDAT,RCTRACE,RCUNM
+11 ;
+12 SET RCSCR("NOEDIT")=+$GET(RCNOED)
+13 SET RCQUIT=0
SET RC0=$GET(^RCY(344.4,RCERA,0))
SET RC5=$GET(^RCY(344.4,RCERA,5))
+14 ; PRCA*4.5*367 - Trace Number
SET RCTRACE=$PIECE(RC0,"^",2)
+15 IF 'RCSCR("NOEDIT")
IF '$ORDER(^RCY(344.49,"B",RCERA,0))
Begin DoDot:1
+16 ;allow additional selections
+17 SET DIR("A",1)="No worklist scratchpad entry exists for this ERA."
+18 SET DIR("A")="(C)reate scratchpad, (V)iew ERA details or (E)xit:"
+19 SET DIR(0)="SAO^C:CREATE SCRATCHPAD;V:VIEW ERA DETAILS;E:EXIT"
+20 WRITE !
DO ^DIR
KILL DIR
+21 IF (Y'="V")&(Y'="C")&(Y'="E")
SET RCERA=-1
SET RCQUIT=1
QUIT
+22 IF Y="V"
SET RCSCR=RCERA
DO PRERA1^RCDPEWL0
SET RCERA=-1
SET RCQUIT=1
QUIT
+23 IF Y="E"
SET RCERA=-1
SET RCQUIT=1
QUIT
+24 ; prca*4.5*298 Y is = "C" therefore perform the pre-existing scratchpad creation/editing algorithm
+25 IF $PIECE(RC0,U,15)'=""
WRITE !!,"PAYMENT METHOD CODE REPORTED: "_$PIECE(RC0,U,15),!
+26 IF $PIECE(RC0,U,15)=""
WRITE !!,"NO PAYMENT METHOD CODE REPORTED",!
+27 IF $PIECE(RC0,U,9)=0
IF $PIECE(RC5,U,2)=""
Begin DoDot:2
+28 SET RCQUIT=0
SET RCUNM=0
+29 IF +$PIECE(RC0,U,5)=0
IF "ACH"'[(U_$PIECE(RC0,U,15)_U)
Begin DoDot:3
+30 SET DIR("A",1)="This ERA has no payment associated with it and can be marked as"
SET DIR("A",2)="'MATCH-0 PAYMENT' to remove it from the ERA AGING REPORT if no paper check or"
SET DIR("A",3)="EFT is expected to be received for this ERA"
+31 SET DIR("?")="Do NOT respond YES here unless you are sure there will be no EFT or paper"
SET DIR("?",1)=" check to be received for this 0-PAYMENT ERA"
+32 SET DIR("A")="Do you want to do this?: "
+33 SET DIR(0)="YA"
+34 DO ^DIR
KILL DIR
+35 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RCQUIT=1
QUIT
+36 IF Y'=1
QUIT
+37 SET DIE="^RCY(344.4,"
SET DR=".09////3;.14////3"
SET DA=RCERA
DO ^DIE
SET RCUNM=1
End DoDot:3
if RCQUIT!RCUNM
QUIT
+38 ; PRCA*4.5*367 - Skip prompt for check number if the ERA is for a TDA
+39 IF 'RCUNM
IF $$HACERA^RCDPEU(RCERA)
Begin DoDot:3
+40 WRITE !!,"This ERA does NOT have a matching EFT"
+41 WRITE !,"ERA #",RCERA," (TRACE #"_RCTRACE_") matched to TDA ",RCTRACE
+42 SET DIR("A")="Has the TDA been received by FMS?: "
SET DIR("B")="YES"
+43 SET DIR(0)="YA"
DO ^DIR
KILL DIR
+44 IF $DATA(DTOUT)!$DATA(DUOUT)!'Y
SET RCQUIT=1
QUIT
+45 ;
+46 ; Null check number field but file date matched and USER
+47 SET DIE="^RCY(344.4,"
SET DA=RCERA
+48 SET DR=".13////@;.09////5;5.03///"_$$DT^XLFDT()_";5.04///"_$GET(DUZ)
+49 DO ^DIE
End DoDot:3
+50 IF '$TEST
IF 'RCUNM
Begin DoDot:3
+51 SET DIR("A",1)="This ERA does NOT have a matching EFT"
SET DIR("A")="Enter the number of the paper check you received for this ERA: "
SET DIR(0)="344.01,.07A"
+52 IF $PIECE(RC5,U,2)'=""
SET DIR("B")=$PIECE(RC5,U,2)
+53 IF $GET(DIR("B"))=""
IF $PIECE(RC0,U,2)'=""
SET DIR("B")=$PIECE(RC0,U,2)
+54 WRITE !
DO ^DIR
KILL DIR
+55 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
Begin DoDot:4
+56 SET DIR(0)="EA"
SET DIR("A",1)="There must be either a paper check or an EFT for this ERA"
SET DIR("A")="PRESS RETURN TO CONTINUE "
WRITE !!
DO ^DIR
KILL DIR
End DoDot:4
SET RCQUIT=1
QUIT
+57 SET RCDAT("CHECK#")=Y
+58 SET DIR(0)="344.01,.1O"
SET DIR("B")=$$FMTE^XLFDT($PIECE(RC0,U,4),2)
+59 WRITE !
DO ^DIR
KILL DIR
+60 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RCQUIT=1
QUIT
+61 SET RCDAT("CHECKDT")=Y
+62 SET DIR(0)="344.01,.08O"
+63 WRITE !
DO ^DIR
KILL DIR
+64 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RCQUIT=1
QUIT
+65 SET RCDAT("BANK")=Y
+66 SET DIR("A",1)="ERA #"_RCERA_" (TRACE #:"_$PIECE(RC0,U,2)_") matched to paper check "_RCDAT("CHECK#")
SET DIR("A")="Is this correct?: "
SET DIR(0)="YA"
SET DIR("B")="YES"
WRITE !
DO ^DIR
KILL DIR
+67 IF Y'=1
SET RCQUIT=1
QUIT
+68 SET DIE="^RCY(344.4,"
SET DA=RCERA
+69 ; PRCA*4.5*326 - Add date matched and user for check match
+70 SET DR=".13////"_RCDAT("CHECK#")_";.09////2;5.03///"_$$DT^XLFDT()_";5.04///"_$GET(DUZ)
+71 DO ^DIE
End DoDot:3
End DoDot:2
if RCQUIT
QUIT
End DoDot:1
if RCQUIT
GOTO DISPQ
+72 ;
+73 SET RCSCR=+$ORDER(^RCY(344.49,"B",RCERA,0))
+74 ; Build the entry in file 344.49
IF 'RCSCR
Begin DoDot:1
+75 IF RCSCR("NOEDIT")
Begin DoDot:2
+76 SET DIR("A")="NO worklist entry exists for this ERA - PRESS RETURN TO CONTINUE "
SET DIR(0)="EA"
WRITE !
DO ^DIR
KILL DIR
End DoDot:2
QUIT
+77 ;
+78 SET RCSCR=+$$ADDREC(RCERA,.RCDAT)
+79 IF RCSCR
Begin DoDot:2
+80 FOR X=1:1:6
LOCK +^RCY(344.4,RCSCR):5
if $TEST
QUIT
IF X=6
Begin DoDot:3
+81 SET DA=RCSCR
SET DIK="^RCY(344.49,"
DO ^DIK
SET RCSCR=0
+82 SET DIR(0)="EA"
SET DIR("A",1)="Another user has locked this entry - NEW RECORD NOT CREATED"
SET DIR("A")="PRESS RETURN TO CONTINUE "
WRITE !
DO ^DIR
KILL DIR
End DoDot:3
QUIT
+83 if 'RCSCR
QUIT
+84 ; prca*4.5*298 per patch requirements, keep code related to
+85 ; creating/maintaining batches but just remove from execution.
+86 ;D SETBATCH^RCDPEWLB(RCSCR) ; prca*4.5*298
+87 DO ADDLINES^RCDPEWLA(RCSCR)
+88 KILL ^TMP($JOB,"BATCHES")
End DoDot:2
if 'RCSCR
QUIT
End DoDot:1
+89 ;
+90 IF RCSCR
Begin DoDot:1
+91 ; prca*4.5*298 per patch requirements, keep code related to
+92 ; creating/maintaining batches but just remove from execution.
+93 ;Q:'$$BAT^RCDPEWL7(RCSCR)
+94 ;I 'RCSCR("NOEDIT"),'$G(^TMP("RCBATCH_SELECTED",$J)) L +^RCY(344.4,RCSCR):5 I '$T W !!,"Another user is currently editing this entry",! S DIR(0)="E" D ^DIR K DIR S RCSCR=0 Q
+95 IF 'RCSCR("NOEDIT")
LOCK +^RCY(344.4,RCSCR):5
IF '$TEST
WRITE !!,"Another user is currently editing this entry",!
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET RCSCR=0
QUIT
+96 DO EN^VALM("RCDPE EOB WORKLIST")
End DoDot:1
if 'RCSCR
GOTO DISPQ
+97 ;
DISPQ LOCK -^RCY(344.4,+$GET(RCERA))
+1 QUIT
+2 ;
INIT ; -- set up initial variables
+1 NEW RCQUIT,RCREV
+2 SET VALMCNT=0
SET VALMBG=1
+3 SET RCQUIT=0
+4 ; PRCA*4.5*298: Removed functionality for retrieving/storing user preferences in file #344.49
+5 ; and replaced with the use of parameters handled by PARAMS^RCDPEWLA.
+6 DO PARAMS^RCDPEWLA("MO")
IF $GET(RCQUIT)
SET VALMQUIT=1
QUIT
+7 DO BLD^RCDPEWL1($GET(^TMP($JOB,"RC_SORTPARM")))
+8 QUIT
+9 ;
CV ; Change View Action for EEOB Worklist
+1 DO FULL^VALM1
+2 DO PARAMS^RCDPEWLA("CV")
+3 DO BLD^RCDPEWL1($GET(^TMP($JOB,"RC_SORTPARM")))
DO HDR
+4 SET VALMBCK="R"
SET VALMBG=1
+5 QUIT
+6 ;
ADDREC(RCERA,RCDAT) ; Add a record to file 344.49
+1 ; RCERA = ien of file 344.4
+2 ; RCDAT = array containing additional data to add to new entry
+3 ;
+4 NEW DIC,DLAYGO,X,Y,DO,DD,RCY,DINUM
+5 SET RCY=0
SET DIC("DR")=""
+6 SET DIC(0)="L"
SET DLAYGO=344.49
SET (DINUM,X)=RCERA
SET DIC="^RCY(344.49,"
+7 IF $GET(RCDAT("CHECK#"))'=""
SET DIC("DR")=".04////"_RCDAT("CHECK#")_";"
+8 IF $GET(RCDAT("CHECKDT"))'=""
SET DIC("DR")=DIC("DR")_".05////"_RCDAT("CHECKDT")_";"
+9 IF $GET(RCDAT("BANK"))'=""
SET DIC("DR")=DIC("DR")_".06////"_RCDAT("BANK")_";"
+10 KILL DD,DO
DO FILE^DICN
KILL DIC
+11 IF Y>0
SET RCY=+Y
+12 QUIT RCY
+13 ;
HDR ; Creates header lines for the selected ERA display
+1 ; PRCA*4.5*349 - Reorganized NEW list & added XX temp. variable
+2 ; PRCA*4.5*326 - RCARC added
NEW I,RCARC,RCEEOBPU,RCSORTBY,RC,RC4,RC5,X,XX,Z
+3 ; PRCA*4.5*349 - Moved to top of subroutine
SET RCSORTBY=$GET(^TMP($JOB,"RC_SORTPARM"))
+4 ; PRCA*4.5*349 - Moved to top of subroutine
SET RCEEOBPU=$GET(^TMP($JOB,"RC_EEOBPOST"))
+5 ; PRCA*4.5*349 - Add a line to the header
FOR I=1:1:6
SET VALMHDR(I)=""
+6 IF '$GET(RCSCR)
SET VALMQUIT=1
QUIT
+7 SET RC=$GET(^RCY(344.4,+RCSCR,0))
SET RC5=$GET(^RCY(344.4,+RCSCR,5))
+8 ;prca*4.5*298
SET RC4=$GET(^RCY(344.4,+RCSCR,4))
+9 ; PRCA*4.5*349 - Begin Modified Code Block - Reorder header information
+10 SET VALMHDR(1)="ERA Entry #: "_$PIECE(RC,U)
+11 SET $EXTRACT(VALMHDR(1),43)="Total Amount Paid: "_$JUSTIFY(+$PIECE(RC,U,5),"",2)
+12 SET XX=$SELECT(RCSORTBY="F":"ZERO-PAYMENTS FIRST",RCSORTBY="L":"ZERO-PAYMENTS LAST",1:"NO SORT ORDER")
+13 SET VALMHDR(2)="Payment Order: "_XX
+14 SET XX=$SELECT(RCEEOBPU="P":"POSTED EEOBs ONLY",RCEEOBPU="U":"UNPOSTED EEOBs ONLY",1:"ALL EEOBS")
+15 SET $EXTRACT(VALMHDR(2),39)="Disp Auto-Posted ERAs: "_XX
+16 ; PRCA*4.5*349 - End Modified Code Block
+17 SET Z=+$ORDER(^RCY(344.31,"AERA",+RCSCR,0))
+18 ; PRCA*4.5*326
IF Z
SET VALMHDR(3)="EFT #/TRACE #: "_$$GET1^DIQ(344.31,Z_",",.01,"E")_"/"_$EXTRACT($PIECE(RC,U,2),1,40)
+19 IF 'Z
IF $PIECE(RC5,U,2)'=""
SET VALMHDR(3)="PAPER CHECK #: "_$PIECE(RC5,U,2)
+20 ; PRCA*4.5*349 - Give all of fourth line to payer name/id
SET VALMHDR(4)=$PIECE(RC,U,6)_"/"_$PIECE(RC,U,3)
+21 ; prca*4.5*298 per patch requirements, keep code related to creating/maintaining
+22 ; batches but just remove from execution.
+23 ;I $G(^TMP("RCBATCH_SELECTED",$J)) D
+24 ;. N Z,Z0
+25 ;. S Z=+$G(^TMP("RCBATCH_SELECTED",$J)),Z0=$G(^RCY(344.49,RCSCR,3,Z,0))
+26 ;. S RCT=RCT+1,VALMHDR(RCT)="BATCH: "_Z_" "_$P(Z0,U,2)_" "_$$EXTERNAL^DILFD(344.493,.03,"",$P(Z0,U,3))
+27 IF $GET(RCSCR("NOEDIT"))
Begin DoDot:1
+28 ; PRCA*4.5*349 - Shift down a line
SET VALMHDR(5)="*** RECEIPT(S) ALREADY CREATED *** ("_$$RECEIPTS(RCSCR)_")"
End DoDot:1
+29 ;AUTO-POST STATUS (344.4, 4.02); if not null, then the selected ERA is designated for auto-post
IF $PIECE(RC4,U,2)]""
Begin DoDot:1
+30 ; Setting the Auto-Post info in the header
+31 NEW AUTOPSTS
+32 SET AUTOPSTS="Auto-Post Status: "_$SELECT($PIECE(RC4,U,2)=0:"Unposted",$PIECE(RC4,U,2)=1:"Partial",1:"Complete")
+33 ; PRCA*4.5*318
SET AUTOPSTS=AUTOPSTS_" Auto-Post Date: "_$SELECT($PIECE(RC4,U,2)>0:$$FMTE^XLFDT($PIECE(RC4,U)),1:"")
+34 ; PRCA*4.5*349 - Shift down a line
SET VALMHDR(6)=AUTOPSTS
End DoDot:1
+35 ; BEGIN PRCA*4,.5*326
+36 ; Check for auto-decrease CARCs if this is a denial ERA
+37 IF $$GET1^DIQ(344.4,+RCSCR,.15)="NON"
Begin DoDot:1
+38 NEW RCARC
+39 SET RCARC=$$WLH^RCDPEWLZ(+RCSCR)
+40 ; PRCA*4.5*349 - Shift down a line
if RCARC]""
SET VALMHDR(5)=RCARC
End DoDot:1
+41 ; ENd PRCA*4,.5*326
+42 ; Displaying Current View (PRCA*4.5*298)
+43 ; PRCA*4.5*349 - Moved to top of routine and restructured
+44 QUIT
+45 ;
FNL ; -- Clean up list
+1 KILL ^TMP("RCDPE-EOB_WLDX",$JOB),^TMP("RCDPE-EOB_WL",$JOB),^TMP($JOB,"RC_SORTPARM"),^TMP($JOB,"RC_BILL")
+2 DO CLEAN^VALM10
DO CLEAR^VALM1
+3 KILL RCFASTXT
+4 QUIT
+5 ;
SEL(RCDA) ; Select entry from worklist scratch pad screen
+1 ; RCDA = array returned if selections made
+2 ; RCDA(n)=ien of entry(s) in file 344.41
+3 ; where n = the line # selected
+4 KILL RCDA
+5 NEW VALMY
+6 DO EN^VALM2($GET(XQORNOD(0)),"S")
+7 SET RCDA=0
FOR
SET RCDA=$ORDER(VALMY(RCDA))
if 'RCDA
QUIT
SET RCDA(RCDA)=$PIECE($GET(^TMP("RCDPE-EOB_WLDX",$JOB,RCDA)),U,2,5)
+8 QUIT
+9 ;
NOEDIT ; Display no edit allowed if receipt exists
+1 NEW DIR,X,Y
+2 SET DIR(0)="EA"
SET DIR("A",1)="This action is NOT available since the ERA already has a receipt."
+3 SET DIR("A")="PRESS RETURN TO CONTINUE "
+4 WRITE !
DO ^DIR
KILL DIR
WRITE !
+5 QUIT
+6 ;
NOBATCH ; Display action not allowed if working at batch level not the ERA level
+1 NEW DIR,X,Y
+2 SET DIR(0)="EA"
SET DIR("A",1)="This action is NOT valid when in a batch within the ERA."
+3 SET DIR("A")="PRESS RETURN TO CONTINUE "
+4 WRITE !
DO ^DIR
KILL DIR
WRITE !
+5 QUIT
+6 ;
RECEIPTS(RCSCR) ; get list of receipts for the ERA
+1 ; Input: RCSCR: ERA File (#344.4) IEN
+2 ; Output: "" - No Receipt / REC# - One Receipt / REC#A-REC#Z - Range of Receipts
+3 NEW X,RECEIPT,CTR,RC0
+4 KILL ARRAY,STR
+5 SET X=0
SET CTR=1
SET (STR,RECEIPT)=""
+6 FOR
SET X=$ORDER(^RCY(344.4,RCSCR,1,"RECEIPT",X))
if 'X
QUIT
Begin DoDot:1
+7 ; get external form of receipt
if X
SET RECEIPT=$PIECE($GET(^RCY(344,X,0)),U)
+8 IF RECEIPT]""
SET ARRAY(RECEIPT)=""
End DoDot:1
+9 ; array of receipts does not exist so this could be a non auto-posted ERA; so only 1 receipt will be assigned; retrieve at 344.4, .08
+10 IF '$DATA(ARRAY)
IF $$GET1^DIQ(344.4,RCSCR,.08)'=""
SET ARRAY($$GET1^DIQ(344.4,RCSCR,.08))=""
+11 ;
+12 IF $ORDER(ARRAY($ORDER(ARRAY(""))))'=""
Begin DoDot:1
+13 SET STR=$ORDER(ARRAY(""))_"-"_$ORDER(ARRAY(""),-1)
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 SET STR=$ORDER(ARRAY(""))
End DoDot:1
+16 QUIT STR
