source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBEPAYP.m@ 1073

RCBEPAYP ;WISC/RFJ-check and apply prepayment to bill                ;1 Jun 00

 ;;4.5;Accounts Receivable;**153**;Mar 20, 1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 Q

 ;

 ;

PREPAY(RCBILLDA,RCSCREEN) ;  if prepayment for patient account,

 ;  apply the prepayment to the bill.

 ;  pass variables:

 ;      rcbillda = active bill that needs to be paid

 ;      rcscreen = 1 if messages should be printed on the screen

 ;

 ;  set rcscreen to 1 to display data on screen

 I '$D(RCSCREEN) N RCSCREEN S RCSCREEN=$S($E($G(IOST),1,2)="C-":1,1:0)

 ;

 I RCSCREEN W !!,"Checking for Prepayment Receivable......"

 ;

 N COMMENT,RCBILBAL,RCDATA0,RCDATA7,RCDEBTDA,RCERROR,RCPAYAMT,RCPREBAL,RCPREDA,RCTRANDA,RCTRVALU,Y

 ;  lock the bill

 L +^PRCA(430,RCBILLDA):10 I '$T S RCERROR="Bill "_$P(^PRCA(430,RCBILLDA,0),"^")_" is locked by another user." D Q Q

 ;

 ;  get the bill data

 S RCDATA0=^PRCA(430,RCBILLDA,0)

 ;

 ;  get the debtor and first party patient ([DPT)

 I $P($G(^RCD(340,+$P(RCDATA0,"^",9),0)),"^")'[";DPT" D Q Q

 S RCDEBTDA=+$P(RCDATA0,"^",9)

 ;

 ;  lock the account to prevent updates

 L +^RCD(340,RCDEBTDA):10 I '$T S RCERROR="Account is locked by another user." D Q Q

 ;

 ;  if the bill is not active or open, quit

 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

 I $P(RCDATA0,"^",2)=26 S RCERROR="Bill is a prepayment" D Q Q

 ;

 ;  get the bills balance, quit if 0

 S RCDATA7=$G(^PRCA(430,RCBILLDA,7))

 S RCBILBAL=$P(RCDATA7,"^")+$P(RCDATA7,"^",2)+$P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5)

 I RCBILBAL'>0 S RCERROR="Bill has no outstanding balance" D Q Q

 ;

 ;  loop open (42) bills for debtor looking for prepayments

 S RCPREDA=0

 F  S RCPREDA=$O(^PRCA(430,"AS",RCDEBTDA,42,RCPREDA)) Q:'RCPREDA!($G(RCERROR)'="")!(RCBILBAL'>0)  D

 .   ;  get the bills balance, quit if 0

 .   S RCDATA7=$G(^PRCA(430,RCBILLDA,7))

 .   S RCBILBAL=$P(RCDATA7,"^")+$P(RCDATA7,"^",2)+$P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5)

 .   I $G(RCBILBAL)'>0 Q

 .   ;

 .   ;  not a prepayment

 .   I $P(^PRCA(430,RCPREDA,0),"^",2)'=26 Q

 .   ;  lock the prepayment

 .   L +^PRCA(430,RCPREDA):5 I '$T Q

 .   ;  no balance on prepayment, cancellation(39) the prepayment

 .   S RCPREBAL=$P($G(^PRCA(430,RCPREDA,7)),"^")

 .   I 'RCPREBAL D CHGSTAT^RCBEUBIL(RCPREDA,39) L -^PRCA(430,RCPREDA) Q

 .   ;  determine payment amount. set to balance of bill.  if

 .   ;  the prepayment amount is less, set to prepayment amount

 .   S RCPAYAMT=RCBILBAL I RCPAYAMT>RCPREBAL S RCPAYAMT=RCPREBAL

 .   ;

 .   ;  post payment, pass bill ien, payment amount, receipt and

 .   ;  payment number is 0 since it is being posted from a

 .   ;  prepayment, payment date = today

 .   S RCTRANDA=$$PAYTRAN^RCBEPAY1(RCBILLDA,RCPAYAMT,0,0,DT)

 .   I 'RCTRANDA S RCERROR=$P(RCTRANDA,"^",2) L -^PRCA(430,RCPREDA) Q

 .   ;

 .   ;  add comment to transaction

 .   S COMMENT(1)="Payment posted from Prepayment Receivable "_$P(^PRCA(430,RCPREDA,0),"^")

 .   D ADDCOMM^RCBEUTRA(RCTRANDA,.COMMENT)

 .   ;

 .   ;  since the bill is being paid with a prepayment, set the

 .   ;  incomplete transaction flag on the payment.  this code

 .   ;  can be removed after patch 146.

 .   S Y=$$EDIT433^RCBEUTRA(RCTRANDA,"10////1;")

 .   ;

 .   ;  get the value of the payment transaction

 .   S RCTRVALU=+$P($G(^PRCA(433,RCTRANDA,1)),"^",5) I 'RCTRVALU L -^PRCA(430,RCPREDA) Q

 .   ;

 .   I RCSCREEN W !,?5,"... Payment of $ ",$J(RCTRVALU,8,2)," applied from prepayment ",$P(^PRCA(430,RCPREDA,0),"^"),"."

 .   ;

 .   ;  decrease the prepayment by amount paid.

 .   ;  pass negative amount paid to create a decrease to prepayment.

 .   ;  pass 0 for date processed, the current date/time will be used.

 .   ;  pass the payment transaction ien (rctranda).

 .   S COMMENT(1)="Auto decrease from Account Receivable "_$P(RCDATA0,"^")

 .   S RCTRANDA=$$INCDEC^RCBEUTR1(RCPREDA,-RCTRVALU,.COMMENT,0,RCTRANDA)

 .   ;

 .   ;  clear the prepayment bill lock

 .   L -^PRCA(430,RCPREDA)

 ;

Q ;  show error to user and unlock

 I $G(RCERROR)'="",RCSCREEN W !,?5,"ERROR: "_RCERROR

 I $G(RCDEBTDA) L -^RCD(340,RCDEBTDA)

 I $G(RCBILLDA) L -^PRCA(430,RCBILLDA)

 Q