RCRJRCOT ;WISC/RFJ-calculate a transactions balance ;1 Mar 97
;;4.5;Accounts Receivable;**68,134,103,153,168,340**;Mar 20, 1995;Build 9
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;
TRANBAL(TRANDA) ; gets a transactions balance
; returns principal ^ interest ^ admin cost ^ mf ^ cc
N ADMIN,COURT,DATA1,DATA2,DATA3,DATA8,INTEREST,MARSHAL,PRINBAL,TRANTYPE
; transaction not valid
I '$$VALID(TRANDA) Q ""
S DATA1=$G(^PRCA(433,TRANDA,1))
S PRINBAL=$P(DATA1,"^",5),INTEREST="",ADMIN="",MARSHAL="",COURT=""
;
S TRANTYPE=+$P(DATA1,"^",2)
I $T(@TRANTYPE)'="" D @TRANTYPE
;
Q PRINBAL_"^"_INTEREST_"^"_ADMIN_"^"_MARSHAL_"^"_COURT
;
;
;
;
1 ; increase adjustment
S PRINBAL=+$P(DATA1,"^",5),(INTEREST,ADMIN,MARSHAL,COURT)=""
Q
;
;
2 ; payment
S DATA3=$G(^PRCA(433,TRANDA,3))
S PRINBAL=+$P(DATA3,"^")
S INTEREST=+$P(DATA3,"^",2)
S ADMIN=+$P(DATA3,"^",3)
S MARSHAL=+$P(DATA3,"^",4)
S COURT=+$P(DATA3,"^",5)
Q
;
;
3 ; refer to district counsel
S PRINBAL=+$P(DATA1,"^",5),(INTEREST,ADMIN,MARSHAL,COURT)=""
Q
;
;
8 ; terminate by fiscal officer
S DATA8=$G(^PRCA(433,TRANDA,8))
S PRINBAL=+$P(DATA8,"^")
S INTEREST=+$P(DATA8,"^",2)
S ADMIN=+$P(DATA8,"^",3)
S MARSHAL=+$P(DATA8,"^",4)
S COURT=+$P(DATA8,"^",5)
;
; if data8 node not defined, lookup on bill
; once patch 146 gets out, this can be removed
I $TR($P(DATA8,"^",1,5),"^0")="" D
. N BILLDA,DATA7
. S BILLDA=+$P(^PRCA(433,TRANDA,0),"^",2)
. S DATA7=$P($G(^PRCA(430,BILLDA,7)),"^",1,5)
. S PRINBAL=+$P(DATA7,"^")
. S INTEREST=+$P(DATA7,"^",2)
. S ADMIN=+$P(DATA7,"^",3)
. S MARSHAL=+$P(DATA7,"^",4)
. S COURT=+$P(DATA7,"^",5)
Q
;
;
9 ; terminate by compromise
D 8
Q
;
;
10 ; payment waived in full
D 8
Q
;
;
11 ; payment waived in partial
D 8
Q
;
;
12 ; admin cost / charge
S DATA2=$G(^PRCA(433,TRANDA,2))
S PRINBAL=""
S INTEREST=+$P(DATA2,"^",7)
S ADMIN=$P(DATA2,"^")+$P(DATA2,"^",2)+$P(DATA2,"^",3)+$P(DATA2,"^",4)+$P(DATA2,"^",8)+$P(DATA2,"^",9)
S MARSHAL=+$P(DATA2,"^",5)
S COURT=+$P(DATA2,"^",6)
Q
;
;
13 ; interest / admin charge
D 12
Q
;
;
14 ; exempt interest / admin cost
S PRINBAL=""
S DATA2=$G(^PRCA(433,TRANDA,2))
S INTEREST=$P(DATA2,"^",7)
S ADMIN=$P(DATA2,"^")+$P(DATA2,"^",2)+$P(DATA2,"^",3)+$P(DATA2,"^",4)+$P(DATA2,"^",8)+$P(DATA2,"^",9)
S MARSHAL=+$P(DATA2,"^",5)
S COURT=+$P(DATA2,"^",6)
; prior to patch 103, exempt interest and admin charges could
; not be broken out
I (INTEREST+ADMIN+MARSHAL+COURT)'=$P(DATA1,"^",5) S INTEREST=$P(DATA1,"^",5),ADMIN="",MARSHAL="",COURT=""
Q
;
;
29 ; terminate by rc/doj
D 8
Q
;
;
34 ; payment in full
D 2
Q
;
;
35 ; decrease adjustment
S PRINBAL=+$P(DATA1,"^",5),(INTEREST,ADMIN,MARSHAL,COURT)=""
; make negative amounts positive
I PRINBAL<0 S PRINBAL=-PRINBAL
Q
;
;
41 ; refund
S PRINBAL=+$P(DATA1,"^",5),(INTEREST,ADMIN,MARSHAL,COURT)=""
; make negative amounts positive
I PRINBAL<0 S PRINBAL=-PRINBAL
Q
;
;
43 ; re-establishment
S DATA8=$G(^PRCA(433,TRANDA,8))
S PRINBAL=+$P(DATA8,"^")
S INTEREST=+$P(DATA8,"^",2)
S ADMIN=+$P(DATA8,"^",3)
S MARSHAL=+$P(DATA8,"^",4)
S COURT=+$P(DATA8,"^",5)
Q
;
;
46 ; unsuspended
S DATA8=$G(^PRCA(433,TRANDA,8))
S PRINBAL=+$P(DATA8,"^")
S INTEREST=+$P(DATA8,"^",2)
S ADMIN=+$P(DATA8,"^",3)
S MARSHAL=+$P(DATA8,"^",4)
S COURT=+$P(DATA8,"^",5)
Q
;
;
47 ; suspended
D 46
Q
;
;
73 ; cs increase adjustment - added with *340
D 1
Q
;
;
74 ; cs admin.cost charge - added with *340
D 12
Q
;
;
TRANAMT(TRANDA) ; calculate transaction amount for transaction tranda
N %,AMT
S AMT=0
S %=0 F S %=$O(^PRCA(433,TRANDA,4,%)) Q:'% S AMT=AMT+$P($G(^(%,0)),"^",5)
Q AMT
;
;
VALID(TRANDA) ; test to see if a transaction is valid
; return 1 if it is, 0 if not
; date entered is not set (this is the processed date)
I '$P($G(^PRCA(433,TRANDA,1)),"^",9) Q 0
N DATA0
S DATA0=$G(^PRCA(433,TRANDA,0))
; transaction status is not complete (2)
I $P(DATA0,"^",4)'=2 Q 0
; incomplete transaction flag set (invalid transaction)
;I $P(DATA0,"^",10) Q 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRJRCOT 4275 printed Dec 13, 2024@01:48:14 Page 2
RCRJRCOT ;WISC/RFJ-calculate a transactions balance ;1 Mar 97
+1 ;;4.5;Accounts Receivable;**68,134,103,153,168,340**;Mar 20, 1995;Build 9
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
TRANBAL(TRANDA) ; gets a transactions balance
+1 ; returns principal ^ interest ^ admin cost ^ mf ^ cc
+2 NEW ADMIN,COURT,DATA1,DATA2,DATA3,DATA8,INTEREST,MARSHAL,PRINBAL,TRANTYPE
+3 ; transaction not valid
+4 IF '$$VALID(TRANDA)
QUIT ""
+5 SET DATA1=$GET(^PRCA(433,TRANDA,1))
+6 SET PRINBAL=$PIECE(DATA1,"^",5)
SET INTEREST=""
SET ADMIN=""
SET MARSHAL=""
SET COURT=""
+7 ;
+8 SET TRANTYPE=+$PIECE(DATA1,"^",2)
+9 IF $TEXT(@TRANTYPE)'=""
DO @TRANTYPE
+10 ;
+11 QUIT PRINBAL_"^"_INTEREST_"^"_ADMIN_"^"_MARSHAL_"^"_COURT
+12 ;
+13 ;
+14 ;
+15 ;
1 ; increase adjustment
+1 SET PRINBAL=+$PIECE(DATA1,"^",5)
SET (INTEREST,ADMIN,MARSHAL,COURT)=""
+2 QUIT
+3 ;
+4 ;
2 ; payment
+1 SET DATA3=$GET(^PRCA(433,TRANDA,3))
+2 SET PRINBAL=+$PIECE(DATA3,"^")
+3 SET INTEREST=+$PIECE(DATA3,"^",2)
+4 SET ADMIN=+$PIECE(DATA3,"^",3)
+5 SET MARSHAL=+$PIECE(DATA3,"^",4)
+6 SET COURT=+$PIECE(DATA3,"^",5)
+7 QUIT
+8 ;
+9 ;
3 ; refer to district counsel
+1 SET PRINBAL=+$PIECE(DATA1,"^",5)
SET (INTEREST,ADMIN,MARSHAL,COURT)=""
+2 QUIT
+3 ;
+4 ;
8 ; terminate by fiscal officer
+1 SET DATA8=$GET(^PRCA(433,TRANDA,8))
+2 SET PRINBAL=+$PIECE(DATA8,"^")
+3 SET INTEREST=+$PIECE(DATA8,"^",2)
+4 SET ADMIN=+$PIECE(DATA8,"^",3)
+5 SET MARSHAL=+$PIECE(DATA8,"^",4)
+6 SET COURT=+$PIECE(DATA8,"^",5)
+7 ;
+8 ; if data8 node not defined, lookup on bill
+9 ; once patch 146 gets out, this can be removed
+10 IF $TRANSLATE($PIECE(DATA8,"^",1,5),"^0")=""
Begin DoDot:1
+11 NEW BILLDA,DATA7
+12 SET BILLDA=+$PIECE(^PRCA(433,TRANDA,0),"^",2)
+13 SET DATA7=$PIECE($GET(^PRCA(430,BILLDA,7)),"^",1,5)
+14 SET PRINBAL=+$PIECE(DATA7,"^")
+15 SET INTEREST=+$PIECE(DATA7,"^",2)
+16 SET ADMIN=+$PIECE(DATA7,"^",3)
+17 SET MARSHAL=+$PIECE(DATA7,"^",4)
+18 SET COURT=+$PIECE(DATA7,"^",5)
End DoDot:1
+19 QUIT
+20 ;
+21 ;
9 ; terminate by compromise
+1 DO 8
+2 QUIT
+3 ;
+4 ;
10 ; payment waived in full
+1 DO 8
+2 QUIT
+3 ;
+4 ;
11 ; payment waived in partial
+1 DO 8
+2 QUIT
+3 ;
+4 ;
12 ; admin cost / charge
+1 SET DATA2=$GET(^PRCA(433,TRANDA,2))
+2 SET PRINBAL=""
+3 SET INTEREST=+$PIECE(DATA2,"^",7)
+4 SET ADMIN=$PIECE(DATA2,"^")+$PIECE(DATA2,"^",2)+$PIECE(DATA2,"^",3)+$PIECE(DATA2,"^",4)+$PIECE(DATA2,"^",8)+$PIECE(DATA2,"^",9)
+5 SET MARSHAL=+$PIECE(DATA2,"^",5)
+6 SET COURT=+$PIECE(DATA2,"^",6)
+7 QUIT
+8 ;
+9 ;
13 ; interest / admin charge
+1 DO 12
+2 QUIT
+3 ;
+4 ;
14 ; exempt interest / admin cost
+1 SET PRINBAL=""
+2 SET DATA2=$GET(^PRCA(433,TRANDA,2))
+3 SET INTEREST=$PIECE(DATA2,"^",7)
+4 SET ADMIN=$PIECE(DATA2,"^")+$PIECE(DATA2,"^",2)+$PIECE(DATA2,"^",3)+$PIECE(DATA2,"^",4)+$PIECE(DATA2,"^",8)+$PIECE(DATA2,"^",9)
+5 SET MARSHAL=+$PIECE(DATA2,"^",5)
+6 SET COURT=+$PIECE(DATA2,"^",6)
+7 ; prior to patch 103, exempt interest and admin charges could
+8 ; not be broken out
+9 IF (INTEREST+ADMIN+MARSHAL+COURT)'=$PIECE(DATA1,"^",5)
SET INTEREST=$PIECE(DATA1,"^",5)
SET ADMIN=""
SET MARSHAL=""
SET COURT=""
+10 QUIT
+11 ;
+12 ;
29 ; terminate by rc/doj
+1 DO 8
+2 QUIT
+3 ;
+4 ;
34 ; payment in full
+1 DO 2
+2 QUIT
+3 ;
+4 ;
35 ; decrease adjustment
+1 SET PRINBAL=+$PIECE(DATA1,"^",5)
SET (INTEREST,ADMIN,MARSHAL,COURT)=""
+2 ; make negative amounts positive
+3 IF PRINBAL<0
SET PRINBAL=-PRINBAL
+4 QUIT
+5 ;
+6 ;
41 ; refund
+1 SET PRINBAL=+$PIECE(DATA1,"^",5)
SET (INTEREST,ADMIN,MARSHAL,COURT)=""
+2 ; make negative amounts positive
+3 IF PRINBAL<0
SET PRINBAL=-PRINBAL
+4 QUIT
+5 ;
+6 ;
43 ; re-establishment
+1 SET DATA8=$GET(^PRCA(433,TRANDA,8))
+2 SET PRINBAL=+$PIECE(DATA8,"^")
+3 SET INTEREST=+$PIECE(DATA8,"^",2)
+4 SET ADMIN=+$PIECE(DATA8,"^",3)
+5 SET MARSHAL=+$PIECE(DATA8,"^",4)
+6 SET COURT=+$PIECE(DATA8,"^",5)
+7 QUIT
+8 ;
+9 ;
46 ; unsuspended
+1 SET DATA8=$GET(^PRCA(433,TRANDA,8))
+2 SET PRINBAL=+$PIECE(DATA8,"^")
+3 SET INTEREST=+$PIECE(DATA8,"^",2)
+4 SET ADMIN=+$PIECE(DATA8,"^",3)
+5 SET MARSHAL=+$PIECE(DATA8,"^",4)
+6 SET COURT=+$PIECE(DATA8,"^",5)
+7 QUIT
+8 ;
+9 ;
47 ; suspended
+1 DO 46
+2 QUIT
+3 ;
+4 ;
73 ; cs increase adjustment - added with *340
+1 DO 1
+2 QUIT
+3 ;
+4 ;
74 ; cs admin.cost charge - added with *340
+1 DO 12
+2 QUIT
+3 ;
+4 ;
TRANAMT(TRANDA) ; calculate transaction amount for transaction tranda
+1 NEW %,AMT
+2 SET AMT=0
+3 SET %=0
FOR
SET %=$ORDER(^PRCA(433,TRANDA,4,%))
if '%
QUIT
SET AMT=AMT+$PIECE($GET(^(%,0)),"^",5)
+4 QUIT AMT
+5 ;
+6 ;
VALID(TRANDA) ; test to see if a transaction is valid
+1 ; return 1 if it is, 0 if not
+2 ; date entered is not set (this is the processed date)
+3 IF '$PIECE($GET(^PRCA(433,TRANDA,1)),"^",9)
QUIT 0
+4 NEW DATA0
+5 SET DATA0=$GET(^PRCA(433,TRANDA,0))
+6 ; transaction status is not complete (2)
+7 IF $PIECE(DATA0,"^",4)'=2
QUIT 0
+8 ; incomplete transaction flag set (invalid transaction)
+9 ;I $P(DATA0,"^",10) Q 0
+10 QUIT 1
