95 lines
4.1 KiB
Mathematica
95 lines
4.1 KiB
Mathematica
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
|