Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCBEPAYP

RCBEPAYP.m

Go to the documentation of this file.
  1. RCBEPAYP ;WISC/RFJ-check and apply prepayment to bill ;1 Jun 00
  1. ;;4.5;Accounts Receivable;**153**;Mar 20, 1995
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. PREPAY(RCBILLDA,RCSCREEN) ; if prepayment for patient account,
  1. ; apply the prepayment to the bill.
  1. ; pass variables:
  1. ; rcbillda = active bill that needs to be paid
  1. ; rcscreen = 1 if messages should be printed on the screen
  1. ;
  1. ; set rcscreen to 1 to display data on screen
  1. I '$D(RCSCREEN) N RCSCREEN S RCSCREEN=$S($E($G(IOST),1,2)="C-":1,1:0)
  1. ;
  1. I RCSCREEN W !!,"Checking for Prepayment Receivable......"
  1. ;
  1. N COMMENT,RCBILBAL,RCDATA0,RCDATA7,RCDEBTDA,RCERROR,RCPAYAMT,RCPREBAL,RCPREDA,RCTRANDA,RCTRVALU,Y
  1. ; lock the bill
  1. L +^PRCA(430,RCBILLDA):10 I '$T S RCERROR="Bill "_$P(^PRCA(430,RCBILLDA,0),"^")_" is locked by another user." D Q Q
  1. ;
  1. ; get the bill data
  1. S RCDATA0=^PRCA(430,RCBILLDA,0)
  1. ;
  1. ; get the debtor and first party patient ([DPT)
  1. I $P($G(^RCD(340,+$P(RCDATA0,"^",9),0)),"^")'[";DPT" D Q Q
  1. S RCDEBTDA=+$P(RCDATA0,"^",9)
  1. ;
  1. ; lock the account to prevent updates
  1. L +^RCD(340,RCDEBTDA):10 I '$T S RCERROR="Account is locked by another user." D Q Q
  1. ;
  1. ; if the bill is not active or open, quit
  1. 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
  1. I $P(RCDATA0,"^",2)=26 S RCERROR="Bill is a prepayment" D Q Q
  1. ;
  1. ; get the bills balance, quit if 0
  1. S RCDATA7=$G(^PRCA(430,RCBILLDA,7))
  1. S RCBILBAL=$P(RCDATA7,"^")+$P(RCDATA7,"^",2)+$P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5)
  1. I RCBILBAL'>0 S RCERROR="Bill has no outstanding balance" D Q Q
  1. ;
  1. ; loop open (42) bills for debtor looking for prepayments
  1. S RCPREDA=0
  1. F S RCPREDA=$O(^PRCA(430,"AS",RCDEBTDA,42,RCPREDA)) Q:'RCPREDA!($G(RCERROR)'="")!(RCBILBAL'>0) D
  1. . ; get the bills balance, quit if 0
  1. . S RCDATA7=$G(^PRCA(430,RCBILLDA,7))
  1. . S RCBILBAL=$P(RCDATA7,"^")+$P(RCDATA7,"^",2)+$P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5)
  1. . I $G(RCBILBAL)'>0 Q
  1. . ;
  1. . ; not a prepayment
  1. . I $P(^PRCA(430,RCPREDA,0),"^",2)'=26 Q
  1. . ; lock the prepayment
  1. . L +^PRCA(430,RCPREDA):5 I '$T Q
  1. . ; no balance on prepayment, cancellation(39) the prepayment
  1. . S RCPREBAL=$P($G(^PRCA(430,RCPREDA,7)),"^")
  1. . I 'RCPREBAL D CHGSTAT^RCBEUBIL(RCPREDA,39) L -^PRCA(430,RCPREDA) Q
  1. . ; determine payment amount. set to balance of bill. if
  1. . ; the prepayment amount is less, set to prepayment amount
  1. . S RCPAYAMT=RCBILBAL I RCPAYAMT>RCPREBAL S RCPAYAMT=RCPREBAL
  1. . ;
  1. . ; post payment, pass bill ien, payment amount, receipt and
  1. . ; payment number is 0 since it is being posted from a
  1. . ; prepayment, payment date = today
  1. . S RCTRANDA=$$PAYTRAN^RCBEPAY1(RCBILLDA,RCPAYAMT,0,0,DT)
  1. . I 'RCTRANDA S RCERROR=$P(RCTRANDA,"^",2) L -^PRCA(430,RCPREDA) Q
  1. . ;
  1. . ; add comment to transaction
  1. . S COMMENT(1)="Payment posted from Prepayment Receivable "_$P(^PRCA(430,RCPREDA,0),"^")
  1. . D ADDCOMM^RCBEUTRA(RCTRANDA,.COMMENT)
  1. . ;
  1. . ; since the bill is being paid with a prepayment, set the
  1. . ; incomplete transaction flag on the payment. this code
  1. . ; can be removed after patch 146.
  1. . S Y=$$EDIT433^RCBEUTRA(RCTRANDA,"10////1;")
  1. . ;
  1. . ; get the value of the payment transaction
  1. . S RCTRVALU=+$P($G(^PRCA(433,RCTRANDA,1)),"^",5) I 'RCTRVALU L -^PRCA(430,RCPREDA) Q
  1. . ;
  1. . I RCSCREEN W !,?5,"... Payment of $ ",$J(RCTRVALU,8,2)," applied from prepayment ",$P(^PRCA(430,RCPREDA,0),"^"),"."
  1. . ;
  1. . ; decrease the prepayment by amount paid.
  1. . ; pass negative amount paid to create a decrease to prepayment.
  1. . ; pass 0 for date processed, the current date/time will be used.
  1. . ; pass the payment transaction ien (rctranda).
  1. . S COMMENT(1)="Auto decrease from Account Receivable "_$P(RCDATA0,"^")
  1. . S RCTRANDA=$$INCDEC^RCBEUTR1(RCPREDA,-RCTRVALU,.COMMENT,0,RCTRANDA)
  1. . ;
  1. . ; clear the prepayment bill lock
  1. . L -^PRCA(430,RCPREDA)
  1. ;
  1. Q ; show error to user and unlock
  1. I $G(RCERROR)'="",RCSCREEN W !,?5,"ERROR: "_RCERROR
  1. I $G(RCDEBTDA) L -^RCD(340,RCDEBTDA)
  1. I $G(RCBILLDA) L -^PRCA(430,RCBILLDA)
  1. Q