source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBEPAY1.m@ 1714

Last change on this file since 1714 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.2 KB
RevLine 
[613]1RCBEPAY1 ;WISC/RFJ-create a payment transaction cont ;1 Jun 00
2 ;;4.5;Accounts Receivable;**153**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7PAYTRAN(RCBILLDA,RCPAYAMT,RCRECTDA,RCPAYDA,RCPAYDAT) ; create the payment
8 ; transaction for a bill.
9 ; return 433 ien transaction if payment made
10 ; or 0^error if not processed.
11 ; input variables:
12 ; rcbillda = ien of bill to apply payment to
13 ; rcpayamt = total payment transaction amount
14 ; rcrectda = ien of receipt in file 344
15 ; rcpayda = payment transaction number in file 344.01
16 ; rcpaydat = date of payment
17 ; note: rcrectda and rcpayda are passed as zero if posting from
18 ; a prepayment bill
19 ;
20 N RCDATA7,RCPAY,RCTRANDA
21 ;
22 ; determine how payment should be applied
23 S RCDATA7=^PRCA(430,RCBILLDA,7)
24 ; === check marshal fee balance and apply payment ===
25 I $P(RCDATA7,"^",4)>0 D
26 . ; if the payment amount is less than mf charge
27 . ; apply all the payment to the mf charge and quit
28 . I RCPAYAMT<$P(RCDATA7,"^",4) D Q
29 . . S RCPAY("MF")=RCPAYAMT
30 . . S RCPAYAMT=0
31 . ; otherwise, apply payment to make the mf balance 0
32 . S RCPAY("MF")=$P(RCDATA7,"^",4)
33 . S RCPAYAMT=RCPAYAMT-$P(RCDATA7,"^",4)
34 ; no payment amount remaining
35 I 'RCPAYAMT D SET^RCBEPAY2 Q RCTRANDA
36 ;
37 ; === check court cost balance and apply payment ===
38 I $P(RCDATA7,"^",5)>0 D
39 . ; if the payment amount is less than cc charge
40 . ; apply all the payment to the cc charge and quit
41 . I RCPAYAMT<$P(RCDATA7,"^",5) D Q
42 . . S RCPAY("CC")=RCPAYAMT
43 . . S RCPAYAMT=0
44 . ; otherwise, apply payment to make the cc balance 0
45 . S RCPAY("CC")=$P(RCDATA7,"^",5)
46 . S RCPAYAMT=RCPAYAMT-$P(RCDATA7,"^",5)
47 ; no payment amount remaining
48 I 'RCPAYAMT D SET^RCBEPAY2 Q RCTRANDA
49 ;
50 ; === check admin balance and apply payment ===
51 I $P(RCDATA7,"^",3)>0 D
52 . ; if the payment amount is less than admin charge
53 . ; apply all the payment to the admin charge and quit
54 . I RCPAYAMT<$P(RCDATA7,"^",3) D Q
55 . . S RCPAY("ADM")=RCPAYAMT
56 . . S RCPAYAMT=0
57 . ; otherwise, apply payment to make the admin balance 0
58 . S RCPAY("ADM")=$P(RCDATA7,"^",3)
59 . S RCPAYAMT=RCPAYAMT-$P(RCDATA7,"^",3)
60 ; no payment amount remaining
61 I 'RCPAYAMT D SET^RCBEPAY2 Q RCTRANDA
62 ;
63 ; === check interest balance and apply payment ===
64 I $P(RCDATA7,"^",2)>0 D
65 . ; if the payment amount is less than interest charge
66 . ; apply all the payment to the interest charge and quit
67 . I RCPAYAMT<$P(RCDATA7,"^",2) D Q
68 . . S RCPAY("INT")=RCPAYAMT
69 . . S RCPAYAMT=0
70 . ; otherwise, apply payment to make the interest balance 0
71 . S RCPAY("INT")=$P(RCDATA7,"^",2)
72 . S RCPAYAMT=RCPAYAMT-$P(RCDATA7,"^",2)
73 ; no payment amount remaining
74 I 'RCPAYAMT D SET^RCBEPAY2 Q RCTRANDA
75 ;
76 ; === check principal balance and apply payment ===
77 I $P(RCDATA7,"^",1)>0 D
78 . ; if the payment amount is less than principal charge
79 . ; apply all the payment to the principal charge and quit
80 . I RCPAYAMT<$P(RCDATA7,"^",1) D Q
81 . . S RCPAY("PRIN")=RCPAYAMT
82 . . S RCPAYAMT=0
83 . ; otherwise, apply payment to make the principal balance 0
84 . S RCPAY("PRIN")=$P(RCDATA7,"^",1)
85 . S RCPAYAMT=RCPAYAMT-$P(RCDATA7,"^",1)
86 ;
87 D SET^RCBEPAY2
88 Q RCTRANDA
Note: See TracBrowser for help on using the repository browser.