| 1 | RCBEUDEB ;WISC/RFJ-utilties for debtors (in file 340) ;1 Jun 00
|
|---|
| 2 | ;;4.5;Accounts Receivable;**153**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | EDIT340(RCDEBTDA,DR) ; edit the field in 340 with the DR string passed
|
|---|
| 8 | I '$D(^RCD(340,RCDEBTDA)) Q
|
|---|
| 9 | N %,D,D0,D1,DA,DDH,DI,DIC,DIE,DQ,J,X,Y
|
|---|
| 10 | S (DIC,DIE)="^RCD(340,",DA=RCDEBTDA
|
|---|
| 11 | D ^DIE
|
|---|
| 12 | ; user pressed up-arrow
|
|---|
| 13 | I $D(Y) Q "0^DEBTOR FIELDS NOT UPDATED"
|
|---|
| 14 | Q 1
|
|---|
| 15 | ;
|
|---|
| 16 | ;
|
|---|
| 17 | TOPAMT(RCBILLDA,AMOUNT) ; increase or decrease current top debt amount
|
|---|
| 18 | ; field 4.03
|
|---|
| 19 | ; pass the bill number and amount, - to decrease.
|
|---|
| 20 | N RCDEBTDA,TOPAMT
|
|---|
| 21 | S RCDEBTDA=+$P($G(^PRCA(430,RCBILLDA,0)),"^",9)
|
|---|
| 22 | I '$D(^RCD(340,RCDEBTDA,0)) Q
|
|---|
| 23 | S TOPAMT=$P($G(^RCD(340,RCDEBTDA,4)),"^",3)+AMOUNT
|
|---|
| 24 | I TOPAMT<0 S TOPAMT=0
|
|---|
| 25 | S $P(^RCD(340,RCDEBTDA,4),"^",3)=TOPAMT
|
|---|
| 26 | Q
|
|---|
