Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPEWLA

RCDPEWLA.m

Go to the documentation of this file.
  1. 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
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ADDLINES(RCSCR) ; Add lines to file 344.49, delete any existing lines
  1. ; RCSCR = ien of entry in file 344.49
  1. ;
  1. N DA,DD,DIC,DIE,DIK,DLAYGO,DO,DR,Q,Q0,Q1,RC0,RCA,RCA0,RCADJ,RCDEC,RCIFN,RCLINE,RCX,X,Y,Z,Z0
  1. K ^TMP($J,"RCA")
  1. 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
  1. ;
  1. S RC0=$G(^RCY(344.4,RCSCR,0)) ; Entries are DINUMED
  1. I $P(RC0,U,5)'="" S DR=".03////"_$P(RC0,U,5),DIE="^RCY(344.49,",DA=RCSCR D ^DIE
  1. ;
  1. 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
  1. . ; for 0-pays
  1. . 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
  1. . I '$P(RCA0,U,2) S RCIFN="0;"_Z,RCA=$P(RCA0,U,5)
  1. . I RCA="" S RCA=RCIFN
  1. . I $D(^TMP($J,"RCA",RCA,+$P(RCA0,U,14))) D
  1. .. 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
  1. . S ^TMP($J,"RCA",RCA,+$P(RCA0,U,14))=RCIFN_U_Z
  1. ;
  1. 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
  1. . S RCIFN=$P(RCA0,U),RCA="**ADJ"_Z
  1. . S ^TMP($J,"RCA",RCA,1)=RCIFN_U_Z
  1. ;
  1. I $P(RC0,U,9)=-1 D ; Check dec adj or additional receipt line needed
  1. . S Z=+$O(^RCY(344.31,"AERA",RCSCR,0))
  1. . Q:'Z
  1. . I $P($G(^RCY(344.31,Z,0)),U,7)-$P(RC0,U,5) D Q
  1. .. S ^TMP($J,"RCA","**ADJ0",1)="TOTALS MISMATCH^^"_($P($G(^RCY(344.31,Z,0)),U,7)-$P(RC0,U,5))
  1. ;
  1. 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
  1. . S Q=$P(Z,";") ; claim #
  1. . 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)))
  1. . ;
  1. . S RCDEC=($P(Q0,U,3)<0) ; is this a decrease
  1. . I Z0=0 D Q ; Add a payment line from the ERA
  1. .. K DO,DD
  1. .. S DIC(0)="L",DLAYGO=344.491,DA(1)=RCSCR,DIC="^RCY(344.49,"_DA(1)_",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"
  1. .. ; prca*4.5*298 per requirements, keep code for creating/maintaining batches but remove from execution
  1. .. ;I $G(^TMP($J,"BATCHES")) D ;prca*4.5*298
  1. .. ;. Assign a batch # here
  1. .. ;. S DIC("DR")=DIC("DR")_";.14////"_$$GETBATCH^RCDPEWLB(Q0) ;prca*4.5*298
  1. .. F X=$O(^RCY(344.49,RCSCR,1,"ASEQ"," "),-1)+1:1 I '$D(^RCY(344.49,RCSCR,"B",X)) Q
  1. .. S RCLINE=X
  1. .. D FILE^DICN K DIC,DO,DD
  1. .. S ^TMP($J,"RCA",Z)=+Y
  1. .. S DIC(0)="L",DLAYGO=344.491,DA(1)=RCSCR,DIC="^RCY(344.49,"_DA(1)_",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:"")
  1. .. S X=RCLINE+.001
  1. .. D FILE^DICN K DIC,DO,DD,DA
  1. .. 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
  1. . ;
  1. . I Z0=1,$P($G(^TMP($J,"RCA",Z,0)),U,3) D Q ; rev of claim within this ERA
  1. .. ; Add adj to line previously added for payment
  1. .. K DO,DD
  1. .. 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
  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"
  1. .. D FILE^DICN K DIC,DO,DD,DA
  1. .. S Q1=$G(^RCY(344.49,RCSCR,1,+$P($G(^TMP($J,"RCA",Z,0)),U,3),0))
  1. .. ; Upd net amt
  1. .. 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
  1. .. ;Upd seq ref,net in 'parent'
  1. .. I $G(^TMP($J,"RCA",Z)) D
  1. ... 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)
  1. ... D ^DIE
  1. . ;
  1. . I Z0=1 D Q ; ERA level adj, no payment for claim lev adj or mismatch
  1. .. ;prca*4.5*298 - flag when an ERA level adj exists - cannot auto post ERAs with ERA level adjustments
  1. .. S ^TMP($J,"RCDPEWLA","ERA LEVEL ADJUSTMENT EXISTS")=""
  1. .. ; Add a line
  1. .. K DO,DD
  1. .. S RCADJ=$S(Z["**ADJ":1,1:0)
  1. .. S DIC(0)="L",DLAYGO=344.491,DA(1)=RCSCR,DIC="^RCY(344.49,"_DA(1)_",1,"
  1. .. S DIC("DR")=$S(Q'=0:".02////"_Q_";",1:"")_".03////0.00;.05////0.00;.13////0"
  1. .. 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
  1. .. D FILE^DICN K DIC,DO,DD,DA
  1. .. S RCLINE=+$P(Y,U,2),^TMP($J,"RCA",Z)=+Y
  1. .. ;
  1. .. S DIC(0)="L",DLAYGO=344.491,DA(1)=RCSCR,DIC="^RCY(344.49,"_DA(1)_",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:"")
  1. .. S X=RCLINE+.001
  1. .. D FILE^DICN K DIC,DO,DD,DA
  1. .. L -^RCY(344.49,RCSCR,1,RCLINE,0)
  1. .. S RCLINE=+Y
  1. .. ; Add adj record
  1. .. S DIC(0)="L",DLAYGO=344.4911,DA(2)=RCSCR,DA(1)=RCLINE,DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",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))
  1. .. 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
  1. .. S X=RCX
  1. .. D FILE^DICN K DIC,DO,DD,DA
  1. .. L -^RCY(344.49,RCSCR,1,RCLINE,1,RCX,0)
  1. .. 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
  1. .. S Q1=$G(^RCY(344.49,RCSCR,1,RCLINE,0))
  1. .. ; Upd seq ref,adj,payment in 'parent'
  1. .. I $G(^TMP($J,"RCA",Z)) D
  1. ... S DA(1)=RCSCR,DA=+^TMP($J,"RCA",Z),DIE="^RCY(344.49,"_DA(1)_",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)
  1. ... D ^DIE
  1. ;
  1. K ^TMP($J,"RCA")
  1. Q
  1. ;
  1. TOOOLD(RCDEP) ; Check if deposit in ien RCDPE (file 344.1) is too old to use
  1. N RCOLD,Q,DIR,X,Y
  1. S Q=$$FMADD^XLFDT(DT,-7),RCOLD=0
  1. I $P($G(^RCY(344.1,RCDEP,0)),U,3)<Q D
  1. . 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
  1. . I Y'=1 S RCOLD=1
  1. Q RCOLD
  1. ;
  1. PARAMS(SOURCE) ;EP Called from INIT^RCDPEWL
  1. ; Retrieve/Edit/Save View Parameters for EEOB Scratchpad Worklist
  1. ; Input: SOURCE - "MO" - Select Entry from the worklist
  1. ; "CV" - Change View from the scratch pad
  1. ; Output: ^TMP($J,"RC_SORTPARM")- Order of Payment
  1. ; ("N":No Order/"F":Zero-Payments First/"L":Zero-Payments Last)
  1. ; ^TMP($J,"RC_EEOBPOST")- EEOB Posting Status ("P":Posted/"U":Unposted/"B":Both)
  1. ; ^TMP("RCSCRATCH_PVW",$J,"RC_SORTPARM") - Order of Payment (same layout as above)
  1. ; ^TMP("RCSCRATCH_PVW",$J,"RC_EEOBPOST") - EEOB Posting Status (same layout as above)
  1. ;
  1. ; The ^TMP("RCSCRATCH_PVW",$J) global contains the sort/filters of the user's preferred
  1. ; view while ^TMP($J,"RC_SORTPARM") & ^TMP($J,"RC_EEOBPOST") contain the
  1. ; sort/filters of what is currently displayed. They may or may not be the same values.
  1. ;
  1. ; Or RCQUIT=1
  1. ;
  1. N DIR,DTOUT,DUOUT,RCPOSTDF
  1. N F,RCXPAR,USEPVW,X,XX,Y ; PRCA*4.5*317 added USEPVW,XX
  1. S RCQUIT=0
  1. ;
  1. ; Get the Scratch Pad's preferred view settings (if any)
  1. D GETLST^XPAR(.RCXPAR,"USR","RCDPE EDI LOCKBOX WORKLIST","I")
  1. ;
  1. ; PRCA*4.5*317 Save copy of the preferred view on file
  1. I $D(RCXPAR("ORDER_OF_PAYMENTS")) D
  1. . K ^TMP("RCSCRATCH_PVW",$J)
  1. . ; only continue if we have answers to all Scratchpad related preferred view prompts
  1. . Q:'$D(RCXPAR("EEOB_POSTING_STATUS")) ; already checked $D(RCXPAR("ORDER_OF_PAYMENTS")) above
  1. . S ^TMP("RCSCRATCH_PVW",$J,"RC_SORTPARM")=RCXPAR("ORDER_OF_PAYMENTS")
  1. . S ^TMP("RCSCRATCH_PVW",$J,"RC_EEOBPOST")=RCXPAR("EEOB_POSTING_STATUS")
  1. ;
  1. ; Setting ^TMP with user's saved parameters or System defaults
  1. I '$D(^TMP($J,"RC_SORTPARM")) D
  1. . S XX=$G(RCXPAR("ORDER_OF_PAYMENTS"))
  1. . S ^TMP($J,"RC_SORTPARM")=$S(XX'="":XX,1:"N")
  1. . S XX=$G(RCXPAR("EEOB_POSTING_STATUS"))
  1. . S ^TMP($J,"RC_EEOBPOST")=$S(XX'="":XX,1:"U")
  1. ;
  1. ; PRCA*4.5*317 Start of added lines
  1. ; Only ask user if they want to use their preferred view in the following scenarios:
  1. ; a) Source is "MO" and user has a preferred view on file
  1. ; b) Source is "CV" (change view action), user has a preferred view but is
  1. ; not using the preferred view criteria at this time.
  1. S XX=$$PREFVW(SOURCE)
  1. I ((XX=1)&(SOURCE="MO"))!((XX=0)&(SOURCE="CV")) D Q:USEPVW
  1. . ; Ask the user if they want to use the preferred view
  1. . S USEPVW=0
  1. . S USEPVW=$$ASKUVW^RCDPEWL0()
  1. . I USEPVW=-1 S RCQUIT=1 Q
  1. . Q:'USEPVW
  1. . ;
  1. . ;Set the Sort/Filtering Criteria from the preferred view
  1. . S ^TMP($J,"RC_SORTPARM")=^TMP("RCSCRATCH_PVW",$J,"RC_SORTPARM")
  1. . S ^TMP($J,"RC_EEOBPOST")=^TMP("RCSCRATCH_PVW",$J,"RC_EEOBPOST")
  1. ; PRCA*4.5*317 End of added lines
  1. ;
  1. S RCQUIT=$$ORDERPAY() ; Ask Order of Payment Sort
  1. Q:RCQUIT
  1. S RCQUIT=$$POSTSTAT() ; Posting Status filter
  1. Q:RCQUIT
  1. D SAVEPVW ; Ask to save as preferred view
  1. Q
  1. ;
  1. PREFVW(SOURCE) ; Checks to see if the user has a preferred view
  1. ; PRCA*4.5*317 added subroutine
  1. ; When source is 'CV', checks to see if the preferred view is being used
  1. ; Input: SOURCE - 'MO' - When called from the Worklist menu
  1. ; option
  1. ; 'CV' - When called from the Change View
  1. ; action
  1. ;
  1. ; ^TMP("RCSCRATCH_PVW") - Global array of preferred view settings
  1. ; ^TMP($J,"RC_SORTPARM") - Order of Payment (currently displayed)
  1. ; ^TMP($J,"RC_EEOBPOST") - EEOB Posting Status (currently displayed)
  1. ;
  1. ; Returns: 1 - User has preferred view if SOURCE is 'MO' or is using
  1. ; their preferred view if SOURCE is 'CV'
  1. ; 0 - User is not using their preferred view
  1. ; -1 - User does not have a preferred view
  1. I SOURCE="MO" Q $S($D(^TMP("RCSCRATCH_PVW",$J)):1,1:-1)
  1. Q:'$D(^TMP("RCSCRATCH_PVW",$J)) -1 ; No stored preferred view
  1. Q:$G(^TMP($J,"RC_SORTPARM"))'=$G(^TMP("RCSCRATCH_PVW",$J,"RC_SORTPARM")) 0
  1. Q:$G(^TMP($J,"RC_EEOBPOST"))'=$G(^TMP("RCSCRATCH_PVW",$J,"RC_EEOBPOST")) 0
  1. Q 1
  1. ;
  1. ORDERPAY() ;ORDER OF PAYMENT Sort Selection
  1. ; Input: ^TMP($J,"RC_SORTPARM") - Current EEOB Sort Parameter (if any)
  1. ; Output: ^TMP($J,"RC_SORTPARM") - Updated EEOB Sort Parameter
  1. ; Returns: 1 if user quit or timed out, 0 otherwise
  1. N DIR,DTOUT,DUOUT,RCSORTBY
  1. S RCSORTBY=$G(^TMP($J,"RC_SORTPARM"))
  1. K DIR
  1. S DIR(0)="SA^N:NO ORDER;F:ZERO-PAYMENTS FIRST;L:ZERO-PAYMENTS LAST"
  1. S DIR("A")="Order of Payment: (N)O ORDER, ZERO-PAYMENTS (F)IRST, ZERO-PAYMENTS (L)AST: "
  1. S DIR("B")="B"
  1. S DIR("?",1)="Enter NO ORDER to not specify a sort."
  1. S DIR("?",2)="Enter FIRST to display ERAs with zero payments first."
  1. S DIR("?")="Enter LAST to display ERAs with zero payments last."
  1. S:RCSORTBY'="" DIR("B")=RCSORTBY ;Stored preferred view, use as default
  1. W !
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) Q 1
  1. S ^TMP($J,"RC_SORTPARM")=Y
  1. Q 0
  1. ;
  1. POSTSTAT() ; EEOB Posting Status (Posted/Unposted/Both) Selection
  1. ; Input: ^TMP($J,"RC_EEOBPOST") - Current EEOB Posting Status (if any)
  1. ; Output: ^TMP($J,"RC_EEOBPOST") - Updated EEOB Posting Status
  1. ; Returns: 1 if user quit or timed out, 0 otherwise
  1. N DIR,DTOUT,DUOUT,RCPOSTDF
  1. S RCPOSTDF=$G(^TMP($J,"RC_EEOBPOST"))
  1. K DIR S DIR(0)="SA^U:UNPOSTED;P:POSTED;A:ALL"
  1. S DIR("A")="Display for Auto-Posted ERAs: (U)NPOSTED EEOBs, (P)OSTED EEOBs, or (A)LL: "
  1. S DIR("B")="U"
  1. S DIR("?",1)="Enter UNPOSTED EEOBS to only display EEOBs that were not auto-posted."
  1. S DIR("?",2)="Enter POSTED EEOBS to only display EEOBs that were auto-posted."
  1. S DIR("?")="Enter ALL to display all EEOBs."
  1. S:RCPOSTDF'="" DIR("B")=RCPOSTDF ;Stored preferred view, use as default
  1. W !
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) Q 1
  1. S ^TMP($J,"RC_EEOBPOST")=Y
  1. Q 0
  1. ;
  1. SAVEPVW ; Option to save as User Preferred View for the scratch pad
  1. ; PRCA*4.5*317 added subroutine
  1. ; Input: ^TMP($J,"RC_EEOBPOST") - Current EEOB Posting Status
  1. ; ^TMP($J,"RC_SORTPARM") - Current EEOB Sort Parameter
  1. ; Output Current worklist scratch pad settings set as preferred view (potentially)
  1. N DIR,DTOUT,DUOUT,RCERROR,XX
  1. K DIR
  1. W !
  1. S DIR(0)="YA",DIR("B")="NO"
  1. S DIR("A")="Do you want to save this as your preferred view (Y/N)? "
  1. D ^DIR
  1. Q:Y'=1
  1. S XX=^TMP($J,"RC_SORTPARM")
  1. D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ORDER_OF_PAYMENTS",XX,.RCERROR)
  1. S XX=^TMP($J,"RC_EEOBPOST")
  1. D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","EEOB_POSTING_STATUS",XX,.RCERROR)
  1. ;
  1. ;Capture new preferred settings for comparison
  1. K ^TMP("RCSCRATCH_PVW",$J)
  1. S ^TMP("RCSCRATCH_PVW",$J,"RC_SORTPARM")=^TMP($J,"RC_SORTPARM")
  1. S ^TMP("RCSCRATCH_PVW",$J,"RC_EEOBPOST")=^TMP($J,"RC_EEOBPOST")
  1. Q