- 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 Jan 18, 2025@02:50:26 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