RCBEUDEB.m

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 ---RCBEUDEB   852     printed  Apr 09, 2024@20:45:23                                                                                                                                                                                                     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