RCBEUDEB ;WISC/RFJ-utilties for debtors (in file 340) ;1 Jun 00
;;4.5;Accounts Receivable;**153**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
EDIT340(RCDEBTDA,DR) ; edit the field in 340 with the DR string passed
I '$D(^RCD(340,RCDEBTDA)) Q
N %,D,D0,D1,DA,DDH,DI,DIC,DIE,DQ,J,X,Y
S (DIC,DIE)="^RCD(340,",DA=RCDEBTDA
D ^DIE
; user pressed up-arrow
I $D(Y) Q "0^DEBTOR FIELDS NOT UPDATED"
Q 1
;
;
TOPAMT(RCBILLDA,AMOUNT) ; increase or decrease current top debt amount
; field 4.03
; pass the bill number and amount, - to decrease.
N RCDEBTDA,TOPAMT
S RCDEBTDA=+$P($G(^PRCA(430,RCBILLDA,0)),"^",9)
I '$D(^RCD(340,RCDEBTDA,0)) Q
S TOPAMT=$P($G(^RCD(340,RCDEBTDA,4)),"^",3)+AMOUNT
I TOPAMT<0 S TOPAMT=0
S $P(^RCD(340,RCDEBTDA,4),"^",3)=TOPAMT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBEUDEB 852 printed Nov 22, 2024@16:53:06 Page 2
RCBEUDEB ;WISC/RFJ-utilties for debtors (in file 340) ;1 Jun 00
+1 ;;4.5;Accounts Receivable;**153**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
EDIT340(RCDEBTDA,DR) ; edit the field in 340 with the DR string passed
+1 IF '$DATA(^RCD(340,RCDEBTDA))
QUIT
+2 NEW %,D,D0,D1,DA,DDH,DI,DIC,DIE,DQ,J,X,Y
+3 SET (DIC,DIE)="^RCD(340,"
SET DA=RCDEBTDA
+4 DO ^DIE
+5 ; user pressed up-arrow
+6 IF $DATA(Y)
QUIT "0^DEBTOR FIELDS NOT UPDATED"
+7 QUIT 1
+8 ;
+9 ;
TOPAMT(RCBILLDA,AMOUNT) ; increase or decrease current top debt amount
+1 ; field 4.03
+2 ; pass the bill number and amount, - to decrease.
+3 NEW RCDEBTDA,TOPAMT
+4 SET RCDEBTDA=+$PIECE($GET(^PRCA(430,RCBILLDA,0)),"^",9)
+5 IF '$DATA(^RCD(340,RCDEBTDA,0))
QUIT
+6 SET TOPAMT=$PIECE($GET(^RCD(340,RCDEBTDA,4)),"^",3)+AMOUNT
+7 IF TOPAMT<0
SET TOPAMT=0
+8 SET $PIECE(^RCD(340,RCDEBTDA,4),"^",3)=TOPAMT
+9 QUIT
