source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBEPAY.m@ 1141

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

initial load of WorldVistAEHR

File size: 3.9 KB
RevLine 
[613]1RCBEPAY ;WISC/RFJ-payment processing (top routine) ;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 ;
7PROCESS(RCRECTDA,RCPAYDA) ; process a payment for receipt
8 ; rcrectda - receipt ien file 344
9 ; rcpayda - payment ien file 344 under rcrectda
10 ; returns 0 if processed, 1^error if not processed
11 ;
12 N RCACCT,RCBILLDA,RCDATA,RCERROR,RCPAYAMT,RCPAYDAT,RCTRANDA,X
13 ;
14 ; lock the receipt payment
15 L +^RCY(344,RCRECTDA,1,RCPAYDA):10
16 I '$T Q "1^Another user is working with this payment"
17 ;
18 ; get the payment data
19 S RCDATA=^RCY(344,RCRECTDA,1,RCPAYDA,0)
20 ;
21 ; there is no account, this will go to suspense
22 I $P(RCDATA,"^",3)="" L -^RCY(344,RCRECTDA,1,RCPAYDA) Q 0
23 ;
24 ; check the payment for errors
25 S X=$$CHECKPAY^RCBEPAYC(RCRECTDA,RCPAYDA)
26 I X L -^RCY(344,RCRECTDA,1,RCPAYDA) Q X
27 ;
28 ; get the payment date from the payment. if not on payment get it
29 ; from the deposit. if not on deposit, set equal to today
30 S RCPAYDAT=$P($P(RCDATA,"^",6),".") I 'RCPAYDAT S RCPAYDAT=$P($G(^RCY(344.1,+$P(^RCY(344,RCRECTDA,0),"^",6),0)),"^",3) I 'RCPAYDAT S RCPAYDAT=DT
31 ; get the payment amount (amount paid minus amount processed).
32 ; if the payment amount is not greater than zero, do not post.
33 S RCPAYAMT=$P(RCDATA,"^",4)-$P(RCDATA,"^",5) I RCPAYAMT'>0 L -^RCY(344,RCRECTDA,1,RCPAYDA) Q 0
34 ;
35 ; get the account
36 S RCACCT=$P(RCDATA,"^",3)
37 ; if the account is a bill and the debtor is first party,
38 ; then get the account from the debtor file
39 I RCACCT["PRCA(430," S X=$P($G(^RCD(340,+$P($G(^PRCA(430,+RCACCT,0)),"^",9),0)),"^") I X["DPT(" S RCACCT=X
40 ;
41 ;
42 ; ----------------- START PROCESSING PAYMENT -----------------
43 ;
44 ; === benefit debt (example: first party account) ===
45 I RCACCT["DPT(" D Q RCERROR
46 . S RCERROR=$$FIRSTPTY^RCBEPAYF
47 . ; store or clear error
48 . D SETERROR(RCRECTDA,RCPAYDA,$P(RCERROR,"^",2))
49 . L -^RCY(344,RCRECTDA,1,RCPAYDA)
50 ;
51 ;
52 ; === non-benefit debt (example: third party) ===
53 S RCBILLDA=+$P(RCDATA,"^",3)
54 ; lock the bill to prevent another used from changing the balance
55 L +^PRCA(430,RCBILLDA):10
56 I '$T D Q RCERROR
57 . S RCERROR="1^Another user is working with bill "_$P(^PRCA(430,RCBILLDA,0),"^")
58 . D SETERROR(RCRECTDA,RCPAYDA,$P(RCERROR,"^",2))
59 . L -^RCY(344,RCRECTDA,1,RCPAYDA)
60 ;
61 ; exempt any interest/admin/penalty charges added on or after
62 ; the payment date
63 D EXEMPT^RCBECHGE(RCBILLDA,RCPAYDAT)
64 ;
65 ; once charges have been exempted, recheck the payment for errors
66 S X=$$CHECKPAY^RCBEPAYC(RCRECTDA,RCPAYDA)
67 I X D Q RCERROR
68 . S RCERROR="1^"_$P(X,"^",2)
69 . D SETERROR(RCRECTDA,RCPAYDA,$P(RCERROR,"^",2))
70 . L -^PRCA(430,RCBILLDA)
71 . L -^RCY(344,RCRECTDA,1,RCPAYDA)
72 ;
73 ; apply payment to bill
74 ; return error if problem adding payment transaction
75 S RCTRANDA=$$PAYTRAN^RCBEPAY1(RCBILLDA,RCPAYAMT,RCRECTDA,RCPAYDA,RCPAYDAT)
76 I 'RCTRANDA D Q RCERROR
77 . S RCERROR="1^"_$P(RCTRANDA,"^",2)
78 . D SETERROR(RCRECTDA,RCPAYDA,$P(RCERROR,"^",2))
79 . L -^PRCA(430,RCBILLDA)
80 . L -^RCY(344,RCRECTDA,1,RCPAYDA)
81 ;
82 ; set the amount processed in the receipt
83 D SETAMT(RCRECTDA,RCPAYDA,$P($G(^PRCA(433,RCTRANDA,1)),"^",5))
84 ;
85 ; payment applied to bill
86 D SETERROR(RCRECTDA,RCPAYDA,"")
87 L -^PRCA(430,RCBILLDA)
88 L -^RCY(344,RCRECTDA,1,RCPAYDA)
89 Q 0
90 ;
91 ;
92SETAMT(RCRECTDA,RCPAYDA,RCAMOUNT) ; update the amount posted on the receipt
93 N DATA
94 S DATA=$G(^RCY(344,RCRECTDA,1,RCPAYDA,0))
95 I DATA="" Q
96 S $P(^RCY(344,RCRECTDA,1,RCPAYDA,0),"^",5)=$P(DATA,"^",5)+RCAMOUNT
97 Q
98 ;
99 ;
100SETERROR(RCRECTDA,RCPAYDA,RCERROR) ; store the error on the receipt
101 ; or clear the posting error if null and defined
102 ; error is null and posting error data in file is null
103 I RCERROR="",$P($G(^RCY(344,RCRECTDA,1,RCPAYDA,1)),"^")="" Q
104 ; error is null, clear posting error
105 I RCERROR="" S $P(^RCY(344,RCRECTDA,1,RCPAYDA,1),"^")="" Q
106 ; error exists, set the posting error
107 I RCERROR'="" S $P(^RCY(344,RCRECTDA,1,RCPAYDA,1),"^")=$E(RCERROR,1,60)
108 Q
Note: See TracBrowser for help on using the repository browser.