- 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 Feb 18, 2025@23:09:10 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