RCBEUTR1 ;WISC/RFJ-add int,admin chg or increase,decrease principal ;1 Jun 00
;;4.5;Accounts Receivable;**153,169,192,226,270,276,301,315,377**;Mar 20, 1995;Build 45
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;
INTADM(RCBILLDA,RCVALUE,RCCOMMNT,RCDATE) ; add an intererst/admin charge (transaction type=13)
; for a bill. rcvalue = interest ^ admin ^ penalty ^ marshal fee ^ court cost
; for the transaction. rcdate = process date (optional)
; returns transaction number if successful
;
N RCDRSTRG,RCTRANDA,Y
; add the transaction (if added to 433, transaction is locked)
S RCTRANDA=$$ADD433^RCBEUTRA(RCBILLDA,13) I 'RCTRANDA Q 0
;
; build dr string
; transaction date (strip off time)
S RCDRSTRG="11////"_$S($G(RCDATE):$P(RCDATE,"."),1:DT)_";"
;
; transaction values
S RCDRSTRG=RCDRSTRG_"15////"_($P(RCVALUE,"^")+$P(RCVALUE,"^",2)+$P(RCVALUE,"^",3)+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5))_";"
I $P(RCVALUE,"^",4) S RCDRSTRG=RCDRSTRG_"25////"_$P(RCVALUE,"^",4)_";" ;marshal fee
I $P(RCVALUE,"^",5) S RCDRSTRG=RCDRSTRG_"26////"_$P(RCVALUE,"^",5)_";" ;court cost
I $P(RCVALUE,"^",1) S RCDRSTRG=RCDRSTRG_"27////"_$P(RCVALUE,"^",1)_";" ;interest
I $P(RCVALUE,"^",2) S RCDRSTRG=RCDRSTRG_"28////"_$P(RCVALUE,"^",2)_";" ;admin
I $P(RCVALUE,"^",3) S RCDRSTRG=RCDRSTRG_"29////"_$P(RCVALUE,"^",3)_";" ;penalty
I $G(RCDATE) S RCDRSTRG=RCDRSTRG_"19////"_RCDATE_";" ;date entered
;
; input the fields for the transaction
S Y=$$EDIT433^RCBEUTRA(RCTRANDA,RCDRSTRG) I 'Y L -^PRCA(433,RCTRANDA) Q 0
;
; set the comment
I $D(RCCOMMNT(1)) D ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
;
; move over 433 from 430 (no principal, just move it)
D FY433^RCBEUTRA(RCTRANDA)
;
; mark transaction as processed
D PROCESS^RCBEUTRA(RCTRANDA)
;
; update the bill file with the balance of the transaction
D SETBAL^RCBEUBIL(RCTRANDA)
;
;PRCA*4.5*377
; Update Repayment Plan if one is attached to the bill
D UPDBAL^RCRPU1(RCBILLDA,RCTRANDA)
;
; if the bill has no balance, close or cancel it
D CLOSEIT(RCBILLDA)
;
; clear the lock and return the transaction added
L -^PRCA(433,RCTRANDA)
Q RCTRANDA
;
; PRCA*4.5*270 add CRD flag so FMS knows this is a corrected record
; INCDEC(RCBILLDA,RCVALUE,RCCOMMNT,RCDATE,RCPREPAY,RCONTADJ) ; automatically
INCDEC(RCBILLDA,RCVALUE,RCCOMMNT,RCDATE,RCPREPAY,RCONTADJ,RCCRD) ;
; automatically create an increase or decrease adjustment for a bill
; pass variables:
; rcvalue = principal value for the transaction.
; if rcvalue is less than zero, it will create a
; decrease adjustment. if rcvalue is greater than
; zero, it will create an increase adjustment.
; rccommnt = the comments for the word processing field.
; rcdate = optional processing date and time. if not
; passed, the current date and time will be used
; rcprepay = optional prepayment transaction. this is the
; payment transaction applied to the bill to
; create the decrease adjustment. this gets
; stored in field 20 (file 433).
; rcontadj = optional contract adjustment. if 1 then this
; gets stored in field 88 (file 433).
; rccrd = optional corrected flag. If 1, then FMS must 1st cancel or delete the
; original billing document before creating the new one.
;
; returns transaction number added to 433 if successful.
;
N ADJNUMB,RCDRSTRG,RCTRANDA,X,Y,RCNEG,TRNTYP
;
; determine transaction type
I RCVALUE>0 S TRNTYP=1 I $D(^PRCA(430,"TCSP",RCBILLDA)) S TRNTYP=73 ;PRCA*4.5*315/DRF
I RCVALUE<0 S TRNTYP=35
;
; add the transaction (if added to 433, transaction is locked)
S RCTRANDA=$$ADD433^RCBEUTRA(RCBILLDA,TRNTYP) I 'RCTRANDA Q 0
;
; build dr string
; 11=transaction date (strip off time)
S RCDRSTRG="11////"_$S($G(RCDATE):$P(RCDATE,"."),1:DT)_";"
; transaction value (make sure it is not negative)
I RCVALUE<0 S RCVALUE=-RCVALUE
S RCDRSTRG=RCDRSTRG_"15////"_RCVALUE_";"
S RCDRSTRG=RCDRSTRG_"81////"_RCVALUE_";"
I $G(RCBETYPE)="DECREASE" S RCDRSTRG=RCDRSTRG_"31////"_RCVALUE_";" ;PRCA*4.5*301
;
; get the next adjustment number if increase(1) or decrease(35)
; start with the last transaction and work backwards
S X=999999999999,ADJNUMB=1
F S X=$O(^PRCA(433,"C",RCBILLDA,X),-1) Q:'X I $P($G(^PRCA(433,X,1)),"^",4) I $P(^(1),"^",2)=1!($P(^(1),"^",2)=35) S ADJNUMB=$P(^(1),"^",4)+1 Q
S RCDRSTRG=RCDRSTRG_"14////"_ADJNUMB_";"
;
; date entered
I $G(RCDATE) S RCDRSTRG=RCDRSTRG_"19////"_RCDATE_";"
;
; store the prepayment transaction
I $G(RCPREPAY) D
. S RCDRSTRG=RCDRSTRG_"20////"_RCPREPAY_";"
. ; for prepayments, set the incomplete transaction flag
. ; this will no longer be used after patch 146 and can
. ; be removed
. S RCDRSTRG=RCDRSTRG_"10////1;"
;
; contract adjustment
I $G(RCONTADJ) S RCDRSTRG=RCDRSTRG_"88///1;"
;
; input the fields for the transaction
S Y=$$EDIT433^RCBEUTRA(RCTRANDA,RCDRSTRG) I 'Y L -^PRCA(433,RCTRANDA) Q 0
;
; set the comment
I $D(RCCOMMNT(1)) D ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
;
; mark the transaction processed
D PROCESS^RCBEUTRA(RCTRANDA)
;
; update the fiscal year multiple (must be done after marked as
; processed so the value is defined)
D FYMULT^RCBEUTRA(RCTRANDA)
;
; update the bill file with the balance of the transaction
; PRCA276 - add exception condition - needs to quit receipt processing when negative claim balance could result
S RCNEG=0 D SETBAL^RCBEUBIL(RCTRANDA,.RCNEG) I RCNEG D DEL433^RCBEUTRA(RCTRANDA,"CANCELLED WORKLIST DEC ADJ TO PREVENT NEG PRIN BAL",1) L -^PRCA(433,RCTRANDA) Q "0^1"
;
; if the bill has no balance, close or cancel it
D CLOSEIT(RCBILLDA)
;
;PRCA*4.5*377 - add hook for repayment plan updates
; if the bill is in a repayment plan, update the plan with the increase or decrease
D UPDBAL^RCRPU1(RCBILLDA,RCTRANDA)
;
; send FMS document if non-accrued (redo this later on)
I '$$ACCK^PRCAACC(RCBILLDA) D
. N D0,DA,DI,DIC,DIE,DIQ2,DQ,DR,ENT,FMSNUM,GECSDATA
. N CATEG,DATA1,ERR
. S CATEG=$P($G(^PRCA(430,RCBILLDA,0)),"^",2)
. ;
. ; category=29 champva, do not send to fms, quit
. I CATEG=29 Q
. ;
. ; category=30 tricare or 32 tricare third party, and contract adj
. I (CATEG=30!(CATEG=32)),$P($G(^PRCA(433,RCTRANDA,8)),"^",8) D Q
. . S DATA1=$G(^PRCA(433,RCTRANDA,1))
. . D EN^PRCAFWO(RCBILLDA,$P(DATA1,"^",1),$P(DATA1,"^",5),$$SITE^RCMSITE,RCTRANDA)
. ;
. ; all other categories
. ; pass trans amount(1;5),trans type(1;2),trans date(1;1)
. S DATA1=$G(^PRCA(433,RCTRANDA,1))
. ;
. ; PRCA*4.5*270 - pass CRD flag to FMS
. D EN^PRCAFBDM(RCBILLDA,$P(DATA1,"^",5),$P(DATA1,"^",2),$P(DATA1,"^",1),RCTRANDA,.ERR,$G(RCCRD))
;
; clear the lock and return the transaction added
L -^PRCA(433,RCTRANDA)
Q RCTRANDA
;
;
CLOSEIT(RCBILLDA) ; check to cancel or close bill with no balance
N AMTPAID,BILLBAL,DATA7,TRANDA
; if the bill has no balance, close or cancel it
S DATA7=$G(^PRCA(430,RCBILLDA,7))
S BILLBAL=$P(DATA7,"^")+$P(DATA7,"^",2)+$P(DATA7,"^",3)+$P(DATA7,"^",4)+$P(DATA7,"^",5)
I 'BILLBAL D
. ; get payments recorded against the bill. if payments have been
. ; made, then the status of the bill should be collected/closed.
. S AMTPAID=$P(DATA7,"^",7)+$P(DATA7,"^",8)+$P(DATA7,"^",9)+$P(DATA7,"^",10)+$P(DATA7,"^",11)
. I AMTPAID D CHGSTAT^RCBEUBIL(RCBILLDA,22) Q
. ; if the last transaction was a decrease contract adjustment,
. ; then the status will be collected/closed
. S TRANDA=+$O(^PRCA(433,"C",RCBILLDA,999999999999),-1)
. I $P($G(^PRCA(433,TRANDA,8)),"^",8) D CHGSTAT^RCBEUBIL(RCBILLDA,22) Q
. ; otherwise it should be cancellation
. D CHGSTAT^RCBEUBIL(RCBILLDA,39)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBEUTR1 8021 printed Sep 23, 2025@19:18:57 Page 2
RCBEUTR1 ;WISC/RFJ-add int,admin chg or increase,decrease principal ;1 Jun 00
+1 ;;4.5;Accounts Receivable;**153,169,192,226,270,276,301,315,377**;Mar 20, 1995;Build 45
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
INTADM(RCBILLDA,RCVALUE,RCCOMMNT,RCDATE) ; add an intererst/admin charge (transaction type=13)
+1 ; for a bill. rcvalue = interest ^ admin ^ penalty ^ marshal fee ^ court cost
+2 ; for the transaction. rcdate = process date (optional)
+3 ; returns transaction number if successful
+4 ;
+5 NEW RCDRSTRG,RCTRANDA,Y
+6 ; add the transaction (if added to 433, transaction is locked)
+7 SET RCTRANDA=$$ADD433^RCBEUTRA(RCBILLDA,13)
IF 'RCTRANDA
QUIT 0
+8 ;
+9 ; build dr string
+10 ; transaction date (strip off time)
+11 SET RCDRSTRG="11////"_$SELECT($GET(RCDATE):$PIECE(RCDATE,"."),1:DT)_";"
+12 ;
+13 ; transaction values
+14 SET RCDRSTRG=RCDRSTRG_"15////"_($PIECE(RCVALUE,"^")+$PIECE(RCVALUE,"^",2)+$PIECE(RCVALUE,"^",3)+$PIECE(RCVALUE,"^",4)+$PIECE(RCVALUE,"^",5))_";"
+15 ;marshal fee
IF $PIECE(RCVALUE,"^",4)
SET RCDRSTRG=RCDRSTRG_"25////"_$PIECE(RCVALUE,"^",4)_";"
+16 ;court cost
IF $PIECE(RCVALUE,"^",5)
SET RCDRSTRG=RCDRSTRG_"26////"_$PIECE(RCVALUE,"^",5)_";"
+17 ;interest
IF $PIECE(RCVALUE,"^",1)
SET RCDRSTRG=RCDRSTRG_"27////"_$PIECE(RCVALUE,"^",1)_";"
+18 ;admin
IF $PIECE(RCVALUE,"^",2)
SET RCDRSTRG=RCDRSTRG_"28////"_$PIECE(RCVALUE,"^",2)_";"
+19 ;penalty
IF $PIECE(RCVALUE,"^",3)
SET RCDRSTRG=RCDRSTRG_"29////"_$PIECE(RCVALUE,"^",3)_";"
+20 ;date entered
IF $GET(RCDATE)
SET RCDRSTRG=RCDRSTRG_"19////"_RCDATE_";"
+21 ;
+22 ; input the fields for the transaction
+23 SET Y=$$EDIT433^RCBEUTRA(RCTRANDA,RCDRSTRG)
IF 'Y
LOCK -^PRCA(433,RCTRANDA)
QUIT 0
+24 ;
+25 ; set the comment
+26 IF $DATA(RCCOMMNT(1))
DO ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
+27 ;
+28 ; move over 433 from 430 (no principal, just move it)
+29 DO FY433^RCBEUTRA(RCTRANDA)
+30 ;
+31 ; mark transaction as processed
+32 DO PROCESS^RCBEUTRA(RCTRANDA)
+33 ;
+34 ; update the bill file with the balance of the transaction
+35 DO SETBAL^RCBEUBIL(RCTRANDA)
+36 ;
+37 ;PRCA*4.5*377
+38 ; Update Repayment Plan if one is attached to the bill
+39 DO UPDBAL^RCRPU1(RCBILLDA,RCTRANDA)
+40 ;
+41 ; if the bill has no balance, close or cancel it
+42 DO CLOSEIT(RCBILLDA)
+43 ;
+44 ; clear the lock and return the transaction added
+45 LOCK -^PRCA(433,RCTRANDA)
+46 QUIT RCTRANDA
+47 ;
+48 ; PRCA*4.5*270 add CRD flag so FMS knows this is a corrected record
+49 ; INCDEC(RCBILLDA,RCVALUE,RCCOMMNT,RCDATE,RCPREPAY,RCONTADJ) ; automatically
INCDEC(RCBILLDA,RCVALUE,RCCOMMNT,RCDATE,RCPREPAY,RCONTADJ,RCCRD) ;
+1 ; automatically create an increase or decrease adjustment for a bill
+2 ; pass variables:
+3 ; rcvalue = principal value for the transaction.
+4 ; if rcvalue is less than zero, it will create a
+5 ; decrease adjustment. if rcvalue is greater than
+6 ; zero, it will create an increase adjustment.
+7 ; rccommnt = the comments for the word processing field.
+8 ; rcdate = optional processing date and time. if not
+9 ; passed, the current date and time will be used
+10 ; rcprepay = optional prepayment transaction. this is the
+11 ; payment transaction applied to the bill to
+12 ; create the decrease adjustment. this gets
+13 ; stored in field 20 (file 433).
+14 ; rcontadj = optional contract adjustment. if 1 then this
+15 ; gets stored in field 88 (file 433).
+16 ; rccrd = optional corrected flag. If 1, then FMS must 1st cancel or delete the
+17 ; original billing document before creating the new one.
+18 ;
+19 ; returns transaction number added to 433 if successful.
+20 ;
+21 NEW ADJNUMB,RCDRSTRG,RCTRANDA,X,Y,RCNEG,TRNTYP
+22 ;
+23 ; determine transaction type
+24 ;PRCA*4.5*315/DRF
IF RCVALUE>0
SET TRNTYP=1
IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
SET TRNTYP=73
+25 IF RCVALUE<0
SET TRNTYP=35
+26 ;
+27 ; add the transaction (if added to 433, transaction is locked)
+28 SET RCTRANDA=$$ADD433^RCBEUTRA(RCBILLDA,TRNTYP)
IF 'RCTRANDA
QUIT 0
+29 ;
+30 ; build dr string
+31 ; 11=transaction date (strip off time)
+32 SET RCDRSTRG="11////"_$SELECT($GET(RCDATE):$PIECE(RCDATE,"."),1:DT)_";"
+33 ; transaction value (make sure it is not negative)
+34 IF RCVALUE<0
SET RCVALUE=-RCVALUE
+35 SET RCDRSTRG=RCDRSTRG_"15////"_RCVALUE_";"
+36 SET RCDRSTRG=RCDRSTRG_"81////"_RCVALUE_";"
+37 ;PRCA*4.5*301
IF $GET(RCBETYPE)="DECREASE"
SET RCDRSTRG=RCDRSTRG_"31////"_RCVALUE_";"
+38 ;
+39 ; get the next adjustment number if increase(1) or decrease(35)
+40 ; start with the last transaction and work backwards
+41 SET X=999999999999
SET ADJNUMB=1
+42 FOR
SET X=$ORDER(^PRCA(433,"C",RCBILLDA,X),-1)
if 'X
QUIT
IF $PIECE($GET(^PRCA(433,X,1)),"^",4)
IF $PIECE(^(1),"^",2)=1!($PIECE(^(1),"^",2)=35)
SET ADJNUMB=$PIECE(^(1),"^",4)+1
QUIT
+43 SET RCDRSTRG=RCDRSTRG_"14////"_ADJNUMB_";"
+44 ;
+45 ; date entered
+46 IF $GET(RCDATE)
SET RCDRSTRG=RCDRSTRG_"19////"_RCDATE_";"
+47 ;
+48 ; store the prepayment transaction
+49 IF $GET(RCPREPAY)
Begin DoDot:1
+50 SET RCDRSTRG=RCDRSTRG_"20////"_RCPREPAY_";"
+51 ; for prepayments, set the incomplete transaction flag
+52 ; this will no longer be used after patch 146 and can
+53 ; be removed
+54 SET RCDRSTRG=RCDRSTRG_"10////1;"
End DoDot:1
+55 ;
+56 ; contract adjustment
+57 IF $GET(RCONTADJ)
SET RCDRSTRG=RCDRSTRG_"88///1;"
+58 ;
+59 ; input the fields for the transaction
+60 SET Y=$$EDIT433^RCBEUTRA(RCTRANDA,RCDRSTRG)
IF 'Y
LOCK -^PRCA(433,RCTRANDA)
QUIT 0
+61 ;
+62 ; set the comment
+63 IF $DATA(RCCOMMNT(1))
DO ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
+64 ;
+65 ; mark the transaction processed
+66 DO PROCESS^RCBEUTRA(RCTRANDA)
+67 ;
+68 ; update the fiscal year multiple (must be done after marked as
+69 ; processed so the value is defined)
+70 DO FYMULT^RCBEUTRA(RCTRANDA)
+71 ;
+72 ; update the bill file with the balance of the transaction
+73 ; PRCA276 - add exception condition - needs to quit receipt processing when negative claim balance could result
+74 SET RCNEG=0
DO SETBAL^RCBEUBIL(RCTRANDA,.RCNEG)
IF RCNEG
DO DEL433^RCBEUTRA(RCTRANDA,"CANCELLED WORKLIST DEC ADJ TO PREVENT NEG PRIN BAL",1)
LOCK -^PRCA(433,RCTRANDA)
QUIT "0^1"
+75 ;
+76 ; if the bill has no balance, close or cancel it
+77 DO CLOSEIT(RCBILLDA)
+78 ;
+79 ;PRCA*4.5*377 - add hook for repayment plan updates
+80 ; if the bill is in a repayment plan, update the plan with the increase or decrease
+81 DO UPDBAL^RCRPU1(RCBILLDA,RCTRANDA)
+82 ;
+83 ; send FMS document if non-accrued (redo this later on)
+84 IF '$$ACCK^PRCAACC(RCBILLDA)
Begin DoDot:1
+85 NEW D0,DA,DI,DIC,DIE,DIQ2,DQ,DR,ENT,FMSNUM,GECSDATA
+86 NEW CATEG,DATA1,ERR
+87 SET CATEG=$PIECE($GET(^PRCA(430,RCBILLDA,0)),"^",2)
+88 ;
+89 ; category=29 champva, do not send to fms, quit
+90 IF CATEG=29
QUIT
+91 ;
+92 ; category=30 tricare or 32 tricare third party, and contract adj
+93 IF (CATEG=30!(CATEG=32))
IF $PIECE($GET(^PRCA(433,RCTRANDA,8)),"^",8)
Begin DoDot:2
+94 SET DATA1=$GET(^PRCA(433,RCTRANDA,1))
+95 DO EN^PRCAFWO(RCBILLDA,$PIECE(DATA1,"^",1),$PIECE(DATA1,"^",5),$$SITE^RCMSITE,RCTRANDA)
End DoDot:2
QUIT
+96 ;
+97 ; all other categories
+98 ; pass trans amount(1;5),trans type(1;2),trans date(1;1)
+99 SET DATA1=$GET(^PRCA(433,RCTRANDA,1))
+100 ;
+101 ; PRCA*4.5*270 - pass CRD flag to FMS
+102 DO EN^PRCAFBDM(RCBILLDA,$PIECE(DATA1,"^",5),$PIECE(DATA1,"^",2),$PIECE(DATA1,"^",1),RCTRANDA,.ERR,$GET(RCCRD))
End DoDot:1
+103 ;
+104 ; clear the lock and return the transaction added
+105 LOCK -^PRCA(433,RCTRANDA)
+106 QUIT RCTRANDA
+107 ;
+108 ;
CLOSEIT(RCBILLDA) ; check to cancel or close bill with no balance
+1 NEW AMTPAID,BILLBAL,DATA7,TRANDA
+2 ; if the bill has no balance, close or cancel it
+3 SET DATA7=$GET(^PRCA(430,RCBILLDA,7))
+4 SET BILLBAL=$PIECE(DATA7,"^")+$PIECE(DATA7,"^",2)+$PIECE(DATA7,"^",3)+$PIECE(DATA7,"^",4)+$PIECE(DATA7,"^",5)
+5 IF 'BILLBAL
Begin DoDot:1
+6 ; get payments recorded against the bill. if payments have been
+7 ; made, then the status of the bill should be collected/closed.
+8 SET AMTPAID=$PIECE(DATA7,"^",7)+$PIECE(DATA7,"^",8)+$PIECE(DATA7,"^",9)+$PIECE(DATA7,"^",10)+$PIECE(DATA7,"^",11)
+9 IF AMTPAID
DO CHGSTAT^RCBEUBIL(RCBILLDA,22)
QUIT
+10 ; if the last transaction was a decrease contract adjustment,
+11 ; then the status will be collected/closed
+12 SET TRANDA=+$ORDER(^PRCA(433,"C",RCBILLDA,999999999999),-1)
+13 IF $PIECE($GET(^PRCA(433,TRANDA,8)),"^",8)
DO CHGSTAT^RCBEUBIL(RCBILLDA,22)
QUIT
+14 ; otherwise it should be cancellation
+15 DO CHGSTAT^RCBEUBIL(RCBILLDA,39)
End DoDot:1
+16 QUIT
