RCDPEWL1 ;ALB/TMK - ELECTRONIC EOB WORKLIST SCREEN ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**173,208,222,298,304,321,326**;Mar 20, 1995;Build 26
;Per VA Directive 6402, this routine should not be modified.
; IA for read access to ^IBM(361.1 = 4051
; IA for call to ^DGENA = 3812
Q
;
BLD(RCSORT) ; Build the detail display record for the WL scratch pad record
; Assume RCSCR = ien from file 344.49
; RCSORT = "" or 'N' for no sort 'F' for 0-pays first, 'L' for last
;
N A,A0,B,B0,Q,Q0,Q1,QQ,V1,X,Y,Z,Z0,Z3,ZZ,ZZ1,RCT,RCZ,RCZ0,RCZZ0,RCSA,RCAZ,RCAZ0,RCSCT,RCS1,RCLI1,RCY34441,RCZERO,RCTS,RCTL,RCCL,RCCL1
N RCECME,RXARRAY,RC4,RECEIPT,AUTOERA ;prca*4.5*298
S RCSORT=$P($G(RCSORT),U),RCSORT=$S(RCSORT="":"N",1:RCSORT)
K ^TMP("RCDPE-EOB_WL",$J),^TMP("RCDPE-EOB_WLDX",$J),^TMP($J,"RCS"),^TMP("RC_BILL",$J)
;
S VALMCNT=0
S Z=0 F S Z=$O(^RCY(344.49,RCSCR,1,"B",Z)) Q:'Z I Z#1=0 S ZZ=+$O(^RCY(344.49,RCSCR,1,"B",Z,0)) I ZZ D
. S RCZ=ZZ,RCZ0=$G(^RCY(344.49,RCSCR,1,ZZ,0)),RCS1=$P(RCZ0,U,6)
. ; prca*4.5*298 per patch requirements, keep code related to
. ; creating/maintaining batches but just remove from execution.
. ;Q:$S('$G(^TMP("RCBATCH_SELECTED",$J)):0,1:$P(RCZ0,U,14)'=+^TMP("RCBATCH_SELECTED",$J)) ; Must be entire ERA or match the selected batch to continue
. S RCZERO=$S($P(RCZ0,U,2)["**ADJ":"-1",RCSORT="N":1,RCSORT="F":+RCS1'=0,1:+RCS1=0)
. ;
. ; This is a top-level entry - find the sublines
. 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($J,"RCS",RCZERO,ZZ,ZZ1)=""
. S ^TMP($J,"RCS",RCZERO,ZZ)=""
;
S RCZERO="",RCTS=0 F S RCZERO=$O(^TMP($J,"RCS",RCZERO)) Q:RCZERO="" S ZZ=0 F S ZZ=$O(^TMP($J,"RCS",RCZERO,ZZ)) Q:'ZZ D
. N A
. S RCZ0=$G(^RCY(344.49,RCSCR,1,ZZ,0)),RCY34441=$G(^RCY(344.4,RCSCR,1,+$P(RCZ0,U,9),0))
.; get ECME# and Receipt from EEOB
. S RC4=$P($G(^RCY(344.4,RCSCR,1,+$P(RCZ0,U,9),4)),U,2,3)
. S RCECME=$P(RC4,U)
. S RECEIPT=$S(+$P(RC4,U,2):$P($G(^RCY(344,$P(RC4,U,2),0)),U),1:"")
. ; get auto-post status
. S AUTOERA=$S($P($G(^RCY(344.4,RCSCR,4)),U,2)]"":1,1:0)
. ;Filtering Posted/Unposted EEOBs (Auto-Posting ERAs only)
. I $G(^TMP($J,"RC_EEOBPOST"))="P",RECEIPT="" Q
. I $G(^TMP($J,"RC_EEOBPOST"))="U",RECEIPT'="" Q
. S RCTS=RCTS+1,A=$$TOPLINE(RCZ0,RCTS)
. D SET(A,RCTS,RCTS,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^RCDPEAA2(RCCL,"RCCL1",56,74)
. . N TLINE S TLINE=$J("",8)_"Claim Comment: "_RCCL1(1)
. . D SET(TLINE,RCTS,RCTS,ZZ)
. . ; If we have a second or third line for the comment then put it on the screen
. . I RCCL1>1 D SET($J("",8)_RCCL1(2),RCTS,RCTS,ZZ) I RCCL1=3 D SET($J("",8)_RCCL1(3),RCTS,RCTS,ZZ)
. ; **End of *304 modifications**
. I $P(RCY34441,U,11) D
.. D SET("EEOB TRANSFERRED TO "_$E($P($G(^DIC(4,+$P(RCY34441,U,11),0)),U),1,20)_" "_$$FMTE^XLFDT($P(RCY34441,U,12),"2D")_" STATUS: "_$$EXTERNAL^DILFD(344.41,.1,"",+$P(RCY34441,U,10)),RCTS,RCTS,ZZ)
. ;
. S RCT=RCTS
. S ZZ1=0 F S ZZ1=$O(^TMP($J,"RCS",RCZERO,ZZ,ZZ1)) Q:'ZZ1 D
.. S RCT=RCT+.001
.. S RCTL=$L(RCT)
.. S RCZZ0=$G(^RCY(344.49,RCSCR,1,ZZ1,0))
.. S V1=$S($P(RCZ0,U,2)'["**ADJ":"",$P($P(RCZ0,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(+$G(^RCY(344.49,RCSCR,0)),RCZ),1:"??"),1:V1)
.. D SET($J("",4)_$P(" ^(V)",U,$P(RCZZ0,U,13)+1)_RCT_RCLI1,RCTS,RCT,ZZ1)
.. I '$P(RCZZ0,U,7),$P(RCZ0,U,2)'["**ADJ" D SET($J("",4+RCTL)_"***CLAIM NOT FOUND IN YOUR AR ***",RCTS,RCT,ZZ1)
.. I $P(RCZZ0,U,7) D
... N A,RCX,Q
... 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,RCTS,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"),RCTS,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),RCTS,RCT,ZZ1)
.. I AUTOERA,$P(RCZZ0,U,3)>0 D SET($J("",9)_"Receipt: "_RECEIPT,RCTS,RCT,ZZ1) ; if auto-posted ERA display EEOB level receipt number
.. ; display pharmacy EEOB data
.. I RCECME]"" D PHARM(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),RCTS,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
.. ; PRCA*4.5*326 BEGIN
.. ; If this is a zero balance denial ERA display auto-decrease total for line
.. I $$GET1^DIQ(344.4,RCSCR_",",.15)="NON" D
... N RCARC
... S RCARC=$$WLL^RCDPEWLZ(RCSCR,ZZ)
... D:RCARC]"" SET($J("",9)_RCARC)
.. ; PRCA*4.5*326 END
.. I $O(^RCY(344.49,RCSCR,1,ZZ1,1,0)) D
... S Z3=""
... D SET($J("",4+RCTL)_"ADJUSTMENTS:",RCTS,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,RCTS,RCT,ZZ1)
.... I $P(RCAZ0,U,9)'="" D SET($J("",Q)_$P(RCAZ0,U,9),RCTS,RCT,ZZ1)
.. ;
.. I $P($G(^TMP($J,"RC_SORTPARM")),U,2) D
... S A=$J("",10)_"REVIEW STATUS: ("_$S($P(RCZ0,U,11)="I":"REVIEW IN PROCESS",$P(RCZ0,U,11)=1:"REVIEWED",1:"NOT REVIEWED")
... I $P(RCZ0,U,12) S A=A_" SET BY: "_$E($P($G(^VA(200,$P(RCZ0,U,12),0)),U),1,20)
... D SET(A_")",+RCTS,RCT,ZZ1)
... S A=0 F S A=$O(^RCY(344.49,RCSCR,1,ZZ,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:""),RCTS,RCT,ZZ1)
.... S B=0 F S B=$O(^RCY(344.49,RCSCR,1,ZZ,4,A,1,B)) Q:'B S B0=$G(^(B,0)) D
..... I $L(B0)>64 D SET($J("",15)_$E(B0,1,64),RCTS,RCT,ZZ1) S B0=" "_$E(B0,65,$L(B0)) ; Split line if > 64 characters in comment line
..... D SET($J("",15)_B0,RCTS,RCT,ZZ1)
.. S A="",$P(A,".",79)="" D SET(A,RCTS,RCT,ZZ1)
; prca*4.5*298 per patch requirements, keep code related to creating/maintaining
; batches but just remove from execution.
; I VALMCNT=0 D
;. I $G(^TMP("RCBATCH_SELECTED",$J)) D
;. . D SET("THERE ARE NO EEOBs ASSIGNED TO THIS BATCH")
;. E D SET("THERE ARE NO EEOBs MATCHING YOUR SELECTION CRITERIA")
I VALMCNT=0 D SET("THERE ARE NO EEOBs MATCHING YOUR SELECTION CRITERIA")
K ^TMP($J,"RCS")
Q
;
TOPLINE(RCZ0,RCTS) ; Function returns the top line of the EEOB display
; RCZ0 = the 0-node of the whole number entry line for the EEOB
; RCTS = the selectable line #
N A
S A=" "_$S($P(RCZ0,U,13):"(V)",1:" ")_"EEOB Seq #"_$S($P(RCZ0,U,9)[",":"'s",1:"")_" On ERA: "_$S($P(RCZ0,U,9)'="":$P(RCZ0,U,9),1:"None")_" Net Payment Amt: "_$J(+$P(RCZ0,U,6),"",2)
I $P($G(^TMP($J,"RC_SORTPARM")),U,2) S A=A_" Reviewed?: "_$S($P(RCZ0,U,11)="":"NO",1:$$EXTERNAL^DILFD(344.491,.11,,$P(RCZ0,U,11)))
S A=$E(RCTS_$J("",4),1,4)_A
Q A
;
PHARM(RCZZ0,RCECME,RCT,ZZ1) ;
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
;
INIT ;
S VALMBG=$G(^TMP($J,"RC_VALMBG"))
Q
;
HDR ;
D HDR^RCDPEWL
Q
;
FNL ; -- Clean up list
K RCFASTXT
Q
;
SET(X,RCSEQ,RCSEQ1,RCZ9) ; -- set 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
;
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEWL1 11293 printed Nov 22, 2024@16:55:52 Page 2
RCDPEWL1 ;ALB/TMK - ELECTRONIC EOB WORKLIST SCREEN ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**173,208,222,298,304,321,326**;Mar 20, 1995;Build 26
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ; IA for read access to ^IBM(361.1 = 4051
+4 ; IA for call to ^DGENA = 3812
+5 QUIT
+6 ;
BLD(RCSORT) ; Build the detail display record for the WL scratch pad record
+1 ; Assume RCSCR = ien from file 344.49
+2 ; RCSORT = "" or 'N' for no sort 'F' for 0-pays first, 'L' for last
+3 ;
+4 NEW A,A0,B,B0,Q,Q0,Q1,QQ,V1,X,Y,Z,Z0,Z3,ZZ,ZZ1,RCT,RCZ,RCZ0,RCZZ0,RCSA,RCAZ,RCAZ0,RCSCT,RCS1,RCLI1,RCY34441,RCZERO,RCTS,RCTL,RCCL,RCCL1
+5 ;prca*4.5*298
NEW RCECME,RXARRAY,RC4,RECEIPT,AUTOERA
+6 SET RCSORT=$PIECE($GET(RCSORT),U)
SET RCSORT=$SELECT(RCSORT="":"N",1:RCSORT)
+7 KILL ^TMP("RCDPE-EOB_WL",$JOB),^TMP("RCDPE-EOB_WLDX",$JOB),^TMP($JOB,"RCS"),^TMP("RC_BILL",$JOB)
+8 ;
+9 SET VALMCNT=0
+10 SET Z=0
FOR
SET Z=$ORDER(^RCY(344.49,RCSCR,1,"B",Z))
if 'Z
QUIT
IF Z#1=0
SET ZZ=+$ORDER(^RCY(344.49,RCSCR,1,"B",Z,0))
IF ZZ
Begin DoDot:1
+11 SET RCZ=ZZ
SET RCZ0=$GET(^RCY(344.49,RCSCR,1,ZZ,0))
SET RCS1=$PIECE(RCZ0,U,6)
+12 ; prca*4.5*298 per patch requirements, keep code related to
+13 ; creating/maintaining batches but just remove from execution.
+14 ;Q:$S('$G(^TMP("RCBATCH_SELECTED",$J)):0,1:$P(RCZ0,U,14)'=+^TMP("RCBATCH_SELECTED",$J)) ; Must be entire ERA or match the selected batch to continue
+15 SET RCZERO=$SELECT($PIECE(RCZ0,U,2)["**ADJ":"-1",RCSORT="N":1,RCSORT="F":+RCS1'=0,1:+RCS1=0)
+16 ;
+17 ; This is a top-level entry - find the sublines
+18 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
+19 SET ^TMP($JOB,"RCS",RCZERO,ZZ,ZZ1)=""
End DoDot:2
+20 SET ^TMP($JOB,"RCS",RCZERO,ZZ)=""
End DoDot:1
+21 ;
+22 SET RCZERO=""
SET RCTS=0
FOR
SET RCZERO=$ORDER(^TMP($JOB,"RCS",RCZERO))
if RCZERO=""
QUIT
SET ZZ=0
FOR
SET ZZ=$ORDER(^TMP($JOB,"RCS",RCZERO,ZZ))
if 'ZZ
QUIT
Begin DoDot:1
+23 NEW A
+24 SET RCZ0=$GET(^RCY(344.49,RCSCR,1,ZZ,0))
SET RCY34441=$GET(^RCY(344.4,RCSCR,1,+$PIECE(RCZ0,U,9),0))
+25 ; get ECME# and Receipt from EEOB
+26 SET RC4=$PIECE($GET(^RCY(344.4,RCSCR,1,+$PIECE(RCZ0,U,9),4)),U,2,3)
+27 SET RCECME=$PIECE(RC4,U)
+28 SET RECEIPT=$SELECT(+$PIECE(RC4,U,2):$PIECE($GET(^RCY(344,$PIECE(RC4,U,2),0)),U),1:"")
+29 ; get auto-post status
+30 SET AUTOERA=$SELECT($PIECE($GET(^RCY(344.4,RCSCR,4)),U,2)]"":1,1:0)
+31 ;Filtering Posted/Unposted EEOBs (Auto-Posting ERAs only)
+32 IF $GET(^TMP($JOB,"RC_EEOBPOST"))="P"
IF RECEIPT=""
QUIT
+33 IF $GET(^TMP($JOB,"RC_EEOBPOST"))="U"
IF RECEIPT'=""
QUIT
+34 SET RCTS=RCTS+1
SET A=$$TOPLINE(RCZ0,RCTS)
+35 DO SET(A,RCTS,RCTS,ZZ)
+36 ; PRCA*4.5*304 - Add claim comment to screen if it exists for this ERA EEOB detail line
+37 if $PIECE(RCZ0,U,9)'=""
SET RCCL=$$GET1^DIQ(344.41,$PIECE(RCZ0,U,9)_","_RCSCR_",",4)
+38 ; If we have a ERA Detail line comment, display it
if $GET(RCCL)'=""
Begin DoDot:2
+39 DO SLINE^RCDPEAA2(RCCL,"RCCL1",56,74)
+40 NEW TLINE
SET TLINE=$JUSTIFY("",8)_"Claim Comment: "_RCCL1(1)
+41 DO SET(TLINE,RCTS,RCTS,ZZ)
+42 ; If we have a second or third line for the comment then put it on the screen
+43 IF RCCL1>1
DO SET($JUSTIFY("",8)_RCCL1(2),RCTS,RCTS,ZZ)
IF RCCL1=3
DO SET($JUSTIFY("",8)_RCCL1(3),RCTS,RCTS,ZZ)
End DoDot:2
+44 ; **End of *304 modifications**
+45 IF $PIECE(RCY34441,U,11)
Begin DoDot:2
+46 DO SET("EEOB TRANSFERRED TO "_$EXTRACT($PIECE($GET(^DIC(4,+$PIECE(RCY34441,U,11),0)),U),1,20)_" "_$$FMTE^XLFDT($PIECE(RCY34441,U,12),"2D")_" STATUS: "_$$EXTERNAL^DILFD(344.41,.1,"",+$PIECE(RCY34441,U,10)),RCTS,RCTS,ZZ)
End DoDot:2
+47 ;
+48 SET RCT=RCTS
+49 SET ZZ1=0
FOR
SET ZZ1=$ORDER(^TMP($JOB,"RCS",RCZERO,ZZ,ZZ1))
if 'ZZ1
QUIT
Begin DoDot:2
+50 SET RCT=RCT+.001
+51 SET RCTL=$LENGTH(RCT)
+52 SET RCZZ0=$GET(^RCY(344.49,RCSCR,1,ZZ1,0))
+53 SET V1=$SELECT($PIECE(RCZ0,U,2)'["**ADJ":"",$PIECE($PIECE(RCZ0,U,2),"ADJ",2):"***ADJUSTMENT AT ERA LEVEL",1:"*** ADJUSTMENT LINE FOR TOTALS MISMATCH")
+54 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(+$GET(^RCY(344.49,RCSCR,0)),RCZ),1:"??
"),1:V1)
+55 DO SET($JUSTIFY("",4)_$PIECE(" ^(V)",U,$PIECE(RCZZ0,U,13)+1)_RCT_RCLI1,RCTS,RCT,ZZ1)
+56 IF '$PIECE(RCZZ0,U,7)
IF $PIECE(RCZ0,U,2)'["**ADJ"
DO SET($JUSTIFY("",4+RCTL)_"***CLAIM NOT FOUND IN YOUR AR ***",RCTS,RCT,ZZ1)
+57 IF $PIECE(RCZZ0,U,7)
Begin DoDot:3
+58 NEW A,RCX,Q
+59 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")=""
+60 ; Find Rx copay status
+61 ;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")
+62 ; Find M/T status
+63 SET RCX=$$LST^DGMTU(A("DFN"),A("SDT"))
SET A("M/T")=$PIECE(RCX,U,4)
+64 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")
+65 ;
+66 SET QQ=" Billed Amt: "_$JUSTIFY(A("OA"),"",2)_" Amt To Post: "_$JUSTIFY(+$PIECE(RCZZ0,U,3),"",2)
+67 DO SET($JUSTIFY("",4+RCTL)_"Claim Bal: "_$JUSTIFY(+$PIECE($$BILL^RCJIBFN2(+$PIECE(RCZZ0,U,7)),U,3),"",2)_QQ,RCTS,RCT,ZZ1)
+68 SET ^TMP("RC_BILL",$JOB,$PIECE(RCZZ0,U,7),RCT)=QQ
+69 SET Z3=$JUSTIFY("",4+RCTL)_"Svc Dt: "_$SELECT(A("SDT")'="":$$FMTE^XLFDT(A("SDT"),2),1:"UNKNOWN")
+70 SET Z3=Z3_" COB: "_$SELECT($DATA(^DGCR(399,+$PIECE(RCZZ0,U,7),"I"_($$COBN(+$PIECE(RCZZ0,U,7))+1))):"YES",1:"NO ")
+71 DO SET(Z3_" Rx Copay: "_$EXTRACT(A("RXCP"),1,17)_" Means Tst: "_A("M/T"),RCTS,RCT,ZZ1)
End DoDot:3
+72 ;
+73 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),RCTS,RCT,ZZ1)
+74 ; if auto-posted ERA display EEOB level receipt number
IF AUTOERA
IF $PIECE(RCZZ0,U,3)>0
DO SET($JUSTIFY("",9)_"Receipt: "_RECEIPT,RCTS,RCT,ZZ1)
+75 ; display pharmacy EEOB data
+76 IF RCECME]""
DO PHARM(RCZZ0,RCECME,RCT,ZZ1)
+77 ; PRCA*4.5*321 BEGIN
+78 IF $PIECE(RCZZ0,U,10)'=""
Begin DoDot:3
+79 DO SET($JUSTIFY("",9)_"Receipt Comment: "_$PIECE(RCZZ0,U,10),RCTS,RCT,ZZ1)
+80 DO SET($JUSTIFY("",9)_"Added By User: "_$$GET1^DIQ(344.491,ZZ1_","_RCSCR_",",2.03),RCTS,RCT,ZZ1)
+81 DO SET($JUSTIFY("",9)_"Date/Time Added: "_$$GET1^DIQ(344.491,ZZ1_","_RCSCR_",",2.04),RCTS,RCT,ZZ1)
End DoDot:3
+82 ; PRCA*4.5*321 END
+83 ; PRCA*4.5*326 BEGIN
+84 ; If this is a zero balance denial ERA display auto-decrease total for line
+85 IF $$GET1^DIQ(344.4,RCSCR_",",.15)="NON"
Begin DoDot:3
+86 NEW RCARC
+87 SET RCARC=$$WLL^RCDPEWLZ(RCSCR,ZZ)
+88 if RCARC]""
DO SET($JUSTIFY("",9)_RCARC)
End DoDot:3
+89 ; PRCA*4.5*326 END
+90 IF $ORDER(^RCY(344.49,RCSCR,1,ZZ1,1,0))
Begin DoDot:3
+91 SET Z3=""
+92 DO SET($JUSTIFY("",4+RCTL)_"ADJUSTMENTS:",RCTS,RCT,ZZ1)
+93 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:4
+94 SET Z3=$JUSTIFY("",6+RCTL)_+RCAZ0_". "
SET Q=$LENGTH(Z3)
+95 ;
+96 IF $PIECE(RCAZ0,U,2)=0
SET Z3=Z3_"Distributed adj dec for retraction "_$PIECE(RCAZ0,U,4)_": "_$PIECE(RCAZ0,U,3)
+97 IF $PIECE(RCAZ0,U,2)=1
SET Z3=Z3_"Adjustment distribution to balance receipt: "_$PIECE(RCAZ0,U,3)
+98 ;
+99 IF $PIECE(RCAZ0,U,2)=2!($PIECE(RCAZ0,U,2)=4)
Begin DoDot:5
+100 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:5
+101 IF $PIECE(RCAZ0,U,2)=5
SET Z3=Z3_"Non-specific payment (ref# "_$PIECE(RCAZ0,U,4)_"): "_$PIECE(RCAZ0,U,3)
+102 IF $PIECE(RCAZ0,U,2)=3
SET Z3=Z3_"Non-specific retraction (ref# "_$PIECE(RCAZ0,U,4)_"): "_$PIECE(RCAZ0,U,3)
+103 DO SET(Z3,RCTS,RCT,ZZ1)
+104 IF $PIECE(RCAZ0,U,9)'=""
DO SET($JUSTIFY("",Q)_$PIECE(RCAZ0,U,9),RCTS,RCT,ZZ1)
End DoDot:4
End DoDot:3
+105 ;
+106 IF $PIECE($GET(^TMP($JOB,"RC_SORTPARM")),U,2)
Begin DoDot:3
+107 SET A=$JUSTIFY("",10)_"REVIEW STATUS: ("_$SELECT($PIECE(RCZ0,U,11)="I":"REVIEW IN PROCESS",$PIECE(RCZ0,U,11)=1:"REVIEWED",1:"NOT REVIEWED")
+108 IF $PIECE(RCZ0,U,12)
SET A=A_" SET BY: "_$EXTRACT($PIECE($GET(^VA(200,$PIECE(RCZ0,U,12),0)),U),1,20)
+109 DO SET(A_")",+RCTS,RCT,ZZ1)
+110 SET A=0
FOR
SET A=$ORDER(^RCY(344.49,RCSCR,1,ZZ,4,A))
if 'A
QUIT
SET A0=$GET(^(A,0))
Begin DoDot:4
+111 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:""),RCTS,RCT,ZZ1)
+112 SET B=0
FOR
SET B=$ORDER(^RCY(344.49,RCSCR,1,ZZ,4,A,1,B))
if 'B
QUIT
SET B0=$GET(^(B,0))
Begin DoDot:5
+113 ; Split line if > 64 characters in comment line
IF $LENGTH(B0)>64
DO SET($JUSTIFY("",15)_$EXTRACT(B0,1,64),RCTS,RCT,ZZ1)
SET B0=" "_$EXTRACT(B0,65,$LENGTH(B0))
+114 DO SET($JUSTIFY("",15)_B0,RCTS,RCT,ZZ1)
End DoDot:5
End DoDot:4
End DoDot:3
+115 SET A=""
SET $PIECE(A,".",79)=""
DO SET(A,RCTS,RCT,ZZ1)
End DoDot:2
End DoDot:1
+116 ; prca*4.5*298 per patch requirements, keep code related to creating/maintaining
+117 ; batches but just remove from execution.
+118 ; I VALMCNT=0 D
+119 ;. I $G(^TMP("RCBATCH_SELECTED",$J)) D
+120 ;. . D SET("THERE ARE NO EEOBs ASSIGNED TO THIS BATCH")
+121 ;. E D SET("THERE ARE NO EEOBs MATCHING YOUR SELECTION CRITERIA")
+122 IF VALMCNT=0
DO SET("THERE ARE NO EEOBs MATCHING YOUR SELECTION CRITERIA")
+123 KILL ^TMP($JOB,"RCS")
+124 QUIT
+125 ;
TOPLINE(RCZ0,RCTS) ; Function returns the top line of the EEOB display
+1 ; RCZ0 = the 0-node of the whole number entry line for the EEOB
+2 ; RCTS = the selectable line #
+3 NEW A
+4 SET A=" "_$SELECT($PIECE(RCZ0,U,13):"(V)",1:" ")_"EEOB Seq #"_$SELECT($PIECE(RCZ0,U,9)[",":"'s",1:"")_" On ERA: "_$SELECT($PIECE(RCZ0,U,9)'="":$PIECE(RCZ0,U,9),1:"None")_" Net Payment Amt: "_$JUSTIFY(+$PIECE(RCZ0,U,6),"",2)
+5 IF $PIECE($GET(^TMP($JOB,"RC_SORTPARM")),U,2)
SET A=A_" Reviewed?: "_$SELECT($PIECE(RCZ0,U,11)="":"NO",1:$$EXTERNAL^DILFD(344.491,.11,,$PIECE(RCZ0,U,11)))
+6 SET A=$EXTRACT(RCTS_$JUSTIFY("",4),1,4)_A
+7 QUIT A
+8 ;
PHARM(RCZZ0,RCECME,RCT,ZZ1) ;
+1 NEW RXARRAY
+2 DO GETPHARM^RCDPEWLP($PIECE(RCZZ0,U,7),.RXARRAY)
+3 DO SET($JUSTIFY("",9)_"ECME #: "_RCECME,$PIECE(RCZZ0,U),RCT,ZZ1)
+4 IF '$DATA(RXARRAY)
DO SET($JUSTIFY("",9)_" Pharmacy data does not exist for this claim",$PIECE(RCZZ0,U),RCT,ZZ1)
QUIT
+5 DO SET($JUSTIFY("",9)_"Rx/Fill/Release Status: "_RXARRAY("RX")_"/"_RXARRAY("FILL")_"/"_RXARRAY("RELEASED STATUS"),$PIECE(RCZZ0,U),RCT,ZZ1)
+6 DO SET($JUSTIFY("",9)_"DOS: "_RXARRAY("DOS"),$PIECE(RCZZ0,U),RCT,ZZ1)
+7 QUIT
+8 ;
INIT ;
+1 SET VALMBG=$GET(^TMP($JOB,"RC_VALMBG"))
+2 QUIT
+3 ;
HDR ;
+1 DO HDR^RCDPEWL
+2 QUIT
+3 ;
FNL ; -- Clean up list
+1 KILL RCFASTXT
+2 QUIT
+3 ;
SET(X,RCSEQ,RCSEQ1,RCZ9) ; -- set 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 ;
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 ;
