Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCWROFF

RCWROFF.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. 8 ; terminated by fiscal officer (trantype=8) (menu option)
  1. N RCDRSTRG
  1. S RCDRSTRG="11TERMINATION DATE;"
  1. S RCDRSTRG=RCDRSTRG_"17;" ;termination reason
  1. D MAIN("8^Fiscal Officer Termination",RCDRSTRG)
  1. Q
  1. ;
  1. ;
  1. 9 ; terminated by compromise (trantype=9) (menu option)
  1. N RCDRSTRG
  1. S RCDRSTRG="11TERMINATION DATE;"
  1. S RCDRSTRG=RCDRSTRG_"17;" ;termination reason
  1. D MAIN("9^Compromise Termination",RCDRSTRG)
  1. Q
  1. ;
  1. ;
  1. A9 ; compromised by rc/doj (use trantype=9) (menu option)
  1. N RCDRSTRG
  1. S RCDRSTRG="11TERMINATION DATE;"
  1. S RCDRSTRG=RCDRSTRG_"17;" ;termination reason
  1. D MAIN("9^Compromise Termination by RC/DOJ",RCDRSTRG)
  1. Q
  1. ;
  1. ;
  1. 10 ; waived in full transaction (trantype=10) (menu option)
  1. D MAIN("10^Waiver","11WAIVED DATE;")
  1. Q
  1. ;
  1. ;
  1. A10 ; waived by rc/doj (use trantype=10) (menu option)
  1. D MAIN("10^RC/DOJ Waiver","11WAIVED DATE;")
  1. Q
  1. ;
  1. ;
  1. 29 ; terminated by rc/doj (trantype=29) (menu option)
  1. N RCDRSTRG
  1. S RCDRSTRG="11TERMINATION DATE;"
  1. S RCDRSTRG=RCDRSTRG_"17;" ;termination reason
  1. D MAIN("29^RC/DOJ Termination",RCDRSTRG)
  1. Q
  1. ;
  1. ;
  1. 47 ; suspended (trantype=47) (menu option)
  1. N RCDRSTRG
  1. S RCDRSTRG="11SUSPENDED DATE;"
  1. S RCDRSTRG=RCDRSTRG_"90.1R;" ;suspension type PRCA*4.5*391
  1. S RCDRSTRG=RCDRSTRG_"S RCX=$$SUSTP^RCWROFF(X);"
  1. S RCDRSTRG=RCDRSTRG_"5.02////^S X=RCX;" ;brief comment
  1. S RCDRSTRG=RCDRSTRG_"K RCX;"
  1. D MAIN("47^Suspension",RCDRSTRG)
  1. Q
  1. ;
  1. SUSTP(X) ; suspension types for brief comment in *309
  1. ; input-code between 0 to 14
  1. ; output-text
  1. N IBX
  1. S IBX=$P($T(SUSTX+X),";;",2)
  1. Q IBX
  1. ;
  1. ; 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
  1. SUSTX ;
  1. ;;NOT CO-PAY SUSPENSION
  1. ;;INITIAL CO-PAY WAIVER
  1. ;;APPEAL CO-PAY WAIVER
  1. ;;ADMINISTRATIVE SUSPENSION
  1. ;;COMPROMISE
  1. ;;TERMINATION
  1. ;;BANKRUPTCY CHAP 7
  1. ;;BANKRUPTCY CHAP 13
  1. ;;BANKRUPTCY OTHER
  1. ;;PROBATE
  1. ;;CHOICE
  1. ;;DISPUTE
  1. ;;INDIAN ATTESTATION
  1. ;;COMPACT
  1. ;;CLELAND-DOLE
  1. ;
  1. ;
  1. MAIN(RCTRTYPE,RCDRSTRG) ; main subroutine to process a waiver, termination, suspended transaction
  1. ; rctrtype = transaction type^description, example 10^waiver
  1. ; rcdrstrg = dr string used when calling die
  1. I '$G(GOTBILL) N RCBILLDA ;PRCA*4.5*315 Pass in RCBILLDA
  1. N BALANCE,DR,RCTRANDA,Y,RCSPFLG
  1. F D Q:RCBILLDA<1!($G(GOTBILL))
  1. . K RCTRANDA ;do not leave around in for loop
  1. . ; select a bill
  1. . I '$G(GOTBILL) S RCBILLDA=$$GETABILL^RCBEUBIL I RCBILLDA<1 Q ;PRCA*4.5*315
  1. . I $D(^PRCA(430,"TCSP",RCBILLDA)) W !,"BILL HAS BEEN REFERRED TO CROSS-SERVICING.",!,"NO TRANSACTIONS ARE ALLOWED." D Q ;prca*4.5*301
  1. . . 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
  1. . ; check to see if bill has been referred to rc/doj (6;4 = referral date)
  1. . I $P(RCTRTYPE,"^",2)["RC/DOJ",$P($G(^PRCA(430,RCBILLDA,6)),"^",4)="" W !,"THIS ACCOUNT IS NOT REFERRED TO RC/DOJ." Q
  1. . ; lock the bill
  1. . L +^PRCA(430,RCBILLDA):5 I '$T W !,"ANOTHER USER IS CURRENTLY WORKING WITH THIS BILL." Q
  1. . D SHOWBILL^RCWROFF1(RCBILLDA)
  1. . I '$G(^PRCA(430,RCBILLDA,7)) W !,"THIS BILL HAS NO PRINCIPAL BALANCE." D UNLOCK Q
  1. . ; ask to enter transaction
  1. . S Y=$$ASKOK($P(RCTRTYPE,"^",2)) ; prca*4.5*315 changes
  1. . I Y'=1 D Q ; user said No, or no response, or ^/timeout
  1. . . D UNLOCK ; unlock bill and transaction
  1. . . I Y<0,'$G(GOTBILL) S RCBILLDA=0 ; ^ or timeout, get out of this loop
  1. . . I Y<0,$G(GOTBILL) S RCDPGQ=1 ; ^ or timeout, set special variable - see RCDPAPL1
  1. . . Q
  1. . ;
  1. . ; add a new transaction to file 433
  1. . S RCTRANDA=$$ADD433^RCBEUTRA(RCBILLDA,$P(RCTRTYPE,"^")) I 'RCTRANDA W !,$P(RCTRANDA,"^",2) D UNLOCK Q
  1. . W !," Transaction number ",RCTRANDA," added ..."
  1. . ;
  1. . ; set up dr string for die call PRCA*4.5*307 - Move comment below balance sets
  1. . S DR=RCDRSTRG ;_"41;" ;comment
  1. . ; bill amount moved to transaction amount
  1. . S BALANCE=$P($G(^PRCA(430,RCBILLDA,7)),"^",1,5)
  1. . S DR=DR_"15////"_($P(BALANCE,"^")+$P(BALANCE,"^",2)+$P(BALANCE,"^",3)+$P(BALANCE,"^",4)+$P(BALANCE,"^",5))_";"
  1. . I $P(BALANCE,"^",1) S DR=DR_"81////"_+$P(BALANCE,"^",1)_";" ;principal
  1. . I $P(BALANCE,"^",2) S DR=DR_"82////"_+$P(BALANCE,"^",2)_";" ;interest
  1. . I $P(BALANCE,"^",3) S DR=DR_"83////"_+$P(BALANCE,"^",3)_";" ;admin
  1. . I $P(BALANCE,"^",4) S DR=DR_"84////"_+$P(BALANCE,"^",4)_";" ;marshal fee
  1. . I $P(BALANCE,"^",5) S DR=DR_"85////"_+$P(BALANCE,"^",5)_";" ;court cost
  1. . ;
  1. . ; PRCA*4.5*307 - Comment save is moved below balance sets
  1. . S DR=DR_"41;"
  1. . ; edit the fields
  1. . S Y=$$EDIT433^RCBEUTRA(RCTRANDA,DR)
  1. . I 'Y W !,$P(Y,"^",2) D DEL433^RCBEUTRA(RCTRANDA,"",0),UNLOCK Q
  1. . ; set the bill and transaction as RC/DOJ
  1. . I $P(RCTRTYPE,"^",2)["RC/DOJ" D SETRCDOJ^RCBEUBIL(RCBILLDA,RCTRANDA,"RC")
  1. . ; change the status of the bill
  1. . I $P(RCTRTYPE,"^")'=47 D CHGSTAT^RCBEUBIL(RCBILLDA,23) ;write off
  1. . I $P(RCTRTYPE,"^")=47 D CHGSTAT^RCBEUBIL(RCBILLDA,40) ;suspended
  1. . ; mark transaction as processed
  1. . D PROCESS^RCBEUTRA(RCTRANDA)
  1. . ;
  1. . ;PRCA*4.5*377
  1. . S RCSPFLG=2
  1. . S:+RCTRTYPE=47 RCSPFLG=1
  1. . ; Update any active repayment plan the bill may be attached to
  1. . D UPDBAL^RCRPU1(RCBILLDA,RCTRANDA,RCSPFLG) ;PRCA*4.5*381 - Add suspend flag.
  1. . ;
  1. . ; create fms write off document, if not accrued and not suspended (47) transaction
  1. . I '$$ACCK^PRCAACC(RCBILLDA),$P($G(^PRCA(433,RCTRANDA,1)),"^",2)'=47 D FMSDOC(RCTRANDA)
  1. . ;
  1. . W !," * * * * * ",$P(RCTRTYPE,"^",2)," has been PROCESSED! * * * * *"
  1. . 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_" * * * *"
  1. . D UNLOCK
  1. Q
  1. ;
  1. ;
  1. FMSDOC(RCTRANDA) ; create fms write off document
  1. N Y
  1. W !!,"Creating FMS Write-off document ... "
  1. S Y=$$BUILDWR^RCXFMSW1(RCTRANDA)
  1. I Y W $P(Y,"^",2)," created."
  1. E W "ERROR: ",$P(Y,"^",2)
  1. Q
  1. ;
  1. ;
  1. UNLOCK ; unlock bill and transaction
  1. L -^PRCA(430,RCBILLDA)
  1. I $G(RCTRANDA) L -^PRCA(433,RCTRANDA)
  1. Q
  1. ;
  1. ;
  1. ASKOK(TRANTYPE) ; ask record transaction
  1. N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="YO",DIR("B")="NO"
  1. S DIR("A")=" Are you sure you want to record this bill as a "
  1. I $L(TRANTYPE)<20 S DIR("A")=DIR("A")_TRANTYPE
  1. E S DIR("A",1)=DIR("A"),DIR("A")=" "_TRANTYPE
  1. W ! D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1. Q Y