RCDPEAA2 ;ALB/KML - APAR Screen - SELECTED EOB ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**298,304,318,321,326,332**;Mar 20, 1995;Build 40
;Per VA Directive 6402, this routine should not be modified.
Q
;
INIT(RCIENS) ; Entry point for List template to build the display of the EEOB on APAR
;
; Input - RCIENS = ien of entry in file 344.49^ien of 344.491^selectable line item from listman screen
;
N FDTTM
D CLEAN^VALM10
K ^TMP("RCDPE-EOB_WL",$J),^TMP("RCDPE-EOB_WLDX",$J),^TMP("RCS",$J)
S VALMCNT=0,VALMBG=1
D BLD(RCIENS)
Q
;
;
BLD(RCIENS) ; Display selected EEOB on APAR screen
N RCZ0,RCZ41,RCERA,RCECME,REASON,V1,RCLI1,TLINE,RCSCR,Z,ZZ,Z0,ZZ1,RC0,RCTL,RCTS,RCCL,RCCL1 ; PRCA*4.5*332
S RCSCR=$P(RCIENS,U),Z=$P(^RCY(344.49,RCSCR,1,$P(RCIENS,U,2),0),U),RCPROG="RCDPEAA2"
I Z#1=0 S ZZ=+$O(^RCY(344.49,RCSCR,1,"B",Z,0)) I ZZ D
. S Z0=Z F S Z0=$O(^RCY(344.49,RCSCR,1,"B",Z0)) Q:((Z0\1)'=(Z\1)) S Z=Z0,ZZ1=+$O(^RCY(344.49,RCSCR,1,"B",Z0,0)) I ZZ1 D
.. S ^TMP("RCS",$J,ZZ,ZZ1)=""
. S ^TMP("RCS",$J,ZZ)=""
S (RCTS,ZZ)=0
F S ZZ=$O(^TMP("RCS",$J,ZZ)) Q:'ZZ D
. S RCZ0=$G(^RCY(344.49,RCSCR,1,ZZ,0))
. S RCECME=$P($G(^RCY(344.4,RCSCR,1,+$P(RCZ0,U,9),4)),U,2) ; ECME # (344.41,.24)
. S REASON=$$GET1^DIQ(344.41,$P(RCZ0,U,9)_","_RCSCR_",",5) ; AUTOPOST REJECTION REASON (344.41,5)
. S TLINE=$$TOPLINE(RCZ0)
. D SET(TLINE,$P(RCZ0,U),$P(RCZ0,U),ZZ)
. ; PRCA*4.5*304 - Add claim comment to screen if it exists for this ERA EEOB detail line
. S:$P(RCZ0,U,9)'="" RCCL=$$GET1^DIQ(344.41,$P(RCZ0,U,9)_","_RCSCR_",",4)
. D:$G(RCCL)'="" ; If we have a ERA Detail line comment, display it
. . D SLINE(RCCL,"RCCL1",58,76)
. . S TLINE=$J("",4)_"Claim Comment: "_RCCL1(1)
. . D SET(TLINE,$P(RCZ0,U),$P(RCZ0,U),ZZ)
. . ; If we have a second line for the comment then put it on the screen
. . I RCCL1>1 D SET($J("",4)_RCCL1(2),$P(RCZ0,U),$P(RCZ0,U),ZZ) I RCCL1=3 D SET($J("",4)_RCCL1(3),$P(RCZ0,U),$P(RCZ0,U),ZZ)
. ; **End of *304 modifications**
. ; sub-line info (e.g., "n.001")
. S ZZ1=0 F S ZZ1=$O(^TMP("RCS",$J,ZZ,ZZ1)) Q:'ZZ1 D
. . S RCZZ0=$G(^RCY(344.49,RCSCR,1,ZZ1,0))
. . S RCT=$P(RCZZ0,U),RCTL=$L(RCT)
. . S RCERA=+$G(^RCY(344.49,RCSCR,0)) ; PRCA*4.5*332
. . S RCZ41=$$IEN41(RCERA,RCT) ; PRCA*4.5*332
. . S V1=$S($P(RCZZ0,U,2)'["**ADJ":"",$P($P(RCZZ0,U,2),"ADJ",2):"***ADJUSTMENT AT ERA LEVEL",1:"*** ADJUSTMENT LINE FOR TOTALS MISMATCH")
. . S RCLI1=$S(V1="":" Claim #: "_$P(RCZZ0,U,2)_" Patient/Last 4: "_$S($P(RCZZ0,U,7):$$PNM4("","",$P(RCZZ0,U,7)),'$P($G(^RCY(344.49,RCSCR,1,ZZ1,2)),U,3):$$PNM4(RCERA,RCZ41),1:"??"),1:V1) ; PRCA*4.5*332
. . D SET($J("",4)_$P(" ^(V)",U,$P(RCZZ0,U,13)+1)_RCT_RCLI1,RCT,RCT,ZZ1)
. . I $P(RCZZ0,U,7) D CLINES(RCZZ0,RCT,ZZ1)
. . ;
. . D SET($J("",4+RCTL)_"Payment Amt: "_$J(+$P(RCZZ0,U,5),"",2)_" Total Adjustments: "_$J(+$P(RCZZ0,U,8),"",2)_" Net: "_$J($P(RCZZ0,U,5)+$P(RCZZ0,U,8),"",2),RCT,RCT,ZZ1)
. . ; display pharmacy EEOB data
. . I RCECME]"" D RXLINES(RCZZ0,RCECME,RCT,ZZ1)
. . ; PRCA*4.5*321 BEGIN
. . I $P(RCZZ0,U,10)'="" D
. . . D SET($J("",9)_"Receipt Comment: "_$P(RCZZ0,U,10),$P(RCZZ0,U),RCT,ZZ1)
. . . D SET($J("",9)_"Added By User: "_$$GET1^DIQ(344.491,ZZ1_","_RCSCR_",",2.03),RCTS,RCT,ZZ1)
. . . D SET($J("",9)_"Date/Time Added: "_$$GET1^DIQ(344.491,ZZ1_","_RCSCR_",",2.04),RCTS,RCT,ZZ1)
. . ; PRCA*4.5*321 END
. . I $O(^RCY(344.49,RCSCR,1,ZZ1,1,0)) D ADJLINES(RCZZ0,RCT,ZZ1)
. . I $G(^TMP($J,"RC_REVIEW")) D REVLINES(RCSCR,RCZZ0,RCT,ZZ1)
. . D SET($J("",7)_"APAR Reason: "_REASON,RCT,RCT,ZZ1)
. . S A="",$P(A,".",79)="" D SET(A,RCT,RCT,ZZ1)
I VALMCNT=0 D SET("THERE ARE NO EEOBs MATCHING YOUR SELECTION CRITERIA")
K ^TMP($J,"RCS")
Q
;
SET(X,RCSEQ,RCSEQ1,RCZ9) ; -- set ListManager arrays
; X = the data to set into the global
; RCSEQ = the selectable line #
; RCSEQ1 = = the sub line #
; RCZ9 = reference to the line(s) in file 344.41 or to the subline in
; file 344.49 for RCSEQ having a decimal
S VALMCNT=VALMCNT+1,^TMP("RCDPE-EOB_WL",$J,VALMCNT,0)=X
I $G(RCSEQ) S ^TMP("RCDPE-EOB_WL",$J,"IDX",VALMCNT,RCSEQ)=""
I $G(RCSEQ1),'$D(^TMP("RCDPE-EOB_WLDX",$J,RCSEQ1)) S ^TMP("RCDPE-EOB_WLDX",$J,RCSEQ1)=VALMCNT_U_$G(RCZ9)
Q
;
TOPLINE(RCZ0) ; Function returns the top line of the EEOB display
; RCZ0 = the 0-node of the whole number entry line for the EEOB
N A
S A=" "_$S($P(RCZ0,U,13):"(V)",1:" ")_"EEOB: ERA Seq #"_$S($P(RCZ0,U,9)[",":"'s",1:"")_" "_$S($P(RCZ0,U,9)'="":$P(RCZ0,U,9),1:"None")_" Net Payment Amt: "_$J(+$P(RCZ0,U,6),"",2)
I $G(^TMP($J,"RC_REVIEW")) S A=A_" Reviewed?: "_$S($P(RCZ0,U,11)="":"NO",1:$$EXTERNAL^DILFD(344.491,.11,,$P(RCZ0,U,11)))
Q A
;
;PRCA*4.5*304 - Split long line into printable lengths
SLINE(ZIN,ZARR,FLN,SLN) ;
; ZIN - Input string; ZARR - Array output of lines ; FLN - First line length ; SLN - Subsequent line lengths
; Assumes ZIN max length is 132 characters and FLN and SLN variables will make ZIN fit in 3 lines.
N ZL,ZI,ZM
I $L(ZIN)<(FLN+1) S @ZARR@(1)=ZIN,@ZARR=1 Q
; Otherwise we are spanning more than 1 line
S ZL="" F ZI=1:1 Q:($L(ZL)+$L($P(ZIN," ",ZI)))>FLN S ZL=ZL_$S($L(ZL)>0:" ",1:"")_$P(ZIN," ",ZI)
S @ZARR@(1)=ZL,ZL=$P(ZIN," ",ZI,9999)
I $L(ZL)<(SLN+1) S @ZARR@(2)=ZL,@ZARR=2 Q
; Spilling onto a third line.
S ZM="" F ZI=1:1 Q:($L(ZM)+$L($P(ZL," ",ZI)))>SLN S ZM=ZM_$S($L(ZM)>0:" ",1:"")_$P(ZL," ",ZI)
S @ZARR@(2)=ZM,ZM=$P(ZL," ",ZI,9999)
S @ZARR@(3)=ZM,@ZARR=3
Q
; **END of *304 changes**
;
CLINES(RCZZ0,RCT,ZZ1) ; called from BLD ; set up the claim information lines
;
; Input - RCZZ0 = zero node data at 344.491
; RCT = sub line #
; ZZ1 = reference to the to the subline in
; file 344.49 for RCSEQ having a decimal
N A,RCX,Q,QQ
S A("OA")=$$ORI^PRCAFN(+$P(RCZZ0,U,7)),A("SDT")=$P($G(^DGCR(399,+$P(RCZZ0,U,7),"U")),U),A("DFN")=+$P($G(^(0)),U,2),A("ENRPR")=""
; Find Rx copay status
S A("RXCP")=$S('A("SDT"):"",1:$$RXST^IBARXEU(A("DFN"),A("SDT"))),A("RXCP")=$S($P(A("RXCP"),U)'="":$P(A("RXCP"),U,2),1:"UNKNOWN") ;IA #10147
; Find M/T status
S RCX=$$LST^DGMTU(A("DFN"),A("SDT")),A("M/T")=$P(RCX,U,4)
S A("M/T")=$S('RCX:"??",A("M/T")="P":"PEN",A("M/T")="C":"YES",A("M/T")="G":"GMT",A("M/T")="R":"REQ",1:"NO")
S QQ=" Billed Amt: "_$J(A("OA"),"",2)_" Amt To Post: "_$J(+$P(RCZZ0,U,3),"",2)
D SET($J("",4+RCTL)_"Claim Bal: "_$J(+$P($$BILL^RCJIBFN2(+$P(RCZZ0,U,7)),U,3),"",2)_QQ,$P(RCZZ0,U),RCT,ZZ1)
S ^TMP("RC_BILL",$J,$P(RCZZ0,U,7),RCT)=QQ
S Z3=$J("",4+RCTL)_"Svc Dt: "_$S(A("SDT")'="":$$FMTE^XLFDT(A("SDT"),2),1:"UNKNOWN")
S Z3=Z3_" COB: "_$S($D(^DGCR(399,+$P(RCZZ0,U,7),"I"_($$COBN(+$P(RCZZ0,U,7))+1))):"YES",1:"NO ")
D SET(Z3_" Rx Copay: "_$E(A("RXCP"),1,17)_" Means Tst: "_A("M/T"),$P(RCZZ0,U),RCT,ZZ1)
Q
;
REVLINES(RCSCR,RCZZ0,RCT,ZZ1) ;called from BLD; set up the reviewed lines
;
; Input - RCSCR = ien of 344.49 (and 344.4)
; RCZZ0 = zero node data at 344.491
; RCT = sub line #
; ZZ1 = reference to the to the subline in
; file 344.49 for RCSEQ having a decimal
N A,A0,B,B0
S A=$J("",10)_"REVIEW STATUS: ("_$S($P(RCZZ0,U,11)="I":"REVIEW IN PROCESS",$P(RCZZ0,U,11)=1:"REVIEWED",1:"NOT REVIEWED")
I $P(RCZZ0,U,12) S A=A_" SET BY: "_$E($P($G(^VA(200,$P(RCZZ0,U,12),0)),U),1,20)
D SET(A_")",+$P(RCZZ0,U),RCT,ZZ1)
S A=0 F S A=$O(^RCY(344.49,RCSCR,1,ZZ1,4,A)) Q:'A S A0=$G(^(A,0)) D
. D SET($J("",12)_$$FMTE^XLFDT($P(A0,U),2)_" "_$P($G(^VA(200,+$P(A0,U,2),0)),U)_$S($P(A0,U,4):" LAST EDIT: "_$$FMTE^XLFDT($P(A0,U,4),2),1:""),$P(RCZZ0,U),RCT,ZZ1)
. S B=0 F S B=$O(^RCY(344.49,RCSCR,1,ZZ1,4,A,1,B)) Q:'B S B0=$G(^(B,0)) D
. . I $L(B0)>64 D SET($J("",15)_$E(B0,1,64),$P(RCZZ0,U),RCT,ZZ1) S B0=" "_$E(B0,65,$L(B0)) ; Split line if > 64 characters in comment line
. . D SET($J("",15)_B0,$P(RCZZ0,U),RCT,ZZ1)
Q
;
ADJLINES(RCZZ0,RCT,ZZ1) ; called from BLD; set up the adjustment lines
;
; Input - RCZZ0 = zero node data at 344.491
; RCT = sub line #
; ZZ1 = reference to the to the subline in
; file 344.49 for RCSEQ having a decimal
N RCAZ,RCAZ0,Z3
S Z3=""
D SET($J("",4+RCTL)_"ADJUSTMENTS:",$P(RCZZ0,U),RCT,ZZ1)
S RCAZ=0 F S RCAZ=$O(^RCY(344.49,RCSCR,1,ZZ1,1,RCAZ)) Q:'RCAZ S RCAZ0=$G(^(RCAZ,0)) D
. S Z3=$J("",6+RCTL)_+RCAZ0_". ",Q=$L(Z3)
. I $P(RCAZ0,U,2)=0 S Z3=Z3_"Distributed adj dec for retraction "_$P(RCAZ0,U,4)_": "_$P(RCAZ0,U,3)
. I $P(RCAZ0,U,2)=1 S Z3=Z3_"Adjustment distribution to balance receipt: "_$P(RCAZ0,U,3)
. I $P(RCAZ0,U,2)=2!($P(RCAZ0,U,2)=4) D
. . S Z3=Z3_"ERA payment adjusted from "_$J($P(RCZZ0,U,5)-$P(RCZZ0,U,6),"",2)_" to "_$J(+$P(RCZZ0,U,5),"",2)_" NET: "_$J($P(RCZZ0,U,5)+$P(RCAZ0,U,3),"",2)
. I $P(RCAZ0,U,2)=5 S Z3=Z3_"Non-specific payment (ref# "_$P(RCAZ0,U,4)_"): "_$P(RCAZ0,U,3)
. I $P(RCAZ0,U,2)=3 S Z3=Z3_"Non-specific retraction (ref# "_$P(RCAZ0,U,4)_"): "_$P(RCAZ0,U,3)
. D SET(Z3,$P(RCZZ0,U),RCT,ZZ1)
. I $P(RCAZ0,U,9)'="" D SET($J("",Q)_$P(RCAZ0,U,9),$P(RCZZ0,U),RCT,ZZ1)
Q
;
;
RXLINES(RCZZ0,RCECME,RCT,ZZ1) ; called from BLD ; set up the Pharmacy lines
;
; Input - RCZZ0 = zero node data at 344.491
; RCECME = ECME # for Pharmacy claims
; RCT = sub line #
; ZZ1 = reference to the to the subline in
; file 344.49 for RCSEQ having a decimal
N RXARRAY
D GETPHARM^RCDPEWLP($P(RCZZ0,U,7),.RXARRAY)
D SET($J("",9)_"ECME #: "_RCECME,$P(RCZZ0,U),RCT,ZZ1)
I '$D(RXARRAY) D SET($J("",9)_" Pharmacy data does not exist for this claim",$P(RCZZ0,U),RCT,ZZ1) Q
D SET($J("",9)_"Rx/Fill/Release Status: "_RXARRAY("RX")_"/"_RXARRAY("FILL")_"/"_RXARRAY("RELEASED STATUS"),$P(RCZZ0,U),RCT,ZZ1)
D SET($J("",9)_"DOS: "_RXARRAY("DOS"),$P(RCZZ0,U),RCT,ZZ1)
Q
;
HDR ; Creates header lines for the selected EEOB display
N RC0,RC4,RC5,Z,RCDA,RCSEQ
I '$G(RCIENS) S VALMQUIT=1 Q
S RCDA=$P(RCIENS,U),RCSEQ=$P(RCIENS,U,3)
S RC0=$G(^RCY(344.4,RCDA,0)),RC4=$G(^RCY(344.4,RCDA,4)),RC5=$G(^RCY(344.4,RCDA,5))
S VALMHDR(1)=$E("ERA Entry #: "_$P(RC0,U)_$J("",31),1,31)_"Total Amt Pd: "_$J(+$P(RC0,U,5),"",2)
I +RCSEQ S VALMHDR(2)=$E("Posted Amt: "_$J($P(^TMP("RCDPE-APAR_EEOB_WLDX",$J,RCSEQ),U,5),"",2)_$J("",31),1,31)
S VALMHDR(2)=$G(VALMHDR(2))_"Un-posted balance: "_$J($P(^TMP("RCDPE-APAR_EEOB_WLDX",$J,RCSEQ),U,4),"",2)
S VALMHDR(3)="Payer Name/ID: "_$P(RC0,U,6)_"/"_$P(RC0,U,3)
S Z=+$O(^RCY(344.31,"AERA",RCDA,0))
I Z S VALMHDR(4)="EFT #/TRACE #: "_$$GET1^DIQ(344.31,Z_",",.01,"E")_"/"_$P(RC0,U,2) ; PRCA*4.5*326
I 'Z,$P(RC5,U,2)'="" S VALMHDR(4)="PAPER CHECK #: "_$P(RC5,U,2)
S VALMHDR(5)="Posted Receipt #(s): "_$$RCPTS(RCDA,RC0)
Q
;
RCPTS(RCDA,RC0) ; pull list of 'other receipt #s
; input - RCDA = ien of entry in 344.4
; RC0 = data string at zero node of entry in 344.4
; output - RCPTS = returns list of receipts stored at 344.4,.08 and 344.48 multiple
N X,RIEN,RCPTS
S X=0
S RCPTS=$P($G(^RCY(344,+$P(RC0,U,8),0)),U)
I RCPTS="" G RCPTSQ ; receipt not posted to any of EEOB items
S RCPTS=RCPTS_","
F S X=$O(^RCY(344.4,RCDA,8,X)) Q:'X S RIEN=+^(X,0) S RCPTS=RCPTS_$P($G(^RCY(344,RIEN,0)),U)_","
S RCPTS=$$TRIM^XLFSTR(RCPTS,"R",",") ; remove orphan comma from last receipt number
RCPTSQ ;
Q RCPTS
;
EXIT ; -- Clean up list
K RCFASTXT
Q
;
PNM4(RCIFN,RCDA,RC) ; Returns either the patient name or patient name/last 4
; RCIFN = ien of file 344.4
; RCDA = ien of file 344.41
; RC = the ien of file 430
N Z,Z0,Q
S Z=""
I $G(RCIFN)'="" D
. S Z0=$G(^RCY(344.4,RCIFN,1,RCDA,0)),Z=""
. I $P(Z0,U,2) S Q=+$P($G(^DGCR(399,+$G(^IBM(361.1,+$P(Z0,U,2),0)),0)),U,2),Z=$P($G(^DPT(Q,0)),U)_"/"_$E($P($G(^(0)),U,9),6,9) ; IA 4051
. I $TR(Z,"/")="" S Z=$P(Z0,U,15)
I $G(RC)'="" D
. S Q=+$P($G(^PRCA(430,RC,0)),U,7)
. I Q S Z=$P($G(^DPT(Q,0)),U)_"/"_$E($P($G(^(0)),U,9),6,9)
Q Z
;
COBN(RC,A) ; Return seq # of selected payer
; A = 'PST' or null to get current bill payer seq #
I $G(A)="" S A=$P($G(^DGCR(399,RC,0)),U,21) S:A="" A="P" S:"PST"'[A A="P"
I 'A S A=$F("PST",A)-1 S:A<1 A=1
Q A
;
COPAY(RCIFN) ; Returns 1 if any not cancelled 1st party bills exist for
; a 3rd party bill or any bills related to this 3rd party bill
; RCIFN = the 3rd party bill #
N FIRST,RCTP0,RCTP1,RCTP2
K ^TMP("IBRBF",$J),^TMP($J,"IBRBF")
D RELBILL^IBRFN(RCIFN) ; DBIA 3124
S RCTP0=0 F S RCTP0=$O(^TMP("IBRBF",$J,RCIFN,RCTP0)) Q:RCTP0="" S RCTP1=$G(^(RCTP0)) D
. I $P(RCTP1,U,3) K ^TMP("IBRBF",$J,RCIFN,RCTP0) Q ; IB cancelled
. S RCTP2=$O(^PRCA(430,"B",+$P(RCTP1,U,4),0)) I $P($G(^PRCA(430,+RCTP2,0)),U,8)=39 K ^TMP("IBRBF",$J,RCIFN,RCTP0) ; AR cancelled
S FIRST=$S($O(^TMP("IBRBF",$J,RCIFN,0)):1,1:0)
K ^TMP("IBRBF",$J),^TMP($J,"IBRBF")
Q FIRST
;
MARK(RCIENS) ;EP - Protocol action - RCDPE MARK FOR AUTO POST
; Mark for Auto-Post - EEOB on APAR gets marked for auto-post if it passes
; autoposting validation
; Input: RCIENS - Internal IEN of entry in file 344.49^ien of
; 344.491^selectable line item from listman screen
;
I '$D(^XUSEC("RCDPEPP",DUZ)) D Q ; PRCA*4.5*318 Added security key check
. D FULL^VALM1
. S VALMBCK="R"
. W !!,"This action can only be taken by users that have the RCDPEPP security key.",!
. D PAUSE^VALM1
;
N RESULT,REASON,LINE,DIR,X,Y,RCERROR,XX,ERADA1,RCDFDA
S:$G(RCIENS)="" RCIENS=+$$SEL^RCDPEAA1()
Q:'RCIENS
I '$$VALID($P(RCIENS,U),$P(RCIENS,U,2),.RESULT) D G MARKQ ; $$VALID split from RCDPEAP - PRCA*4.5*326
. S LINE=$O(RESULT(""))
. S REASON=$TR(RESULT(LINE),U,"-")
. S DIR(0)="EA",DIR("A",1)="EEOB cannot be marked for Auto-Post for the following reason:"
. S DIR("A",2)=REASON
. S DIR("A")="PRESS RETURN TO CONTINUE "
. W ! D ^DIR K DIR W !
; EEOB passed validation; ready for Autopost
L +^RCY(344.4,$P(RCIENS,U),0):5 I '$T D NOLOCK G MARKQ
S ERADA1=$P($G(^RCY(344.49,$P(RCIENS,U),1,$P(RCIENS,U,2),0)),U,9) ; get 344.41 ien (344.491,.09)
S RCDFDA(344.41,ERADA1_","_$P(RCIENS,U)_",",6)=1
S RCDFDA(344.41,ERADA1_","_$P(RCIENS,U)_",",6.01)=DUZ ; PRCA*4.5*326
D FILE^DIE("","RCDFDA")
D UPDERA($P(RCIENS,U),DUZ) ; PRCA*4.5*326 - also update top level ERA
S DIR(0)="EA",DIR("A",1)=$P(RCIENS,U)_"."_ERADA1_" has been marked for auto-post and has been removed from the APAR List."
S DIR("A")="PRESS RETURN TO CONTINUE "
W ! D ^DIR K DIR W !
L -^RCY(344.4,$P(RCIENS,U),0)
MARKQ ;
Q
;
NOLOCK ; entry cannot be locked
N DIR
S DIR(0)="EA"
S DIR("A",1)="Sorry, another user is editing this ERA entry."
S DIR("A",2)="Try again later."
S DIR("A",3)=""
S DIR("A")="PRESS ENTER TO CONTINUE "
D ^DIR
Q
;
VIEWERA(RCIENS) ; View/Print ERA - protocol entry from APAR EEOB List screen and APAR - EEOB ITEM - SCRATCHPAD screen
N RCSCR
I RCPROG="RCDPEAA2" S RCSCR=$P(RCIENS,U)
I RCPROG="RCDPEAA1" S RCSCR=+$$SEL^RCDPEAA1()
I RCSCR>0 D PRERA^RCDPEWL0
Q
;
VALID(RCSCR,SCRLINE,RCARRAY) ;Validates Scratchpad line - Used by APAR/Mark for Auto-post - split from RCDPEAP - PRCA*4.5*326
;Input
; RCSCR - #344.4/#344.49 file IEN
; SCRLINE - Subscript of first scratchpad entry for the ERA line
; RCARRAY - Passed reference to result array
;Output
; OK - Boolean 1 or 0
; RCARRAY - Array of claim(s) which fail validation
;
; e.g line number 2
; RCARRAY(2.001)="K800001^NOT AN ACTIVE CLAIM"
;
; e.g. split line number 2
; RCARRAY(2.001)="K800002^CLAIM REFERRED TO GENERAL COUNCIL"
; RCARRAY(2.006)="K800003^PAYMENT EXCEEDS CLAIM BALANCE"
;
N CLAIM,DONE,SEQ,SEQ1,SUB,STATUS,WLINE
K RCARRAY,CLARRAY
S SUB=SCRLINE,SEQ=$P($G(^RCY(344.49,RCSCR,1,SUB,0)),U),DONE=0
F S SUB=$O(^RCY(344.49,RCSCR,1,SUB)) Q:SUB="" D Q:DONE
. ;Get scratchpad N.001 line and data
. S WLINE=$G(^RCY(344.49,RCSCR,1,SUB,0)),SEQ1=$P(WLINE,".") I SEQ1'=SEQ S DONE=1 Q
. ;Get claim number from N.00N line - ignore suspense lines
. S CLAIM=$P(WLINE,U,7) I 'CLAIM Q
. ;Claim must be OPEN or ACTIVE
. S STATUS=$P($G(^PRCA(430,CLAIM,0)),"^",8) I STATUS'=42,STATUS'=16 S RCARRAY(SEQ1)=$P(WLINE,U,2)_"^NOT AN ACTIVE CLAIM" Q
. ;Check that payment does not exceed balance and no pending payments (at the time of auto posting)
. S CLARRAY(CLAIM)=+$G(CLARRAY(CLAIM))+$P(WLINE,U,3) I '$$CHECKPAY^RCDPEAP(.CLARRAY,CLAIM) S RCARRAY(SEQ1)=$P(WLINE,U,2)_"^PAYMENT EXCEEDS CLAIM BALANCE" Q
. ;Check if referred to general council
. I $P($G(^PRCA(430,CLAIM,6)),U,4)]"" S RCARRAY(SEQ1)=$P(WLINE,U,2)_"^CLAIM REFERRED TO GENERAL COUNCIL" Q
. ;Check that payment is not negative
. I $P(WLINE,U,6)<0 S RCARRAY(SEQ1)=$P(WLINE,U,2)_"^PAYMENT AMOUNT IS NEGATIVE" Q
;Returns 1 if line is OK
Q $S($O(RCARRAY(""))]"":0,1:1)
;
UPDERA(ERAIEN,RCDUZ) ; Update MARK FOR AUTOPOST USER top level ERA with DUZ from detail line. PRCA*4.5*326
; MARK FOR AUTOPOST USER is required at ERA level for initial receipt and AR transaction crreation
; so the MARK FOR AUTOPOST USER at the top level will be equal to the last detail line marekd for autopost
N FDA,IENS
S FDA(344.4,ERAIEN_",",4.04)=RCDUZ
D FILE^DIE("","FDA")
Q
IEN41(IEN,LINE) ; Given a scratch pad line, find the original ERA detail line. PRCA*4.5*332
; Input: IEN - Internal Entry number of ERA scratchpad from file 344.49
; LINE - Line from ERA scratchpad file 344.49
N IEN2
S IEN2=$O(^RCY(344.49,IEN,1,"ASEQ",LINE\1,0))
Q +$$GET1^DIQ(344.491,IEN2_","_IEN_",",.09,"E")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAA2 17630 printed Dec 13, 2024@01:44:06 Page 2
RCDPEAA2 ;ALB/KML - APAR Screen - SELECTED EOB ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**298,304,318,321,326,332**;Mar 20, 1995;Build 40
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
INIT(RCIENS) ; Entry point for List template to build the display of the EEOB on APAR
+1 ;
+2 ; Input - RCIENS = ien of entry in file 344.49^ien of 344.491^selectable line item from listman screen
+3 ;
+4 NEW FDTTM
+5 DO CLEAN^VALM10
+6 KILL ^TMP("RCDPE-EOB_WL",$JOB),^TMP("RCDPE-EOB_WLDX",$JOB),^TMP("RCS",$JOB)
+7 SET VALMCNT=0
SET VALMBG=1
+8 DO BLD(RCIENS)
+9 QUIT
+10 ;
+11 ;
BLD(RCIENS) ; Display selected EEOB on APAR screen
+1 ; PRCA*4.5*332
NEW RCZ0,RCZ41,RCERA,RCECME,REASON,V1,RCLI1,TLINE,RCSCR,Z,ZZ,Z0,ZZ1,RC0,RCTL,RCTS,RCCL,RCCL1
+2 SET RCSCR=$PIECE(RCIENS,U)
SET Z=$PIECE(^RCY(344.49,RCSCR,1,$PIECE(RCIENS,U,2),0),U)
SET RCPROG="RCDPEAA2"
+3 IF Z#1=0
SET ZZ=+$ORDER(^RCY(344.49,RCSCR,1,"B",Z,0))
IF ZZ
Begin DoDot:1
+4 SET Z0=Z
FOR
SET Z0=$ORDER(^RCY(344.49,RCSCR,1,"B",Z0))
if ((Z0\1)'=(Z\1))
QUIT
SET Z=Z0
SET ZZ1=+$ORDER(^RCY(344.49,RCSCR,1,"B",Z0,0))
IF ZZ1
Begin DoDot:2
+5 SET ^TMP("RCS",$JOB,ZZ,ZZ1)=""
End DoDot:2
+6 SET ^TMP("RCS",$JOB,ZZ)=""
End DoDot:1
+7 SET (RCTS,ZZ)=0
+8 FOR
SET ZZ=$ORDER(^TMP("RCS",$JOB,ZZ))
if 'ZZ
QUIT
Begin DoDot:1
+9 SET RCZ0=$GET(^RCY(344.49,RCSCR,1,ZZ,0))
+10 ; ECME # (344.41,.24)
SET RCECME=$PIECE($GET(^RCY(344.4,RCSCR,1,+$PIECE(RCZ0,U,9),4)),U,2)
+11 ; AUTOPOST REJECTION REASON (344.41,5)
SET REASON=$$GET1^DIQ(344.41,$PIECE(RCZ0,U,9)_","_RCSCR_",",5)
+12 SET TLINE=$$TOPLINE(RCZ0)
+13 DO SET(TLINE,$PIECE(RCZ0,U),$PIECE(RCZ0,U),ZZ)
+14 ; PRCA*4.5*304 - Add claim comment to screen if it exists for this ERA EEOB detail line
+15 if $PIECE(RCZ0,U,9)'=""
SET RCCL=$$GET1^DIQ(344.41,$PIECE(RCZ0,U,9)_","_RCSCR_",",4)
+16 ; If we have a ERA Detail line comment, display it
if $GET(RCCL)'=""
Begin DoDot:2
+17 DO SLINE(RCCL,"RCCL1",58,76)
+18 SET TLINE=$JUSTIFY("",4)_"Claim Comment: "_RCCL1(1)
+19 DO SET(TLINE,$PIECE(RCZ0,U),$PIECE(RCZ0,U),ZZ)
+20 ; If we have a second line for the comment then put it on the screen
+21 IF RCCL1>1
DO SET($JUSTIFY("",4)_RCCL1(2),$PIECE(RCZ0,U),$PIECE(RCZ0,U),ZZ)
IF RCCL1=3
DO SET($JUSTIFY("",4)_RCCL1(3),$PIECE(RCZ0,U),$PIECE(RCZ0,U),ZZ)
End DoDot:2
+22 ; **End of *304 modifications**
+23 ; sub-line info (e.g., "n.001")
+24 SET ZZ1=0
FOR
SET ZZ1=$ORDER(^TMP("RCS",$JOB,ZZ,ZZ1))
if 'ZZ1
QUIT
Begin DoDot:2
+25 SET RCZZ0=$GET(^RCY(344.49,RCSCR,1,ZZ1,0))
+26 SET RCT=$PIECE(RCZZ0,U)
SET RCTL=$LENGTH(RCT)
+27 ; PRCA*4.5*332
SET RCERA=+$GET(^RCY(344.49,RCSCR,0))
+28 ; PRCA*4.5*332
SET RCZ41=$$IEN41(RCERA,RCT)
+29 SET V1=$SELECT($PIECE(RCZZ0,U,2)'["**ADJ":"",$PIECE($PIECE(RCZZ0,U,2),"ADJ",2):"***ADJUSTMENT AT ERA LEVEL",1:"*** ADJUSTMENT LINE FOR TOTALS MISMATCH")
+30 ; PRCA*4.5*332
SET RCLI1=$SELECT(V1="":" Claim #: "_$PIECE(RCZZ0,U,2)_" Patient/Last 4: "_$SELECT($PIECE(RCZZ0,U,7):$$PNM4("","",$PIECE(RCZZ0,U,7)),'$PIECE($GET(^RCY(344.49,RCSCR,1,ZZ1,2)),U,3):$$PNM4(RCERA,RCZ41),1:"??"),1:V1)
+31 DO SET($JUSTIFY("",4)_$PIECE(" ^(V)",U,$PIECE(RCZZ0,U,13)+1)_RCT_RCLI1,RCT,RCT,ZZ1)
+32 IF $PIECE(RCZZ0,U,7)
DO CLINES(RCZZ0,RCT,ZZ1)
+33 ;
+34 DO SET($JUSTIFY("",4+RCTL)_"Payment Amt: "_$JUSTIFY(+$PIECE(RCZZ0,U,5),"",2)_" Total Adjustments: "_$JUSTIFY(+$PIECE(RCZZ0,U,8),"",2)_" Net: "_$JUSTIFY($PIECE(RCZZ0,U,5)+$PIECE(RCZZ0,U,8),"",2),RCT,RCT,ZZ1)
+35 ; display pharmacy EEOB data
+36 IF RCECME]""
DO RXLINES(RCZZ0,RCECME,RCT,ZZ1)
+37 ; PRCA*4.5*321 BEGIN
+38 IF $PIECE(RCZZ0,U,10)'=""
Begin DoDot:3
+39 DO SET($JUSTIFY("",9)_"Receipt Comment: "_$PIECE(RCZZ0,U,10),$PIECE(RCZZ0,U),RCT,ZZ1)
+40 DO SET($JUSTIFY("",9)_"Added By User: "_$$GET1^DIQ(344.491,ZZ1_","_RCSCR_",",2.03),RCTS,RCT,ZZ1)
+41 DO SET($JUSTIFY("",9)_"Date/Time Added: "_$$GET1^DIQ(344.491,ZZ1_","_RCSCR_",",2.04),RCTS,RCT,ZZ1)
End DoDot:3
+42 ; PRCA*4.5*321 END
+43 IF $ORDER(^RCY(344.49,RCSCR,1,ZZ1,1,0))
DO ADJLINES(RCZZ0,RCT,ZZ1)
+44 IF $GET(^TMP($JOB,"RC_REVIEW"))
DO REVLINES(RCSCR,RCZZ0,RCT,ZZ1)
+45 DO SET($JUSTIFY("",7)_"APAR Reason: "_REASON,RCT,RCT,ZZ1)
+46 SET A=""
SET $PIECE(A,".",79)=""
DO SET(A,RCT,RCT,ZZ1)
End DoDot:2
End DoDot:1
+47 IF VALMCNT=0
DO SET("THERE ARE NO EEOBs MATCHING YOUR SELECTION CRITERIA")
+48 KILL ^TMP($JOB,"RCS")
+49 QUIT
+50 ;
SET(X,RCSEQ,RCSEQ1,RCZ9) ; -- set ListManager arrays
+1 ; X = the data to set into the global
+2 ; RCSEQ = the selectable line #
+3 ; RCSEQ1 = = the sub line #
+4 ; RCZ9 = reference to the line(s) in file 344.41 or to the subline in
+5 ; file 344.49 for RCSEQ having a decimal
+6 SET VALMCNT=VALMCNT+1
SET ^TMP("RCDPE-EOB_WL",$JOB,VALMCNT,0)=X
+7 IF $GET(RCSEQ)
SET ^TMP("RCDPE-EOB_WL",$JOB,"IDX",VALMCNT,RCSEQ)=""
+8 IF $GET(RCSEQ1)
IF '$DATA(^TMP("RCDPE-EOB_WLDX",$JOB,RCSEQ1))
SET ^TMP("RCDPE-EOB_WLDX",$JOB,RCSEQ1)=VALMCNT_U_$GET(RCZ9)
+9 QUIT
+10 ;
TOPLINE(RCZ0) ; Function returns the top line of the EEOB display
+1 ; RCZ0 = the 0-node of the whole number entry line for the EEOB
+2 NEW A
+3 SET A=" "_$SELECT($PIECE(RCZ0,U,13):"(V)",1:" ")_"EEOB: ERA Seq #"_$SELECT($PIECE(RCZ0,U,9)[",":"'s",1:"")_" "_$SELECT($PIECE(RCZ0,U,9)'="":$PIECE(RCZ0,U,9),1:"None")_" Net Payment Amt: "_$JUSTIFY(+$PIECE(RCZ0,U,6),"",2)
+4 IF $GET(^TMP($JOB,"RC_REVIEW"))
SET A=A_" Reviewed?: "_$SELECT($PIECE(RCZ0,U,11)="":"NO",1:$$EXTERNAL^DILFD(344.491,.11,,$PIECE(RCZ0,U,11)))
+5 QUIT A
+6 ;
+7 ;PRCA*4.5*304 - Split long line into printable lengths
SLINE(ZIN,ZARR,FLN,SLN) ;
+1 ; ZIN - Input string; ZARR - Array output of lines ; FLN - First line length ; SLN - Subsequent line lengths
+2 ; Assumes ZIN max length is 132 characters and FLN and SLN variables will make ZIN fit in 3 lines.
+3 NEW ZL,ZI,ZM
+4 IF $LENGTH(ZIN)<(FLN+1)
SET @ZARR@(1)=ZIN
SET @ZARR=1
QUIT
+5 ; Otherwise we are spanning more than 1 line
+6 SET ZL=""
FOR ZI=1:1
if ($LENGTH(ZL)+$LENGTH($PIECE(ZIN," ",ZI)))>FLN
QUIT
SET ZL=ZL_$SELECT($LENGTH(ZL)>0:" ",1:"")_$PIECE(ZIN," ",ZI)
+7 SET @ZARR@(1)=ZL
SET ZL=$PIECE(ZIN," ",ZI,9999)
+8 IF $LENGTH(ZL)<(SLN+1)
SET @ZARR@(2)=ZL
SET @ZARR=2
QUIT
+9 ; Spilling onto a third line.
+10 SET ZM=""
FOR ZI=1:1
if ($LENGTH(ZM)+$LENGTH($PIECE(ZL," ",ZI)))>SLN
QUIT
SET ZM=ZM_$SELECT($LENGTH(ZM)>0:" ",1:"")_$PIECE(ZL," ",ZI)
+11 SET @ZARR@(2)=ZM
SET ZM=$PIECE(ZL," ",ZI,9999)
+12 SET @ZARR@(3)=ZM
SET @ZARR=3
+13 QUIT
+14 ; **END of *304 changes**
+15 ;
CLINES(RCZZ0,RCT,ZZ1) ; called from BLD ; set up the claim information lines
+1 ;
+2 ; Input - RCZZ0 = zero node data at 344.491
+3 ; RCT = sub line #
+4 ; ZZ1 = reference to the to the subline in
+5 ; file 344.49 for RCSEQ having a decimal
+6 NEW A,RCX,Q,QQ
+7 SET A("OA")=$$ORI^PRCAFN(+$PIECE(RCZZ0,U,7))
SET A("SDT")=$PIECE($GET(^DGCR(399,+$PIECE(RCZZ0,U,7),"U")),U)
SET A("DFN")=+$PIECE($GET(^(0)),U,2)
SET A("ENRPR")=""
+8 ; Find Rx copay status
+9 ;IA #10147
SET A("RXCP")=$SELECT('A("SDT"):"",1:$$RXST^IBARXEU(A("DFN"),A("SDT")))
SET A("RXCP")=$SELECT($PIECE(A("RXCP"),U)'="":$PIECE(A("RXCP"),U,2),1:"UNKNOWN")
+10 ; Find M/T status
+11 SET RCX=$$LST^DGMTU(A("DFN"),A("SDT"))
SET A("M/T")=$PIECE(RCX,U,4)
+12 SET A("M/T")=$SELECT('RCX:"??",A("M/T")="P":"PEN",A("M/T")="C":"YES",A("M/T")="G":"GMT",A("M/T")="R":"REQ",1:"NO")
+13 SET QQ=" Billed Amt: "_$JUSTIFY(A("OA"),"",2)_" Amt To Post: "_$JUSTIFY(+$PIECE(RCZZ0,U,3),"",2)
+14 DO SET($JUSTIFY("",4+RCTL)_"Claim Bal: "_$JUSTIFY(+$PIECE($$BILL^RCJIBFN2(+$PIECE(RCZZ0,U,7)),U,3),"",2)_QQ,$PIECE(RCZZ0,U),RCT,ZZ1)
+15 SET ^TMP("RC_BILL",$JOB,$PIECE(RCZZ0,U,7),RCT)=QQ
+16 SET Z3=$JUSTIFY("",4+RCTL)_"Svc Dt: "_$SELECT(A("SDT")'="":$$FMTE^XLFDT(A("SDT"),2),1:"UNKNOWN")
+17 SET Z3=Z3_" COB: "_$SELECT($DATA(^DGCR(399,+$PIECE(RCZZ0,U,7),"I"_($$COBN(+$PIECE(RCZZ0,U,7))+1))):"YES",1:"NO ")
+18 DO SET(Z3_" Rx Copay: "_$EXTRACT(A("RXCP"),1,17)_" Means Tst: "_A("M/T"),$PIECE(RCZZ0,U),RCT,ZZ1)
+19 QUIT
+20 ;
REVLINES(RCSCR,RCZZ0,RCT,ZZ1) ;called from BLD; set up the reviewed lines
+1 ;
+2 ; Input - RCSCR = ien of 344.49 (and 344.4)
+3 ; RCZZ0 = zero node data at 344.491
+4 ; RCT = sub line #
+5 ; ZZ1 = reference to the to the subline in
+6 ; file 344.49 for RCSEQ having a decimal
+7 NEW A,A0,B,B0
+8 SET A=$JUSTIFY("",10)_"REVIEW STATUS: ("_$SELECT($PIECE(RCZZ0,U,11)="I":"REVIEW IN PROCESS",$PIECE(RCZZ0,U,11)=1:"REVIEWED",1:"NOT REVIEWED")
+9 IF $PIECE(RCZZ0,U,12)
SET A=A_" SET BY: "_$EXTRACT($PIECE($GET(^VA(200,$PIECE(RCZZ0,U,12),0)),U),1,20)
+10 DO SET(A_")",+$PIECE(RCZZ0,U),RCT,ZZ1)
+11 SET A=0
FOR
SET A=$ORDER(^RCY(344.49,RCSCR,1,ZZ1,4,A))
if 'A
QUIT
SET A0=$GET(^(A,0))
Begin DoDot:1
+12 DO SET($JUSTIFY("",12)_$$FMTE^XLFDT($PIECE(A0,U),2)_" "_$PIECE($GET(^VA(200,+$PIECE(A0,U,2),0)),U)_$SELECT($PIECE(A0,U,4):" LAST EDIT: "_$$FMTE^XLFDT($PIECE(A0,U,4),2),1:""),$PIECE(RCZZ0,U),RCT,ZZ1)
+13 SET B=0
FOR
SET B=$ORDER(^RCY(344.49,RCSCR,1,ZZ1,4,A,1,B))
if 'B
QUIT
SET B0=$GET(^(B,0))
Begin DoDot:2
+14 ; Split line if > 64 characters in comment line
IF $LENGTH(B0)>64
DO SET($JUSTIFY("",15)_$EXTRACT(B0,1,64),$PIECE(RCZZ0,U),RCT,ZZ1)
SET B0=" "_$EXTRACT(B0,65,$LENGTH(B0))
+15 DO SET($JUSTIFY("",15)_B0,$PIECE(RCZZ0,U),RCT,ZZ1)
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
ADJLINES(RCZZ0,RCT,ZZ1) ; called from BLD; set up the adjustment lines
+1 ;
+2 ; Input - RCZZ0 = zero node data at 344.491
+3 ; RCT = sub line #
+4 ; ZZ1 = reference to the to the subline in
+5 ; file 344.49 for RCSEQ having a decimal
+6 NEW RCAZ,RCAZ0,Z3
+7 SET Z3=""
+8 DO SET($JUSTIFY("",4+RCTL)_"ADJUSTMENTS:",$PIECE(RCZZ0,U),RCT,ZZ1)
+9 SET RCAZ=0
FOR
SET RCAZ=$ORDER(^RCY(344.49,RCSCR,1,ZZ1,1,RCAZ))
if 'RCAZ
QUIT
SET RCAZ0=$GET(^(RCAZ,0))
Begin DoDot:1
+10 SET Z3=$JUSTIFY("",6+RCTL)_+RCAZ0_". "
SET Q=$LENGTH(Z3)
+11 IF $PIECE(RCAZ0,U,2)=0
SET Z3=Z3_"Distributed adj dec for retraction "_$PIECE(RCAZ0,U,4)_": "_$PIECE(RCAZ0,U,3)
+12 IF $PIECE(RCAZ0,U,2)=1
SET Z3=Z3_"Adjustment distribution to balance receipt: "_$PIECE(RCAZ0,U,3)
+13 IF $PIECE(RCAZ0,U,2)=2!($PIECE(RCAZ0,U,2)=4)
Begin DoDot:2
+14 SET Z3=Z3_"ERA payment adjusted from "_$JUSTIFY($PIECE(RCZZ0,U,5)-$PIECE(RCZZ0,U,6),"",2)_" to "_$JUSTIFY(+$PIECE(RCZZ0,U,5),"",2)_" NET: "_$JUSTIFY($PIECE(RCZZ0,U,5)+$PIECE(RCAZ0,U,3),"",2)
End DoDot:2
+15 IF $PIECE(RCAZ0,U,2)=5
SET Z3=Z3_"Non-specific payment (ref# "_$PIECE(RCAZ0,U,4)_"): "_$PIECE(RCAZ0,U,3)
+16 IF $PIECE(RCAZ0,U,2)=3
SET Z3=Z3_"Non-specific retraction (ref# "_$PIECE(RCAZ0,U,4)_"): "_$PIECE(RCAZ0,U,3)
+17 DO SET(Z3,$PIECE(RCZZ0,U),RCT,ZZ1)
+18 IF $PIECE(RCAZ0,U,9)'=""
DO SET($JUSTIFY("",Q)_$PIECE(RCAZ0,U,9),$PIECE(RCZZ0,U),RCT,ZZ1)
End DoDot:1
+19 QUIT
+20 ;
+21 ;
RXLINES(RCZZ0,RCECME,RCT,ZZ1) ; called from BLD ; set up the Pharmacy lines
+1 ;
+2 ; Input - RCZZ0 = zero node data at 344.491
+3 ; RCECME = ECME # for Pharmacy claims
+4 ; RCT = sub line #
+5 ; ZZ1 = reference to the to the subline in
+6 ; file 344.49 for RCSEQ having a decimal
+7 NEW RXARRAY
+8 DO GETPHARM^RCDPEWLP($PIECE(RCZZ0,U,7),.RXARRAY)
+9 DO SET($JUSTIFY("",9)_"ECME #: "_RCECME,$PIECE(RCZZ0,U),RCT,ZZ1)
+10 IF '$DATA(RXARRAY)
DO SET($JUSTIFY("",9)_" Pharmacy data does not exist for this claim",$PIECE(RCZZ0,U),RCT,ZZ1)
QUIT
+11 DO SET($JUSTIFY("",9)_"Rx/Fill/Release Status: "_RXARRAY("RX")_"/"_RXARRAY("FILL")_"/"_RXARRAY("RELEASED STATUS"),$PIECE(RCZZ0,U),RCT,ZZ1)
+12 DO SET($JUSTIFY("",9)_"DOS: "_RXARRAY("DOS"),$PIECE(RCZZ0,U),RCT,ZZ1)
+13 QUIT
+14 ;
HDR ; Creates header lines for the selected EEOB display
+1 NEW RC0,RC4,RC5,Z,RCDA,RCSEQ
+2 IF '$GET(RCIENS)
SET VALMQUIT=1
QUIT
+3 SET RCDA=$PIECE(RCIENS,U)
SET RCSEQ=$PIECE(RCIENS,U,3)
+4 SET RC0=$GET(^RCY(344.4,RCDA,0))
SET RC4=$GET(^RCY(344.4,RCDA,4))
SET RC5=$GET(^RCY(344.4,RCDA,5))
+5 SET VALMHDR(1)=$EXTRACT("ERA Entry #: "_$PIECE(RC0,U)_$JUSTIFY("",31),1,31)_"Total Amt Pd: "_$JUSTIFY(+$PIECE(RC0,U,5),"",2)
+6 IF +RCSEQ
SET VALMHDR(2)=$EXTRACT("Posted Amt: "_$JUSTIFY($PIECE(^TMP("RCDPE-APAR_EEOB_WLDX",$JOB,RCSEQ),U,5),"",2)_$JUSTIFY("",31),1,31)
+7 SET VALMHDR(2)=$GET(VALMHDR(2))_"Un-posted balance: "_$JUSTIFY($PIECE(^TMP("RCDPE-APAR_EEOB_WLDX",$JOB,RCSEQ),U,4),"",2)
+8 SET VALMHDR(3)="Payer Name/ID: "_$PIECE(RC0,U,6)_"/"_$PIECE(RC0,U,3)
+9 SET Z=+$ORDER(^RCY(344.31,"AERA",RCDA,0))
+10 ; PRCA*4.5*326
IF Z
SET VALMHDR(4)="EFT #/TRACE #: "_$$GET1^DIQ(344.31,Z_",",.01,"E")_"/"_$PIECE(RC0,U,2)
+11 IF 'Z
IF $PIECE(RC5,U,2)'=""
SET VALMHDR(4)="PAPER CHECK #: "_$PIECE(RC5,U,2)
+12 SET VALMHDR(5)="Posted Receipt #(s): "_$$RCPTS(RCDA,RC0)
+13 QUIT
+14 ;
RCPTS(RCDA,RC0) ; pull list of 'other receipt #s
+1 ; input - RCDA = ien of entry in 344.4
+2 ; RC0 = data string at zero node of entry in 344.4
+3 ; output - RCPTS = returns list of receipts stored at 344.4,.08 and 344.48 multiple
+4 NEW X,RIEN,RCPTS
+5 SET X=0
+6 SET RCPTS=$PIECE($GET(^RCY(344,+$PIECE(RC0,U,8),0)),U)
+7 ; receipt not posted to any of EEOB items
IF RCPTS=""
GOTO RCPTSQ
+8 SET RCPTS=RCPTS_","
+9 FOR
SET X=$ORDER(^RCY(344.4,RCDA,8,X))
if 'X
QUIT
SET RIEN=+^(X,0)
SET RCPTS=RCPTS_$PIECE($GET(^RCY(344,RIEN,0)),U)_","
+10 ; remove orphan comma from last receipt number
SET RCPTS=$$TRIM^XLFSTR(RCPTS,"R",",")
RCPTSQ ;
+1 QUIT RCPTS
+2 ;
EXIT ; -- Clean up list
+1 KILL RCFASTXT
+2 QUIT
+3 ;
PNM4(RCIFN,RCDA,RC) ; Returns either the patient name or patient name/last 4
+1 ; RCIFN = ien of file 344.4
+2 ; RCDA = ien of file 344.41
+3 ; RC = the ien of file 430
+4 NEW Z,Z0,Q
+5 SET Z=""
+6 IF $GET(RCIFN)'=""
Begin DoDot:1
+7 SET Z0=$GET(^RCY(344.4,RCIFN,1,RCDA,0))
SET Z=""
+8 ; IA 4051
IF $PIECE(Z0,U,2)
SET Q=+$PIECE($GET(^DGCR(399,+$GET(^IBM(361.1,+$PIECE(Z0,U,2),0)),0)),U,2)
SET Z=$PIECE($GET(^DPT(Q,0)),U)_"/"_$EXTRACT($PIECE($GET(^(0)),U,9),6,9)
+9 IF $TRANSLATE(Z,"/")=""
SET Z=$PIECE(Z0,U,15)
End DoDot:1
+10 IF $GET(RC)'=""
Begin DoDot:1
+11 SET Q=+$PIECE($GET(^PRCA(430,RC,0)),U,7)
+12 IF Q
SET Z=$PIECE($GET(^DPT(Q,0)),U)_"/"_$EXTRACT($PIECE($GET(^(0)),U,9),6,9)
End DoDot:1
+13 QUIT Z
+14 ;
COBN(RC,A) ; Return seq # of selected payer
+1 ; A = 'PST' or null to get current bill payer seq #
+2 IF $GET(A)=""
SET A=$PIECE($GET(^DGCR(399,RC,0)),U,21)
if A=""
SET A="P"
if "PST"'[A
SET A="P"
+3 IF 'A
SET A=$FIND("PST",A)-1
if A<1
SET A=1
+4 QUIT A
+5 ;
COPAY(RCIFN) ; Returns 1 if any not cancelled 1st party bills exist for
+1 ; a 3rd party bill or any bills related to this 3rd party bill
+2 ; RCIFN = the 3rd party bill #
+3 NEW FIRST,RCTP0,RCTP1,RCTP2
+4 KILL ^TMP("IBRBF",$JOB),^TMP($JOB,"IBRBF")
+5 ; DBIA 3124
DO RELBILL^IBRFN(RCIFN)
+6 SET RCTP0=0
FOR
SET RCTP0=$ORDER(^TMP("IBRBF",$JOB,RCIFN,RCTP0))
if RCTP0=""
QUIT
SET RCTP1=$GET(^(RCTP0))
Begin DoDot:1
+7 ; IB cancelled
IF $PIECE(RCTP1,U,3)
KILL ^TMP("IBRBF",$JOB,RCIFN,RCTP0)
QUIT
+8 ; AR cancelled
SET RCTP2=$ORDER(^PRCA(430,"B",+$PIECE(RCTP1,U,4),0))
IF $PIECE($GET(^PRCA(430,+RCTP2,0)),U,8)=39
KILL ^TMP("IBRBF",$JOB,RCIFN,RCTP0)
End DoDot:1
+9 SET FIRST=$SELECT($ORDER(^TMP("IBRBF",$JOB,RCIFN,0)):1,1:0)
+10 KILL ^TMP("IBRBF",$JOB),^TMP($JOB,"IBRBF")
+11 QUIT FIRST
+12 ;
MARK(RCIENS) ;EP - Protocol action - RCDPE MARK FOR AUTO POST
+1 ; Mark for Auto-Post - EEOB on APAR gets marked for auto-post if it passes
+2 ; autoposting validation
+3 ; Input: RCIENS - Internal IEN of entry in file 344.49^ien of
+4 ; 344.491^selectable line item from listman screen
+5 ;
+6 ; PRCA*4.5*318 Added security key check
IF '$DATA(^XUSEC("RCDPEPP",DUZ))
Begin DoDot:1
+7 DO FULL^VALM1
+8 SET VALMBCK="R"
+9 WRITE !!,"This action can only be taken by users that have the RCDPEPP security key.",!
+10 DO PAUSE^VALM1
End DoDot:1
QUIT
+11 ;
+12 NEW RESULT,REASON,LINE,DIR,X,Y,RCERROR,XX,ERADA1,RCDFDA
+13 if $GET(RCIENS)=""
SET RCIENS=+$$SEL^RCDPEAA1()
+14 if 'RCIENS
QUIT
+15 ; $$VALID split from RCDPEAP - PRCA*4.5*326
IF '$$VALID($PIECE(RCIENS,U),$PIECE(RCIENS,U,2),.RESULT)
Begin DoDot:1
+16 SET LINE=$ORDER(RESULT(""))
+17 SET REASON=$TRANSLATE(RESULT(LINE),U,"-")
+18 SET DIR(0)="EA"
SET DIR("A",1)="EEOB cannot be marked for Auto-Post for the following reason:"
+19 SET DIR("A",2)=REASON
+20 SET DIR("A")="PRESS RETURN TO CONTINUE "
+21 WRITE !
DO ^DIR
KILL DIR
WRITE !
End DoDot:1
GOTO MARKQ
+22 ; EEOB passed validation; ready for Autopost
+23 LOCK +^RCY(344.4,$PIECE(RCIENS,U),0):5
IF '$TEST
DO NOLOCK
GOTO MARKQ
+24 ; get 344.41 ien (344.491,.09)
SET ERADA1=$PIECE($GET(^RCY(344.49,$PIECE(RCIENS,U),1,$PIECE(RCIENS,U,2),0)),U,9)
+25 SET RCDFDA(344.41,ERADA1_","_$PIECE(RCIENS,U)_",",6)=1
+26 ; PRCA*4.5*326
SET RCDFDA(344.41,ERADA1_","_$PIECE(RCIENS,U)_",",6.01)=DUZ
+27 DO FILE^DIE("","RCDFDA")
+28 ; PRCA*4.5*326 - also update top level ERA
DO UPDERA($PIECE(RCIENS,U),DUZ)
+29 SET DIR(0)="EA"
SET DIR("A",1)=$PIECE(RCIENS,U)_"."_ERADA1_" has been marked for auto-post and has been removed from the APAR List."
+30 SET DIR("A")="PRESS RETURN TO CONTINUE "
+31 WRITE !
DO ^DIR
KILL DIR
WRITE !
+32 LOCK -^RCY(344.4,$PIECE(RCIENS,U),0)
MARKQ ;
+1 QUIT
+2 ;
NOLOCK ; entry cannot be locked
+1 NEW DIR
+2 SET DIR(0)="EA"
+3 SET DIR("A",1)="Sorry, another user is editing this ERA entry."
+4 SET DIR("A",2)="Try again later."
+5 SET DIR("A",3)=""
+6 SET DIR("A")="PRESS ENTER TO CONTINUE "
+7 DO ^DIR
+8 QUIT
+9 ;
VIEWERA(RCIENS) ; View/Print ERA - protocol entry from APAR EEOB List screen and APAR - EEOB ITEM - SCRATCHPAD screen
+1 NEW RCSCR
+2 IF RCPROG="RCDPEAA2"
SET RCSCR=$PIECE(RCIENS,U)
+3 IF RCPROG="RCDPEAA1"
SET RCSCR=+$$SEL^RCDPEAA1()
+4 IF RCSCR>0
DO PRERA^RCDPEWL0
+5 QUIT
+6 ;
VALID(RCSCR,SCRLINE,RCARRAY) ;Validates Scratchpad line - Used by APAR/Mark for Auto-post - split from RCDPEAP - PRCA*4.5*326
+1 ;Input
+2 ; RCSCR - #344.4/#344.49 file IEN
+3 ; SCRLINE - Subscript of first scratchpad entry for the ERA line
+4 ; RCARRAY - Passed reference to result array
+5 ;Output
+6 ; OK - Boolean 1 or 0
+7 ; RCARRAY - Array of claim(s) which fail validation
+8 ;
+9 ; e.g line number 2
+10 ; RCARRAY(2.001)="K800001^NOT AN ACTIVE CLAIM"
+11 ;
+12 ; e.g. split line number 2
+13 ; RCARRAY(2.001)="K800002^CLAIM REFERRED TO GENERAL COUNCIL"
+14 ; RCARRAY(2.006)="K800003^PAYMENT EXCEEDS CLAIM BALANCE"
+15 ;
+16 NEW CLAIM,DONE,SEQ,SEQ1,SUB,STATUS,WLINE
+17 KILL RCARRAY,CLARRAY
+18 SET SUB=SCRLINE
SET SEQ=$PIECE($GET(^RCY(344.49,RCSCR,1,SUB,0)),U)
SET DONE=0
+19 FOR
SET SUB=$ORDER(^RCY(344.49,RCSCR,1,SUB))
if SUB=""
QUIT
Begin DoDot:1
+20 ;Get scratchpad N.001 line and data
+21 SET WLINE=$GET(^RCY(344.49,RCSCR,1,SUB,0))
SET SEQ1=$PIECE(WLINE,".")
IF SEQ1'=SEQ
SET DONE=1
QUIT
+22 ;Get claim number from N.00N line - ignore suspense lines
+23 SET CLAIM=$PIECE(WLINE,U,7)
IF 'CLAIM
QUIT
+24 ;Claim must be OPEN or ACTIVE
+25 SET STATUS=$PIECE($GET(^PRCA(430,CLAIM,0)),"^",8)
IF STATUS'=42
IF STATUS'=16
SET RCARRAY(SEQ1)=$PIECE(WLINE,U,2)_"^NOT AN ACTIVE CLAIM"
QUIT
+26 ;Check that payment does not exceed balance and no pending payments (at the time of auto posting)
+27 SET CLARRAY(CLAIM)=+$GET(CLARRAY(CLAIM))+$PIECE(WLINE,U,3)
IF '$$CHECKPAY^RCDPEAP(.CLARRAY,CLAIM)
SET RCARRAY(SEQ1)=$PIECE(WLINE,U,2)_"^PAYMENT EXCEEDS CLAIM BALANCE"
QUIT
+28 ;Check if referred to general council
+29 IF $PIECE($GET(^PRCA(430,CLAIM,6)),U,4)]""
SET RCARRAY(SEQ1)=$PIECE(WLINE,U,2)_"^CLAIM REFERRED TO GENERAL COUNCIL"
QUIT
+30 ;Check that payment is not negative
+31 IF $PIECE(WLINE,U,6)<0
SET RCARRAY(SEQ1)=$PIECE(WLINE,U,2)_"^PAYMENT AMOUNT IS NEGATIVE"
QUIT
End DoDot:1
if DONE
QUIT
+32 ;Returns 1 if line is OK
+33 QUIT $SELECT($ORDER(RCARRAY(""))]"":0,1:1)
+34 ;
UPDERA(ERAIEN,RCDUZ) ; Update MARK FOR AUTOPOST USER top level ERA with DUZ from detail line. PRCA*4.5*326
+1 ; MARK FOR AUTOPOST USER is required at ERA level for initial receipt and AR transaction crreation
+2 ; so the MARK FOR AUTOPOST USER at the top level will be equal to the last detail line marekd for autopost
+3 NEW FDA,IENS
+4 SET FDA(344.4,ERAIEN_",",4.04)=RCDUZ
+5 DO FILE^DIE("","FDA")
+6 QUIT
IEN41(IEN,LINE) ; Given a scratch pad line, find the original ERA detail line. PRCA*4.5*332
+1 ; Input: IEN - Internal Entry number of ERA scratchpad from file 344.49
+2 ; LINE - Line from ERA scratchpad file 344.49
+3 NEW IEN2
+4 SET IEN2=$ORDER(^RCY(344.49,IEN,1,"ASEQ",LINE\1,0))
+5 QUIT +$$GET1^DIQ(344.491,IEN2_","_IEN_",",.09,"E")
