| 1 | RCBEPAYP ;WISC/RFJ-check and apply prepayment to bill                ;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 | PREPAY(RCBILLDA,RCSCREEN) ;  if prepayment for patient account, | 
|---|
| 8 | ;  apply the prepayment to the bill. | 
|---|
| 9 | ;  pass variables: | 
|---|
| 10 | ;      rcbillda = active bill that needs to be paid | 
|---|
| 11 | ;      rcscreen = 1 if messages should be printed on the screen | 
|---|
| 12 | ; | 
|---|
| 13 | ;  set rcscreen to 1 to display data on screen | 
|---|
| 14 | I '$D(RCSCREEN) N RCSCREEN S RCSCREEN=$S($E($G(IOST),1,2)="C-":1,1:0) | 
|---|
| 15 | ; | 
|---|
| 16 | I RCSCREEN W !!,"Checking for Prepayment Receivable......" | 
|---|
| 17 | ; | 
|---|
| 18 | N COMMENT,RCBILBAL,RCDATA0,RCDATA7,RCDEBTDA,RCERROR,RCPAYAMT,RCPREBAL,RCPREDA,RCTRANDA,RCTRVALU,Y | 
|---|
| 19 | ;  lock the bill | 
|---|
| 20 | L +^PRCA(430,RCBILLDA):10 I '$T S RCERROR="Bill "_$P(^PRCA(430,RCBILLDA,0),"^")_" is locked by another user." D Q Q | 
|---|
| 21 | ; | 
|---|
| 22 | ;  get the bill data | 
|---|
| 23 | S RCDATA0=^PRCA(430,RCBILLDA,0) | 
|---|
| 24 | ; | 
|---|
| 25 | ;  get the debtor and first party patient ([DPT) | 
|---|
| 26 | I $P($G(^RCD(340,+$P(RCDATA0,"^",9),0)),"^")'[";DPT" D Q Q | 
|---|
| 27 | S RCDEBTDA=+$P(RCDATA0,"^",9) | 
|---|
| 28 | ; | 
|---|
| 29 | ;  lock the account to prevent updates | 
|---|
| 30 | L +^RCD(340,RCDEBTDA):10 I '$T S RCERROR="Account is locked by another user." D Q Q | 
|---|
| 31 | ; | 
|---|
| 32 | ;  if the bill is not active or open, quit | 
|---|
| 33 | I $P(RCDATA0,"^",8)'=16,$P(RCDATA0,"^",8)'=42 S RCERROR="BILL STATUS IS "_$P($G(^PRCA(430.3,$P(RCDATA0,"^",8),0)),"^") D Q Q | 
|---|
| 34 | I $P(RCDATA0,"^",2)=26 S RCERROR="Bill is a prepayment" D Q Q | 
|---|
| 35 | ; | 
|---|
| 36 | ;  get the bills balance, quit if 0 | 
|---|
| 37 | S RCDATA7=$G(^PRCA(430,RCBILLDA,7)) | 
|---|
| 38 | S RCBILBAL=$P(RCDATA7,"^")+$P(RCDATA7,"^",2)+$P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5) | 
|---|
| 39 | I RCBILBAL'>0 S RCERROR="Bill has no outstanding balance" D Q Q | 
|---|
| 40 | ; | 
|---|
| 41 | ;  loop open (42) bills for debtor looking for prepayments | 
|---|
| 42 | S RCPREDA=0 | 
|---|
| 43 | F  S RCPREDA=$O(^PRCA(430,"AS",RCDEBTDA,42,RCPREDA)) Q:'RCPREDA!($G(RCERROR)'="")!(RCBILBAL'>0)  D | 
|---|
| 44 | .   ;  get the bills balance, quit if 0 | 
|---|
| 45 | .   S RCDATA7=$G(^PRCA(430,RCBILLDA,7)) | 
|---|
| 46 | .   S RCBILBAL=$P(RCDATA7,"^")+$P(RCDATA7,"^",2)+$P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5) | 
|---|
| 47 | .   I $G(RCBILBAL)'>0 Q | 
|---|
| 48 | .   ; | 
|---|
| 49 | .   ;  not a prepayment | 
|---|
| 50 | .   I $P(^PRCA(430,RCPREDA,0),"^",2)'=26 Q | 
|---|
| 51 | .   ;  lock the prepayment | 
|---|
| 52 | .   L +^PRCA(430,RCPREDA):5 I '$T Q | 
|---|
| 53 | .   ;  no balance on prepayment, cancellation(39) the prepayment | 
|---|
| 54 | .   S RCPREBAL=$P($G(^PRCA(430,RCPREDA,7)),"^") | 
|---|
| 55 | .   I 'RCPREBAL D CHGSTAT^RCBEUBIL(RCPREDA,39) L -^PRCA(430,RCPREDA) Q | 
|---|
| 56 | .   ;  determine payment amount. set to balance of bill.  if | 
|---|
| 57 | .   ;  the prepayment amount is less, set to prepayment amount | 
|---|
| 58 | .   S RCPAYAMT=RCBILBAL I RCPAYAMT>RCPREBAL S RCPAYAMT=RCPREBAL | 
|---|
| 59 | .   ; | 
|---|
| 60 | .   ;  post payment, pass bill ien, payment amount, receipt and | 
|---|
| 61 | .   ;  payment number is 0 since it is being posted from a | 
|---|
| 62 | .   ;  prepayment, payment date = today | 
|---|
| 63 | .   S RCTRANDA=$$PAYTRAN^RCBEPAY1(RCBILLDA,RCPAYAMT,0,0,DT) | 
|---|
| 64 | .   I 'RCTRANDA S RCERROR=$P(RCTRANDA,"^",2) L -^PRCA(430,RCPREDA) Q | 
|---|
| 65 | .   ; | 
|---|
| 66 | .   ;  add comment to transaction | 
|---|
| 67 | .   S COMMENT(1)="Payment posted from Prepayment Receivable "_$P(^PRCA(430,RCPREDA,0),"^") | 
|---|
| 68 | .   D ADDCOMM^RCBEUTRA(RCTRANDA,.COMMENT) | 
|---|
| 69 | .   ; | 
|---|
| 70 | .   ;  since the bill is being paid with a prepayment, set the | 
|---|
| 71 | .   ;  incomplete transaction flag on the payment.  this code | 
|---|
| 72 | .   ;  can be removed after patch 146. | 
|---|
| 73 | .   S Y=$$EDIT433^RCBEUTRA(RCTRANDA,"10////1;") | 
|---|
| 74 | .   ; | 
|---|
| 75 | .   ;  get the value of the payment transaction | 
|---|
| 76 | .   S RCTRVALU=+$P($G(^PRCA(433,RCTRANDA,1)),"^",5) I 'RCTRVALU L -^PRCA(430,RCPREDA) Q | 
|---|
| 77 | .   ; | 
|---|
| 78 | .   I RCSCREEN W !,?5,"... Payment of $ ",$J(RCTRVALU,8,2)," applied from prepayment ",$P(^PRCA(430,RCPREDA,0),"^"),"." | 
|---|
| 79 | .   ; | 
|---|
| 80 | .   ;  decrease the prepayment by amount paid. | 
|---|
| 81 | .   ;  pass negative amount paid to create a decrease to prepayment. | 
|---|
| 82 | .   ;  pass 0 for date processed, the current date/time will be used. | 
|---|
| 83 | .   ;  pass the payment transaction ien (rctranda). | 
|---|
| 84 | .   S COMMENT(1)="Auto decrease from Account Receivable "_$P(RCDATA0,"^") | 
|---|
| 85 | .   S RCTRANDA=$$INCDEC^RCBEUTR1(RCPREDA,-RCTRVALU,.COMMENT,0,RCTRANDA) | 
|---|
| 86 | .   ; | 
|---|
| 87 | .   ;  clear the prepayment bill lock | 
|---|
| 88 | .   L -^PRCA(430,RCPREDA) | 
|---|
| 89 | ; | 
|---|
| 90 | Q ;  show error to user and unlock | 
|---|
| 91 | I $G(RCERROR)'="",RCSCREEN W !,?5,"ERROR: "_RCERROR | 
|---|
| 92 | I $G(RCDEBTDA) L -^RCD(340,RCDEBTDA) | 
|---|
| 93 | I $G(RCBILLDA) L -^PRCA(430,RCBILLDA) | 
|---|
| 94 | Q | 
|---|