- 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 Feb 18, 2025@23:12:05 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 ;