RCDPEWL6 ;ALB/TMK - ELECTRONIC EOB WORKLIST ACTIONS ;18-MAR-03
 ;;4.5;Accounts Receivable;**173,208,222**;Mar 20, 1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 Q
 ;
DISTADJ ; Distribute an adjustment that retracts a payment to other bill(s)
 ; NOTE: RCSCR is assumed to be the IEN of the ERA entry in file 344.49
 N RCDA,RCDA1,RCAMT,RCADJ,RCQUIT,Z,Z0,Z1,DIR,X,Y,CT,RCZ,RCZ1,RCZ2,RCADJOK,TOT,DTOUT,DUOUT
 D FULL^VALM1
 I $G(RCSCR("NOEDIT")) D NOEDIT^RCDPEWL G DISTQ
 I $G(^TMP("RCBATCH_SELECTED",$J)) D NOBATCH^RCDPEWL G DISTQ
 ;
 S Z=0,RCADJOK="" F  S Z=$O(^TMP("RCDPE-EOB_WLDX",$J,Z)) Q:'Z  S Z1=+$P($G(^(Z)),U,2),Z0=$G(^RCY(344.49,RCSCR,1,Z1,0)) D
 . ;(^RCY(344.49,RCSCR,1,Z)) Q:'Z  S Z0=$G(^(Z,0)) D
 . I $P(Z0,U)'["." S RCADJOK=($P(Z0,U,2)["**ADJ") Q
 . I '$P(Z0,U,7),'RCADJOK Q  ; Suspense item cannot be used to adjust
 . I $P(Z0,U,6)<0 S RCZ(Z)=$P(Z0,U,6)_U_Z1 Q
 . I $P(Z0,U,6)>0 D  Q
 .. N Q,ONHLD,IBA
 .. S ONHLD=0
 .. I $P(Z0,U,7) I $$IB^IBRUTL(+$P(Z0,U,7),1) S Q=0 F  S Q=$O(IBA(Q)) Q:'Q  I $P($G(^IB(+IBA(Q),0)),U,5)=8 S ONHLD=1 Q
 .. S RCZ1(+$P(Z0,U,6),Z)=Z1_U_ONHLD,RCZ2(Z)=Z1_U_$P(Z0,U,6)_U_ONHLD Q
 ;
 I $O(RCZ(0))="" D  G DISTQ
 . S DIR(0)="EA",DIR("A",1)="NO LINES EXIST NEEDING ADJUSTMENT DISTRIBUTION",DIR("A")="PRESS RETURN TO CONTINUE" W ! D ^DIR K DIR
 ;
 I $O(RCZ1(0))="" D  G DISTQ
 . S DIR(0)="EA",DIR("A",1)="NO VALID LINES EXIST ON THIS ERA WHERE A DISTRIBUTION CAN BE MADE",DIR("A",2)=$$WHAT(RCSCR),DIR("A")="PRESS RETURN TO CONTINUE" W ! D ^DIR K DIR
 ;
 S RCQUIT=0
 F  S DIR(0)="NA^1:9999:3",DIR("A")="SELECT A LINE THAT NEEDS AN ADJUSTMENT AMOUNT DISTRIBUTED: " D  Q:RCQUIT
 . S DIR("?",1)="THE FOLLOWING LINE(S) HAVE AN ADJUSTMENT THAT CAUSED A NEGATIVE NET PAYMENT.",DIR("?",2)="IN ORDER TO BALANCE THE RECEIPT AND THE DEPOSIT, THESE AMOUNTS WILL NEED TO",DIR("?",3)="  BE DISTRIBUTED TO OTHER LINE(S)",CT=3
 . S Z=0
 . F  S Z=$O(RCZ(Z)) Q:'Z  S CT=CT+1,DIR("?",CT)="  "_$J(Z,8)_"  "_$J($P(RCZ(Z),U),15,2)
 . S DIR("?")=" "
 . I $O(RCZ(0))=$O(RCZ(""),-1) S DIR("B")=$O(RCZ(0))
 . W ! D ^DIR K DIR
 . I $D(DUOUT)!$D(DTOUT)!(Y="") S RCQUIT=1,RCDA="" Q
 . I '$D(^TMP("RCDPE-EOB_WLDX",$J,Y)) W !,"THIS LINE DOES NOT EXIST FOR THIS ERA" W ! Q
 . I '$D(RCZ(Y)) D  Q:Y=""
 .. I Y'[".",$D(RCZ(Y_".001")),$O(RCZ(Y+1),-1)=(Y_".001") S Y=Y_".001" Q
 .. W !,$S(Y["."!($O(RCZ(Y))\1'=(Y\1)):"THIS LINE DOESN'T NEED AN ADJUSTMENT DISTRIBUTION",1:"PLEASE ENTER THE ENTIRE LINE # (Such as: 1.001)") W !
 .. S Y=""
 . W !,"  LINE #: "_+Y_"  AMOUNT NEEDED TO DISTRIBUTE: "_$J(+RCZ(Y),"",2),!
 . ; RCDA = the ien of the line in file 344.491
 . ; RCDA(1) = the line #        RCDA(2) = the amount to be adjusted (+)
 . S RCDA=$P(RCZ(Y),U,2),RCDA(1)=Y,RCQUIT=1,RCDA(2)=-$P(RCZ(Y),U)
 ;
 G:$G(RCDA)="" DISTQ
 ;
 S RCQUIT=0
 ;
 S (TOT,Z)=0 F  S Z=$O(RCZ1(Z)) Q:'Z  S TOT=TOT+Z
 I TOT<RCDA(2) D  G DISTQ
 . S DIR(0)="EA",DIR("A",1)="THE ERA DOES NOT HAVE ENOUGH VALID PAYMENTS TO OFFSET THIS DISTRIBUTION",DIR("A",2)=$$WHAT(RCSCR),DIR("A")="PRESS RETURN TO CONTINUE" W ! D ^DIR K DIR
 ;
 F  S DIR(0)="NA^1:9999:3",DIR("A")="SELECT A LINE TO DISTRIBUTE THE ADJUSTMENT AMOUNT TO: " D  Q:RCQUIT
 . S DIR("?",1)="THE FOLLOWING LINE(S) HAVE A NET PAYMENT THAT CAN BE USED TO OFFSET THE",DIR("?",2)="  NEGATIVE NET PAYMENT FOR LINE "_RCDA(1)_" ("_$J(+$P(RCZ(RCDA(1)),U),"",2)_"):",CT=2
 . S Z="" F  S Z=$O(RCZ1(Z),-1) Q:'Z  S Z0=0 F  S Z0=$O(RCZ1(Z,Z0)) Q:'Z0  S CT=CT+1,DIR("?",CT)="  "_$J(Z0,8)_"  "_$J(+Z,15,2)_$S($P(RCZ1(Z,Z0),U,2):" On hold exists",1:"")
 . S DIR("?")=" "
 . I $O(RCZ2(0))=$O(RCZ2(""),-1) S DIR("B")=$O(RCZ2(0))
 . W ! D ^DIR K DIR
 . I $D(DUOUT)!$D(DTOUT)!(Y="") S RCQUIT=1,RCDA1="" Q
 . I '$D(^TMP("RCDPE-EOB_WLDX",$J,Y)) W !,"THIS LINE DOES NOT EXIST FOR THIS ERA" W ! Q
 . I '$D(RCZ2(Y)) D  Q:Y=""
 .. I Y'[".",$D(RCZ2(Y_".001")),$O(RCZ2(Y+1),-1)=(Y_".001") S Y=Y_".001" Q
 .. I Y'[".",$O(RCZ2(Y))\1'=Y S Y=Y_"."
 .. W !,$S(Y[".":"THIS LINE CANNOT BE USED FOR AN ADJUSTMENT DISTRIBUTION",1:"PLEASE ENTER THE ENTIRE LINE # (Such as: 1.001)") W !
 .. S Y=""
 . I $P(RCZ2(Y),U,3) W !,"Warning - on-hold exists for this claim",!
 . W !,"  LINE #: "_+Y_"  LINE BALANCE: "_$J(+$P(RCZ2(Y),U,2),"",2),!
 . ; RCDA1 = the ien of the line in file 344.491
 . ; RCDA1(1) = the line # in the display
 . S RCDA1(1)=Y,RCDA1=+$G(RCZ2(Y)),RCQUIT=1
 . S Z=$O(^RCY(344.49,RCSCR,1,"B",RCDA1(1)\1,0))
 . S RCADJ=0
 . I $P($G(^RCY(344.49,RCSCR,1,Z,0)),U,2)["**ADJ" S RCADJ=1 W !,"THE LINE SELECTED IS AN ADDITIONAL PAYMENT LINE, NOT SPECIFIC TO A CLAIM",!,"THE AMT WILL BE DISTRIBUTED, BUT A DECREASE ADJUSTMENT WILL NOT BE PERFORMED",!
 ;
 G:'$G(RCDA1) DISTQ
 ;
 S DIR("B")=$S(RCDA(2)<$P(RCZ2(RCDA1(1)),U,2):$J(RCDA(2),"",2),1:$J($P(RCZ2(+RCDA1(1)),U,2),"",2))
 S DIR(0)="NA^.01:"_DIR("B")_":2",DIR("A")="ADJUSTMENT AMOUNT TO DISTRIBUTE: "
 S DIR("?",1)="THIS IS THE AMOUNT OF THE ADJUSTMENT THAT SHOULD BE APPLIED TO THIS",DIR("?")="PAYMENT LINE.  THE AMT ENTERED MUST BE BETWEEN .01 AND "_$J(DIR("B"),"",2)
 D ^DIR K DIR
 ;
 I $D(DUOUT)!$D(DTOUT)!'Y D  G DISTQ
 . S DIR(0)="EA",DIR("A",1)="NO AMOUNT WAS ENTERED - TRY AGAIN LATER",DIR("A")="PRESS RETURN TO CONTINUE " D ^DIR K DIR
 S RCAMT=$J(Y,"",2)
 ;
 D ^DIR K DIR
 I $D(DUOUT)!$D(DTOUT) D  G DISTQ
 . S DIR(0)="EA",DIR("A")="USER ABORT - PRESS RETURN TO CONTINUE " D ^DIR K DIR
 ;
 S Y=""
 I 'RCADJ D  G:'$D(RCDA) DISTQ
 . N Z,RCA
 . S RCA=0,Z1=+$P($G(^TMP("RCDPE-EOB_WLDX",$J,RCDA(1)\1)),U,2),Z=$G(^RCY(344.49,RCSCR,1,Z1,0)),RCA("#")=+$P($P(Z,U,2),"**ADJ",2)
 . I $P(Z,U,2)["**ADJ" D
 .. S RCA=1
 .. S RCA("REF")=$S(RCA("#"):$P($G(^RCY(344.4,RCSCR,2,RCA("#"),0)),U),1:$P(Z,U,9))
 . S Z=$S(RCA:RCA("#"),1:$G(^RCY(344.49,RCSCR,1,RCDA,0)))
 . S DIR(0)="FAO^1:60",DIR("A")="  > ",DIR("A",1)="DECREASE ADJ COMMENT (1-60 CHARACTERS): "
 . S DIR("B")="RETRACTED FOR "
 . S DIR("B")=DIR("B")_$S(RCA:"ERA ADJ #"_Z_" Ref: "_RCA("REF"),1:"CLAIM "_$S($P(Z,U,2)'="":$P(Z,U,2),1:"UNKNOWN"))
 . I $L(DIR("B"))>60 S DIR("B")=$E(DIR("B"),1,60)
 . D ^DIR K DIR
 . ;
 . I $D(DUOUT)!$D(DTOUT) D  Q
 .. K RCDA
 .. S DIR(0)="EA",DIR("A")="USER ABORT - PRESS RETURN TO CONTINUE " D ^DIR K DIR
 ;
 D DISTADJ^RCDPEWL4(RCDA,RCDA1,RCAMT,Y)
 ;
DISTQ S VALMBCK="R"
 Q
 ;
REFRESH ; Refresh the entry in file 344.49 to remove all user adjustments
 N RCREDEF,RCQUIT,DIR,X,Y,Z,Z0,DA,DIK
 D FULL^VALM1
 I $G(RCSCR("NOEDIT")) D NOEDIT^RCDPEWL G REFQ
 I $G(^TMP("RCBATCH_SELECTED",$J)) D NOBATCH^RCDPEWL G REFQ
 S DIR(0)="YA"
 S DIR("A",1)="THIS ACTION WILL DELETE AND REBUILD THIS EEOB WORKLIST SCRATCH PAD ENTRY",DIR("A",2)="ALL EDITS/SPLITS/DISTRIBUTE ADJUSTMENTS ENTERED FOR THIS ERA WILL BE ERASED"
 S DIR("A",3)="AND ALL ENTRIES MARKED AS MANUALLY VERIFIED WILL BE UNMARKED",DIR("A",4)=" "
 S DIR("A")="ARE YOU SURE YOU WANT TO DO THIS?: "
 W ! D ^DIR K DIR
 I Y'=1 G REFQ
 I $O(^RCY(344.49,RCSCR,3,0)) S RCQUIT=0 D  I RCQUIT G REFQ
 . S DIR(0)="YA",DIR("A")="DO YOU WANT TO REDEFINE YOUR BATCHES TOO?: ",DIR("B")="NO" W ! D ^DIR K DIR
 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
 . S RCREDEF=+Y
 . K ^TMP($J,"BATCHES")
 . S Z=0 F  S Z=$O(^RCY(344.49,RCSCR,3,Z)) Q:'Z  S Z0=$G(^(Z,0)) D
 .. I RCREDEF S DA=Z,DA(1)=RCSCR,DIK="^RCY(344.49,"_DA(1)_",3," D ^DIK Q
 .. S ^TMP($J,"BATCHES",+$P(Z0,U,6),$P(Z0,U,7))=+Z0_U_$P(Z0,U,8)
 . I 'RCREDEF S ^TMP($J,"BATCHES")=+$O(^TMP($J,"BATCHES",0))
 . I RCREDEF D SETBATCH^RCDPEWLB(RCSCR)
 D ADDLINES^RCDPEWLA(RCSCR)
 D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM")))
 K ^TMP($J,"BATCHES")
REFQ S VALMBG=1,VALMBCK="R"
 Q
 ;
WHAT(RCSCR) ; Text for what to do if not enough funds found for dist adj
 Q $S($O(^RCY(344.31,"AERA",+RCSCR,0)):"THIS ERA MUST BE MOVED TO SUSPENSE",1:"THIS ERA'S RECEIPT MUST BE ENTERED MANUALLY")
 ;
ADJUST ; Allow entry into increase/decrease adjustment functions
 N DIR,X,Y,RCTYP,RCY,DIC
 D FULL^VALM1
 ;
 I $G(RCSCR("NOEDIT"))=2 D NOTAV^RCDPEWL2 G ADJUSTQ
 ;
 S DIR(0)="SA^D:DECREASE ADJUSTMENT;I:INCREASE ADJUSTMENT",DIR("B")="DECREASE ADJUSTMENT",DIR("A")="TYPE OF ADJUSTMENT: "
 W ! D ^DIR K DIR
 M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
 I $D(DUOUT)!$D(DTOUT)!(Y="") G ADJUSTQ
 ;
 S RCTYP=$S(Y="D":"DECREASE",1:"INCREASE")
 F  S RCY=$$GETABILL^RCBEUBIL Q:RCY<0!(RCY'<1)
 G:RCY<1 ADJUSTQ
 D ADJUST^RCBEADJ(RCTYP,RCY_";"_RCSCR)
 I $D(^TMP("RC_BILL",$J,RCY)) D
 . D UPDBAL(RCY)
 . W !,"Claim balance is now: ",$J(+$P($$BILL^RCJIBFN2(RCY),U,3),"",2)
 ;
ADJUSTQ D RESTMP
 D RET^RCDPEWL2
 S VALMBCK="R"
 Q
 ;
RESTMP ;
 I $D(^TMP("RC_SAVE_TMP",$J)) M ^TMP($J)=^TMP("RC_SAVE_TMP",$J) K ^TMP("RC_SAVE_TMP")
 Q
 ;
UPDBAL(RCY) ; Updates the claim balance if bill exists in list
 ; RCY = ien of bill in file 430
 ;
 N X,Y,Z,Z0,Z1
 S Z0=$J(+$P($$BILL^RCJIBFN2(RCY),U,3),"",2)
 S Z=0 F  S Z=$O(^TMP("RC_BILL",$J,RCY,Z)) Q:'Z  D
 . S X=+$G(^TMP("RCDPE-EOB_WLDX",$J,Z))
 . Q:'X
 . S Y=$G(^TMP("RCDPE-EOB_WL",$J,X+1,0))
 . I Y["Claim Bal: " S Z1=$P(Y,"Claim Bal: ")_"Claim Bal: "_Z0_$G(^TMP("RC_BILL",$J,RCY,Z)),^TMP("RCDPE-EOB_WL",$J,X+1,0)=Z1
 Q
 ;