[613] | 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
|
---|