RCBEPAY1 ;WISC/RFJ-create a payment transaction cont ;1 Jun 00
;;4.5;Accounts Receivable;**153**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
PAYTRAN(RCBILLDA,RCPAYAMT,RCRECTDA,RCPAYDA,RCPAYDAT) ; create the payment
; transaction for a bill.
; return 433 ien transaction if payment made
; or 0^error if not processed.
; input variables:
; rcbillda = ien of bill to apply payment to
; rcpayamt = total payment transaction amount
; rcrectda = ien of receipt in file 344
; rcpayda = payment transaction number in file 344.01
; rcpaydat = date of payment
; note: rcrectda and rcpayda are passed as zero if posting from
; a prepayment bill
;
N RCDATA7,RCPAY,RCTRANDA
;
; determine how payment should be applied
S RCDATA7=^PRCA(430,RCBILLDA,7)
; === check marshal fee balance and apply payment ===
I $P(RCDATA7,"^",4)>0 D
. ; if the payment amount is less than mf charge
. ; apply all the payment to the mf charge and quit
. I RCPAYAMT<$P(RCDATA7,"^",4) D Q
. . S RCPAY("MF")=RCPAYAMT
. . S RCPAYAMT=0
. ; otherwise, apply payment to make the mf balance 0
. S RCPAY("MF")=$P(RCDATA7,"^",4)
. S RCPAYAMT=RCPAYAMT-$P(RCDATA7,"^",4)
; no payment amount remaining
I 'RCPAYAMT D SET^RCBEPAY2 Q RCTRANDA
;
; === check court cost balance and apply payment ===
I $P(RCDATA7,"^",5)>0 D
. ; if the payment amount is less than cc charge
. ; apply all the payment to the cc charge and quit
. I RCPAYAMT<$P(RCDATA7,"^",5) D Q
. . S RCPAY("CC")=RCPAYAMT
. . S RCPAYAMT=0
. ; otherwise, apply payment to make the cc balance 0
. S RCPAY("CC")=$P(RCDATA7,"^",5)
. S RCPAYAMT=RCPAYAMT-$P(RCDATA7,"^",5)
; no payment amount remaining
I 'RCPAYAMT D SET^RCBEPAY2 Q RCTRANDA
;
; === check admin balance and apply payment ===
I $P(RCDATA7,"^",3)>0 D
. ; if the payment amount is less than admin charge
. ; apply all the payment to the admin charge and quit
. I RCPAYAMT<$P(RCDATA7,"^",3) D Q
. . S RCPAY("ADM")=RCPAYAMT
. . S RCPAYAMT=0
. ; otherwise, apply payment to make the admin balance 0
. S RCPAY("ADM")=$P(RCDATA7,"^",3)
. S RCPAYAMT=RCPAYAMT-$P(RCDATA7,"^",3)
; no payment amount remaining
I 'RCPAYAMT D SET^RCBEPAY2 Q RCTRANDA
;
; === check interest balance and apply payment ===
I $P(RCDATA7,"^",2)>0 D
. ; if the payment amount is less than interest charge
. ; apply all the payment to the interest charge and quit
. I RCPAYAMT<$P(RCDATA7,"^",2) D Q
. . S RCPAY("INT")=RCPAYAMT
. . S RCPAYAMT=0
. ; otherwise, apply payment to make the interest balance 0
. S RCPAY("INT")=$P(RCDATA7,"^",2)
. S RCPAYAMT=RCPAYAMT-$P(RCDATA7,"^",2)
; no payment amount remaining
I 'RCPAYAMT D SET^RCBEPAY2 Q RCTRANDA
;
; === check principal balance and apply payment ===
I $P(RCDATA7,"^",1)>0 D
. ; if the payment amount is less than principal charge
. ; apply all the payment to the principal charge and quit
. I RCPAYAMT<$P(RCDATA7,"^",1) D Q
. . S RCPAY("PRIN")=RCPAYAMT
. . S RCPAYAMT=0
. ; otherwise, apply payment to make the principal balance 0
. S RCPAY("PRIN")=$P(RCDATA7,"^",1)
. S RCPAYAMT=RCPAYAMT-$P(RCDATA7,"^",1)
;
D SET^RCBEPAY2
Q RCTRANDA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBEPAY1 3415 printed Dec 13, 2024@01:42:46 Page 2
RCBEPAY1 ;WISC/RFJ-create a payment transaction cont ;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 ;
PAYTRAN(RCBILLDA,RCPAYAMT,RCRECTDA,RCPAYDA,RCPAYDAT) ; create the payment
+1 ; transaction for a bill.
+2 ; return 433 ien transaction if payment made
+3 ; or 0^error if not processed.
+4 ; input variables:
+5 ; rcbillda = ien of bill to apply payment to
+6 ; rcpayamt = total payment transaction amount
+7 ; rcrectda = ien of receipt in file 344
+8 ; rcpayda = payment transaction number in file 344.01
+9 ; rcpaydat = date of payment
+10 ; note: rcrectda and rcpayda are passed as zero if posting from
+11 ; a prepayment bill
+12 ;
+13 NEW RCDATA7,RCPAY,RCTRANDA
+14 ;
+15 ; determine how payment should be applied
+16 SET RCDATA7=^PRCA(430,RCBILLDA,7)
+17 ; === check marshal fee balance and apply payment ===
+18 IF $PIECE(RCDATA7,"^",4)>0
Begin DoDot:1
+19 ; if the payment amount is less than mf charge
+20 ; apply all the payment to the mf charge and quit
+21 IF RCPAYAMT<$PIECE(RCDATA7,"^",4)
Begin DoDot:2
+22 SET RCPAY("MF")=RCPAYAMT
+23 SET RCPAYAMT=0
End DoDot:2
QUIT
+24 ; otherwise, apply payment to make the mf balance 0
+25 SET RCPAY("MF")=$PIECE(RCDATA7,"^",4)
+26 SET RCPAYAMT=RCPAYAMT-$PIECE(RCDATA7,"^",4)
End DoDot:1
+27 ; no payment amount remaining
+28 IF 'RCPAYAMT
DO SET^RCBEPAY2
QUIT RCTRANDA
+29 ;
+30 ; === check court cost balance and apply payment ===
+31 IF $PIECE(RCDATA7,"^",5)>0
Begin DoDot:1
+32 ; if the payment amount is less than cc charge
+33 ; apply all the payment to the cc charge and quit
+34 IF RCPAYAMT<$PIECE(RCDATA7,"^",5)
Begin DoDot:2
+35 SET RCPAY("CC")=RCPAYAMT
+36 SET RCPAYAMT=0
End DoDot:2
QUIT
+37 ; otherwise, apply payment to make the cc balance 0
+38 SET RCPAY("CC")=$PIECE(RCDATA7,"^",5)
+39 SET RCPAYAMT=RCPAYAMT-$PIECE(RCDATA7,"^",5)
End DoDot:1
+40 ; no payment amount remaining
+41 IF 'RCPAYAMT
DO SET^RCBEPAY2
QUIT RCTRANDA
+42 ;
+43 ; === check admin balance and apply payment ===
+44 IF $PIECE(RCDATA7,"^",3)>0
Begin DoDot:1
+45 ; if the payment amount is less than admin charge
+46 ; apply all the payment to the admin charge and quit
+47 IF RCPAYAMT<$PIECE(RCDATA7,"^",3)
Begin DoDot:2
+48 SET RCPAY("ADM")=RCPAYAMT
+49 SET RCPAYAMT=0
End DoDot:2
QUIT
+50 ; otherwise, apply payment to make the admin balance 0
+51 SET RCPAY("ADM")=$PIECE(RCDATA7,"^",3)
+52 SET RCPAYAMT=RCPAYAMT-$PIECE(RCDATA7,"^",3)
End DoDot:1
+53 ; no payment amount remaining
+54 IF 'RCPAYAMT
DO SET^RCBEPAY2
QUIT RCTRANDA
+55 ;
+56 ; === check interest balance and apply payment ===
+57 IF $PIECE(RCDATA7,"^",2)>0
Begin DoDot:1
+58 ; if the payment amount is less than interest charge
+59 ; apply all the payment to the interest charge and quit
+60 IF RCPAYAMT<$PIECE(RCDATA7,"^",2)
Begin DoDot:2
+61 SET RCPAY("INT")=RCPAYAMT
+62 SET RCPAYAMT=0
End DoDot:2
QUIT
+63 ; otherwise, apply payment to make the interest balance 0
+64 SET RCPAY("INT")=$PIECE(RCDATA7,"^",2)
+65 SET RCPAYAMT=RCPAYAMT-$PIECE(RCDATA7,"^",2)
End DoDot:1
+66 ; no payment amount remaining
+67 IF 'RCPAYAMT
DO SET^RCBEPAY2
QUIT RCTRANDA
+68 ;
+69 ; === check principal balance and apply payment ===
+70 IF $PIECE(RCDATA7,"^",1)>0
Begin DoDot:1
+71 ; if the payment amount is less than principal charge
+72 ; apply all the payment to the principal charge and quit
+73 IF RCPAYAMT<$PIECE(RCDATA7,"^",1)
Begin DoDot:2
+74 SET RCPAY("PRIN")=RCPAYAMT
+75 SET RCPAYAMT=0
End DoDot:2
QUIT
+76 ; otherwise, apply payment to make the principal balance 0
+77 SET RCPAY("PRIN")=$PIECE(RCDATA7,"^",1)
+78 SET RCPAYAMT=RCPAYAMT-$PIECE(RCDATA7,"^",1)
End DoDot:1
+79 ;
+80 DO SET^RCBEPAY2
+81 QUIT RCTRANDA
