1 | RCBEPAYC ;WISC/RFJ-check a payment before processing ;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 | ;
|
---|
7 | CHECKPAY(RCRECTDA,RCPAYDA) ; check a payment before processing. this call
|
---|
8 | ; is normally used to check a payment and verify that the billed
|
---|
9 | ; amount is not less than the paid amount.
|
---|
10 | ; returns 1^error if the payment cannot be processed
|
---|
11 | ;
|
---|
12 | N RCACCT,RCBILAMT,RCDATA,RCPAYAMT,X
|
---|
13 | ;
|
---|
14 | S RCDATA=$G(^RCY(344,RCRECTDA,1,RCPAYDA,0))
|
---|
15 | I RCDATA="" Q "1^Unable to find payment"
|
---|
16 | ;
|
---|
17 | S RCACCT=$P(RCDATA,"^",3)
|
---|
18 | I RCACCT="" Q "1^Account not defined"
|
---|
19 | ;
|
---|
20 | ; get the payment amount (amount paid minus amount processed)
|
---|
21 | ; if no payment amount, do not return error
|
---|
22 | S RCPAYAMT=$P(RCDATA,"^",4)-$P(RCDATA,"^",5) I RCPAYAMT'>0 Q 0
|
---|
23 | ;
|
---|
24 | ; if first party bill, everything is ok, quit
|
---|
25 | I $P(RCDATA,"^",3)["DPT(" Q 0
|
---|
26 | I $P(RCDATA,"^",3)["PRCA(430,",$P($G(^RCD(340,+$P($G(^PRCA(430,+$P(RCDATA,"^",3),0)),"^",9),0)),"^")["DPT(" Q 0
|
---|
27 | ;
|
---|
28 | ; === third party bills ===
|
---|
29 | ;
|
---|
30 | ; bill not activated or open
|
---|
31 | S X=$P($G(^PRCA(430,+$P(RCDATA,"^",3),0)),"^",8)
|
---|
32 | I X'=42,X'=16 Q "1^Bill not activated or open"
|
---|
33 | ;
|
---|
34 | ; calculate dollars on receivable
|
---|
35 | S X=$G(^PRCA(430,+$P(RCDATA,"^",3),7))
|
---|
36 | S RCBILAMT=$P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5)
|
---|
37 | ;
|
---|
38 | ; does the payment exceed the billed amount?
|
---|
39 | ; pending payments is not greater than bill balance, payment ok, quit
|
---|
40 | I RCPAYAMT'>RCBILAMT Q 0
|
---|
41 | ;
|
---|
42 | ; pending payments exceed balance of the bill, return error
|
---|
43 | Q "1^Pending Payments of "_$J(RCPAYAMT,0,2)_" is greater than the balance of the bill "_$J(RCBILAMT,0,2)
|
---|