- 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 Dec 13, 2024@01:42:50 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