| [613] | 1 | RCDPEWL6 ;ALB/TMK - ELECTRONIC EOB WORKLIST ACTIONS ;18-MAR-03
|
|---|
| 2 | ;;4.5;Accounts Receivable;**173,208,222**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | DISTADJ ; Distribute an adjustment that retracts a payment to other bill(s)
|
|---|
| 7 | ; NOTE: RCSCR is assumed to be the IEN of the ERA entry in file 344.49
|
|---|
| 8 | N RCDA,RCDA1,RCAMT,RCADJ,RCQUIT,Z,Z0,Z1,DIR,X,Y,CT,RCZ,RCZ1,RCZ2,RCADJOK,TOT,DTOUT,DUOUT
|
|---|
| 9 | D FULL^VALM1
|
|---|
| 10 | I $G(RCSCR("NOEDIT")) D NOEDIT^RCDPEWL G DISTQ
|
|---|
| 11 | I $G(^TMP("RCBATCH_SELECTED",$J)) D NOBATCH^RCDPEWL G DISTQ
|
|---|
| 12 | ;
|
|---|
| 13 | 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
|
|---|
| 14 | . ;(^RCY(344.49,RCSCR,1,Z)) Q:'Z S Z0=$G(^(Z,0)) D
|
|---|
| 15 | . I $P(Z0,U)'["." S RCADJOK=($P(Z0,U,2)["**ADJ") Q
|
|---|
| 16 | . I '$P(Z0,U,7),'RCADJOK Q ; Suspense item cannot be used to adjust
|
|---|
| 17 | . I $P(Z0,U,6)<0 S RCZ(Z)=$P(Z0,U,6)_U_Z1 Q
|
|---|
| 18 | . I $P(Z0,U,6)>0 D Q
|
|---|
| 19 | .. N Q,ONHLD,IBA
|
|---|
| 20 | .. S ONHLD=0
|
|---|
| 21 | .. 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
|
|---|
| 22 | .. S RCZ1(+$P(Z0,U,6),Z)=Z1_U_ONHLD,RCZ2(Z)=Z1_U_$P(Z0,U,6)_U_ONHLD Q
|
|---|
| 23 | ;
|
|---|
| 24 | I $O(RCZ(0))="" D G DISTQ
|
|---|
| 25 | . S DIR(0)="EA",DIR("A",1)="NO LINES EXIST NEEDING ADJUSTMENT DISTRIBUTION",DIR("A")="PRESS RETURN TO CONTINUE" W ! D ^DIR K DIR
|
|---|
| 26 | ;
|
|---|
| 27 | I $O(RCZ1(0))="" D G DISTQ
|
|---|
| 28 | . 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
|
|---|
| 29 | ;
|
|---|
| 30 | S RCQUIT=0
|
|---|
| 31 | F S DIR(0)="NA^1:9999:3",DIR("A")="SELECT A LINE THAT NEEDS AN ADJUSTMENT AMOUNT DISTRIBUTED: " D Q:RCQUIT
|
|---|
| 32 | . 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
|
|---|
| 33 | . S Z=0
|
|---|
| 34 | . F S Z=$O(RCZ(Z)) Q:'Z S CT=CT+1,DIR("?",CT)=" "_$J(Z,8)_" "_$J($P(RCZ(Z),U),15,2)
|
|---|
| 35 | . S DIR("?")=" "
|
|---|
| 36 | . I $O(RCZ(0))=$O(RCZ(""),-1) S DIR("B")=$O(RCZ(0))
|
|---|
| 37 | . W ! D ^DIR K DIR
|
|---|
| 38 | . I $D(DUOUT)!$D(DTOUT)!(Y="") S RCQUIT=1,RCDA="" Q
|
|---|
| 39 | . I '$D(^TMP("RCDPE-EOB_WLDX",$J,Y)) W !,"THIS LINE DOES NOT EXIST FOR THIS ERA" W ! Q
|
|---|
| 40 | . I '$D(RCZ(Y)) D Q:Y=""
|
|---|
| 41 | .. I Y'[".",$D(RCZ(Y_".001")),$O(RCZ(Y+1),-1)=(Y_".001") S Y=Y_".001" Q
|
|---|
| 42 | .. 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 !
|
|---|
| 43 | .. S Y=""
|
|---|
| 44 | . W !," LINE #: "_+Y_" AMOUNT NEEDED TO DISTRIBUTE: "_$J(+RCZ(Y),"",2),!
|
|---|
| 45 | . ; RCDA = the ien of the line in file 344.491
|
|---|
| 46 | . ; RCDA(1) = the line # RCDA(2) = the amount to be adjusted (+)
|
|---|
| 47 | . S RCDA=$P(RCZ(Y),U,2),RCDA(1)=Y,RCQUIT=1,RCDA(2)=-$P(RCZ(Y),U)
|
|---|
| 48 | ;
|
|---|
| 49 | G:$G(RCDA)="" DISTQ
|
|---|
| 50 | ;
|
|---|
| 51 | S RCQUIT=0
|
|---|
| 52 | ;
|
|---|
| 53 | S (TOT,Z)=0 F S Z=$O(RCZ1(Z)) Q:'Z S TOT=TOT+Z
|
|---|
| 54 | I TOT<RCDA(2) D G DISTQ
|
|---|
| 55 | . 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
|
|---|
| 56 | ;
|
|---|
| 57 | F S DIR(0)="NA^1:9999:3",DIR("A")="SELECT A LINE TO DISTRIBUTE THE ADJUSTMENT AMOUNT TO: " D Q:RCQUIT
|
|---|
| 58 | . 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
|
|---|
| 59 | . 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:"")
|
|---|
| 60 | . S DIR("?")=" "
|
|---|
| 61 | . I $O(RCZ2(0))=$O(RCZ2(""),-1) S DIR("B")=$O(RCZ2(0))
|
|---|
| 62 | . W ! D ^DIR K DIR
|
|---|
| 63 | . I $D(DUOUT)!$D(DTOUT)!(Y="") S RCQUIT=1,RCDA1="" Q
|
|---|
| 64 | . I '$D(^TMP("RCDPE-EOB_WLDX",$J,Y)) W !,"THIS LINE DOES NOT EXIST FOR THIS ERA" W ! Q
|
|---|
| 65 | . I '$D(RCZ2(Y)) D Q:Y=""
|
|---|
| 66 | .. I Y'[".",$D(RCZ2(Y_".001")),$O(RCZ2(Y+1),-1)=(Y_".001") S Y=Y_".001" Q
|
|---|
| 67 | .. I Y'[".",$O(RCZ2(Y))\1'=Y S Y=Y_"."
|
|---|
| 68 | .. W !,$S(Y[".":"THIS LINE CANNOT BE USED FOR AN ADJUSTMENT DISTRIBUTION",1:"PLEASE ENTER THE ENTIRE LINE # (Such as: 1.001)") W !
|
|---|
| 69 | .. S Y=""
|
|---|
| 70 | . I $P(RCZ2(Y),U,3) W !,"Warning - on-hold exists for this claim",!
|
|---|
| 71 | . W !," LINE #: "_+Y_" LINE BALANCE: "_$J(+$P(RCZ2(Y),U,2),"",2),!
|
|---|
| 72 | . ; RCDA1 = the ien of the line in file 344.491
|
|---|
| 73 | . ; RCDA1(1) = the line # in the display
|
|---|
| 74 | . S RCDA1(1)=Y,RCDA1=+$G(RCZ2(Y)),RCQUIT=1
|
|---|
| 75 | . S Z=$O(^RCY(344.49,RCSCR,1,"B",RCDA1(1)\1,0))
|
|---|
| 76 | . S RCADJ=0
|
|---|
| 77 | . 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",!
|
|---|
| 78 | ;
|
|---|
| 79 | G:'$G(RCDA1) DISTQ
|
|---|
| 80 | ;
|
|---|
| 81 | 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))
|
|---|
| 82 | S DIR(0)="NA^.01:"_DIR("B")_":2",DIR("A")="ADJUSTMENT AMOUNT TO DISTRIBUTE: "
|
|---|
| 83 | 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)
|
|---|
| 84 | D ^DIR K DIR
|
|---|
| 85 | ;
|
|---|
| 86 | I $D(DUOUT)!$D(DTOUT)!'Y D G DISTQ
|
|---|
| 87 | . S DIR(0)="EA",DIR("A",1)="NO AMOUNT WAS ENTERED - TRY AGAIN LATER",DIR("A")="PRESS RETURN TO CONTINUE " D ^DIR K DIR
|
|---|
| 88 | S RCAMT=$J(Y,"",2)
|
|---|
| 89 | ;
|
|---|
| 90 | D ^DIR K DIR
|
|---|
| 91 | I $D(DUOUT)!$D(DTOUT) D G DISTQ
|
|---|
| 92 | . S DIR(0)="EA",DIR("A")="USER ABORT - PRESS RETURN TO CONTINUE " D ^DIR K DIR
|
|---|
| 93 | ;
|
|---|
| 94 | S Y=""
|
|---|
| 95 | I 'RCADJ D G:'$D(RCDA) DISTQ
|
|---|
| 96 | . N Z,RCA
|
|---|
| 97 | . 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)
|
|---|
| 98 | . I $P(Z,U,2)["**ADJ" D
|
|---|
| 99 | .. S RCA=1
|
|---|
| 100 | .. S RCA("REF")=$S(RCA("#"):$P($G(^RCY(344.4,RCSCR,2,RCA("#"),0)),U),1:$P(Z,U,9))
|
|---|
| 101 | . S Z=$S(RCA:RCA("#"),1:$G(^RCY(344.49,RCSCR,1,RCDA,0)))
|
|---|
| 102 | . S DIR(0)="FAO^1:60",DIR("A")=" > ",DIR("A",1)="DECREASE ADJ COMMENT (1-60 CHARACTERS): "
|
|---|
| 103 | . S DIR("B")="RETRACTED FOR "
|
|---|
| 104 | . 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"))
|
|---|
| 105 | . I $L(DIR("B"))>60 S DIR("B")=$E(DIR("B"),1,60)
|
|---|
| 106 | . D ^DIR K DIR
|
|---|
| 107 | . ;
|
|---|
| 108 | . I $D(DUOUT)!$D(DTOUT) D Q
|
|---|
| 109 | .. K RCDA
|
|---|
| 110 | .. S DIR(0)="EA",DIR("A")="USER ABORT - PRESS RETURN TO CONTINUE " D ^DIR K DIR
|
|---|
| 111 | ;
|
|---|
| 112 | D DISTADJ^RCDPEWL4(RCDA,RCDA1,RCAMT,Y)
|
|---|
| 113 | ;
|
|---|
| 114 | DISTQ S VALMBCK="R"
|
|---|
| 115 | Q
|
|---|
| 116 | ;
|
|---|
| 117 | REFRESH ; Refresh the entry in file 344.49 to remove all user adjustments
|
|---|
| 118 | N RCREDEF,RCQUIT,DIR,X,Y,Z,Z0,DA,DIK
|
|---|
| 119 | D FULL^VALM1
|
|---|
| 120 | I $G(RCSCR("NOEDIT")) D NOEDIT^RCDPEWL G REFQ
|
|---|
| 121 | I $G(^TMP("RCBATCH_SELECTED",$J)) D NOBATCH^RCDPEWL G REFQ
|
|---|
| 122 | S DIR(0)="YA"
|
|---|
| 123 | 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"
|
|---|
| 124 | S DIR("A",3)="AND ALL ENTRIES MARKED AS MANUALLY VERIFIED WILL BE UNMARKED",DIR("A",4)=" "
|
|---|
| 125 | S DIR("A")="ARE YOU SURE YOU WANT TO DO THIS?: "
|
|---|
| 126 | W ! D ^DIR K DIR
|
|---|
| 127 | I Y'=1 G REFQ
|
|---|
| 128 | I $O(^RCY(344.49,RCSCR,3,0)) S RCQUIT=0 D I RCQUIT G REFQ
|
|---|
| 129 | . S DIR(0)="YA",DIR("A")="DO YOU WANT TO REDEFINE YOUR BATCHES TOO?: ",DIR("B")="NO" W ! D ^DIR K DIR
|
|---|
| 130 | . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
|
|---|
| 131 | . S RCREDEF=+Y
|
|---|
| 132 | . K ^TMP($J,"BATCHES")
|
|---|
| 133 | . S Z=0 F S Z=$O(^RCY(344.49,RCSCR,3,Z)) Q:'Z S Z0=$G(^(Z,0)) D
|
|---|
| 134 | .. I RCREDEF S DA=Z,DA(1)=RCSCR,DIK="^RCY(344.49,"_DA(1)_",3," D ^DIK Q
|
|---|
| 135 | .. S ^TMP($J,"BATCHES",+$P(Z0,U,6),$P(Z0,U,7))=+Z0_U_$P(Z0,U,8)
|
|---|
| 136 | . I 'RCREDEF S ^TMP($J,"BATCHES")=+$O(^TMP($J,"BATCHES",0))
|
|---|
| 137 | . I RCREDEF D SETBATCH^RCDPEWLB(RCSCR)
|
|---|
| 138 | D ADDLINES^RCDPEWLA(RCSCR)
|
|---|
| 139 | D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM")))
|
|---|
| 140 | K ^TMP($J,"BATCHES")
|
|---|
| 141 | REFQ S VALMBG=1,VALMBCK="R"
|
|---|
| 142 | Q
|
|---|
| 143 | ;
|
|---|
| 144 | WHAT(RCSCR) ; Text for what to do if not enough funds found for dist adj
|
|---|
| 145 | 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")
|
|---|
| 146 | ;
|
|---|
| 147 | ADJUST ; Allow entry into increase/decrease adjustment functions
|
|---|
| 148 | N DIR,X,Y,RCTYP,RCY,DIC
|
|---|
| 149 | D FULL^VALM1
|
|---|
| 150 | ;
|
|---|
| 151 | I $G(RCSCR("NOEDIT"))=2 D NOTAV^RCDPEWL2 G ADJUSTQ
|
|---|
| 152 | ;
|
|---|
| 153 | S DIR(0)="SA^D:DECREASE ADJUSTMENT;I:INCREASE ADJUSTMENT",DIR("B")="DECREASE ADJUSTMENT",DIR("A")="TYPE OF ADJUSTMENT: "
|
|---|
| 154 | W ! D ^DIR K DIR
|
|---|
| 155 | M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
|
|---|
| 156 | I $D(DUOUT)!$D(DTOUT)!(Y="") G ADJUSTQ
|
|---|
| 157 | ;
|
|---|
| 158 | S RCTYP=$S(Y="D":"DECREASE",1:"INCREASE")
|
|---|
| 159 | F S RCY=$$GETABILL^RCBEUBIL Q:RCY<0!(RCY'<1)
|
|---|
| 160 | G:RCY<1 ADJUSTQ
|
|---|
| 161 | D ADJUST^RCBEADJ(RCTYP,RCY_";"_RCSCR)
|
|---|
| 162 | I $D(^TMP("RC_BILL",$J,RCY)) D
|
|---|
| 163 | . D UPDBAL(RCY)
|
|---|
| 164 | . W !,"Claim balance is now: ",$J(+$P($$BILL^RCJIBFN2(RCY),U,3),"",2)
|
|---|
| 165 | ;
|
|---|
| 166 | ADJUSTQ D RESTMP
|
|---|
| 167 | D RET^RCDPEWL2
|
|---|
| 168 | S VALMBCK="R"
|
|---|
| 169 | Q
|
|---|
| 170 | ;
|
|---|
| 171 | RESTMP ;
|
|---|
| 172 | I $D(^TMP("RC_SAVE_TMP",$J)) M ^TMP($J)=^TMP("RC_SAVE_TMP",$J) K ^TMP("RC_SAVE_TMP")
|
|---|
| 173 | Q
|
|---|
| 174 | ;
|
|---|
| 175 | UPDBAL(RCY) ; Updates the claim balance if bill exists in list
|
|---|
| 176 | ; RCY = ien of bill in file 430
|
|---|
| 177 | ;
|
|---|
| 178 | N X,Y,Z,Z0,Z1
|
|---|
| 179 | S Z0=$J(+$P($$BILL^RCJIBFN2(RCY),U,3),"",2)
|
|---|
| 180 | S Z=0 F S Z=$O(^TMP("RC_BILL",$J,RCY,Z)) Q:'Z D
|
|---|
| 181 | . S X=+$G(^TMP("RCDPE-EOB_WLDX",$J,Z))
|
|---|
| 182 | . Q:'X
|
|---|
| 183 | . S Y=$G(^TMP("RCDPE-EOB_WL",$J,X+1,0))
|
|---|
| 184 | . 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
|
|---|
| 185 | Q
|
|---|
| 186 | ;
|
|---|
