RCBEPAY2 ;WISC/RFJ - create a payment transaction cont ;1 Jun 00
;;4.5;Accounts Receivable;**153,162,377,389**;Mar 20, 1995;Build 36
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
SET ; set the transactions and balances (continuation of rcbepay1)
N COMMENT,DR,RCDATA3,RCLINE,RCREPAMT,RCREPDA,RCTOTAL,RCTYPE,X,RCFLG60,RCRPIEN,RPMNTS
;
; no payment amount
S RCTOTAL=$G(RCPAY("PRIN"))+$G(RCPAY("INT"))+$G(RCPAY("ADM"))+$G(RCPAY("MF"))+$G(RCPAY("CC"))
I 'RCTOTAL S RCTRANDA="0^Bill has no balance, no payment made" Q
;
; create 433 transaction for bill, transaction type = payment (2)
; the transaction will be locked
S RCTRANDA=$$ADD433^RCBEUTRA(RCBILLDA,2)
I 'RCTRANDA S RCTRANDA="0^Unable to add a payment transaction to file 433" Q
; 433 transaction added and lock applied
;
; edit/setup fields for 433 transaction. 11=payment date
; 13=receipt number; 15=trasaction amount; 7=rcdoj code
; 5.02=brief comment = deposit / receipt / payment #
S DR="11////"_RCPAYDAT_";"
S DR=DR_"15////"_RCTOTAL_";"
; if receipt is passed, set fields for receipt
; note: a receipt is not passed if posting from a prepayment
S X=$G(^RCY(344,+RCRECTDA,0)) I X'="" D
. S DR=DR_"13////"_$P(X,"^")_";"
. S DR=DR_"5.02////"_$P($G(^RCY(344.1,+$P(X,"^",6),0)),"^")_" / "_$P(X,"^")_" / "_RCPAYDA_";"
;
; determine if DOJ, RC, TOP, or IRS payment
S RCTYPE=$P($G(^RC(341.1,+$P($G(^RCY(344,+RCRECTDA,0)),"^",4),0)),"^",2)
S RCTYPE=$S(RCTYPE=5:"DOJ",RCTYPE=3:"RC",RCTYPE=13:"TOP",RCTYPE=11:"IRS",1:"")
I RCTYPE="" S RCTYPE=$P($G(^PRCA(430,RCBILLDA,6)),"^",5)
I RCTYPE'="" S:RCTYPE="DC" RCTYPE="RC" S DR=DR_"7////"_RCTYPE_";"
S X=$$EDIT433^RCBEUTRA(RCTRANDA,DR)
I 'X S RCTRANDA="0^Unable to set fields for transaction "_RCTRANDA L -^PRCA(433,RCTRANDA) Q
;
; if TOP, decrement current top debt amount (field 4.03 in file 340)
I RCTYPE="TOP" D TOPAMT^RCBEUDEB(RCBILLDA,-RCTOTAL)
;
;PRCA*4.5*377 - Retiring this old functionality adding new functionality.
;
; if there is a repayment plan, set as being paid in file 430
; loop thru all repayment plans and keep paying them off till
; you run out of money. this code is for double payments.
;S RCREPAMT=$P($G(^PRCA(430,RCBILLDA,4)),"^",3)
; is there a repayment amount and is the total amt equal to
; or greater than the expected repayment amount?
;I RCREPAMT,RCTOTAL'<RCREPAMT D
;. S RCREPDA=0 F S RCREPDA=$O(^PRCA(430,RCBILLDA,5,RCREPDA)) Q:'RCREPDA D I 'RCREPDA Q
;. . I +$P($G(^PRCA(430,RCBILLDA,5,RCREPDA,0)),"^",2)=1 Q
;. . S $P(^PRCA(430,RCBILLDA,5,RCREPDA,0),"^",2,4)="1^0^"_RCTRANDA
;. . S RCTOTAL=RCTOTAL-RCREPAMT I RCTOTAL<RCREPAMT S RCREPDA=0
;
; If this bill is linked to a repayment plan, update the plan with the payment information,
; Update the schedule, and recalculate it's status.
I +$G(^PRCA(430,RCBILLDA,4)) D
.S RCRPIEN=$P($G(^PRCA(430,RCBILLDA,4)),U,5)
.D UPDPAY^RCRPU1(RCRPIEN,RCTRANDA,RCTOTAL)
.S RCFLG60=$$GET1^DIQ(340.5,RCRPIEN_",",1.01,"I"),RPMNTS=$$REMPMNTS^RCRPU3(RCRPIEN) ; PRCA*4.5*389
.I RCFLG60,RPMNTS'>57 D UPDRVW^RCRPU2(RCRPIEN,0) ; if 60 months review flag is set and reamining # of payments is <=57, clear the flag PRCA*4.5*389
.Q
;
; set 433 transaction with payment amounts
S RCDATA3=""
S $P(RCDATA3,"^",1)=$G(RCPAY("PRIN")) ; amount paid principal
S $P(RCDATA3,"^",2)=$G(RCPAY("INT")) ; amount paid interest
S $P(RCDATA3,"^",3)=$G(RCPAY("ADM")) ; amount paid admin
S $P(RCDATA3,"^",4)=$G(RCPAY("MF")) ; amount paid marshal fee
S $P(RCDATA3,"^",5)=$G(RCPAY("CC")) ; amount paid court cost
S ^PRCA(433,RCTRANDA,3)=RCDATA3
;
; set 430 bill balance amounts
S $P(RCDATA7,"^",1)=$P(RCDATA7,"^",1)-$G(RCPAY("PRIN")) ; principal
S $P(RCDATA7,"^",2)=$P(RCDATA7,"^",2)-$G(RCPAY("INT")) ; interest
S $P(RCDATA7,"^",3)=$P(RCDATA7,"^",3)-$G(RCPAY("ADM")) ; admin
S $P(RCDATA7,"^",4)=$P(RCDATA7,"^",4)-$G(RCPAY("MF")) ; marshal fee
S $P(RCDATA7,"^",5)=$P(RCDATA7,"^",5)-$G(RCPAY("CC")) ; court cost
;
; set 430 amounts paid
S $P(RCDATA7,"^",7)=$P(RCDATA7,"^",7)+$G(RCPAY("PRIN")) ; principal
S $P(RCDATA7,"^",8)=$P(RCDATA7,"^",8)+$G(RCPAY("INT")) ; interest
S $P(RCDATA7,"^",9)=$P(RCDATA7,"^",9)+$G(RCPAY("ADM")) ; admin
S $P(RCDATA7,"^",10)=$P(RCDATA7,"^",10)+$G(RCPAY("MF")) ; marshal fee
S $P(RCDATA7,"^",11)=$P(RCDATA7,"^",11)+$G(RCPAY("CC")) ; court cost
S ^PRCA(430,RCBILLDA,7)=RCDATA7
;
; set new bill balances in 433 (for reference)
S $P(^PRCA(433,RCTRANDA,8),"^",1,5)=$P(RCDATA7,"^",1,5)
;
; if the bill has no balance, set as being paid in full
S X=$P(RCDATA7,"^")+$P(RCDATA7,"^",2)+$P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5)
I 'X D
. ; change the status to collected/closed (22)
. D CHGSTAT^RCBEUBIL(RCBILLDA,22)
. ;
. ; change the transaction type in file 433 to payment in full
. S DR="12////34;"
. S X=$$EDIT433^RCBEUTRA(RCTRANDA,DR)
. ;
. ; if third party bill (with no balance) generate ib bulletin
. ; look at field 5 in 430.2 to determine type of bill based
. ; on category
. I $P($G(^PRCA(430.2,+$P(^PRCA(430,RCBILLDA,0),"^",2),0)),"^",6)="T" D
. . D BULL^IBCNSBL2(RCBILLDA,$P(^PRCA(430,RCBILLDA,0),"^",3),$$PAID^PRCAFN1(RCBILLDA))
. . N PRCABN,PRCAEN
. . S PRCABN=RCBILLDA,PRCAEN=RCTRANDA
. . D PF^RCRCAT("P")
;
; add comment field to 433 (only if receipt passed)
S X=$G(^RCY(344,+RCRECTDA,1,+RCPAYDA,0))
I X'="" D
. S RCLINE=0
. I $P(X,"^",7)'="" S RCLINE=RCLINE+1,COMMENT(RCLINE)="Check#: "_$P(X,"^",7)
. I $P(X,"^",8)'="" S RCLINE=RCLINE+1,COMMENT(RCLINE)="Bank Routing#: "_$P(X,"^",8)
. I $P(X,"^",10)'="" S RCLINE=RCLINE+1,COMMENT(RCLINE)="Check Date: "_$E($P(X,"^",10),4,5)_"-"_$E($P(X,"^",10),6,7)_"-"_$E($P(X,"^",10),2,3)
. I $P(X,"^",13)'="" S RCLINE=RCLINE+1,COMMENT(RCLINE)="Check Acct: "_$P(X,"^",13)
. I $P(X,"^",11)'="" S RCLINE=RCLINE+1,COMMENT(RCLINE)="Credit Card: "_$P(X,"^",11)
. S X=$G(^RCY(344,RCRECTDA,1,RCPAYDA,2))
. I $P(X,"^",2)'="" S RCLINE=RCLINE+1,COMMENT(RCLINE)="Batch: "_$P(X,"^",2)
. I $P(X,"^",3)'="" S RCLINE=RCLINE+1,COMMENT(RCLINE)="Sequence: "_$P(X,"^",3)
. I $G(COMMENT(1))'="" D ADDCOMM^RCBEUTRA(RCTRANDA,.COMMENT)
;
; mark 433 transaction as processed
D PROCESS^RCBEUTRA(RCTRANDA)
;
; update 433 fy multiple
D FYMULT^RCBEUTRA(RCTRANDA)
;
; unlock 433 transaction
L -^PRCA(433,RCTRANDA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBEPAY2 6554 printed Dec 13, 2024@01:42:47 Page 2
RCBEPAY2 ;WISC/RFJ - create a payment transaction cont ;1 Jun 00
+1 ;;4.5;Accounts Receivable;**153,162,377,389**;Mar 20, 1995;Build 36
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
SET ; set the transactions and balances (continuation of rcbepay1)
+1 NEW COMMENT,DR,RCDATA3,RCLINE,RCREPAMT,RCREPDA,RCTOTAL,RCTYPE,X,RCFLG60,RCRPIEN,RPMNTS
+2 ;
+3 ; no payment amount
+4 SET RCTOTAL=$GET(RCPAY("PRIN"))+$GET(RCPAY("INT"))+$GET(RCPAY("ADM"))+$GET(RCPAY("MF"))+$GET(RCPAY("CC"))
+5 IF 'RCTOTAL
SET RCTRANDA="0^Bill has no balance, no payment made"
QUIT
+6 ;
+7 ; create 433 transaction for bill, transaction type = payment (2)
+8 ; the transaction will be locked
+9 SET RCTRANDA=$$ADD433^RCBEUTRA(RCBILLDA,2)
+10 IF 'RCTRANDA
SET RCTRANDA="0^Unable to add a payment transaction to file 433"
QUIT
+11 ; 433 transaction added and lock applied
+12 ;
+13 ; edit/setup fields for 433 transaction. 11=payment date
+14 ; 13=receipt number; 15=trasaction amount; 7=rcdoj code
+15 ; 5.02=brief comment = deposit / receipt / payment #
+16 SET DR="11////"_RCPAYDAT_";"
+17 SET DR=DR_"15////"_RCTOTAL_";"
+18 ; if receipt is passed, set fields for receipt
+19 ; note: a receipt is not passed if posting from a prepayment
+20 SET X=$GET(^RCY(344,+RCRECTDA,0))
IF X'=""
Begin DoDot:1
+21 SET DR=DR_"13////"_$PIECE(X,"^")_";"
+22 SET DR=DR_"5.02////"_$PIECE($GET(^RCY(344.1,+$PIECE(X,"^",6),0)),"^")_" / "_$PIECE(X,"^")_" / "_RCPAYDA_";"
End DoDot:1
+23 ;
+24 ; determine if DOJ, RC, TOP, or IRS payment
+25 SET RCTYPE=$PIECE($GET(^RC(341.1,+$PIECE($GET(^RCY(344,+RCRECTDA,0)),"^",4),0)),"^",2)
+26 SET RCTYPE=$SELECT(RCTYPE=5:"DOJ",RCTYPE=3:"RC",RCTYPE=13:"TOP",RCTYPE=11:"IRS",1:"")
+27 IF RCTYPE=""
SET RCTYPE=$PIECE($GET(^PRCA(430,RCBILLDA,6)),"^",5)
+28 IF RCTYPE'=""
if RCTYPE="DC"
SET RCTYPE="RC"
SET DR=DR_"7////"_RCTYPE_";"
+29 SET X=$$EDIT433^RCBEUTRA(RCTRANDA,DR)
+30 IF 'X
SET RCTRANDA="0^Unable to set fields for transaction "_RCTRANDA
LOCK -^PRCA(433,RCTRANDA)
QUIT
+31 ;
+32 ; if TOP, decrement current top debt amount (field 4.03 in file 340)
+33 IF RCTYPE="TOP"
DO TOPAMT^RCBEUDEB(RCBILLDA,-RCTOTAL)
+34 ;
+35 ;PRCA*4.5*377 - Retiring this old functionality adding new functionality.
+36 ;
+37 ; if there is a repayment plan, set as being paid in file 430
+38 ; loop thru all repayment plans and keep paying them off till
+39 ; you run out of money. this code is for double payments.
+40 ;S RCREPAMT=$P($G(^PRCA(430,RCBILLDA,4)),"^",3)
+41 ; is there a repayment amount and is the total amt equal to
+42 ; or greater than the expected repayment amount?
+43 ;I RCREPAMT,RCTOTAL'<RCREPAMT D
+44 ;. S RCREPDA=0 F S RCREPDA=$O(^PRCA(430,RCBILLDA,5,RCREPDA)) Q:'RCREPDA D I 'RCREPDA Q
+45 ;. . I +$P($G(^PRCA(430,RCBILLDA,5,RCREPDA,0)),"^",2)=1 Q
+46 ;. . S $P(^PRCA(430,RCBILLDA,5,RCREPDA,0),"^",2,4)="1^0^"_RCTRANDA
+47 ;. . S RCTOTAL=RCTOTAL-RCREPAMT I RCTOTAL<RCREPAMT S RCREPDA=0
+48 ;
+49 ; If this bill is linked to a repayment plan, update the plan with the payment information,
+50 ; Update the schedule, and recalculate it's status.
+51 IF +$GET(^PRCA(430,RCBILLDA,4))
Begin DoDot:1
+52 SET RCRPIEN=$PIECE($GET(^PRCA(430,RCBILLDA,4)),U,5)
+53 DO UPDPAY^RCRPU1(RCRPIEN,RCTRANDA,RCTOTAL)
+54 ; PRCA*4.5*389
SET RCFLG60=$$GET1^DIQ(340.5,RCRPIEN_",",1.01,"I")
SET RPMNTS=$$REMPMNTS^RCRPU3(RCRPIEN)
+55 ; if 60 months review flag is set and reamining # of payments is <=57, clear the flag PRCA*4.5*389
IF RCFLG60
IF RPMNTS'>57
DO UPDRVW^RCRPU2(RCRPIEN,0)
+56 QUIT
End DoDot:1
+57 ;
+58 ; set 433 transaction with payment amounts
+59 SET RCDATA3=""
+60 ; amount paid principal
SET $PIECE(RCDATA3,"^",1)=$GET(RCPAY("PRIN"))
+61 ; amount paid interest
SET $PIECE(RCDATA3,"^",2)=$GET(RCPAY("INT"))
+62 ; amount paid admin
SET $PIECE(RCDATA3,"^",3)=$GET(RCPAY("ADM"))
+63 ; amount paid marshal fee
SET $PIECE(RCDATA3,"^",4)=$GET(RCPAY("MF"))
+64 ; amount paid court cost
SET $PIECE(RCDATA3,"^",5)=$GET(RCPAY("CC"))
+65 SET ^PRCA(433,RCTRANDA,3)=RCDATA3
+66 ;
+67 ; set 430 bill balance amounts
+68 ; principal
SET $PIECE(RCDATA7,"^",1)=$PIECE(RCDATA7,"^",1)-$GET(RCPAY("PRIN"))
+69 ; interest
SET $PIECE(RCDATA7,"^",2)=$PIECE(RCDATA7,"^",2)-$GET(RCPAY("INT"))
+70 ; admin
SET $PIECE(RCDATA7,"^",3)=$PIECE(RCDATA7,"^",3)-$GET(RCPAY("ADM"))
+71 ; marshal fee
SET $PIECE(RCDATA7,"^",4)=$PIECE(RCDATA7,"^",4)-$GET(RCPAY("MF"))
+72 ; court cost
SET $PIECE(RCDATA7,"^",5)=$PIECE(RCDATA7,"^",5)-$GET(RCPAY("CC"))
+73 ;
+74 ; set 430 amounts paid
+75 ; principal
SET $PIECE(RCDATA7,"^",7)=$PIECE(RCDATA7,"^",7)+$GET(RCPAY("PRIN"))
+76 ; interest
SET $PIECE(RCDATA7,"^",8)=$PIECE(RCDATA7,"^",8)+$GET(RCPAY("INT"))
+77 ; admin
SET $PIECE(RCDATA7,"^",9)=$PIECE(RCDATA7,"^",9)+$GET(RCPAY("ADM"))
+78 ; marshal fee
SET $PIECE(RCDATA7,"^",10)=$PIECE(RCDATA7,"^",10)+$GET(RCPAY("MF"))
+79 ; court cost
SET $PIECE(RCDATA7,"^",11)=$PIECE(RCDATA7,"^",11)+$GET(RCPAY("CC"))
+80 SET ^PRCA(430,RCBILLDA,7)=RCDATA7
+81 ;
+82 ; set new bill balances in 433 (for reference)
+83 SET $PIECE(^PRCA(433,RCTRANDA,8),"^",1,5)=$PIECE(RCDATA7,"^",1,5)
+84 ;
+85 ; if the bill has no balance, set as being paid in full
+86 SET X=$PIECE(RCDATA7,"^")+$PIECE(RCDATA7,"^",2)+$PIECE(RCDATA7,"^",3)+$PIECE(RCDATA7,"^",4)+$PIECE(RCDATA7,"^",5)
+87 IF 'X
Begin DoDot:1
+88 ; change the status to collected/closed (22)
+89 DO CHGSTAT^RCBEUBIL(RCBILLDA,22)
+90 ;
+91 ; change the transaction type in file 433 to payment in full
+92 SET DR="12////34;"
+93 SET X=$$EDIT433^RCBEUTRA(RCTRANDA,DR)
+94 ;
+95 ; if third party bill (with no balance) generate ib bulletin
+96 ; look at field 5 in 430.2 to determine type of bill based
+97 ; on category
+98 IF $PIECE($GET(^PRCA(430.2,+$PIECE(^PRCA(430,RCBILLDA,0),"^",2),0)),"^",6)="T"
Begin DoDot:2
+99 DO BULL^IBCNSBL2(RCBILLDA,$PIECE(^PRCA(430,RCBILLDA,0),"^",3),$$PAID^PRCAFN1(RCBILLDA))
+100 NEW PRCABN,PRCAEN
+101 SET PRCABN=RCBILLDA
SET PRCAEN=RCTRANDA
+102 DO PF^RCRCAT("P")
End DoDot:2
End DoDot:1
+103 ;
+104 ; add comment field to 433 (only if receipt passed)
+105 SET X=$GET(^RCY(344,+RCRECTDA,1,+RCPAYDA,0))
+106 IF X'=""
Begin DoDot:1
+107 SET RCLINE=0
+108 IF $PIECE(X,"^",7)'=""
SET RCLINE=RCLINE+1
SET COMMENT(RCLINE)="Check#: "_$PIECE(X,"^",7)
+109 IF $PIECE(X,"^",8)'=""
SET RCLINE=RCLINE+1
SET COMMENT(RCLINE)="Bank Routing#: "_$PIECE(X,"^",8)
+110 IF $PIECE(X,"^",10)'=""
SET RCLINE=RCLINE+1
SET COMMENT(RCLINE)="Check Date: "_$EXTRACT($PIECE(X,"^",10),4,5)_"-"_$EXTRACT($PIECE(X,"^",10),6,7)_"-"_$EXTRACT($PIECE(X,"^",10),2,3)
+111 IF $PIECE(X,"^",13)'=""
SET RCLINE=RCLINE+1
SET COMMENT(RCLINE)="Check Acct: "_$PIECE(X,"^",13)
+112 IF $PIECE(X,"^",11)'=""
SET RCLINE=RCLINE+1
SET COMMENT(RCLINE)="Credit Card: "_$PIECE(X,"^",11)
+113 SET X=$GET(^RCY(344,RCRECTDA,1,RCPAYDA,2))
+114 IF $PIECE(X,"^",2)'=""
SET RCLINE=RCLINE+1
SET COMMENT(RCLINE)="Batch: "_$PIECE(X,"^",2)
+115 IF $PIECE(X,"^",3)'=""
SET RCLINE=RCLINE+1
SET COMMENT(RCLINE)="Sequence: "_$PIECE(X,"^",3)
+116 IF $GET(COMMENT(1))'=""
DO ADDCOMM^RCBEUTRA(RCTRANDA,.COMMENT)
End DoDot:1
+117 ;
+118 ; mark 433 transaction as processed
+119 DO PROCESS^RCBEUTRA(RCTRANDA)
+120 ;
+121 ; update 433 fy multiple
+122 DO FYMULT^RCBEUTRA(RCTRANDA)
+123 ;
+124 ; unlock 433 transaction
+125 LOCK -^PRCA(433,RCTRANDA)
+126 QUIT
