RCBDBBAL ;WISC/RFJ-bill balances check ;1 Mar 2001
;;4.5;Accounts Receivable;**169**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
OUTOFBAL(RCBILLDA) ; returns balance if a bill is out of balance
; returns rclist array of transactions against bill
; locks to file 430 should be applied before calling this function
;
N BALANCE,DATA7,OUTOFBAL,STATUS
; if it is not activated, not out of balance
I '$P($G(^PRCA(430,RCBILLDA,6)),"^",21) Q ""
;
; calculate balance and get current balance
S BALANCE=$$GETTRANS^RCDPBTLM(RCBILLDA)
S DATA7=$G(^PRCA(430,RCBILLDA,7))
S STATUS=$P($G(^PRCA(430,RCBILLDA,0)),"^",8)
;
; for a write-off bill, the balance should equal all zeros, for
; these bills, node 7 is the write-off amount, so for the out of
; balance check to work, node 7 needs to be adjusted to all zeros
I STATUS=23 S DATA7="0^0^0^0^0"
;
; test for out of balance
S OUTOFBAL=0
I +$P(DATA7,"^")'=+$P(BALANCE,"^")!(+$P(DATA7,"^",2)'=+$P(BALANCE,"^",2))!(+$P(DATA7,"^",3)'=+$P(BALANCE,"^",3))!(+$P(DATA7,"^",4)'=+$P(BALANCE,"^",4))!(+$P(DATA7,"^",5)'=+$P(BALANCE,"^",5)) S OUTOFBAL=1
;
; for collected/closed (22) and cancellation (39) bills
; the balance in 430 should equal 0, if not it is out of balance
I STATUS=22!(STATUS)=39 I $TR($P(DATA7,"^",1,5),"^0")'="" S OUTOFBAL=1
;
Q $S('OUTOFBAL:"",1:BALANCE)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBDBBAL 1419 printed Dec 13, 2024@01:42:30 Page 2
RCBDBBAL ;WISC/RFJ-bill balances check ;1 Mar 2001
+1 ;;4.5;Accounts Receivable;**169**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
OUTOFBAL(RCBILLDA) ; returns balance if a bill is out of balance
+1 ; returns rclist array of transactions against bill
+2 ; locks to file 430 should be applied before calling this function
+3 ;
+4 NEW BALANCE,DATA7,OUTOFBAL,STATUS
+5 ; if it is not activated, not out of balance
+6 IF '$PIECE($GET(^PRCA(430,RCBILLDA,6)),"^",21)
QUIT ""
+7 ;
+8 ; calculate balance and get current balance
+9 SET BALANCE=$$GETTRANS^RCDPBTLM(RCBILLDA)
+10 SET DATA7=$GET(^PRCA(430,RCBILLDA,7))
+11 SET STATUS=$PIECE($GET(^PRCA(430,RCBILLDA,0)),"^",8)
+12 ;
+13 ; for a write-off bill, the balance should equal all zeros, for
+14 ; these bills, node 7 is the write-off amount, so for the out of
+15 ; balance check to work, node 7 needs to be adjusted to all zeros
+16 IF STATUS=23
SET DATA7="0^0^0^0^0"
+17 ;
+18 ; test for out of balance
+19 SET OUTOFBAL=0
+20 IF +$PIECE(DATA7,"^")'=+$PIECE(BALANCE,"^")!(+$PIECE(DATA7,"^",2)'=+$PIECE(BALANCE,"^",2))!(+$PIECE(DATA7,"^",3)'=+$PIECE(BALANCE,"^",3))!(+$PIECE(DATA7,"^",4)'=+$PIECE(BALANCE,"^",4))!(+$PIECE(DATA7,"^",5)'=+$PIECE(BALANCE,"^",5))
SET OUTOFBAL=1
+21 ;
+22 ; for collected/closed (22) and cancellation (39) bills
+23 ; the balance in 430 should equal 0, if not it is out of balance
+24 IF STATUS=22!(STATUS)=39
IF $TRANSLATE($PIECE(DATA7,"^",1,5),"^0")'=""
SET OUTOFBAL=1
+25 ;
+26 QUIT $SELECT('OUTOFBAL:"",1:BALANCE)
