RCWROFF ;WISC/RFJ - write off, terminated ;1 Feb 2000
;;4.5;Accounts Receivable;**168,204,309,301,307,315,377,381,391,378,418**;Mar 20, 1995;Build 9
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;
8 ; terminated by fiscal officer (trantype=8) (menu option)
N RCDRSTRG
S RCDRSTRG="11TERMINATION DATE;"
S RCDRSTRG=RCDRSTRG_"17;" ;termination reason
D MAIN("8^Fiscal Officer Termination",RCDRSTRG)
Q
;
;
9 ; terminated by compromise (trantype=9) (menu option)
N RCDRSTRG
S RCDRSTRG="11TERMINATION DATE;"
S RCDRSTRG=RCDRSTRG_"17;" ;termination reason
D MAIN("9^Compromise Termination",RCDRSTRG)
Q
;
;
A9 ; compromised by rc/doj (use trantype=9) (menu option)
N RCDRSTRG
S RCDRSTRG="11TERMINATION DATE;"
S RCDRSTRG=RCDRSTRG_"17;" ;termination reason
D MAIN("9^Compromise Termination by RC/DOJ",RCDRSTRG)
Q
;
;
10 ; waived in full transaction (trantype=10) (menu option)
D MAIN("10^Waiver","11WAIVED DATE;")
Q
;
;
A10 ; waived by rc/doj (use trantype=10) (menu option)
D MAIN("10^RC/DOJ Waiver","11WAIVED DATE;")
Q
;
;
29 ; terminated by rc/doj (trantype=29) (menu option)
N RCDRSTRG
S RCDRSTRG="11TERMINATION DATE;"
S RCDRSTRG=RCDRSTRG_"17;" ;termination reason
D MAIN("29^RC/DOJ Termination",RCDRSTRG)
Q
;
;
47 ; suspended (trantype=47) (menu option)
N RCDRSTRG
S RCDRSTRG="11SUSPENDED DATE;"
S RCDRSTRG=RCDRSTRG_"90.1R;" ;suspension type PRCA*4.5*391
S RCDRSTRG=RCDRSTRG_"S RCX=$$SUSTP^RCWROFF(X);"
S RCDRSTRG=RCDRSTRG_"5.02////^S X=RCX;" ;brief comment
S RCDRSTRG=RCDRSTRG_"K RCX;"
D MAIN("47^Suspension",RCDRSTRG)
Q
;
SUSTP(X) ; suspension types for brief comment in *309
; input-code between 0 to 14
; output-text
N IBX
S IBX=$P($T(SUSTX+X),";;",2)
Q IBX
;
; PRCA*4.5*391 - moved everything in tag SUSTX 1 line down to accomodate for switch of suspension type to a dictionary file 433.001
SUSTX ;
;;NOT CO-PAY SUSPENSION
;;INITIAL CO-PAY WAIVER
;;APPEAL CO-PAY WAIVER
;;ADMINISTRATIVE SUSPENSION
;;COMPROMISE
;;TERMINATION
;;BANKRUPTCY CHAP 7
;;BANKRUPTCY CHAP 13
;;BANKRUPTCY OTHER
;;PROBATE
;;CHOICE
;;DISPUTE
;;INDIAN ATTESTATION
;;COMPACT
;;CLELAND-DOLE
;
;
MAIN(RCTRTYPE,RCDRSTRG) ; main subroutine to process a waiver, termination, suspended transaction
; rctrtype = transaction type^description, example 10^waiver
; rcdrstrg = dr string used when calling die
I '$G(GOTBILL) N RCBILLDA ;PRCA*4.5*315 Pass in RCBILLDA
N BALANCE,DR,RCTRANDA,Y,RCSPFLG
F D Q:RCBILLDA<1!($G(GOTBILL))
. K RCTRANDA ;do not leave around in for loop
. ; select a bill
. I '$G(GOTBILL) S RCBILLDA=$$GETABILL^RCBEUBIL I RCBILLDA<1 Q ;PRCA*4.5*315
. I $D(^PRCA(430,"TCSP",RCBILLDA)) W !,"BILL HAS BEEN REFERRED TO CROSS-SERVICING.",!,"NO TRANSACTIONS ARE ALLOWED." D Q ;prca*4.5*301
. . I +RCTRTYPE=10!(+RCTRTYPE=47)!(+RCTRTYPE=9)!(+RCTRTYPE=8) W !,"** THE RECALL PROCESS MUST BE UTILIZED PRIOR TO PERFORMING THIS FUNCTION **" ;prca*4.5*301
. ; check to see if bill has been referred to rc/doj (6;4 = referral date)
. I $P(RCTRTYPE,"^",2)["RC/DOJ",$P($G(^PRCA(430,RCBILLDA,6)),"^",4)="" W !,"THIS ACCOUNT IS NOT REFERRED TO RC/DOJ." Q
. ; lock the bill
. L +^PRCA(430,RCBILLDA):5 I '$T W !,"ANOTHER USER IS CURRENTLY WORKING WITH THIS BILL." Q
. D SHOWBILL^RCWROFF1(RCBILLDA)
. I '$G(^PRCA(430,RCBILLDA,7)) W !,"THIS BILL HAS NO PRINCIPAL BALANCE." D UNLOCK Q
. ; ask to enter transaction
. S Y=$$ASKOK($P(RCTRTYPE,"^",2)) ; prca*4.5*315 changes
. I Y'=1 D Q ; user said No, or no response, or ^/timeout
. . D UNLOCK ; unlock bill and transaction
. . I Y<0,'$G(GOTBILL) S RCBILLDA=0 ; ^ or timeout, get out of this loop
. . I Y<0,$G(GOTBILL) S RCDPGQ=1 ; ^ or timeout, set special variable - see RCDPAPL1
. . Q
. ;
. ; add a new transaction to file 433
. S RCTRANDA=$$ADD433^RCBEUTRA(RCBILLDA,$P(RCTRTYPE,"^")) I 'RCTRANDA W !,$P(RCTRANDA,"^",2) D UNLOCK Q
. W !," Transaction number ",RCTRANDA," added ..."
. ;
. ; set up dr string for die call PRCA*4.5*307 - Move comment below balance sets
. S DR=RCDRSTRG ;_"41;" ;comment
. ; bill amount moved to transaction amount
. S BALANCE=$P($G(^PRCA(430,RCBILLDA,7)),"^",1,5)
. S DR=DR_"15////"_($P(BALANCE,"^")+$P(BALANCE,"^",2)+$P(BALANCE,"^",3)+$P(BALANCE,"^",4)+$P(BALANCE,"^",5))_";"
. I $P(BALANCE,"^",1) S DR=DR_"81////"_+$P(BALANCE,"^",1)_";" ;principal
. I $P(BALANCE,"^",2) S DR=DR_"82////"_+$P(BALANCE,"^",2)_";" ;interest
. I $P(BALANCE,"^",3) S DR=DR_"83////"_+$P(BALANCE,"^",3)_";" ;admin
. I $P(BALANCE,"^",4) S DR=DR_"84////"_+$P(BALANCE,"^",4)_";" ;marshal fee
. I $P(BALANCE,"^",5) S DR=DR_"85////"_+$P(BALANCE,"^",5)_";" ;court cost
. ;
. ; PRCA*4.5*307 - Comment save is moved below balance sets
. S DR=DR_"41;"
. ; edit the fields
. S Y=$$EDIT433^RCBEUTRA(RCTRANDA,DR)
. I 'Y W !,$P(Y,"^",2) D DEL433^RCBEUTRA(RCTRANDA,"",0),UNLOCK Q
. ; set the bill and transaction as RC/DOJ
. I $P(RCTRTYPE,"^",2)["RC/DOJ" D SETRCDOJ^RCBEUBIL(RCBILLDA,RCTRANDA,"RC")
. ; change the status of the bill
. I $P(RCTRTYPE,"^")'=47 D CHGSTAT^RCBEUBIL(RCBILLDA,23) ;write off
. I $P(RCTRTYPE,"^")=47 D CHGSTAT^RCBEUBIL(RCBILLDA,40) ;suspended
. ; mark transaction as processed
. D PROCESS^RCBEUTRA(RCTRANDA)
. ;
. ;PRCA*4.5*377
. S RCSPFLG=2
. S:+RCTRTYPE=47 RCSPFLG=1
. ; Update any active repayment plan the bill may be attached to
. D UPDBAL^RCRPU1(RCBILLDA,RCTRANDA,RCSPFLG) ;PRCA*4.5*381 - Add suspend flag.
. ;
. ; create fms write off document, if not accrued and not suspended (47) transaction
. I '$$ACCK^PRCAACC(RCBILLDA),$P($G(^PRCA(433,RCTRANDA,1)),"^",2)'=47 D FMSDOC(RCTRANDA)
. ;
. W !," * * * * * ",$P(RCTRTYPE,"^",2)," has been PROCESSED! * * * * *"
. I '$G(REFMS)&(DT>$$LDATE^RCRJR(DT)) S Y=$E($$FPS^RCAMFN01(DT,1),1,5)_"01" D DD^%DT W !!," * * * * Transmission will be held until "_Y_" * * * *"
. D UNLOCK
Q
;
;
FMSDOC(RCTRANDA) ; create fms write off document
N Y
W !!,"Creating FMS Write-off document ... "
S Y=$$BUILDWR^RCXFMSW1(RCTRANDA)
I Y W $P(Y,"^",2)," created."
E W "ERROR: ",$P(Y,"^",2)
Q
;
;
UNLOCK ; unlock bill and transaction
L -^PRCA(430,RCBILLDA)
I $G(RCTRANDA) L -^PRCA(433,RCTRANDA)
Q
;
;
ASKOK(TRANTYPE) ; ask record transaction
N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="YO",DIR("B")="NO"
S DIR("A")=" Are you sure you want to record this bill as a "
I $L(TRANTYPE)<20 S DIR("A")=DIR("A")_TRANTYPE
E S DIR("A",1)=DIR("A"),DIR("A")=" "_TRANTYPE
W ! D ^DIR
I $G(DTOUT)!($G(DUOUT)) S Y=-1
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCWROFF 6885 printed Apr 09, 2024@20:47:03 Page 2
RCWROFF ;WISC/RFJ - write off, terminated ;1 Feb 2000
+1 ;;4.5;Accounts Receivable;**168,204,309,301,307,315,377,381,391,378,418**;Mar 20, 1995;Build 9
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
8 ; terminated by fiscal officer (trantype=8) (menu option)
+1 NEW RCDRSTRG
+2 SET RCDRSTRG="11TERMINATION DATE;"
+3 ;termination reason
SET RCDRSTRG=RCDRSTRG_"17;"
+4 DO MAIN("8^Fiscal Officer Termination",RCDRSTRG)
+5 QUIT
+6 ;
+7 ;
9 ; terminated by compromise (trantype=9) (menu option)
+1 NEW RCDRSTRG
+2 SET RCDRSTRG="11TERMINATION DATE;"
+3 ;termination reason
SET RCDRSTRG=RCDRSTRG_"17;"
+4 DO MAIN("9^Compromise Termination",RCDRSTRG)
+5 QUIT
+6 ;
+7 ;
A9 ; compromised by rc/doj (use trantype=9) (menu option)
+1 NEW RCDRSTRG
+2 SET RCDRSTRG="11TERMINATION DATE;"
+3 ;termination reason
SET RCDRSTRG=RCDRSTRG_"17;"
+4 DO MAIN("9^Compromise Termination by RC/DOJ",RCDRSTRG)
+5 QUIT
+6 ;
+7 ;
10 ; waived in full transaction (trantype=10) (menu option)
+1 DO MAIN("10^Waiver","11WAIVED DATE;")
+2 QUIT
+3 ;
+4 ;
A10 ; waived by rc/doj (use trantype=10) (menu option)
+1 DO MAIN("10^RC/DOJ Waiver","11WAIVED DATE;")
+2 QUIT
+3 ;
+4 ;
29 ; terminated by rc/doj (trantype=29) (menu option)
+1 NEW RCDRSTRG
+2 SET RCDRSTRG="11TERMINATION DATE;"
+3 ;termination reason
SET RCDRSTRG=RCDRSTRG_"17;"
+4 DO MAIN("29^RC/DOJ Termination",RCDRSTRG)
+5 QUIT
+6 ;
+7 ;
47 ; suspended (trantype=47) (menu option)
+1 NEW RCDRSTRG
+2 SET RCDRSTRG="11SUSPENDED DATE;"
+3 ;suspension type PRCA*4.5*391
SET RCDRSTRG=RCDRSTRG_"90.1R;"
+4 SET RCDRSTRG=RCDRSTRG_"S RCX=$$SUSTP^RCWROFF(X);"
+5 ;brief comment
SET RCDRSTRG=RCDRSTRG_"5.02////^S X=RCX;"
+6 SET RCDRSTRG=RCDRSTRG_"K RCX;"
+7 DO MAIN("47^Suspension",RCDRSTRG)
+8 QUIT
+9 ;
SUSTP(X) ; suspension types for brief comment in *309
+1 ; input-code between 0 to 14
+2 ; output-text
+3 NEW IBX
+4 SET IBX=$PIECE($TEXT(SUSTX+X),";;",2)
+5 QUIT IBX
+6 ;
+7 ; PRCA*4.5*391 - moved everything in tag SUSTX 1 line down to accomodate for switch of suspension type to a dictionary file 433.001
SUSTX ;
+1 ;;NOT CO-PAY SUSPENSION
+2 ;;INITIAL CO-PAY WAIVER
+3 ;;APPEAL CO-PAY WAIVER
+4 ;;ADMINISTRATIVE SUSPENSION
+5 ;;COMPROMISE
+6 ;;TERMINATION
+7 ;;BANKRUPTCY CHAP 7
+8 ;;BANKRUPTCY CHAP 13
+9 ;;BANKRUPTCY OTHER
+10 ;;PROBATE
+11 ;;CHOICE
+12 ;;DISPUTE
+13 ;;INDIAN ATTESTATION
+14 ;;COMPACT
+15 ;;CLELAND-DOLE
+16 ;
+17 ;
MAIN(RCTRTYPE,RCDRSTRG) ; main subroutine to process a waiver, termination, suspended transaction
+1 ; rctrtype = transaction type^description, example 10^waiver
+2 ; rcdrstrg = dr string used when calling die
+3 ;PRCA*4.5*315 Pass in RCBILLDA
IF '$GET(GOTBILL)
NEW RCBILLDA
+4 NEW BALANCE,DR,RCTRANDA,Y,RCSPFLG
+5 FOR
Begin DoDot:1
+6 ;do not leave around in for loop
KILL RCTRANDA
+7 ; select a bill
+8 ;PRCA*4.5*315
IF '$GET(GOTBILL)
SET RCBILLDA=$$GETABILL^RCBEUBIL
IF RCBILLDA<1
QUIT
+9 ;prca*4.5*301
IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
WRITE !,"BILL HAS BEEN REFERRED TO CROSS-SERVICING.",!,"NO TRANSACTIONS ARE ALLOWED."
Begin DoDot:2
+10 ;prca*4.5*301
IF +RCTRTYPE=10!(+RCTRTYPE=47)!(+RCTRTYPE=9)!(+RCTRTYPE=8)
WRITE !,"** THE RECALL PROCESS MUST BE UTILIZED PRIOR TO PERFORMING THIS FUNCTION **"
End DoDot:2
QUIT
+11 ; check to see if bill has been referred to rc/doj (6;4 = referral date)
+12 IF $PIECE(RCTRTYPE,"^",2)["RC/DOJ"
IF $PIECE($GET(^PRCA(430,RCBILLDA,6)),"^",4)=""
WRITE !,"THIS ACCOUNT IS NOT REFERRED TO RC/DOJ."
QUIT
+13 ; lock the bill
+14 LOCK +^PRCA(430,RCBILLDA):5
IF '$TEST
WRITE !,"ANOTHER USER IS CURRENTLY WORKING WITH THIS BILL."
QUIT
+15 DO SHOWBILL^RCWROFF1(RCBILLDA)
+16 IF '$GET(^PRCA(430,RCBILLDA,7))
WRITE !,"THIS BILL HAS NO PRINCIPAL BALANCE."
DO UNLOCK
QUIT
+17 ; ask to enter transaction
+18 ; prca*4.5*315 changes
SET Y=$$ASKOK($PIECE(RCTRTYPE,"^",2))
+19 ; user said No, or no response, or ^/timeout
IF Y'=1
Begin DoDot:2
+20 ; unlock bill and transaction
DO UNLOCK
+21 ; ^ or timeout, get out of this loop
IF Y<0
IF '$GET(GOTBILL)
SET RCBILLDA=0
+22 ; ^ or timeout, set special variable - see RCDPAPL1
IF Y<0
IF $GET(GOTBILL)
SET RCDPGQ=1
+23 QUIT
End DoDot:2
QUIT
+24 ;
+25 ; add a new transaction to file 433
+26 SET RCTRANDA=$$ADD433^RCBEUTRA(RCBILLDA,$PIECE(RCTRTYPE,"^"))
IF 'RCTRANDA
WRITE !,$PIECE(RCTRANDA,"^",2)
DO UNLOCK
QUIT
+27 WRITE !," Transaction number ",RCTRANDA," added ..."
+28 ;
+29 ; set up dr string for die call PRCA*4.5*307 - Move comment below balance sets
+30 ;_"41;" ;comment
SET DR=RCDRSTRG
+31 ; bill amount moved to transaction amount
+32 SET BALANCE=$PIECE($GET(^PRCA(430,RCBILLDA,7)),"^",1,5)
+33 SET DR=DR_"15////"_($PIECE(BALANCE,"^")+$PIECE(BALANCE,"^",2)+$PIECE(BALANCE,"^",3)+$PIECE(BALANCE,"^",4)+$PIECE(BALANCE,"^",5))_";"
+34 ;principal
IF $PIECE(BALANCE,"^",1)
SET DR=DR_"81////"_+$PIECE(BALANCE,"^",1)_";"
+35 ;interest
IF $PIECE(BALANCE,"^",2)
SET DR=DR_"82////"_+$PIECE(BALANCE,"^",2)_";"
+36 ;admin
IF $PIECE(BALANCE,"^",3)
SET DR=DR_"83////"_+$PIECE(BALANCE,"^",3)_";"
+37 ;marshal fee
IF $PIECE(BALANCE,"^",4)
SET DR=DR_"84////"_+$PIECE(BALANCE,"^",4)_";"
+38 ;court cost
IF $PIECE(BALANCE,"^",5)
SET DR=DR_"85////"_+$PIECE(BALANCE,"^",5)_";"
+39 ;
+40 ; PRCA*4.5*307 - Comment save is moved below balance sets
+41 SET DR=DR_"41;"
+42 ; edit the fields
+43 SET Y=$$EDIT433^RCBEUTRA(RCTRANDA,DR)
+44 IF 'Y
WRITE !,$PIECE(Y,"^",2)
DO DEL433^RCBEUTRA(RCTRANDA,"",0)
DO UNLOCK
QUIT
+45 ; set the bill and transaction as RC/DOJ
+46 IF $PIECE(RCTRTYPE,"^",2)["RC/DOJ"
DO SETRCDOJ^RCBEUBIL(RCBILLDA,RCTRANDA,"RC")
+47 ; change the status of the bill
+48 ;write off
IF $PIECE(RCTRTYPE,"^")'=47
DO CHGSTAT^RCBEUBIL(RCBILLDA,23)
+49 ;suspended
IF $PIECE(RCTRTYPE,"^")=47
DO CHGSTAT^RCBEUBIL(RCBILLDA,40)
+50 ; mark transaction as processed
+51 DO PROCESS^RCBEUTRA(RCTRANDA)
+52 ;
+53 ;PRCA*4.5*377
+54 SET RCSPFLG=2
+55 if +RCTRTYPE=47
SET RCSPFLG=1
+56 ; Update any active repayment plan the bill may be attached to
+57 ;PRCA*4.5*381 - Add suspend flag.
DO UPDBAL^RCRPU1(RCBILLDA,RCTRANDA,RCSPFLG)
+58 ;
+59 ; create fms write off document, if not accrued and not suspended (47) transaction
+60 IF '$$ACCK^PRCAACC(RCBILLDA)
IF $PIECE($GET(^PRCA(433,RCTRANDA,1)),"^",2)'=47
DO FMSDOC(RCTRANDA)
+61 ;
+62 WRITE !," * * * * * ",$PIECE(RCTRTYPE,"^",2)," has been PROCESSED! * * * * *"
+63 IF '$GET(REFMS)&(DT>$$LDATE^RCRJR(DT))
SET Y=$EXTRACT($$FPS^RCAMFN01(DT,1),1,5)_"01"
DO DD^%DT
WRITE !!," * * * * Transmission will be held until "_Y_" * * * *"
+64 DO UNLOCK
End DoDot:1
if RCBILLDA<1!($GET(GOTBILL))
QUIT
+65 QUIT
+66 ;
+67 ;
FMSDOC(RCTRANDA) ; create fms write off document
+1 NEW Y
+2 WRITE !!,"Creating FMS Write-off document ... "
+3 SET Y=$$BUILDWR^RCXFMSW1(RCTRANDA)
+4 IF Y
WRITE $PIECE(Y,"^",2)," created."
+5 IF '$TEST
WRITE "ERROR: ",$PIECE(Y,"^",2)
+6 QUIT
+7 ;
+8 ;
UNLOCK ; unlock bill and transaction
+1 LOCK -^PRCA(430,RCBILLDA)
+2 IF $GET(RCTRANDA)
LOCK -^PRCA(433,RCTRANDA)
+3 QUIT
+4 ;
+5 ;
ASKOK(TRANTYPE) ; ask record transaction
+1 NEW DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="YO"
SET DIR("B")="NO"
+3 SET DIR("A")=" Are you sure you want to record this bill as a "
+4 IF $LENGTH(TRANTYPE)<20
SET DIR("A")=DIR("A")_TRANTYPE
+5 IF '$TEST
SET DIR("A",1)=DIR("A")
SET DIR("A")=" "_TRANTYPE
+6 WRITE !
DO ^DIR
+7 IF $GET(DTOUT)!($GET(DUOUT))
SET Y=-1
+8 QUIT Y
