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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBEPAYP 4293 printed Apr 09, 2024@20:54:49 Page 2
RCBEPAYP ;WISC/RFJ-check and apply prepayment to bill ;1 Jun 00
+1 ;;4.5;Accounts Receivable;**153**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
PREPAY(RCBILLDA,RCSCREEN) ; if prepayment for patient account,
+1 ; apply the prepayment to the bill.
+2 ; pass variables:
+3 ; rcbillda = active bill that needs to be paid
+4 ; rcscreen = 1 if messages should be printed on the screen
+5 ;
+6 ; set rcscreen to 1 to display data on screen
+7 IF '$DATA(RCSCREEN)
NEW RCSCREEN
SET RCSCREEN=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+8 ;
+9 IF RCSCREEN
WRITE !!,"Checking for Prepayment Receivable......"
+10 ;
+11 NEW COMMENT,RCBILBAL,RCDATA0,RCDATA7,RCDEBTDA,RCERROR,RCPAYAMT,RCPREBAL,RCPREDA,RCTRANDA,RCTRVALU,Y
+12 ; lock the bill
+13 LOCK +^PRCA(430,RCBILLDA):10
IF '$TEST
SET RCERROR="Bill "_$PIECE(^PRCA(430,RCBILLDA,0),"^")_" is locked by another user."
DO Q
QUIT
+14 ;
+15 ; get the bill data
+16 SET RCDATA0=^PRCA(430,RCBILLDA,0)
+17 ;
+18 ; get the debtor and first party patient ([DPT)
+19 IF $PIECE($GET(^RCD(340,+$PIECE(RCDATA0,"^",9),0)),"^")'[";DPT"
DO Q
QUIT
+20 SET RCDEBTDA=+$PIECE(RCDATA0,"^",9)
+21 ;
+22 ; lock the account to prevent updates
+23 LOCK +^RCD(340,RCDEBTDA):10
IF '$TEST
SET RCERROR="Account is locked by another user."
DO Q
QUIT
+24 ;
+25 ; if the bill is not active or open, quit
+26 IF $PIECE(RCDATA0,"^",8)'=16
IF $PIECE(RCDATA0,"^",8)'=42
SET RCERROR="BILL STATUS IS "_$PIECE($GET(^PRCA(430.3,$PIECE(RCDATA0,"^",8),0)),"^")
DO Q
QUIT
+27 IF $PIECE(RCDATA0,"^",2)=26
SET RCERROR="Bill is a prepayment"
DO Q
QUIT
+28 ;
+29 ; get the bills balance, quit if 0
+30 SET RCDATA7=$GET(^PRCA(430,RCBILLDA,7))
+31 SET RCBILBAL=$PIECE(RCDATA7,"^")+$PIECE(RCDATA7,"^",2)+$PIECE(RCDATA7,"^",3)+$PIECE(RCDATA7,"^",4)+$PIECE(RCDATA7,"^",5)
+32 IF RCBILBAL'>0
SET RCERROR="Bill has no outstanding balance"
DO Q
QUIT
+33 ;
+34 ; loop open (42) bills for debtor looking for prepayments
+35 SET RCPREDA=0
+36 FOR
SET RCPREDA=$ORDER(^PRCA(430,"AS",RCDEBTDA,42,RCPREDA))
if 'RCPREDA!($GET(RCERROR)'="")!(RCBILBAL'>0)
QUIT
Begin DoDot:1
+37 ; get the bills balance, quit if 0
+38 SET RCDATA7=$GET(^PRCA(430,RCBILLDA,7))
+39 SET RCBILBAL=$PIECE(RCDATA7,"^")+$PIECE(RCDATA7,"^",2)+$PIECE(RCDATA7,"^",3)+$PIECE(RCDATA7,"^",4)+$PIECE(RCDATA7,"^",5)
+40 IF $GET(RCBILBAL)'>0
QUIT
+41 ;
+42 ; not a prepayment
+43 IF $PIECE(^PRCA(430,RCPREDA,0),"^",2)'=26
QUIT
+44 ; lock the prepayment
+45 LOCK +^PRCA(430,RCPREDA):5
IF '$TEST
QUIT
+46 ; no balance on prepayment, cancellation(39) the prepayment
+47 SET RCPREBAL=$PIECE($GET(^PRCA(430,RCPREDA,7)),"^")
+48 IF 'RCPREBAL
DO CHGSTAT^RCBEUBIL(RCPREDA,39)
LOCK -^PRCA(430,RCPREDA)
QUIT
+49 ; determine payment amount. set to balance of bill. if
+50 ; the prepayment amount is less, set to prepayment amount
+51 SET RCPAYAMT=RCBILBAL
IF RCPAYAMT>RCPREBAL
SET RCPAYAMT=RCPREBAL
+52 ;
+53 ; post payment, pass bill ien, payment amount, receipt and
+54 ; payment number is 0 since it is being posted from a
+55 ; prepayment, payment date = today
+56 SET RCTRANDA=$$PAYTRAN^RCBEPAY1(RCBILLDA,RCPAYAMT,0,0,DT)
+57 IF 'RCTRANDA
SET RCERROR=$PIECE(RCTRANDA,"^",2)
LOCK -^PRCA(430,RCPREDA)
QUIT
+58 ;
+59 ; add comment to transaction
+60 SET COMMENT(1)="Payment posted from Prepayment Receivable "_$PIECE(^PRCA(430,RCPREDA,0),"^")
+61 DO ADDCOMM^RCBEUTRA(RCTRANDA,.COMMENT)
+62 ;
+63 ; since the bill is being paid with a prepayment, set the
+64 ; incomplete transaction flag on the payment. this code
+65 ; can be removed after patch 146.
+66 SET Y=$$EDIT433^RCBEUTRA(RCTRANDA,"10////1;")
+67 ;
+68 ; get the value of the payment transaction
+69 SET RCTRVALU=+$PIECE($GET(^PRCA(433,RCTRANDA,1)),"^",5)
IF 'RCTRVALU
LOCK -^PRCA(430,RCPREDA)
QUIT
+70 ;
+71 IF RCSCREEN
WRITE !,?5,"... Payment of $ ",$JUSTIFY(RCTRVALU,8,2)," applied from prepayment ",$PIECE(^PRCA(430,RCPREDA,0),"^"),"."
+72 ;
+73 ; decrease the prepayment by amount paid.
+74 ; pass negative amount paid to create a decrease to prepayment.
+75 ; pass 0 for date processed, the current date/time will be used.
+76 ; pass the payment transaction ien (rctranda).
+77 SET COMMENT(1)="Auto decrease from Account Receivable "_$PIECE(RCDATA0,"^")
+78 SET RCTRANDA=$$INCDEC^RCBEUTR1(RCPREDA,-RCTRVALU,.COMMENT,0,RCTRANDA)
+79 ;
+80 ; clear the prepayment bill lock
+81 LOCK -^PRCA(430,RCPREDA)
End DoDot:1
+82 ;
Q ; show error to user and unlock
+1 IF $GET(RCERROR)'=""
IF RCSCREEN
WRITE !,?5,"ERROR: "_RCERROR
+2 IF $GET(RCDEBTDA)
LOCK -^RCD(340,RCDEBTDA)
+3 IF $GET(RCBILLDA)
LOCK -^PRCA(430,RCBILLDA)
+4 QUIT
