RCBEPAYC.m

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 ---RCBEPAYC   1695     printed  Apr 09, 2024@20:55:10                                                                                                                                                                                                    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)