RCBDBBAL.m

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 ---RCBDBBAL   1419     printed  Apr 09, 2024@20:48:57                                                                                                                                                                                                    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)