source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBEPAY2.m@ 1261

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

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1RCBEPAY2 ;WISC/RFJ-create a payment transaction cont ;1 Jun 00
2 ;;4.5;Accounts Receivable;**153,162**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7SET ; set the transactions and balances (continuation of rcbepay1)
8 N COMMENT,DR,RCDATA3,RCLINE,RCREPAMT,RCREPDA,RCTOTAL,RCTYPE,X
9 ;
10 ; no payment amount
11 S RCTOTAL=$G(RCPAY("PRIN"))+$G(RCPAY("INT"))+$G(RCPAY("ADM"))+$G(RCPAY("MF"))+$G(RCPAY("CC"))
12 I 'RCTOTAL S RCTRANDA="0^Bill has no balance, no payment made" Q
13 ;
14 ; create 433 transaction for bill, transaction type = payment (2)
15 ; the transaction will be locked
16 S RCTRANDA=$$ADD433^RCBEUTRA(RCBILLDA,2)
17 I 'RCTRANDA S RCTRANDA="0^Unable to add a payment transaction to file 433" Q
18 ; 433 transaction added and lock applied
19 ;
20 ; edit/setup fields for 433 transaction. 11=payment date
21 ; 13=receipt number; 15=trasaction amount; 7=rcdoj code
22 ; 5.02=brief comment = deposit / receipt / payment #
23 S DR="11////"_RCPAYDAT_";"
24 S DR=DR_"15////"_RCTOTAL_";"
25 ; if receipt is passed, set fields for receipt
26 ; note: a receipt is not passed if posting from a prepayment
27 S X=$G(^RCY(344,+RCRECTDA,0)) I X'="" D
28 . S DR=DR_"13////"_$P(X,"^")_";"
29 . S DR=DR_"5.02////"_$P($G(^RCY(344.1,+$P(X,"^",6),0)),"^")_" / "_$P(X,"^")_" / "_RCPAYDA_";"
30 ;
31 ; determine if DOJ, RC, TOP, or IRS payment
32 S RCTYPE=$P($G(^RC(341.1,+$P($G(^RCY(344,+RCRECTDA,0)),"^",4),0)),"^",2)
33 S RCTYPE=$S(RCTYPE=5:"DOJ",RCTYPE=3:"RC",RCTYPE=13:"TOP",RCTYPE=11:"IRS",1:"")
34 I RCTYPE="" S RCTYPE=$P($G(^PRCA(430,RCBILLDA,6)),"^",5)
35 I RCTYPE'="" S:RCTYPE="DC" RCTYPE="RC" S DR=DR_"7////"_RCTYPE_";"
36 S X=$$EDIT433^RCBEUTRA(RCTRANDA,DR)
37 I 'X S RCTRANDA="0^Unable to set fields for transaction "_RCTRANDA L -^PRCA(433,RCTRANDA) Q
38 ;
39 ; if TOP, decrement current top debt amount (field 4.03 in file 340)
40 I RCTYPE="TOP" D TOPAMT^RCBEUDEB(RCBILLDA,-RCTOTAL)
41 ;
42 ; if there is a repayment plan, set as being paid in file 430
43 ; loop thru all repayment plans and keep paying them off till
44 ; you run out of money. this code is for double payments.
45 S RCREPAMT=$P($G(^PRCA(430,RCBILLDA,4)),"^",3)
46 ; is there a repayment amount and is the total amt equal to
47 ; or greater than the expected repayment amount?
48 I RCREPAMT,RCTOTAL'<RCREPAMT D
49 . S RCREPDA=0 F S RCREPDA=$O(^PRCA(430,RCBILLDA,5,RCREPDA)) Q:'RCREPDA D I 'RCREPDA Q
50 . . I +$P($G(^PRCA(430,RCBILLDA,5,RCREPDA,0)),"^",2)=1 Q
51 . . S $P(^PRCA(430,RCBILLDA,5,RCREPDA,0),"^",2,4)="1^0^"_RCTRANDA
52 . . S RCTOTAL=RCTOTAL-RCREPAMT I RCTOTAL<RCREPAMT S RCREPDA=0
53 ;
54 ; set 433 transaction with payment amounts
55 S RCDATA3=""
56 S $P(RCDATA3,"^",1)=$G(RCPAY("PRIN")) ; amount paid principal
57 S $P(RCDATA3,"^",2)=$G(RCPAY("INT")) ; amount paid interest
58 S $P(RCDATA3,"^",3)=$G(RCPAY("ADM")) ; amount paid admin
59 S $P(RCDATA3,"^",4)=$G(RCPAY("MF")) ; amount paid marshal fee
60 S $P(RCDATA3,"^",5)=$G(RCPAY("CC")) ; amount paid court cost
61 S ^PRCA(433,RCTRANDA,3)=RCDATA3
62 ;
63 ; set 430 bill balance amounts
64 S $P(RCDATA7,"^",1)=$P(RCDATA7,"^",1)-$G(RCPAY("PRIN")) ; principal
65 S $P(RCDATA7,"^",2)=$P(RCDATA7,"^",2)-$G(RCPAY("INT")) ; interest
66 S $P(RCDATA7,"^",3)=$P(RCDATA7,"^",3)-$G(RCPAY("ADM")) ; admin
67 S $P(RCDATA7,"^",4)=$P(RCDATA7,"^",4)-$G(RCPAY("MF")) ; marshal fee
68 S $P(RCDATA7,"^",5)=$P(RCDATA7,"^",5)-$G(RCPAY("CC")) ; court cost
69 ;
70 ; set 430 amounts paid
71 S $P(RCDATA7,"^",7)=$P(RCDATA7,"^",7)+$G(RCPAY("PRIN")) ; principal
72 S $P(RCDATA7,"^",8)=$P(RCDATA7,"^",8)+$G(RCPAY("INT")) ; interest
73 S $P(RCDATA7,"^",9)=$P(RCDATA7,"^",9)+$G(RCPAY("ADM")) ; admin
74 S $P(RCDATA7,"^",10)=$P(RCDATA7,"^",10)+$G(RCPAY("MF")) ; marshal fee
75 S $P(RCDATA7,"^",11)=$P(RCDATA7,"^",11)+$G(RCPAY("CC")) ; court cost
76 S ^PRCA(430,RCBILLDA,7)=RCDATA7
77 ;
78 ; set new bill balances in 433 (for reference)
79 S $P(^PRCA(433,RCTRANDA,8),"^",1,5)=$P(RCDATA7,"^",1,5)
80 ;
81 ; if the bill has no balance, set as being paid in full
82 S X=$P(RCDATA7,"^")+$P(RCDATA7,"^",2)+$P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5)
83 I 'X D
84 . ; change the status to collected/closed (22)
85 . D CHGSTAT^RCBEUBIL(RCBILLDA,22)
86 . ;
87 . ; change the transaction type in file 433 to payment in full
88 . S DR="12////34;"
89 . S X=$$EDIT433^RCBEUTRA(RCTRANDA,DR)
90 . ;
91 . ; if third party bill (with no balance) generate ib bulletin
92 . ; look at field 5 in 430.2 to determine type of bill based
93 . ; on category
94 . I $P($G(^PRCA(430.2,+$P(^PRCA(430,RCBILLDA,0),"^",2),0)),"^",6)="T" D
95 . . D BULL^IBCNSBL2(RCBILLDA,$P(^PRCA(430,RCBILLDA,0),"^",3),$$PAID^PRCAFN1(RCBILLDA))
96 . . N PRCABN,PRCAEN
97 . . S PRCABN=RCBILLDA,PRCAEN=RCTRANDA
98 . . D PF^RCRCAT("P")
99 ;
100 ; add comment field to 433 (only if receipt passed)
101 S X=$G(^RCY(344,+RCRECTDA,1,+RCPAYDA,0))
102 I X'="" D
103 . S RCLINE=0
104 . I $P(X,"^",7)'="" S RCLINE=RCLINE+1,COMMENT(RCLINE)="Check#: "_$P(X,"^",7)
105 . I $P(X,"^",8)'="" S RCLINE=RCLINE+1,COMMENT(RCLINE)="Bank Routing#: "_$P(X,"^",8)
106 . I $P(X,"^",10)'="" S RCLINE=RCLINE+1,COMMENT(RCLINE)="Check Date: "_$E($P(X,"^",10),4,5)_"-"_$E($P(X,"^",10),6,7)_"-"_$E($P(X,"^",10),2,3)
107 . I $P(X,"^",13)'="" S RCLINE=RCLINE+1,COMMENT(RCLINE)="Check Acct: "_$P(X,"^",13)
108 . I $P(X,"^",11)'="" S RCLINE=RCLINE+1,COMMENT(RCLINE)="Credit Card: "_$P(X,"^",11)
109 . S X=$G(^RCY(344,RCRECTDA,1,RCPAYDA,2))
110 . I $P(X,"^",2)'="" S RCLINE=RCLINE+1,COMMENT(RCLINE)="Batch: "_$P(X,"^",2)
111 . I $P(X,"^",3)'="" S RCLINE=RCLINE+1,COMMENT(RCLINE)="Sequence: "_$P(X,"^",3)
112 . I $G(COMMENT(1))'="" D ADDCOMM^RCBEUTRA(RCTRANDA,.COMMENT)
113 ;
114 ; mark 433 transaction as processed
115 D PROCESS^RCBEUTRA(RCTRANDA)
116 ;
117 ; update 433 fy multiple
118 D FYMULT^RCBEUTRA(RCTRANDA)
119 ;
120 ; unlock 433 transaction
121 L -^PRCA(433,RCTRANDA)
122 Q
Note: See TracBrowser for help on using the repository browser.