RCDPEWL3 ;ALB/TMK/KML - ELECTRONIC EOB WORKLIST ACTIONS ;24-FEB-03
;;4.5;Accounts Receivable;**173,276,321**;Mar 20, 1995;Build 48
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
SPLIT(RCSCR,RCL) ; Perform line splits
N Z,Z0,DIR,X,Y,RCL1,DA,DR,DIE,DIC,RCDONE,RCDIR,RCSPLIT,RCTOT,RCOK,RCLINE
;
D CLEAR^VALM1
S ^TMP($J,"RCDPE_SPLIT")=""
S RCLINE=$G(^TMP("RCDPE-EOB_WLDX",$J,RCL)),RCL1=$G(^TMP("RCDPE-EOB_WLDX",$J,RCL\1))
;
S Z=+$O(^TMP("RCDPE-EOB_WLDX",$J,RCL)),Z0=+$G(^TMP("RCDPE-EOB_WLDX",$J,Z)) S:'Z0 Z0=999
W !
F Z=+RCLINE:1:Z0 Q:'$D(^TMP("RCDPE-EOB_WL",$J,Z,0))!(Z'<Z0) W !,^TMP("RCDPE-EOB_WL",$J,Z,0)
;
I $E($P(RCL1,U,2),1,3)["ADJ" D G SPLITQ
. W !,"THIS IS AN ERA-LEVEL ADJUSTMENT - ONLY THE ADJUSTMENT COMMENT CAN BE EDITED"
. S DIR(0)="A" D ^DIR K DIR
. S DA(2)=RCSCR,DA(1)=+$P(RCLINE,U,2),DA=+$P($P(RCL1,U,2),"ADJ",2)
. Q:'DA
. D EDITCOM(.DA)
;
S RCDONE=0,RCDIR(1)=$P($G(^RCY(344.49,RCSCR,1,+$P(RCLINE,U,2),0)),U,2),RCDIR(2)=$P($G(^RCY(344.49,RCSCR,1,+$P(RCLINE,U,2),0)),U,5),RCDIR(3)=$P($G(^RCY(344.49,RCSCR,1,+$P(RCLINE,U,2),0)),U,8),RCDIR(6)=+$P(RCLINE,U,2)
S RCDIR=RCDIR(1)_U_RCDIR(2)_U_RCDIR(3)
;
S RCSPLIT=0
I $P(RCDIR,U,3) W !!,"NOTE: THIS LINE HAS AN ADJUSTMENT RECORD ASSOCIATED WITH IT",!
F D Q:RCDONE
. S RCSPLIT=RCSPLIT+1
. D EDIT(RCSCR,RCLINE,.RCDIR,.RCSPLIT,"",.RCDONE)
. I '$D(RCSPLIT(RCSPLIT)) S RCSPLIT=RCSPLIT-1
;
G:'$O(RCSPLIT(0)) SPLITQ
N VALMCNT,VALMBG
S VALMCNT=0,VALMBG=1
S ^TMP($J,"RCDPE_SPLIT_FILE")=1
D EN^VALM("RCDPE EOB WORKLIST SPLIT")
;
SPLITQ Q
;
TOT(N,RCSPLIT,RCLINE) ; CALCULATE TOTAL OF PAY (N=2) or ADJ (N=3)
; RCSPLIT = the array (passed by ref) where the amounts are stored
; RCLINE = if editing, this is the line # NOT to add in when
; determining previous amounts entered
N Z,Z0
S (Z,Z0)=0
F S Z=$O(RCSPLIT(Z)) Q:'Z I $S('$G(RCLINE):1,1:RCLINE'=Z) S Z0=Z0+$P(RCSPLIT(Z),U,N)
Q $J(Z0,"",2)
;
UPD(Q,Q1) ;
N DA,DIE,DR,X,Y
S DA(1)=Q,DA=Q1
S DIE="^RCY(344.49,"_DA(1)_",1,",DR="2.03////"_DUZ_";2.04////"_$$NOW^XLFDT() D ^DIE
S ^TMP("RCDPE_SPLIT_REBLD",$J)=1
Q
;
HDR ;
N Z,Z0,ZCT
S ZCT=0
S Z=+$O(^TMP("RCDPE-EOB_WLDX",$J,RCL)),Z0=+$G(^TMP("RCDPE-EOB_WLDX",$J,Z)) S:'Z0 Z0=999
F Z=+RCLINE:1:Z0 Q:'$D(^TMP("RCDPE-EOB_WL",$J,Z,0))!(Z'<Z0)!(ZCT'<6) S ZCT=ZCT+1,VALMHDR(ZCT)=^TMP("RCDPE-EOB_WL",$J,Z,0)
S ZCT=ZCT+1,VALMHDR(ZCT)=" "
Q
;
FNL ;
K ^TMP("RCDPE_EOB_SPLIT",$J),^TMP("RCDPE_EOB_SPLIT_OK",$J),^TMP("RCDPE_EOB_SPLITDX",$J)
Q
;
INIT ; Build screen for display
; RCSCR, RCDIR, RCSPLIT must already exist
N Z,RCTOT,DIR,X,Y,RCNT,RCCT,Q,RCT
K ^TMP("RCDPE_EOB_SPLIT",$J)
S (VALMCNT,RCNT)=0
S ^TMP("RCDPE_EOB_SPLIT_OK",$J)=1
F Z=2,3 S RCTOT(Z)=$$TOT(Z,.RCSPLIT)
I +RCTOT(2)'=+$P(RCDIR,U,2)!(+RCTOT(3)'=+$P(RCDIR,U,3)) D
. D SET("**** TOTAL AMOUNTS ENTERED DO NOT MATCH THE ORIGINAL AMOUNTS ****",1),SET(" ",1)
. S ^TMP("RCDPE_EOB_SPLIT_OK",$J)=0
;
S (RCCT,Z,RCT(1),RCT(2),RCT(3))=0
F S Z=$O(RCSPLIT(Z)) Q:'Z D
. S X="",RCCT=RCCT+1
. S X=$$SETFLD^VALM1(RCCT,X,"NUM")
. S X=$$SETFLD^VALM1($P(RCSPLIT(Z),U)_$S('$P(RCSPLIT(Z),U,5):" (NOT IN A/R)",1:""),X,"CLAIM")
. S X=$$SETFLD^VALM1($J(+$P(RCSPLIT(Z),U,2),15,2),X,"PAYMENT"),RCT(1)=RCT(1)+$P(RCSPLIT(Z),U,2)
. S X=$$SETFLD^VALM1($J(+$P(RCSPLIT(Z),U,3),15,2),X,"ADJUSTMENT"),RCT(2)=RCT(2)+$P(RCSPLIT(Z),U,3)
. S X=$$SETFLD^VALM1($J($P(RCSPLIT(Z),U,2)+$P(RCSPLIT(Z),U,3),15,2),X,"NET"),RCT(3)=RCT(3)+$P(RCSPLIT(Z),U,2)+$P(RCSPLIT(Z),U,3)
. D SET(X,RCCT)
. I $P(RCSPLIT(Z),U,6)'="",$P(RCSPLIT(Z),U,6)'="@" S X=$$SETSTR^VALM1($J("",10)_$P(RCSPLIT(Z),U,6),"",1,70) D SET(X,RCCT)
S Q="",$P(Q,"=",15)=""
D SET($J("",32)_Q_" "_Q_" "_Q,RCCT),SET($E(" TOTALS: "_$J("",31),1,31)_$E($J(+RCT(1),15,2)_$J("",17),1,17)_$E($J(+RCT(2),15,2)_$J("",17),1,17)_$E($J(+RCT(3),15,2)_$J("",17),1,17),RCCT)
;
Q
;
SET(X,RCSEQ) ;
S VALMCNT=VALMCNT+1
S ^TMP("RCDPE_EOB_SPLIT",$J,VALMCNT,0)=X
S ^TMP("RCDPE_EOB_SPLIT",$J,"IDX",VALMCNT,RCSEQ)=""
S ^TMP("RCDPE_EOB_SPLITDX",$J,RCSEQ)=VALMCNT
Q
;
EDITCOM(DA) ; Edit the comment for an adjustment entry
N RCX,DIE,X,Y,DR
S RCX=$P($G(^RCY(344.49,DA(2),1,DA(1),1,DA,0)),U,9)
S DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,",DR=".09"
D ^DIE
Q:$P($G(^RCY(344.49,DA(2),1,DA(1),1,DA,0)),U,9)=RCX
D UPD(DA(2),DA(1))
Q
;
EDIT(RCSCR,RCLINE,RCDIR,RCSPLIT,RCDEF,RCDONE) ; Edit a split line
;
N CT,DIC,DIR,DIRUT,DTOUT,DUOUT,RCOK,RCL,X,Y,Z
; Enter claim #
S RCL=$G(RCDIR(6))
EDCL ;
S DIR("?",1)="ENTER THE CLAIM # TO WHICH THE PAYMENT OR ADJUSTMENT WILL BE APPLIED."
S DIR("?",2)="THE CLAIM # DOES NOT HAVE TO EXIST IN YOUR AR IF THE PAYMENT/ADJUSTMENT"
S DIR("?")="BELONGS TO ANOTHER SITE."
S DIR(0)="FAO^1:15",DIR("A")="CLAIM #: "
S:$P($G(RCDEF),U)'="" DIR("B")=$P(RCDEF,U)
S:$G(RCDIR(1))'=""&($G(DIR("B"))="") DIR("B")=RCDIR(1)
W ! D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) D ABORT Q
I Y="" D G:'RCDONE EDCL Q
. S DIR(0)="YA",DIR("A",1)="YOU MUST SPLIT THE ENTIRE AMOUNT OF THE LINE."
. S DIR("A",2)=" $"_$J(+RCDIR(2),"",2)_" PAYMENT IS LEFT"_$S($P(RCDIR,U,3)&$G(RCDIR(3)):" AND $"_$J(+RCDIR(3),"",2)_" ADJ IS LEFT",1:"")
. S DIR("A")="DO YOU WANT TO ABORT THIS SPLIT NOW?: ",DIR("B")="NO"
. W ! D ^DIR K DIR
. I Y'=0 D ABORT Q
S $P(RCSPLIT(RCSPLIT),U)=Y
;
I $E(Y,1,3)?3N,$L(Y)>7,Y'["-" S Y=$E(Y,1,3)_"-"_$E(Y,4,$L(Y))
I $TR(Y," ")="" S Y=-1
I Y'=-1 S DIC="^PRCA(430,",DIC(0)="M" D ^DIC K DIC
I +Y>0 D I 'RCOK K RCSPLIT(RCSPLIT) G EDCL
. S RCOK=1
. I '$D(^DGCR(399,+Y,0)) D Q ; prca276 place screen to only allow selection of third party claims
. . W !," THIS IS NOT A 3RD PARTY CLAIM. CLAIMS NEED TO BE 3RD PARTY."
. . S RCOK=0
. I '$$VALSTAT^RCDPEM5(+Y) W !," CLAIM IS IN AN INCOMPLETE STATUS. ENTER ANOTHER CLAIM." S RCOK=0 ; prca276 do not allow incomplete claims
I Y<0 D G:'RCOK EDCL
. S RCOK=1
. S DIR("A")=" THIS CLAIM WAS NOT FOUND IN YOUR AR. DO YOU WANT TO CONTINUE?: ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR W ! I Y'=1 K RCSPLIT(RCSPLIT) S RCOK=0
E D
. S $P(RCSPLIT(RCSPLIT),U,5)=+Y
. W " >>Current claim balance is: ",$J(+$P($$BILL^RCJIBFN2(+Y),U,3),"",2)
; Enter payment
S RCDIR(1)=""
S DIR("?",1)="**************"
S CT=1
I $P(RCDIR,U,3) D
. S DIR("?",CT+1)="SINCE THIS LINE HAS AN ADJUSTMENT, THE AMOUNT ENTERED HERE SHOULD BE THE",DIR("?",CT+2)="CORRECTED AMOUNT THE PAYER INDICATED THEY SHOULD HAVE PAID FOR THE CLAIM",DIR("?",CT+3)=" ",CT=CT+3
S CT=CT+1,DIR("?",CT)="ENTER THE AMT FROM THE PAYMENT TOTAL FOR THIS LINE ("_$J(+$P(RCDIR,U,2),"",2)_")"
I $G(RCDEF)="" D
. S CT=CT+1,DIR("?",CT)=" THAT APPLIES TO THIS CLAIM. THE PAYMENT AMOUNT ALREADY USED FOR THIS"
. S CT=CT+1,DIR("?",CT)=" LINE SPLIT IS: "_$J(+$$TOT(2,.RCSPLIT,$S(RCDEF="":"",1:RCSPLIT)),"",2)_" LEAVING A BALANCE TO DISTRIBUTE OF: "_$J($P(RCDIR,U,2)-$$TOT(2,.RCSPLIT,$S(RCDEF="":"",1:RCSPLIT)),"",2)
S CT=CT+1,DIR("?",CT)="THE TOTAL PAYMENTS ENTERED DURING THIS SPLIT MUST EQUAL THE ORIGINAL LINE",DIR("?")=" PAYMENT AMOUNT OF $"_$J(+$P(RCDIR,U,2),"",2)
S DIR(0)="NAO^0:"_$S(RCDEF="":$P(RCDIR,U,2)-$$TOT(2,.RCSPLIT,RCSPLIT),1:$P(RCDIR,U,2))_":2"
S DIR("A")="PAYMENT AMOUNT TO APPLY TO THIS CLAIM: " S:$P($G(RCDEF),U,2)'="" DIR("B")=$J(+$P(RCDEF,U,2),"",2) S:$G(RCDIR(2))'=""&($G(DIR("B"))="") DIR("B")=RCDIR(2) D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) K RCSPLIT(RCSPLIT) G EDCL
S $P(RCSPLIT(RCSPLIT),U,2)=Y,RCDIR(2)=$J($P(RCDIR,U,2)-$$TOT(2,.RCSPLIT),"",2)
; Enter adj
I $O(^RCY(344.49,RCSCR,1,+$P(RCLINE,U,2),1,0)) D G:'RCOK EDCL
. S RCOK=1
. W !!,$J("",5)_"THIS LINE CONTAINS AN ADJUSTMENT AMOUNT OF $"_$J(+$P(RCDIR,U,3),"",2),!,$J("",5)_"THIS AMT IS USUALLY THE AMT THE PAYER PREVIOUSLY PAID",!,$J("",5),"ON A CLAIM WHICH THEY HAVE NOW AMENDED. IF THERE WAS"
. W !,$J("",5)_"AN AMT PREVIOUSLY PAID FOR THIS CLAIM, ENTER THAT AMOUNT",!,$J("",5),"AS A NEGATIVE AMOUNT HERE.",!
. S DIR("?",1)="**************"
. S DIR("?",2)="ENTER THE AMT FROM THE ADJUSTMENT TOTAL FOR THIS LINE ("_$J(+$P(RCDIR,U,3),"",2)_")",DIR("?",3)=" THAT APPLIES TO THIS CLAIM. THE ADJUSTMENT AMOUNT ALREADY USED FOR THIS"
. S DIR("?",4)=" LINE SPLIT IS "_$J(+$$TOT(3,.RCSPLIT,$S(RCDEF="":"",1:RCSPLIT)),"",2)_" LEAVING A BALANCE OF "_$J($P(RCDIR,U,3)-$$TOT(3,.RCSPLIT,$S(RCDEF="":"",1:RCSPLIT)),"",2)_" TO DISTRIBUTE"
. S DIR("?",5)=" ENTER IT AS THE NEGATIVE OF THE AMT THE PAYER PREVIOUSLY PAID ON THIS CLAIM"
. S DIR("?",6)="THE TOTAL ADJUSTMENTS ENTERED DURING THIS SPLIT MUST EQUAL THE ORIGINAL LINE",DIR("?")=" ADJUSTMENT AMOUNT OF $"_$J(+$P(RCDIR,U,3),"",2)
. S DIR(0)="NAO^"_$J($P(RCDIR,U,3)-$$TOT(3,.RCSPLIT,$S(RCDEF="":"",1:RCSPLIT)),"",2)_":0:2",DIR("A")="ADJUSTMENT AMOUNT: " S:$P($G(RCDEF),U,3)'="" DIR("B")=$J(+$P(RCDEF,U,3),"",2) S:$G(RCDIR(3))'=""&($G(DIR("B"))="") DIR("B")=RCDIR(3)
. D ^DIR K DIR
. I $D(DTOUT)!$D(DUOUT) S RCOK=0 K RCSPLIT(RCSPLIT) Q
. S $P(RCSPLIT(RCSPLIT),U,3)=Y,RCDIR(3)=$J($P(RCDIR,U,3)-$$TOT(3,.RCSPLIT),"",2)
I +RCDIR(2)=0,+RCDIR(3)=0 S RCDONE=1
; PRCA*4.5*321 - BEGIN
S DIR("A")="RECEIPT LINE COMMENT: "
;Retrieve comment previously entered from RCSPLIT if present
I $P($G(RCSPLIT(RCSPLIT)),U,6)'="" D
. I $P(RCSPLIT(RCSPLIT),U,6)'="@" S DIR("B")=$P(RCSPLIT(RCSPLIT),U,6)
;Otherwise retrieve comment previously filed in scratchpad
E D
. I $P($G(^RCY(344.49,RCSCR,1,+RCL,0)),U,10)'="" S DIR("B")=$P(^(0),U,10)
;If non-suspensed line allow optional free text entry
I $P(RCSPLIT(RCSPLIT),U,5) D
. S DIR(0)="344.491,.1AO"
. D ^DIR
;if suspense force selection from drop down list
I '$P(RCSPLIT(RCSPLIT),U,5) S Y=$$COM^RCDPECH I Y=-1 K RCSPLIT(RCSPLIT) G EDCL
; PRCA*4.5*321 - END
;
I Y="",$G(DIR("B"))'="" W " Comment will be deleted"
K DIR
I $D(DTOUT)!$D(DUOUT) K RCSPLIT(RCSPLIT) G EDCL
S $P(RCSPLIT(RCSPLIT),U,6)=$S(Y="":"@",1:Y)
Q
;
ABORT ; User aborted split - kill split array
N Z
S Z=RCSPLIT K RCSPLIT S RCSPLIT=Z,RCDONE=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEWL3 9970 printed Apr 09, 2024@20:53:57 Page 2
RCDPEWL3 ;ALB/TMK/KML - ELECTRONIC EOB WORKLIST ACTIONS ;24-FEB-03
+1 ;;4.5;Accounts Receivable;**173,276,321**;Mar 20, 1995;Build 48
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
SPLIT(RCSCR,RCL) ; Perform line splits
+1 NEW Z,Z0,DIR,X,Y,RCL1,DA,DR,DIE,DIC,RCDONE,RCDIR,RCSPLIT,RCTOT,RCOK,RCLINE
+2 ;
+3 DO CLEAR^VALM1
+4 SET ^TMP($JOB,"RCDPE_SPLIT")=""
+5 SET RCLINE=$GET(^TMP("RCDPE-EOB_WLDX",$JOB,RCL))
SET RCL1=$GET(^TMP("RCDPE-EOB_WLDX",$JOB,RCL\1))
+6 ;
+7 SET Z=+$ORDER(^TMP("RCDPE-EOB_WLDX",$JOB,RCL))
SET Z0=+$GET(^TMP("RCDPE-EOB_WLDX",$JOB,Z))
if 'Z0
SET Z0=999
+8 WRITE !
+9 FOR Z=+RCLINE:1:Z0
if '$DATA(^TMP("RCDPE-EOB_WL",$JOB,Z,0))!(Z'<Z0)
QUIT
WRITE !,^TMP("RCDPE-EOB_WL",$JOB,Z,0)
+10 ;
+11 IF $EXTRACT($PIECE(RCL1,U,2),1,3)["ADJ"
Begin DoDot:1
+12 WRITE !,"THIS IS AN ERA-LEVEL ADJUSTMENT - ONLY THE ADJUSTMENT COMMENT CAN BE EDITED"
+13 SET DIR(0)="A"
DO ^DIR
KILL DIR
+14 SET DA(2)=RCSCR
SET DA(1)=+$PIECE(RCLINE,U,2)
SET DA=+$PIECE($PIECE(RCL1,U,2),"ADJ",2)
+15 if 'DA
QUIT
+16 DO EDITCOM(.DA)
End DoDot:1
GOTO SPLITQ
+17 ;
+18 SET RCDONE=0
SET RCDIR(1)=$PIECE($GET(^RCY(344.49,RCSCR,1,+$PIECE(RCLINE,U,2),0)),U,2)
SET RCDIR(2)=$PIECE($GET(^RCY(344.49,RCSCR,1,+$PIECE(RCLINE,U,2),0)),U,5)
SET RCDIR(3)=$PIECE($GET(^RCY(344.49,RCSCR,1,+$PIECE(RCLINE,U,2),0)),U,8)
SET RCDIR(6)=+$PIECE(RCLINE,U,2)
+19 SET RCDIR=RCDIR(1)_U_RCDIR(2)_U_RCDIR(3)
+20 ;
+21 SET RCSPLIT=0
+22 IF $PIECE(RCDIR,U,3)
WRITE !!,"NOTE: THIS LINE HAS AN ADJUSTMENT RECORD ASSOCIATED WITH IT",!
+23 FOR
Begin DoDot:1
+24 SET RCSPLIT=RCSPLIT+1
+25 DO EDIT(RCSCR,RCLINE,.RCDIR,.RCSPLIT,"",.RCDONE)
+26 IF '$DATA(RCSPLIT(RCSPLIT))
SET RCSPLIT=RCSPLIT-1
End DoDot:1
if RCDONE
QUIT
+27 ;
+28 if '$ORDER(RCSPLIT(0))
GOTO SPLITQ
+29 NEW VALMCNT,VALMBG
+30 SET VALMCNT=0
SET VALMBG=1
+31 SET ^TMP($JOB,"RCDPE_SPLIT_FILE")=1
+32 DO EN^VALM("RCDPE EOB WORKLIST SPLIT")
+33 ;
SPLITQ QUIT
+1 ;
TOT(N,RCSPLIT,RCLINE) ; CALCULATE TOTAL OF PAY (N=2) or ADJ (N=3)
+1 ; RCSPLIT = the array (passed by ref) where the amounts are stored
+2 ; RCLINE = if editing, this is the line # NOT to add in when
+3 ; determining previous amounts entered
+4 NEW Z,Z0
+5 SET (Z,Z0)=0
+6 FOR
SET Z=$ORDER(RCSPLIT(Z))
if 'Z
QUIT
IF $SELECT('$GET(RCLINE):1,1:RCLINE'=Z)
SET Z0=Z0+$PIECE(RCSPLIT(Z),U,N)
+7 QUIT $JUSTIFY(Z0,"",2)
+8 ;
UPD(Q,Q1) ;
+1 NEW DA,DIE,DR,X,Y
+2 SET DA(1)=Q
SET DA=Q1
+3 SET DIE="^RCY(344.49,"_DA(1)_",1,"
SET DR="2.03////"_DUZ_";2.04////"_$$NOW^XLFDT()
DO ^DIE
+4 SET ^TMP("RCDPE_SPLIT_REBLD",$JOB)=1
+5 QUIT
+6 ;
HDR ;
+1 NEW Z,Z0,ZCT
+2 SET ZCT=0
+3 SET Z=+$ORDER(^TMP("RCDPE-EOB_WLDX",$JOB,RCL))
SET Z0=+$GET(^TMP("RCDPE-EOB_WLDX",$JOB,Z))
if 'Z0
SET Z0=999
+4 FOR Z=+RCLINE:1:Z0
if '$DATA(^TMP("RCDPE-EOB_WL",$JOB,Z,0))!(Z'<Z0)!(ZCT'<6)
QUIT
SET ZCT=ZCT+1
SET VALMHDR(ZCT)=^TMP("RCDPE-EOB_WL",$JOB,Z,0)
+5 SET ZCT=ZCT+1
SET VALMHDR(ZCT)=" "
+6 QUIT
+7 ;
FNL ;
+1 KILL ^TMP("RCDPE_EOB_SPLIT",$JOB),^TMP("RCDPE_EOB_SPLIT_OK",$JOB),^TMP("RCDPE_EOB_SPLITDX",$JOB)
+2 QUIT
+3 ;
INIT ; Build screen for display
+1 ; RCSCR, RCDIR, RCSPLIT must already exist
+2 NEW Z,RCTOT,DIR,X,Y,RCNT,RCCT,Q,RCT
+3 KILL ^TMP("RCDPE_EOB_SPLIT",$JOB)
+4 SET (VALMCNT,RCNT)=0
+5 SET ^TMP("RCDPE_EOB_SPLIT_OK",$JOB)=1
+6 FOR Z=2,3
SET RCTOT(Z)=$$TOT(Z,.RCSPLIT)
+7 IF +RCTOT(2)'=+$PIECE(RCDIR,U,2)!(+RCTOT(3)'=+$PIECE(RCDIR,U,3))
Begin DoDot:1
+8 DO SET("**** TOTAL AMOUNTS ENTERED DO NOT MATCH THE ORIGINAL AMOUNTS ****",1)
DO SET(" ",1)
+9 SET ^TMP("RCDPE_EOB_SPLIT_OK",$JOB)=0
End DoDot:1
+10 ;
+11 SET (RCCT,Z,RCT(1),RCT(2),RCT(3))=0
+12 FOR
SET Z=$ORDER(RCSPLIT(Z))
if 'Z
QUIT
Begin DoDot:1
+13 SET X=""
SET RCCT=RCCT+1
+14 SET X=$$SETFLD^VALM1(RCCT,X,"NUM")
+15 SET X=$$SETFLD^VALM1($PIECE(RCSPLIT(Z),U)_$SELECT('$PIECE(RCSPLIT(Z),U,5):" (NOT IN A/R)",1:""),X,"CLAIM")
+16 SET X=$$SETFLD^VALM1($JUSTIFY(+$PIECE(RCSPLIT(Z),U,2),15,2),X,"PAYMENT")
SET RCT(1)=RCT(1)+$PIECE(RCSPLIT(Z),U,2)
+17 SET X=$$SETFLD^VALM1($JUSTIFY(+$PIECE(RCSPLIT(Z),U,3),15,2),X,"ADJUSTMENT")
SET RCT(2)=RCT(2)+$PIECE(RCSPLIT(Z),U,3)
+18 SET X=$$SETFLD^VALM1($JUSTIFY($PIECE(RCSPLIT(Z),U,2)+$PIECE(RCSPLIT(Z),U,3),15,2),X,"NET")
SET RCT(3)=RCT(3)+$PIECE(RCSPLIT(Z),U,2)+$PIECE(RCSPLIT(Z),U,3)
+19 DO SET(X,RCCT)
+20 IF $PIECE(RCSPLIT(Z),U,6)'=""
IF $PIECE(RCSPLIT(Z),U,6)'="@"
SET X=$$SETSTR^VALM1($JUSTIFY("",10)_$PIECE(RCSPLIT(Z),U,6),"",1,70)
DO SET(X,RCCT)
End DoDot:1
+21 SET Q=""
SET $PIECE(Q,"=",15)=""
+22 DO SET($JUSTIFY("",32)_Q_" "_Q_" "_Q,RCCT)
DO SET($EXTRACT(" TOTALS: "_$JUSTIFY("",31),1,31)_$EXTRACT($JUSTIFY(+RCT(1),15,2)_$JUSTIFY("",17),1,17)_$EXTRACT($JUSTIFY(+RCT(2),15,2)_$JUSTIFY("",17),1,17)_$EXTRACT($JUSTIFY(+RCT(3),15,2)_$JUSTIFY("",17),1,17),RCCT)
+23 ;
+24 QUIT
+25 ;
SET(X,RCSEQ) ;
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("RCDPE_EOB_SPLIT",$JOB,VALMCNT,0)=X
+3 SET ^TMP("RCDPE_EOB_SPLIT",$JOB,"IDX",VALMCNT,RCSEQ)=""
+4 SET ^TMP("RCDPE_EOB_SPLITDX",$JOB,RCSEQ)=VALMCNT
+5 QUIT
+6 ;
EDITCOM(DA) ; Edit the comment for an adjustment entry
+1 NEW RCX,DIE,X,Y,DR
+2 SET RCX=$PIECE($GET(^RCY(344.49,DA(2),1,DA(1),1,DA,0)),U,9)
+3 SET DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,"
SET DR=".09"
+4 DO ^DIE
+5 if $PIECE($GET(^RCY(344.49,DA(2),1,DA(1),1,DA,0)),U,9)=RCX
QUIT
+6 DO UPD(DA(2),DA(1))
+7 QUIT
+8 ;
EDIT(RCSCR,RCLINE,RCDIR,RCSPLIT,RCDEF,RCDONE) ; Edit a split line
+1 ;
+2 NEW CT,DIC,DIR,DIRUT,DTOUT,DUOUT,RCOK,RCL,X,Y,Z
+3 ; Enter claim #
+4 SET RCL=$GET(RCDIR(6))
EDCL ;
+1 SET DIR("?",1)="ENTER THE CLAIM # TO WHICH THE PAYMENT OR ADJUSTMENT WILL BE APPLIED."
+2 SET DIR("?",2)="THE CLAIM # DOES NOT HAVE TO EXIST IN YOUR AR IF THE PAYMENT/ADJUSTMENT"
+3 SET DIR("?")="BELONGS TO ANOTHER SITE."
+4 SET DIR(0)="FAO^1:15"
SET DIR("A")="CLAIM #: "
+5 if $PIECE($GET(RCDEF),U)'=""
SET DIR("B")=$PIECE(RCDEF,U)
+6 if $GET(RCDIR(1))'=""&($GET(DIR("B"))="")
SET DIR("B")=RCDIR(1)
+7 WRITE !
DO ^DIR
KILL DIR
+8 IF $DATA(DTOUT)!$DATA(DUOUT)
DO ABORT
QUIT
+9 IF Y=""
Begin DoDot:1
+10 SET DIR(0)="YA"
SET DIR("A",1)="YOU MUST SPLIT THE ENTIRE AMOUNT OF THE LINE."
+11 SET DIR("A",2)=" $"_$JUSTIFY(+RCDIR(2),"",2)_" PAYMENT IS LEFT"_$SELECT($PIECE(RCDIR,U,3)&$GET(RCDIR(3)):" AND $"_$JUSTIFY(+RCDIR(3),"",2)_" ADJ IS LEFT",1:"")
+12 SET DIR("A")="DO YOU WANT TO ABORT THIS SPLIT NOW?: "
SET DIR("B")="NO"
+13 WRITE !
DO ^DIR
KILL DIR
+14 IF Y'=0
DO ABORT
QUIT
End DoDot:1
if 'RCDONE
GOTO EDCL
QUIT
+15 SET $PIECE(RCSPLIT(RCSPLIT),U)=Y
+16 ;
+17 IF $EXTRACT(Y,1,3)?3N
IF $LENGTH(Y)>7
IF Y'["-"
SET Y=$EXTRACT(Y,1,3)_"-"_$EXTRACT(Y,4,$LENGTH(Y))
+18 IF $TRANSLATE(Y," ")=""
SET Y=-1
+19 IF Y'=-1
SET DIC="^PRCA(430,"
SET DIC(0)="M"
DO ^DIC
KILL DIC
+20 IF +Y>0
Begin DoDot:1
+21 SET RCOK=1
+22 ; prca276 place screen to only allow selection of third party claims
IF '$DATA(^DGCR(399,+Y,0))
Begin DoDot:2
+23 WRITE !," THIS IS NOT A 3RD PARTY CLAIM. CLAIMS NEED TO BE 3RD PARTY."
+24 SET RCOK=0
End DoDot:2
QUIT
+25 ; prca276 do not allow incomplete claims
IF '$$VALSTAT^RCDPEM5(+Y)
WRITE !," CLAIM IS IN AN INCOMPLETE STATUS. ENTER ANOTHER CLAIM."
SET RCOK=0
End DoDot:1
IF 'RCOK
KILL RCSPLIT(RCSPLIT)
GOTO EDCL
+26 IF Y<0
Begin DoDot:1
+27 SET RCOK=1
+28 SET DIR("A")=" THIS CLAIM WAS NOT FOUND IN YOUR AR. DO YOU WANT TO CONTINUE?: "
SET DIR("B")="NO"
SET DIR(0)="YA"
DO ^DIR
KILL DIR
WRITE !
IF Y'=1
KILL RCSPLIT(RCSPLIT)
SET RCOK=0
End DoDot:1
if 'RCOK
GOTO EDCL
+29 IF '$TEST
Begin DoDot:1
+30 SET $PIECE(RCSPLIT(RCSPLIT),U,5)=+Y
+31 WRITE " >>Current claim balance is: ",$JUSTIFY(+$PIECE($$BILL^RCJIBFN2(+Y),U,3),"",2)
End DoDot:1
+32 ; Enter payment
+33 SET RCDIR(1)=""
+34 SET DIR("?",1)="**************"
+35 SET CT=1
+36 IF $PIECE(RCDIR,U,3)
Begin DoDot:1
+37 SET DIR("?",CT+1)="SINCE THIS LINE HAS AN ADJUSTMENT, THE AMOUNT ENTERED HERE SHOULD BE THE"
SET DIR("?",CT+2)="CORRECTED AMOUNT THE PAYER INDICATED THEY SHOULD HAVE PAID FOR THE CLAIM"
SET DIR("?",CT+3)=" "
SET CT=CT+3
End DoDot:1
+38 SET CT=CT+1
SET DIR("?",CT)="ENTER THE AMT FROM THE PAYMENT TOTAL FOR THIS LINE ("_$JUSTIFY(+$PIECE(RCDIR,U,2),"",2)_")"
+39 IF $GET(RCDEF)=""
Begin DoDot:1
+40 SET CT=CT+1
SET DIR("?",CT)=" THAT APPLIES TO THIS CLAIM. THE PAYMENT AMOUNT ALREADY USED FOR THIS"
+41 SET CT=CT+1
SET DIR("?",CT)=" LINE SPLIT IS: "_$JUSTIFY(+$$TOT(2,.RCSPLIT,$SELECT(RCDEF="":"",1:RCSPLIT)),"",2)_" LEAVING A BALANCE TO DISTRIBUTE OF: "_$JUSTIFY($PIECE(RCDIR,U,2)-$$TOT(2,.RCSPLIT,$SELECT(RCDEF="":"",1:RCSPLIT)),"",2)
End DoDot:1
+42 SET CT=CT+1
SET DIR("?",CT)="THE TOTAL PAYMENTS ENTERED DURING THIS SPLIT MUST EQUAL THE ORIGINAL LINE"
SET DIR("?")=" PAYMENT AMOUNT OF $"_$JUSTIFY(+$PIECE(RCDIR,U,2),"",2)
+43 SET DIR(0)="NAO^0:"_$SELECT(RCDEF="":$PIECE(RCDIR,U,2)-$$TOT(2,.RCSPLIT,RCSPLIT),1:$PIECE(RCDIR,U,2))_":2"
+44 SET DIR("A")="PAYMENT AMOUNT TO APPLY TO THIS CLAIM: "
if $PIECE($GET(RCDEF),U,2)'=""
SET DIR("B")=$JUSTIFY(+$PIECE(RCDEF,U,2),"",2)
if $GET(RCDIR(2))'=""&($GET(DIR("B"))="")
SET DIR("B")=RCDIR(2)
DO ^DIR
KILL DIR
+45 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL RCSPLIT(RCSPLIT)
GOTO EDCL
+46 SET $PIECE(RCSPLIT(RCSPLIT),U,2)=Y
SET RCDIR(2)=$JUSTIFY($PIECE(RCDIR,U,2)-$$TOT(2,.RCSPLIT),"",2)
+47 ; Enter adj
+48 IF $ORDER(^RCY(344.49,RCSCR,1,+$PIECE(RCLINE,U,2),1,0))
Begin DoDot:1
+49 SET RCOK=1
+50 WRITE !!,$JUSTIFY("",5)_"THIS LINE CONTAINS AN ADJUSTMENT AMOUNT OF $"_$JUSTIFY(+$PIECE(RCDIR,U,3),"",2),!,$JUSTIFY("",5)_"THIS AMT IS USUALLY THE AMT THE PAYER PREVIOUSLY PAID",!,$JUSTIFY("",5),"ON A CLAIM WHICH THEY HAVE NOW AMENDED.
IF THERE WAS"
+51 WRITE !,$JUSTIFY("",5)_"AN AMT PREVIOUSLY PAID FOR THIS CLAIM, ENTER THAT AMOUNT",!,$JUSTIFY("",5),"AS A NEGATIVE AMOUNT HERE.",!
+52 SET DIR("?",1)="**************"
+53 SET DIR("?",2)="ENTER THE AMT FROM THE ADJUSTMENT TOTAL FOR THIS LINE ("_$JUSTIFY(+$PIECE(RCDIR,U,3),"",2)_")"
SET DIR("?",3)=" THAT APPLIES TO THIS CLAIM. THE ADJUSTMENT AMOUNT ALREADY USED FOR THIS"
+54 SET DIR("?",4)=" LINE SPLIT IS "_$JUSTIFY(+$$TOT(3,.RCSPLIT,$SELECT(RCDEF="":"",1:RCSPLIT)),"",2)_" LEAVING A BALANCE OF "_$JUSTIFY($PIECE(RCDIR,U,3)-$$TOT(3,.RCSPLIT,$SELECT(RCDEF="":"",1:RCSPLIT)),"",2)_" TO DISTRIBUTE"
+55 SET DIR("?",5)=" ENTER IT AS THE NEGATIVE OF THE AMT THE PAYER PREVIOUSLY PAID ON THIS CLAIM"
+56 SET DIR("?",6)="THE TOTAL ADJUSTMENTS ENTERED DURING THIS SPLIT MUST EQUAL THE ORIGINAL LINE"
SET DIR("?")=" ADJUSTMENT AMOUNT OF $"_$JUSTIFY(+$PIECE(RCDIR,U,3),"",2)
+57 SET DIR(0)="NAO^"_$JUSTIFY($PIECE(RCDIR,U,3)-$$TOT(3,.RCSPLIT,$SELECT(RCDEF="":"",1:RCSPLIT)),"",2)_":0:2"
SET DIR("A")="ADJUSTMENT AMOUNT: "
if $PIECE($GET(RCDEF),U,3)'=""
SET DIR("B")=$JUSTIFY(+$PIECE(RCDEF,U,3),"",2)
if $GET(RCDIR(3))'=""&($GET(DIR("B"))="")
SET DIR("B")=RCDIR(3)
+58 DO ^DIR
KILL DIR
+59 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RCOK=0
KILL RCSPLIT(RCSPLIT)
QUIT
+60 SET $PIECE(RCSPLIT(RCSPLIT),U,3)=Y
SET RCDIR(3)=$JUSTIFY($PIECE(RCDIR,U,3)-$$TOT(3,.RCSPLIT),"",2)
End DoDot:1
if 'RCOK
GOTO EDCL
+61 IF +RCDIR(2)=0
IF +RCDIR(3)=0
SET RCDONE=1
+62 ; PRCA*4.5*321 - BEGIN
+63 SET DIR("A")="RECEIPT LINE COMMENT: "
+64 ;Retrieve comment previously entered from RCSPLIT if present
+65 IF $PIECE($GET(RCSPLIT(RCSPLIT)),U,6)'=""
Begin DoDot:1
+66 IF $PIECE(RCSPLIT(RCSPLIT),U,6)'="@"
SET DIR("B")=$PIECE(RCSPLIT(RCSPLIT),U,6)
End DoDot:1
+67 ;Otherwise retrieve comment previously filed in scratchpad
+68 IF '$TEST
Begin DoDot:1
+69 IF $PIECE($GET(^RCY(344.49,RCSCR,1,+RCL,0)),U,10)'=""
SET DIR("B")=$PIECE(^(0),U,10)
End DoDot:1
+70 ;If non-suspensed line allow optional free text entry
+71 IF $PIECE(RCSPLIT(RCSPLIT),U,5)
Begin DoDot:1
+72 SET DIR(0)="344.491,.1AO"
+73 DO ^DIR
End DoDot:1
+74 ;if suspense force selection from drop down list
+75 IF '$PIECE(RCSPLIT(RCSPLIT),U,5)
SET Y=$$COM^RCDPECH
IF Y=-1
KILL RCSPLIT(RCSPLIT)
GOTO EDCL
+76 ; PRCA*4.5*321 - END
+77 ;
+78 IF Y=""
IF $GET(DIR("B"))'=""
WRITE " Comment will be deleted"
+79 KILL DIR
+80 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL RCSPLIT(RCSPLIT)
GOTO EDCL
+81 SET $PIECE(RCSPLIT(RCSPLIT),U,6)=$SELECT(Y="":"@",1:Y)
+82 QUIT
+83 ;
ABORT ; User aborted split - kill split array
+1 NEW Z
+2 SET Z=RCSPLIT
KILL RCSPLIT
SET RCSPLIT=Z
SET RCDONE=1
+3 QUIT
+4 ;
