source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCWROFF.m@ 703

Last change on this file since 703 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.9 KB
Line 
1RCWROFF ;WISC/RFJ-write off, terminated ;1 Feb 2000
2 ;;4.5;Accounts Receivable;**168,204**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
78 ; terminated by fiscal officer (trantype=8) (menu option)
8 N RCDRSTRG
9 S RCDRSTRG="11TERMINATION DATE;"
10 S RCDRSTRG=RCDRSTRG_"17;" ;termination reason
11 D MAIN("8^Fiscal Officer Termination",RCDRSTRG)
12 Q
13 ;
14 ;
159 ; terminated by compromise (trantype=9) (menu option)
16 N RCDRSTRG
17 S RCDRSTRG="11TERMINATION DATE;"
18 S RCDRSTRG=RCDRSTRG_"17;" ;termination reason
19 D MAIN("9^Compromise Termination",RCDRSTRG)
20 Q
21 ;
22 ;
23A9 ; compromised by rc/doj (use trantype=9) (menu option)
24 N RCDRSTRG
25 S RCDRSTRG="11TERMINATION DATE;"
26 S RCDRSTRG=RCDRSTRG_"17;" ;termination reason
27 D MAIN("9^Compromise Termination by RC/DOJ",RCDRSTRG)
28 Q
29 ;
30 ;
3110 ; waived in full transaction (trantype=10) (menu option)
32 D MAIN("10^Waiver","11WAIVED DATE;")
33 Q
34 ;
35 ;
36A10 ; waived by rc/doj (use trantype=10) (menu option)
37 D MAIN("10^RC/DOJ Waiver","11WAIVED DATE;")
38 Q
39 ;
40 ;
4129 ; terminated by rc/doj (trantype=29) (menu option)
42 N RCDRSTRG
43 S RCDRSTRG="11TERMINATION DATE;"
44 S RCDRSTRG=RCDRSTRG_"17;" ;termination reason
45 D MAIN("29^RC/DOJ Termination",RCDRSTRG)
46 Q
47 ;
48 ;
4947 ; suspended (trantype=47) (menu option)
50 N RCDRSTRG
51 S RCDRSTRG="11SUSPENDED DATE;"
52 S RCDRSTRG=RCDRSTRG_"90R;" ;suspension type
53 S RCDRSTRG=RCDRSTRG_"S RCX=$S('X:""NOT CO-PAY SUSPENSION"",X=1:""INITIAL CO-PAY WAIVER"",1:""APPEAL CO-PAY WAIVER"");"
54 S RCDRSTRG=RCDRSTRG_"5.02////^S X=RCX;" ;brief comment
55 S RCDRSTRG=RCDRSTRG_"K RCX;"
56 D MAIN("47^Suspension",RCDRSTRG)
57 Q
58 ;
59 ;
60MAIN(RCTRTYPE,RCDRSTRG) ; main subroutine to process a waiver, termination, suspended transaction
61 ; rctrtype = transaction type^description, example 10^waiver
62 ; rcdrstrg = dr string used when calling die
63 N BALANCE,DR,RCBILLDA,RCTRANDA,Y
64 F D Q:RCBILLDA<1
65 . K RCTRANDA ;do not leave around in for loop
66 . ; select a bill
67 . S RCBILLDA=$$GETABILL^RCBEUBIL I RCBILLDA<1 Q
68 . ; check to see if bill has been referred to rc/doj (6;4 = referral date)
69 . I $P(RCTRTYPE,"^",2)["RC/DOJ",$P($G(^PRCA(430,RCBILLDA,6)),"^",4)="" W !,"THIS ACCOUNT IS NOT REFERRED TO RC/DOJ." Q
70 . ; lock the bill
71 . L +^PRCA(430,RCBILLDA):5 I '$T W !,"ANOTHER USER IS CURRENTLY WORKING WITH THIS BILL." Q
72 . D SHOWBILL^RCWROFF1(RCBILLDA)
73 . I '$G(^PRCA(430,RCBILLDA,7)) W !,"THIS BILL HAS NO PRINCIPAL BALANCE." D UNLOCK Q
74 . ; ask to enter transaction
75 . S Y=$$ASKOK($P(RCTRTYPE,"^",2)) I Y'=1 D UNLOCK S:Y<0 RCBILLDA=0 Q
76 . ; add a new transaction to file 433
77 . S RCTRANDA=$$ADD433^RCBEUTRA(RCBILLDA,$P(RCTRTYPE,"^")) I 'RCTRANDA W !,$P(RCTRANDA,"^",2) D UNLOCK Q
78 . W !," Transaction number ",RCTRANDA," added ..."
79 . ;
80 . ; set up dr string for die call
81 . S DR=RCDRSTRG_"41;" ;comment
82 . ; bill amount moved to transaction amount
83 . S BALANCE=$P($G(^PRCA(430,RCBILLDA,7)),"^",1,5)
84 . S DR=DR_"15////"_($P(BALANCE,"^")+$P(BALANCE,"^",2)+$P(BALANCE,"^",3)+$P(BALANCE,"^",4)+$P(BALANCE,"^",5))_";"
85 . I $P(BALANCE,"^",1) S DR=DR_"81////"_+$P(BALANCE,"^",1)_";" ;principal
86 . I $P(BALANCE,"^",2) S DR=DR_"82////"_+$P(BALANCE,"^",2)_";" ;interest
87 . I $P(BALANCE,"^",3) S DR=DR_"83////"_+$P(BALANCE,"^",3)_";" ;admin
88 . I $P(BALANCE,"^",4) S DR=DR_"84////"_+$P(BALANCE,"^",4)_";" ;marshal fee
89 . I $P(BALANCE,"^",5) S DR=DR_"85////"_+$P(BALANCE,"^",5)_";" ;court cost
90 . ;
91 . ; edit the fields
92 . S Y=$$EDIT433^RCBEUTRA(RCTRANDA,DR)
93 . I 'Y W !,$P(Y,"^",2) D DEL433^RCBEUTRA(RCTRANDA,"",0),UNLOCK Q
94 . ; set the bill and transaction as RC/DOJ
95 . I $P(RCTRTYPE,"^",2)["RC/DOJ" D SETRCDOJ^RCBEUBIL(RCBILLDA,RCTRANDA,"RC")
96 . ; change the status of the bill
97 . I $P(RCTRTYPE,"^")'=47 D CHGSTAT^RCBEUBIL(RCBILLDA,23) ;write off
98 . I $P(RCTRTYPE,"^")=47 D CHGSTAT^RCBEUBIL(RCBILLDA,40) ;suspended
99 . ; mark transaction as processed
100 . D PROCESS^RCBEUTRA(RCTRANDA)
101 . ;
102 . ; create fms write off document, if not accrued and not suspended (47) transaction
103 . I '$$ACCK^PRCAACC(RCBILLDA),$P($G(^PRCA(433,RCTRANDA,1)),"^",2)'=47 D FMSDOC(RCTRANDA)
104 . ;
105 . W !," * * * * * ",$P(RCTRTYPE,"^",2)," has been PROCESSED! * * * * *"
106 .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_" * * * *"
107 . D UNLOCK
108 Q
109 ;
110 ;
111FMSDOC(RCTRANDA) ; create fms write off document
112 N Y
113 W !!,"Creating FMS Write-off document ... "
114 S Y=$$BUILDWR^RCXFMSW1(RCTRANDA)
115 I Y W $P(Y,"^",2)," created."
116 E W "ERROR: ",$P(Y,"^",2)
117 Q
118 ;
119 ;
120UNLOCK ; unlock bill and transaction
121 L -^PRCA(430,RCBILLDA)
122 I $G(RCTRANDA) L -^PRCA(433,RCTRANDA)
123 Q
124 ;
125 ;
126ASKOK(TRANTYPE) ; ask record transaction
127 N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
128 S DIR(0)="YO",DIR("B")="NO"
129 S DIR("A")=" Are you sure you want to record this bill as a "
130 I $L(TRANTYPE)<20 S DIR("A")=DIR("A")_TRANTYPE
131 E S DIR("A",1)=DIR("A"),DIR("A")=" "_TRANTYPE
132 W ! D ^DIR
133 I $G(DTOUT)!($G(DUOUT)) S Y=-1
134 Q Y
Note: See TracBrowser for help on using the repository browser.