RCBEPAYC ;WISC/RFJ-check a payment before processing ;1 Jun 00
;;4.5;Accounts Receivable;**153**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
CHECKPAY(RCRECTDA,RCPAYDA) ; check a payment before processing. this call
; is normally used to check a payment and verify that the billed
; amount is not less than the paid amount.
; returns 1^error if the payment cannot be processed
;
N RCACCT,RCBILAMT,RCDATA,RCPAYAMT,X
;
S RCDATA=$G(^RCY(344,RCRECTDA,1,RCPAYDA,0))
I RCDATA="" Q "1^Unable to find payment"
;
S RCACCT=$P(RCDATA,"^",3)
I RCACCT="" Q "1^Account not defined"
;
; get the payment amount (amount paid minus amount processed)
; if no payment amount, do not return error
S RCPAYAMT=$P(RCDATA,"^",4)-$P(RCDATA,"^",5) I RCPAYAMT'>0 Q 0
;
; if first party bill, everything is ok, quit
I $P(RCDATA,"^",3)["DPT(" Q 0
I $P(RCDATA,"^",3)["PRCA(430,",$P($G(^RCD(340,+$P($G(^PRCA(430,+$P(RCDATA,"^",3),0)),"^",9),0)),"^")["DPT(" Q 0
;
; === third party bills ===
;
; bill not activated or open
S X=$P($G(^PRCA(430,+$P(RCDATA,"^",3),0)),"^",8)
I X'=42,X'=16 Q "1^Bill not activated or open"
;
; calculate dollars on receivable
S X=$G(^PRCA(430,+$P(RCDATA,"^",3),7))
S RCBILAMT=$P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5)
;
; does the payment exceed the billed amount?
; pending payments is not greater than bill balance, payment ok, quit
I RCPAYAMT'>RCBILAMT Q 0
;
; pending payments exceed balance of the bill, return error
Q "1^Pending Payments of "_$J(RCPAYAMT,0,2)_" is greater than the balance of the bill "_$J(RCBILAMT,0,2)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBEPAYC 1695 printed Sep 23, 2025@19:18:50 Page 2
RCBEPAYC ;WISC/RFJ-check a payment before processing ;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 ;
CHECKPAY(RCRECTDA,RCPAYDA) ; check a payment before processing. this call
+1 ; is normally used to check a payment and verify that the billed
+2 ; amount is not less than the paid amount.
+3 ; returns 1^error if the payment cannot be processed
+4 ;
+5 NEW RCACCT,RCBILAMT,RCDATA,RCPAYAMT,X
+6 ;
+7 SET RCDATA=$GET(^RCY(344,RCRECTDA,1,RCPAYDA,0))
+8 IF RCDATA=""
QUIT "1^Unable to find payment"
+9 ;
+10 SET RCACCT=$PIECE(RCDATA,"^",3)
+11 IF RCACCT=""
QUIT "1^Account not defined"
+12 ;
+13 ; get the payment amount (amount paid minus amount processed)
+14 ; if no payment amount, do not return error
+15 SET RCPAYAMT=$PIECE(RCDATA,"^",4)-$PIECE(RCDATA,"^",5)
IF RCPAYAMT'>0
QUIT 0
+16 ;
+17 ; if first party bill, everything is ok, quit
+18 IF $PIECE(RCDATA,"^",3)["DPT("
QUIT 0
+19 IF $PIECE(RCDATA,"^",3)["PRCA(430,"
IF $PIECE($GET(^RCD(340,+$PIECE($GET(^PRCA(430,+$PIECE(RCDATA,"^",3),0)),"^",9),0)),"^")["DPT("
QUIT 0
+20 ;
+21 ; === third party bills ===
+22 ;
+23 ; bill not activated or open
+24 SET X=$PIECE($GET(^PRCA(430,+$PIECE(RCDATA,"^",3),0)),"^",8)
+25 IF X'=42
IF X'=16
QUIT "1^Bill not activated or open"
+26 ;
+27 ; calculate dollars on receivable
+28 SET X=$GET(^PRCA(430,+$PIECE(RCDATA,"^",3),7))
+29 SET RCBILAMT=$PIECE(X,"^")+$PIECE(X,"^",2)+$PIECE(X,"^",3)+$PIECE(X,"^",4)+$PIECE(X,"^",5)
+30 ;
+31 ; does the payment exceed the billed amount?
+32 ; pending payments is not greater than bill balance, payment ok, quit
+33 IF RCPAYAMT'>RCBILAMT
QUIT 0
+34 ;
+35 ; pending payments exceed balance of the bill, return error
+36 QUIT "1^Pending Payments of "_$JUSTIFY(RCPAYAMT,0,2)_" is greater than the balance of the bill "_$JUSTIFY(RCBILAMT,0,2)
