RCDPEWLA ;ALB/TMK - ELECTRONIC EOB MESSAGE WORKLIST ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**173,208,298,317**;Mar 20, 1995;Build 8
;Per VA Directive 6402, this routine should not be modified.
ADDLINES(RCSCR) ; Add lines to file 344.49, delete any existing lines
; RCSCR = ien of entry in file 344.49
;
N DA,DD,DIC,DIE,DIK,DLAYGO,DO,DR,Q,Q0,Q1,RC0,RCA,RCA0,RCADJ,RCDEC,RCIFN,RCLINE,RCX,X,Y,Z,Z0
K ^TMP($J,"RCA")
S Z=0 F S Z=$O(^RCY(344.49,RCSCR,1,Z)) Q:'Z S DA(1)=RCSCR,DA=Z,DIK="^RCY(344.49,"_DA(1)_",1," D ^DIK
;
S RC0=$G(^RCY(344.4,RCSCR,0)) ; Entries are DINUMED
I $P(RC0,U,5)'="" S DR=".03////"_$P(RC0,U,5),DIE="^RCY(344.49,",DA=RCSCR D ^DIE
;
S Z=0 F S Z=$O(^RCY(344.4,+RC0,1,Z)) Q:'Z S RCA0=$G(^(Z,0)) I RCA0'="" D ; Sort the lines to put adjustments with the payments, check sort order
. ; for 0-pays
. I $P(RCA0,U,2) S RCIFN=+$G(^IBM(361.1,+$P(RCA0,U,2),0)),RCA=$P($G(^DGCR(399,RCIFN,0)),U) ; IA 4051
. I '$P(RCA0,U,2) S RCIFN="0;"_Z,RCA=$P(RCA0,U,5)
. I RCA="" S RCA=RCIFN
. I $D(^TMP($J,"RCA",RCA,+$P(RCA0,U,14))) D
.. F Q0=1:1:999 S Q=RCA_";"_$E(1000+Q0,2,4) I '$D(^TMP($J,"RCA",Q,+$P(RCA0,U,14))) S RCA=Q Q
. S ^TMP($J,"RCA",RCA,+$P(RCA0,U,14))=RCIFN_U_Z
;
S Z=0 F S Z=$O(^RCY(344.4,+RC0,2,Z)) Q:'Z S RCA0=$G(^(Z,0)) I RCA0'="" D ; Extract ERA level adjs
. S RCIFN=$P(RCA0,U),RCA="**ADJ"_Z
. S ^TMP($J,"RCA",RCA,1)=RCIFN_U_Z
;
I $P(RC0,U,9)=-1 D ; Check dec adj or additional receipt line needed
. S Z=+$O(^RCY(344.31,"AERA",RCSCR,0))
. Q:'Z
. I $P($G(^RCY(344.31,Z,0)),U,7)-$P(RC0,U,5) D Q
.. S ^TMP($J,"RCA","**ADJ0",1)="TOTALS MISMATCH^^"_($P($G(^RCY(344.31,Z,0)),U,7)-$P(RC0,U,5))
;
S Z="" F S Z=$O(^TMP($J,"RCA",Z)) Q:Z="" S Z0="" F S Z0=$O(^TMP($J,"RCA",Z,Z0)) Q:Z0="" D
. S Q=$P(Z,";") ; claim #
. S Q0=$S($E(Q,1,2)'="**":$G(^RCY(344.4,+RC0,1,+$P(^TMP($J,"RCA",Z,Z0),U,2),0)),Q["ADJ"&($P(Q,"ADJ",2)):$G(^RCY(344.4,+RC0,2,+$P(^TMP($J,"RCA",Z,Z0),U,2),0)),1:$G(^TMP($J,"RCA",Z,Z0)))
. ;
. S RCDEC=($P(Q0,U,3)<0) ; is this a decrease
. I Z0=0 D Q ; Add a payment line from the ERA
.. K DO,DD
.. S DIC(0)="L",DLAYGO=344.491,DA(1)=RCSCR,DIC="^RCY(344.49,"_DA(1)_",1,"
.. S DIC("DR")=".02////"_Q_";.05////"_$P(Q0,U,3)_";.06////"_$P(Q0,U,3)_";.09////"_$P(^TMP($J,"RCA",Z,Z0),U,2)_";.13////0"
.. ; prca*4.5*298 per requirements, keep code for creating/maintaining batches but remove from execution
.. ;I $G(^TMP($J,"BATCHES")) D ;prca*4.5*298
.. ;. Assign a batch # here
.. ;. S DIC("DR")=DIC("DR")_";.14////"_$$GETBATCH^RCDPEWLB(Q0) ;prca*4.5*298
.. F X=$O(^RCY(344.49,RCSCR,1,"ASEQ"," "),-1)+1:1 I '$D(^RCY(344.49,RCSCR,"B",X)) Q
.. S RCLINE=X
.. D FILE^DICN K DIC,DO,DD
.. S ^TMP($J,"RCA",Z)=+Y
.. S DIC(0)="L",DLAYGO=344.491,DA(1)=RCSCR,DIC="^RCY(344.49,"_DA(1)_",1,"
.. S DIC("DR")=".02////"_Q_";.05////"_$P(Q0,U,3)_";.06////"_$P(Q0,U,3)_$S($P(^TMP($J,"RCA",Z,Z0),U):";.07////"_$P(^TMP($J,"RCA",Z,Z0),U),1:"")
.. S X=RCLINE+.001
.. D FILE^DICN K DIC,DO,DD,DA
.. S $P(^TMP($J,"RCA",Z,0),U,3)=+Y S DA(1)=RCSCR,DA=+^TMP($J,"RCA",Z),DIE="^RCY(344.49,"_DA(1)_",1,",DR=".13////"_+$$VER^RCDPEV(RCSCR,$P(^TMP($J,"RCA",Z,Z0),U),+$P(^TMP($J,"RCA",Z,Z0),U,2)) D ^DIE
. ;
. I Z0=1,$P($G(^TMP($J,"RCA",Z,0)),U,3) D Q ; rev of claim within this ERA
.. ; Add adj to line previously added for payment
.. K DO,DD
.. S DA(2)=RCSCR,DA(1)=+$P($G(^TMP($J,"RCA",Z,0)),U,3),DIC(0)="L",DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,",DLAYGO=344.4911,X=+$O(^RCY(344.49,DA(2),1,DA(1),1," "),-1)+1
.. S DIC("DR")=".02////"_$S(RCDEC:2,1:4)_";.03////"_$P(Q0,U,3)_";.05////"_$S(RCDEC:"0;.08////1;.06////1",1:"3;.08////0;.06////0")_";.07////"_+Q0_";.13////0"
.. D FILE^DICN K DIC,DO,DD,DA
.. S Q1=$G(^RCY(344.49,RCSCR,1,+$P($G(^TMP($J,"RCA",Z,0)),U,3),0))
.. ; Upd net amt
.. S DA(1)=RCSCR,DA=+$P($G(^TMP($J,"RCA",Z,0)),U,3),DIE="^RCY(344.49,"_DA(1)_",1,",DR=".06////"_$J($P(Q1,U,6)+$P(Q0,U,3),"",2)_";.08////"_$J($P(Q1,U,8)+$P(Q0,U,3),"",2) D ^DIE
.. ;Upd seq ref,net in 'parent'
.. I $G(^TMP($J,"RCA",Z)) D
... S DA(1)=RCSCR,DA=+$G(^TMP($J,"RCA",Z)),DIE="^RCY(344.49,"_DA(1)_",1,",DR=".09////"_($P($G(^RCY(344.49,RCSCR,1,DA,0)),U,9)_","_$P(^TMP($J,"RCA",Z,Z0),U,2))_";.06////"_$J($P($G(^RCY(344.49,DA(1),1,DA,0)),U,6)+$P(Q0,U,3),"",2)
... D ^DIE
. ;
. I Z0=1 D Q ; ERA level adj, no payment for claim lev adj or mismatch
.. ;prca*4.5*298 - flag when an ERA level adj exists - cannot auto post ERAs with ERA level adjustments
.. S ^TMP($J,"RCDPEWLA","ERA LEVEL ADJUSTMENT EXISTS")=""
.. ; Add a line
.. K DO,DD
.. S RCADJ=$S(Z["**ADJ":1,1:0)
.. S DIC(0)="L",DLAYGO=344.491,DA(1)=RCSCR,DIC="^RCY(344.49,"_DA(1)_",1,"
.. S DIC("DR")=$S(Q'=0:".02////"_Q_";",1:"")_".03////0.00;.05////0.00;.13////0"
.. F X=$O(^RCY(344.49,RCSCR,1,"ASEQ"," "),-1)+1:1 I '$D(^RCY(344.49,RCSCR,"B",X)) L +^RCY(344.49,RCSCR,1,X,0):1 Q:$T
.. D FILE^DICN K DIC,DO,DD,DA
.. S RCLINE=+$P(Y,U,2),^TMP($J,"RCA",Z)=+Y
.. ;
.. S DIC(0)="L",DLAYGO=344.491,DA(1)=RCSCR,DIC="^RCY(344.49,"_DA(1)_",1,"
.. S DIC("DR")=$S('RCADJ:".02///"_$P(Z,";")_";",1:"")_".03////0.00;.05////0.00;.06////0.00"_$S($P(^TMP($J,"RCA",Z,Z0),U)&'RCADJ:";.07////"_$P(^TMP($J,"RCA",Z,Z0),U),1:"")
.. S X=RCLINE+.001
.. D FILE^DICN K DIC,DO,DD,DA
.. L -^RCY(344.49,RCSCR,1,RCLINE,0)
.. S RCLINE=+Y
.. ; Add adj record
.. S DIC(0)="L",DLAYGO=344.4911,DA(2)=RCSCR,DA(1)=RCLINE,DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,"
.. S DIC("DR")=".02////"_$S(RCDEC:2+RCADJ,1:4+RCADJ)_";.03////"_$P(Q0,U,3)_";.05////"_$S('RCDEC:"3;.06////0;.08////0",1:"0;.06////1;.08////1")_";.07////"_$S(RCADJ:Z_";.04////"_$P(^TMP($J,"RCA",Z,Z0),U),1:+$P(^TMP($J,"RCA",Z,Z0),U,2))
.. F RCX=$O(^RCY(344.49,RCSCR,1,RCLINE,1," "),-1)+1:1 I '$D(^RCY(344.49,RCSCR,1,RCLINE,1,X,0)) L +^RCY(344.49,RCSCR,1,RCLINE,1,RCX,0):1 Q:$T
.. S X=RCX
.. D FILE^DICN K DIC,DO,DD,DA
.. L -^RCY(344.49,RCSCR,1,RCLINE,1,RCX,0)
.. S DA(1)=RCSCR,DA=RCLINE,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".06////"_$P(Q0,U,3)_";.08////"_$P(Q0,U,3) D ^DIE
.. S Q1=$G(^RCY(344.49,RCSCR,1,RCLINE,0))
.. ; Upd seq ref,adj,payment in 'parent'
.. I $G(^TMP($J,"RCA",Z)) D
... S DA(1)=RCSCR,DA=+^TMP($J,"RCA",Z),DIE="^RCY(344.49,"_DA(1)_",1,"
... S DR=".09////"_$S(RCADJ:$S($P(Z,"**ADJ",2):$P(Z,"**",2),1:"TOTALS MISMATCH"),1:$P(^TMP($J,"RCA",Z,Z0),U,2))_";.06////"_$J($P($G(^RCY(344.49,DA(1),1,DA,0)),U,6)+$P(Q0,U,3),"",2)_";.08////"_$P(Q0,U,3)
... D ^DIE
;
K ^TMP($J,"RCA")
Q
;
TOOOLD(RCDEP) ; Check if deposit in ien RCDPE (file 344.1) is too old to use
N RCOLD,Q,DIR,X,Y
S Q=$$FMADD^XLFDT(DT,-7),RCOLD=0
I $P($G(^RCY(344.1,RCDEP,0)),U,3)<Q D
. S DIR("A",1)="This deposit was opened MORE THAN ONE WEEK ago ("_$$FMTE^XLFDT($P($G(^RCY(344.1,RCDEP,0)),U,3),2)_")",DIR("A")="Are you sure you want to use this deposit?: ",DIR("B")="NO",DIR(0)="YA" W ! D ^DIR K DIR
. I Y'=1 S RCOLD=1
Q RCOLD
;
PARAMS(SOURCE) ;EP Called from INIT^RCDPEWL
; Retrieve/Edit/Save View Parameters for EEOB Scratchpad Worklist
; Input: SOURCE - "MO" - Select Entry from the worklist
; "CV" - Change View from the scratch pad
; Output: ^TMP($J,"RC_SORTPARM")- Order of Payment
; ("N":No Order/"F":Zero-Payments First/"L":Zero-Payments Last)
; ^TMP($J,"RC_EEOBPOST")- EEOB Posting Status ("P":Posted/"U":Unposted/"B":Both)
; ^TMP("RCSCRATCH_PVW",$J,"RC_SORTPARM") - Order of Payment (same layout as above)
; ^TMP("RCSCRATCH_PVW",$J,"RC_EEOBPOST") - EEOB Posting Status (same layout as above)
;
; The ^TMP("RCSCRATCH_PVW",$J) global contains the sort/filters of the user's preferred
; view while ^TMP($J,"RC_SORTPARM") & ^TMP($J,"RC_EEOBPOST") contain the
; sort/filters of what is currently displayed. They may or may not be the same values.
;
; Or RCQUIT=1
;
N DIR,DTOUT,DUOUT,RCPOSTDF
N F,RCXPAR,USEPVW,X,XX,Y ; PRCA*4.5*317 added USEPVW,XX
S RCQUIT=0
;
; Get the Scratch Pad's preferred view settings (if any)
D GETLST^XPAR(.RCXPAR,"USR","RCDPE EDI LOCKBOX WORKLIST","I")
;
; PRCA*4.5*317 Save copy of the preferred view on file
I $D(RCXPAR("ORDER_OF_PAYMENTS")) D
. K ^TMP("RCSCRATCH_PVW",$J)
. ; only continue if we have answers to all Scratchpad related preferred view prompts
. Q:'$D(RCXPAR("EEOB_POSTING_STATUS")) ; already checked $D(RCXPAR("ORDER_OF_PAYMENTS")) above
. S ^TMP("RCSCRATCH_PVW",$J,"RC_SORTPARM")=RCXPAR("ORDER_OF_PAYMENTS")
. S ^TMP("RCSCRATCH_PVW",$J,"RC_EEOBPOST")=RCXPAR("EEOB_POSTING_STATUS")
;
; Setting ^TMP with user's saved parameters or System defaults
I '$D(^TMP($J,"RC_SORTPARM")) D
. S XX=$G(RCXPAR("ORDER_OF_PAYMENTS"))
. S ^TMP($J,"RC_SORTPARM")=$S(XX'="":XX,1:"N")
. S XX=$G(RCXPAR("EEOB_POSTING_STATUS"))
. S ^TMP($J,"RC_EEOBPOST")=$S(XX'="":XX,1:"U")
;
; PRCA*4.5*317 Start of added lines
; Only ask user if they want to use their preferred view in the following scenarios:
; a) Source is "MO" and user has a preferred view on file
; b) Source is "CV" (change view action), user has a preferred view but is
; not using the preferred view criteria at this time.
S XX=$$PREFVW(SOURCE)
I ((XX=1)&(SOURCE="MO"))!((XX=0)&(SOURCE="CV")) D Q:USEPVW
. ; Ask the user if they want to use the preferred view
. S USEPVW=0
. S USEPVW=$$ASKUVW^RCDPEWL0()
. I USEPVW=-1 S RCQUIT=1 Q
. Q:'USEPVW
. ;
. ;Set the Sort/Filtering Criteria from the preferred view
. S ^TMP($J,"RC_SORTPARM")=^TMP("RCSCRATCH_PVW",$J,"RC_SORTPARM")
. S ^TMP($J,"RC_EEOBPOST")=^TMP("RCSCRATCH_PVW",$J,"RC_EEOBPOST")
; PRCA*4.5*317 End of added lines
;
S RCQUIT=$$ORDERPAY() ; Ask Order of Payment Sort
Q:RCQUIT
S RCQUIT=$$POSTSTAT() ; Posting Status filter
Q:RCQUIT
D SAVEPVW ; Ask to save as preferred view
Q
;
PREFVW(SOURCE) ; Checks to see if the user has a preferred view
; PRCA*4.5*317 added subroutine
; When source is 'CV', checks to see if the preferred view is being used
; Input: SOURCE - 'MO' - When called from the Worklist menu
; option
; 'CV' - When called from the Change View
; action
;
; ^TMP("RCSCRATCH_PVW") - Global array of preferred view settings
; ^TMP($J,"RC_SORTPARM") - Order of Payment (currently displayed)
; ^TMP($J,"RC_EEOBPOST") - EEOB Posting Status (currently displayed)
;
; Returns: 1 - User has preferred view if SOURCE is 'MO' or is using
; their preferred view if SOURCE is 'CV'
; 0 - User is not using their preferred view
; -1 - User does not have a preferred view
I SOURCE="MO" Q $S($D(^TMP("RCSCRATCH_PVW",$J)):1,1:-1)
Q:'$D(^TMP("RCSCRATCH_PVW",$J)) -1 ; No stored preferred view
Q:$G(^TMP($J,"RC_SORTPARM"))'=$G(^TMP("RCSCRATCH_PVW",$J,"RC_SORTPARM")) 0
Q:$G(^TMP($J,"RC_EEOBPOST"))'=$G(^TMP("RCSCRATCH_PVW",$J,"RC_EEOBPOST")) 0
Q 1
;
ORDERPAY() ;ORDER OF PAYMENT Sort Selection
; Input: ^TMP($J,"RC_SORTPARM") - Current EEOB Sort Parameter (if any)
; Output: ^TMP($J,"RC_SORTPARM") - Updated EEOB Sort Parameter
; Returns: 1 if user quit or timed out, 0 otherwise
N DIR,DTOUT,DUOUT,RCSORTBY
S RCSORTBY=$G(^TMP($J,"RC_SORTPARM"))
K DIR
S DIR(0)="SA^N:NO ORDER;F:ZERO-PAYMENTS FIRST;L:ZERO-PAYMENTS LAST"
S DIR("A")="Order of Payment: (N)O ORDER, ZERO-PAYMENTS (F)IRST, ZERO-PAYMENTS (L)AST: "
S DIR("B")="B"
S DIR("?",1)="Enter NO ORDER to not specify a sort."
S DIR("?",2)="Enter FIRST to display ERAs with zero payments first."
S DIR("?")="Enter LAST to display ERAs with zero payments last."
S:RCSORTBY'="" DIR("B")=RCSORTBY ;Stored preferred view, use as default
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
S ^TMP($J,"RC_SORTPARM")=Y
Q 0
;
POSTSTAT() ; EEOB Posting Status (Posted/Unposted/Both) Selection
; Input: ^TMP($J,"RC_EEOBPOST") - Current EEOB Posting Status (if any)
; Output: ^TMP($J,"RC_EEOBPOST") - Updated EEOB Posting Status
; Returns: 1 if user quit or timed out, 0 otherwise
N DIR,DTOUT,DUOUT,RCPOSTDF
S RCPOSTDF=$G(^TMP($J,"RC_EEOBPOST"))
K DIR S DIR(0)="SA^U:UNPOSTED;P:POSTED;A:ALL"
S DIR("A")="Display for Auto-Posted ERAs: (U)NPOSTED EEOBs, (P)OSTED EEOBs, or (A)LL: "
S DIR("B")="U"
S DIR("?",1)="Enter UNPOSTED EEOBS to only display EEOBs that were not auto-posted."
S DIR("?",2)="Enter POSTED EEOBS to only display EEOBs that were auto-posted."
S DIR("?")="Enter ALL to display all EEOBs."
S:RCPOSTDF'="" DIR("B")=RCPOSTDF ;Stored preferred view, use as default
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
S ^TMP($J,"RC_EEOBPOST")=Y
Q 0
;
SAVEPVW ; Option to save as User Preferred View for the scratch pad
; PRCA*4.5*317 added subroutine
; Input: ^TMP($J,"RC_EEOBPOST") - Current EEOB Posting Status
; ^TMP($J,"RC_SORTPARM") - Current EEOB Sort Parameter
; Output Current worklist scratch pad settings set as preferred view (potentially)
N DIR,DTOUT,DUOUT,RCERROR,XX
K DIR
W !
S DIR(0)="YA",DIR("B")="NO"
S DIR("A")="Do you want to save this as your preferred view (Y/N)? "
D ^DIR
Q:Y'=1
S XX=^TMP($J,"RC_SORTPARM")
D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ORDER_OF_PAYMENTS",XX,.RCERROR)
S XX=^TMP($J,"RC_EEOBPOST")
D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","EEOB_POSTING_STATUS",XX,.RCERROR)
;
;Capture new preferred settings for comparison
K ^TMP("RCSCRATCH_PVW",$J)
S ^TMP("RCSCRATCH_PVW",$J,"RC_SORTPARM")=^TMP($J,"RC_SORTPARM")
S ^TMP("RCSCRATCH_PVW",$J,"RC_EEOBPOST")=^TMP($J,"RC_EEOBPOST")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEWLA 13756 printed Apr 09, 2024@20:46:12 Page 2
RCDPEWLA ;ALB/TMK - ELECTRONIC EOB MESSAGE WORKLIST ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**173,208,298,317**;Mar 20, 1995;Build 8
+2 ;Per VA Directive 6402, this routine should not be modified.
ADDLINES(RCSCR) ; Add lines to file 344.49, delete any existing lines
+1 ; RCSCR = ien of entry in file 344.49
+2 ;
+3 NEW DA,DD,DIC,DIE,DIK,DLAYGO,DO,DR,Q,Q0,Q1,RC0,RCA,RCA0,RCADJ,RCDEC,RCIFN,RCLINE,RCX,X,Y,Z,Z0
+4 KILL ^TMP($JOB,"RCA")
+5 SET Z=0
FOR
SET Z=$ORDER(^RCY(344.49,RCSCR,1,Z))
if 'Z
QUIT
SET DA(1)=RCSCR
SET DA=Z
SET DIK="^RCY(344.49,"_DA(1)_",1,"
DO ^DIK
+6 ;
+7 ; Entries are DINUMED
SET RC0=$GET(^RCY(344.4,RCSCR,0))
+8 IF $PIECE(RC0,U,5)'=""
SET DR=".03////"_$PIECE(RC0,U,5)
SET DIE="^RCY(344.49,"
SET DA=RCSCR
DO ^DIE
+9 ;
+10 ; Sort the lines to put adjustments with the payments, check sort order
SET Z=0
FOR
SET Z=$ORDER(^RCY(344.4,+RC0,1,Z))
if 'Z
QUIT
SET RCA0=$GET(^(Z,0))
IF RCA0'=""
Begin DoDot:1
+11 ; for 0-pays
+12 ; IA 4051
IF $PIECE(RCA0,U,2)
SET RCIFN=+$GET(^IBM(361.1,+$PIECE(RCA0,U,2),0))
SET RCA=$PIECE($GET(^DGCR(399,RCIFN,0)),U)
+13 IF '$PIECE(RCA0,U,2)
SET RCIFN="0;"_Z
SET RCA=$PIECE(RCA0,U,5)
+14 IF RCA=""
SET RCA=RCIFN
+15 IF $DATA(^TMP($JOB,"RCA",RCA,+$PIECE(RCA0,U,14)))
Begin DoDot:2
+16 FOR Q0=1:1:999
SET Q=RCA_";"_$EXTRACT(1000+Q0,2,4)
IF '$DATA(^TMP($JOB,"RCA",Q,+$PIECE(RCA0,U,14)))
SET RCA=Q
QUIT
End DoDot:2
+17 SET ^TMP($JOB,"RCA",RCA,+$PIECE(RCA0,U,14))=RCIFN_U_Z
End DoDot:1
+18 ;
+19 ; Extract ERA level adjs
SET Z=0
FOR
SET Z=$ORDER(^RCY(344.4,+RC0,2,Z))
if 'Z
QUIT
SET RCA0=$GET(^(Z,0))
IF RCA0'=""
Begin DoDot:1
+20 SET RCIFN=$PIECE(RCA0,U)
SET RCA="**ADJ"_Z
+21 SET ^TMP($JOB,"RCA",RCA,1)=RCIFN_U_Z
End DoDot:1
+22 ;
+23 ; Check dec adj or additional receipt line needed
IF $PIECE(RC0,U,9)=-1
Begin DoDot:1
+24 SET Z=+$ORDER(^RCY(344.31,"AERA",RCSCR,0))
+25 if 'Z
QUIT
+26 IF $PIECE($GET(^RCY(344.31,Z,0)),U,7)-$PIECE(RC0,U,5)
Begin DoDot:2
+27 SET ^TMP($JOB,"RCA","**ADJ0",1)="TOTALS MISMATCH^^"_($PIECE($GET(^RCY(344.31,Z,0)),U,7)-$PIECE(RC0,U,5))
End DoDot:2
QUIT
End DoDot:1
+28 ;
+29 SET Z=""
FOR
SET Z=$ORDER(^TMP($JOB,"RCA",Z))
if Z=""
QUIT
SET Z0=""
FOR
SET Z0=$ORDER(^TMP($JOB,"RCA",Z,Z0))
if Z0=""
QUIT
Begin DoDot:1
+30 ; claim #
SET Q=$PIECE(Z,";")
+31 SET Q0=$SELECT($EXTRACT(Q,1,2)'="**":$GET(^RCY(344.4,+RC0,1,+$PIECE(^TMP($JOB,"RCA",Z,Z0),U,2),0)),Q["ADJ"&($PIECE(Q,"ADJ",2)):$GET(^RCY(344.4,+RC0,2,+$PIECE(^TMP($JOB,"RCA",Z,Z0),U,2),0)),1:$GET(^TMP($JOB,"RCA",Z,Z0)))
+32 ;
+33 ; is this a decrease
SET RCDEC=($PIECE(Q0,U,3)<0)
+34 ; Add a payment line from the ERA
IF Z0=0
Begin DoDot:2
+35 KILL DO,DD
+36 SET DIC(0)="L"
SET DLAYGO=344.491
SET DA(1)=RCSCR
SET DIC="^RCY(344.49,"_DA(1)_",1,"
+37 SET DIC("DR")=".02////"_Q_";.05////"_$PIECE(Q0,U,3)_";.06////"_$PIECE(Q0,U,3)_";.09////"_$PIECE(^TMP($JOB,"RCA",Z,Z0),U,2)_";.13////0"
+38 ; prca*4.5*298 per requirements, keep code for creating/maintaining batches but remove from execution
+39 ;I $G(^TMP($J,"BATCHES")) D ;prca*4.5*298
+40 ;. Assign a batch # here
+41 ;. S DIC("DR")=DIC("DR")_";.14////"_$$GETBATCH^RCDPEWLB(Q0) ;prca*4.5*298
+42 FOR X=$ORDER(^RCY(344.49,RCSCR,1,"ASEQ"," "),-1)+1:1
IF '$DATA(^RCY(344.49,RCSCR,"B",X))
QUIT
+43 SET RCLINE=X
+44 DO FILE^DICN
KILL DIC,DO,DD
+45 SET ^TMP($JOB,"RCA",Z)=+Y
+46 SET DIC(0)="L"
SET DLAYGO=344.491
SET DA(1)=RCSCR
SET DIC="^RCY(344.49,"_DA(1)_",1,"
+47 SET DIC("DR")=".02////"_Q_";.05////"_$PIECE(Q0,U,3)_";.06////"_$PIECE(Q0,U,3)_$SELECT($PIECE(^TMP($JOB,"RCA",Z,Z0),U):";.07////"_$PIECE(^TMP($JOB,"RCA",Z,Z0),U),1:"")
+48 SET X=RCLINE+.001
+49 DO FILE^DICN
KILL DIC,DO,DD,DA
+50 SET $PIECE(^TMP($JOB,"RCA",Z,0),U,3)=+Y
SET DA(1)=RCSCR
SET DA=+^TMP($JOB,"RCA",Z)
SET DIE="^RCY(344.49,"_DA(1)_",1,"
SET DR=".13////"_+$$VER^RCDPEV(RCSCR,$PIECE(^TMP($JOB,"RCA",Z,Z0),U),+$PIECE(^TMP($JOB,"RCA",Z,Z0),U,2))
DO ^DIE
End DoDot:2
QUIT
+51 ;
+52 ; rev of claim within this ERA
IF Z0=1
IF $PIECE($GET(^TMP($JOB,"RCA",Z,0)),U,3)
Begin DoDot:2
+53 ; Add adj to line previously added for payment
+54 KILL DO,DD
+55 SET DA(2)=RCSCR
SET DA(1)=+$PIECE($GET(^TMP($JOB,"RCA",Z,0)),U,3)
SET DIC(0)="L"
SET DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,"
SET DLAYGO=344.4911
SET X=+$ORDER(^RCY(344.49,DA(2),1,DA(1),1," "),-1)+1
+56 SET DIC("DR")=".02////"_$SELECT(RCDEC:2,1:4)_";.03////"_$PIECE(Q0,U,3)_";.05////"_$SELECT(RCDEC:"0;.08////1;.06////1",1:"3;.08////0;.06////0")_";.07////"_+Q0_";.13////0"
+57 DO FILE^DICN
KILL DIC,DO,DD,DA
+58 SET Q1=$GET(^RCY(344.49,RCSCR,1,+$PIECE($GET(^TMP($JOB,"RCA",Z,0)),U,3),0))
+59 ; Upd net amt
+60 SET DA(1)=RCSCR
SET DA=+$PIECE($GET(^TMP($JOB,"RCA",Z,0)),U,3)
SET DIE="^RCY(344.49,"_DA(1)_",1,"
SET DR=".06////"_$JUSTIFY($PIECE(Q1,U,6)+$PIECE(Q0,U,3),"",2)_";.08////"_$JUSTIFY($PIECE(Q1,U,8)+$PIECE(Q0,U,3),"",2)
DO ^DIE
+61 ;Upd seq ref,net in 'parent'
+62 IF $GET(^TMP($JOB,"RCA",Z))
Begin DoDot:3
+63 SET DA(1)=RCSCR
SET DA=+$GET(^TMP($JOB,"RCA",Z))
SET DIE="^RCY(344.49,"_DA(1)_",1,"
SET DR=".09////"_($PIECE($GET(^RCY(344.49,RCSCR,1,DA,0)),U,9)_","_$PIECE(^TMP($JOB,"RCA",Z,Z0),U,2))_";.06////"_$JUSTIFY($PIECE($GET(^RCY(344.49,DA(1),1,DA,0)),U,6)+$PIECE(Q0,U,3),"",2)
+64 DO ^DIE
End DoDot:3
End DoDot:2
QUIT
+65 ;
+66 ; ERA level adj, no payment for claim lev adj or mismatch
IF Z0=1
Begin DoDot:2
+67 ;prca*4.5*298 - flag when an ERA level adj exists - cannot auto post ERAs with ERA level adjustments
+68 SET ^TMP($JOB,"RCDPEWLA","ERA LEVEL ADJUSTMENT EXISTS")=""
+69 ; Add a line
+70 KILL DO,DD
+71 SET RCADJ=$SELECT(Z["**ADJ":1,1:0)
+72 SET DIC(0)="L"
SET DLAYGO=344.491
SET DA(1)=RCSCR
SET DIC="^RCY(344.49,"_DA(1)_",1,"
+73 SET DIC("DR")=$SELECT(Q'=0:".02////"_Q_";",1:"")_".03////0.00;.05////0.00;.13////0"
+74 FOR X=$ORDER(^RCY(344.49,RCSCR,1,"ASEQ"," "),-1)+1:1
IF '$DATA(^RCY(344.49,RCSCR,"B",X))
LOCK +^RCY(344.49,RCSCR,1,X,0):1
if $TEST
QUIT
+75 DO FILE^DICN
KILL DIC,DO,DD,DA
+76 SET RCLINE=+$PIECE(Y,U,2)
SET ^TMP($JOB,"RCA",Z)=+Y
+77 ;
+78 SET DIC(0)="L"
SET DLAYGO=344.491
SET DA(1)=RCSCR
SET DIC="^RCY(344.49,"_DA(1)_",1,"
+79 SET DIC("DR")=$SELECT('RCADJ:".02///"_$PIECE(Z,";")_";",1:"")_".03////0.00;.05////0.00;.06////0.00"_$SELECT($PIECE(^TMP($JOB,"RCA",Z,Z0),U)&'RCADJ:";.07////"_$PIECE(^TMP($JOB,"RCA",Z,Z0),U),1:"")
+80 SET X=RCLINE+.001
+81 DO FILE^DICN
KILL DIC,DO,DD,DA
+82 LOCK -^RCY(344.49,RCSCR,1,RCLINE,0)
+83 SET RCLINE=+Y
+84 ; Add adj record
+85 SET DIC(0)="L"
SET DLAYGO=344.4911
SET DA(2)=RCSCR
SET DA(1)=RCLINE
SET DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,"
+86 SET DIC("DR")=".02////"_$SELECT(RCDEC:2+RCADJ,1:4+RCADJ)_";.03////"_$PIECE(Q0,U,3)_";.05////"_$SELECT('RCDEC:"3;.06////0;.08////0",1:"0;.06////1;.08////1")_";.07////"_$SELECT(RCADJ:Z_";.04////"_...
... $PIECE(^TMP($JOB,"RCA",Z,Z0),U),1:+$PIECE(^TMP($JOB,"RCA",Z,Z0),U,2))
+87 FOR RCX=$ORDER(^RCY(344.49,RCSCR,1,RCLINE,1," "),-1)+1:1
IF '$DATA(^RCY(344.49,RCSCR,1,RCLINE,1,X,0))
LOCK +^RCY(344.49,RCSCR,1,RCLINE,1,RCX,0):1
if $TEST
QUIT
+88 SET X=RCX
+89 DO FILE^DICN
KILL DIC,DO,DD,DA
+90 LOCK -^RCY(344.49,RCSCR,1,RCLINE,1,RCX,0)
+91 SET DA(1)=RCSCR
SET DA=RCLINE
SET DIE="^RCY(344.49,"_DA(1)_",1,"
SET DR=".06////"_$PIECE(Q0,U,3)_";.08////"_$PIECE(Q0,U,3)
DO ^DIE
+92 SET Q1=$GET(^RCY(344.49,RCSCR,1,RCLINE,0))
+93 ; Upd seq ref,adj,payment in 'parent'
+94 IF $GET(^TMP($JOB,"RCA",Z))
Begin DoDot:3
+95 SET DA(1)=RCSCR
SET DA=+^TMP($JOB,"RCA",Z)
SET DIE="^RCY(344.49,"_DA(1)_",1,"
+96 SET DR=".09////"_$SELECT(RCADJ:$SELECT($PIECE(Z,"**ADJ",2):$PIECE(Z,"**",2),1:"TOTALS MISMATCH"),1:$PIECE(^TMP($JOB,"RCA",Z,Z0),U,2))_";.06////"_$JUSTIFY($PIECE($GET(^RCY(344.49,DA(1),1,DA,0)),U,6)+$PIECE(Q0,U,3),"",
2)_";.08////"_$PIECE(Q0,U,3)
+97 DO ^DIE
End DoDot:3
End DoDot:2
QUIT
End DoDot:1
+98 ;
+99 KILL ^TMP($JOB,"RCA")
+100 QUIT
+101 ;
TOOOLD(RCDEP) ; Check if deposit in ien RCDPE (file 344.1) is too old to use
+1 NEW RCOLD,Q,DIR,X,Y
+2 SET Q=$$FMADD^XLFDT(DT,-7)
SET RCOLD=0
+3 IF $PIECE($GET(^RCY(344.1,RCDEP,0)),U,3)<Q
Begin DoDot:1
+4 SET DIR("A",1)="This deposit was opened MORE THAN ONE WEEK ago ("_$$FMTE^XLFDT($PIECE($GET(^RCY(344.1,RCDEP,0)),U,3),2)_")"
SET DIR("A")="Are you sure you want to use this deposit?: "
SET DIR("B")="NO"
SET DIR(0)="YA"
WRITE !
DO ^DIR
KILL DIR
+5 IF Y'=1
SET RCOLD=1
End DoDot:1
+6 QUIT RCOLD
+7 ;
PARAMS(SOURCE) ;EP Called from INIT^RCDPEWL
+1 ; Retrieve/Edit/Save View Parameters for EEOB Scratchpad Worklist
+2 ; Input: SOURCE - "MO" - Select Entry from the worklist
+3 ; "CV" - Change View from the scratch pad
+4 ; Output: ^TMP($J,"RC_SORTPARM")- Order of Payment
+5 ; ("N":No Order/"F":Zero-Payments First/"L":Zero-Payments Last)
+6 ; ^TMP($J,"RC_EEOBPOST")- EEOB Posting Status ("P":Posted/"U":Unposted/"B":Both)
+7 ; ^TMP("RCSCRATCH_PVW",$J,"RC_SORTPARM") - Order of Payment (same layout as above)
+8 ; ^TMP("RCSCRATCH_PVW",$J,"RC_EEOBPOST") - EEOB Posting Status (same layout as above)
+9 ;
+10 ; The ^TMP("RCSCRATCH_PVW",$J) global contains the sort/filters of the user's preferred
+11 ; view while ^TMP($J,"RC_SORTPARM") & ^TMP($J,"RC_EEOBPOST") contain the
+12 ; sort/filters of what is currently displayed. They may or may not be the same values.
+13 ;
+14 ; Or RCQUIT=1
+15 ;
+16 NEW DIR,DTOUT,DUOUT,RCPOSTDF
+17 ; PRCA*4.5*317 added USEPVW,XX
NEW F,RCXPAR,USEPVW,X,XX,Y
+18 SET RCQUIT=0
+19 ;
+20 ; Get the Scratch Pad's preferred view settings (if any)
+21 DO GETLST^XPAR(.RCXPAR,"USR","RCDPE EDI LOCKBOX WORKLIST","I")
+22 ;
+23 ; PRCA*4.5*317 Save copy of the preferred view on file
+24 IF $DATA(RCXPAR("ORDER_OF_PAYMENTS"))
Begin DoDot:1
+25 KILL ^TMP("RCSCRATCH_PVW",$JOB)
+26 ; only continue if we have answers to all Scratchpad related preferred view prompts
+27 ; already checked $D(RCXPAR("ORDER_OF_PAYMENTS")) above
if '$DATA(RCXPAR("EEOB_POSTING_STATUS"))
QUIT
+28 SET ^TMP("RCSCRATCH_PVW",$JOB,"RC_SORTPARM")=RCXPAR("ORDER_OF_PAYMENTS")
+29 SET ^TMP("RCSCRATCH_PVW",$JOB,"RC_EEOBPOST")=RCXPAR("EEOB_POSTING_STATUS")
End DoDot:1
+30 ;
+31 ; Setting ^TMP with user's saved parameters or System defaults
+32 IF '$DATA(^TMP($JOB,"RC_SORTPARM"))
Begin DoDot:1
+33 SET XX=$GET(RCXPAR("ORDER_OF_PAYMENTS"))
+34 SET ^TMP($JOB,"RC_SORTPARM")=$SELECT(XX'="":XX,1:"N")
+35 SET XX=$GET(RCXPAR("EEOB_POSTING_STATUS"))
+36 SET ^TMP($JOB,"RC_EEOBPOST")=$SELECT(XX'="":XX,1:"U")
End DoDot:1
+37 ;
+38 ; PRCA*4.5*317 Start of added lines
+39 ; Only ask user if they want to use their preferred view in the following scenarios:
+40 ; a) Source is "MO" and user has a preferred view on file
+41 ; b) Source is "CV" (change view action), user has a preferred view but is
+42 ; not using the preferred view criteria at this time.
+43 SET XX=$$PREFVW(SOURCE)
+44 IF ((XX=1)&(SOURCE="MO"))!((XX=0)&(SOURCE="CV"))
Begin DoDot:1
+45 ; Ask the user if they want to use the preferred view
+46 SET USEPVW=0
+47 SET USEPVW=$$ASKUVW^RCDPEWL0()
+48 IF USEPVW=-1
SET RCQUIT=1
QUIT
+49 if 'USEPVW
QUIT
+50 ;
+51 ;Set the Sort/Filtering Criteria from the preferred view
+52 SET ^TMP($JOB,"RC_SORTPARM")=^TMP("RCSCRATCH_PVW",$JOB,"RC_SORTPARM")
+53 SET ^TMP($JOB,"RC_EEOBPOST")=^TMP("RCSCRATCH_PVW",$JOB,"RC_EEOBPOST")
End DoDot:1
if USEPVW
QUIT
+54 ; PRCA*4.5*317 End of added lines
+55 ;
+56 ; Ask Order of Payment Sort
SET RCQUIT=$$ORDERPAY()
+57 if RCQUIT
QUIT
+58 ; Posting Status filter
SET RCQUIT=$$POSTSTAT()
+59 if RCQUIT
QUIT
+60 ; Ask to save as preferred view
DO SAVEPVW
+61 QUIT
+62 ;
PREFVW(SOURCE) ; Checks to see if the user has a preferred view
+1 ; PRCA*4.5*317 added subroutine
+2 ; When source is 'CV', checks to see if the preferred view is being used
+3 ; Input: SOURCE - 'MO' - When called from the Worklist menu
+4 ; option
+5 ; 'CV' - When called from the Change View
+6 ; action
+7 ;
+8 ; ^TMP("RCSCRATCH_PVW") - Global array of preferred view settings
+9 ; ^TMP($J,"RC_SORTPARM") - Order of Payment (currently displayed)
+10 ; ^TMP($J,"RC_EEOBPOST") - EEOB Posting Status (currently displayed)
+11 ;
+12 ; Returns: 1 - User has preferred view if SOURCE is 'MO' or is using
+13 ; their preferred view if SOURCE is 'CV'
+14 ; 0 - User is not using their preferred view
+15 ; -1 - User does not have a preferred view
+16 IF SOURCE="MO"
QUIT $SELECT($DATA(^TMP("RCSCRATCH_PVW",$JOB)):1,1:-1)
+17 ; No stored preferred view
if '$DATA(^TMP("RCSCRATCH_PVW",$JOB))
QUIT -1
+18 if $GET(^TMP($JOB,"RC_SORTPARM"))'=$GET(^TMP("RCSCRATCH_PVW",$JOB,"RC_SORTPARM"))
QUIT 0
+19 if $GET(^TMP($JOB,"RC_EEOBPOST"))'=$GET(^TMP("RCSCRATCH_PVW",$JOB,"RC_EEOBPOST"))
QUIT 0
+20 QUIT 1
+21 ;
ORDERPAY() ;ORDER OF PAYMENT Sort Selection
+1 ; Input: ^TMP($J,"RC_SORTPARM") - Current EEOB Sort Parameter (if any)
+2 ; Output: ^TMP($J,"RC_SORTPARM") - Updated EEOB Sort Parameter
+3 ; Returns: 1 if user quit or timed out, 0 otherwise
+4 NEW DIR,DTOUT,DUOUT,RCSORTBY
+5 SET RCSORTBY=$GET(^TMP($JOB,"RC_SORTPARM"))
+6 KILL DIR
+7 SET DIR(0)="SA^N:NO ORDER;F:ZERO-PAYMENTS FIRST;L:ZERO-PAYMENTS LAST"
+8 SET DIR("A")="Order of Payment: (N)O ORDER, ZERO-PAYMENTS (F)IRST, ZERO-PAYMENTS (L)AST: "
+9 SET DIR("B")="B"
+10 SET DIR("?",1)="Enter NO ORDER to not specify a sort."
+11 SET DIR("?",2)="Enter FIRST to display ERAs with zero payments first."
+12 SET DIR("?")="Enter LAST to display ERAs with zero payments last."
+13 ;Stored preferred view, use as default
if RCSORTBY'=""
SET DIR("B")=RCSORTBY
+14 WRITE !
+15 DO ^DIR
+16 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+17 SET ^TMP($JOB,"RC_SORTPARM")=Y
+18 QUIT 0
+19 ;
POSTSTAT() ; EEOB Posting Status (Posted/Unposted/Both) Selection
+1 ; Input: ^TMP($J,"RC_EEOBPOST") - Current EEOB Posting Status (if any)
+2 ; Output: ^TMP($J,"RC_EEOBPOST") - Updated EEOB Posting Status
+3 ; Returns: 1 if user quit or timed out, 0 otherwise
+4 NEW DIR,DTOUT,DUOUT,RCPOSTDF
+5 SET RCPOSTDF=$GET(^TMP($JOB,"RC_EEOBPOST"))
+6 KILL DIR
SET DIR(0)="SA^U:UNPOSTED;P:POSTED;A:ALL"
+7 SET DIR("A")="Display for Auto-Posted ERAs: (U)NPOSTED EEOBs, (P)OSTED EEOBs, or (A)LL: "
+8 SET DIR("B")="U"
+9 SET DIR("?",1)="Enter UNPOSTED EEOBS to only display EEOBs that were not auto-posted."
+10 SET DIR("?",2)="Enter POSTED EEOBS to only display EEOBs that were auto-posted."
+11 SET DIR("?")="Enter ALL to display all EEOBs."
+12 ;Stored preferred view, use as default
if RCPOSTDF'=""
SET DIR("B")=RCPOSTDF
+13 WRITE !
+14 DO ^DIR
+15 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+16 SET ^TMP($JOB,"RC_EEOBPOST")=Y
+17 QUIT 0
+18 ;
SAVEPVW ; Option to save as User Preferred View for the scratch pad
+1 ; PRCA*4.5*317 added subroutine
+2 ; Input: ^TMP($J,"RC_EEOBPOST") - Current EEOB Posting Status
+3 ; ^TMP($J,"RC_SORTPARM") - Current EEOB Sort Parameter
+4 ; Output Current worklist scratch pad settings set as preferred view (potentially)
+5 NEW DIR,DTOUT,DUOUT,RCERROR,XX
+6 KILL DIR
+7 WRITE !
+8 SET DIR(0)="YA"
SET DIR("B")="NO"
+9 SET DIR("A")="Do you want to save this as your preferred view (Y/N)? "
+10 DO ^DIR
+11 if Y'=1
QUIT
+12 SET XX=^TMP($JOB,"RC_SORTPARM")
+13 DO EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ORDER_OF_PAYMENTS",XX,.RCERROR)
+14 SET XX=^TMP($JOB,"RC_EEOBPOST")
+15 DO EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","EEOB_POSTING_STATUS",XX,.RCERROR)
+16 ;
+17 ;Capture new preferred settings for comparison
+18 KILL ^TMP("RCSCRATCH_PVW",$JOB)
+19 SET ^TMP("RCSCRATCH_PVW",$JOB,"RC_SORTPARM")=^TMP($JOB,"RC_SORTPARM")
+20 SET ^TMP("RCSCRATCH_PVW",$JOB,"RC_EEOBPOST")=^TMP($JOB,"RC_EEOBPOST")
+21 QUIT
