| 1 | RCBEPAY ;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 |  ;
 | 
|---|
| 7 | PROCESS(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 |  ;
 | 
|---|
| 92 | SETAMT(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 |  ;
 | 
|---|
| 100 | SETERROR(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
 | 
|---|