source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPBTLM.m@ 724

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

initial load of WorldVistAEHR
File size: 7.8 KB
RevLine 
[613]1RCDPBTLM ;WISC/RFJ - bill transactions List Manager top routine ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114,148,153,168,169,198,247**;Mar 20, 1995;Build 5
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6 ; called from menu option (19)
7 ;
8 N RCBILLDA,RCDPFXIT
9 ;
10 F D Q:'RCBILLDA
11 . W !! S RCBILLDA=$$SELBILL
12 . I RCBILLDA<1 S RCBILLDA=0 Q
13 . D EN^VALM("RCDP TRANSACTIONS LIST")
14 . ; fast exit
15 . I $G(RCDPFXIT) S RCBILLDA=0
16 Q
17 ;
18 ;
19INIT ; initialization for list manager list
20 ; requires rcbillda
21 N ADMIN,DATE,RCLINE,RCLIST,RCTOTAL,RCTRAN,RCTRANDA
22 K ^TMP("RCDPBTLM",$J),^TMP("VALM VIDEO",$J)
23 ;
24 ; fast exit
25 I $G(RCDPFXIT) S VALMQUIT=1 Q
26 ;
27 ; set the List Manager line number
28 S RCLINE=0
29 ; set the List Manager transaction number
30 S RCTRAN=0
31 ;
32 ; get transactions and balance for bill
33 S RCTOTAL=$$GETTRANS(RCBILLDA)
34 ;
35 S DATE="" F S DATE=$O(RCLIST(DATE)) Q:'DATE D
36 . S RCTRANDA="" F S RCTRANDA=$O(RCLIST(DATE,RCTRANDA)) Q:RCTRANDA="" D
37 . . S RCLINE=RCLINE+1
38 . . ;
39 . . ; create an index array for transaction lookup in list
40 . . I RCTRANDA D
41 . . . S RCTRAN=RCTRAN+1
42 . . . S ^TMP("RCDPBTLM",$J,"IDX",RCTRAN,RCTRAN)=RCTRANDA
43 . . . D SET^RCDPAPLI(RCTRAN,RCLINE,1,80,0,IORVON,IORVOFF)
44 . . ;
45 . . D SET^RCDPAPLI($S(RCTRANDA:RCTRANDA,1:" "),RCLINE,4,80)
46 . . D SET^RCDPAPLI($E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3),RCLINE,13,21)
47 . . D SET^RCDPAPLI($TR($P(RCLIST(DATE,RCTRANDA),"^"),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz"),RCLINE,25,50)
48 . . D SET^RCDPAPLI($J($P(RCLIST(DATE,RCTRANDA),"^",2),9,2),RCLINE,53,62)
49 . . D SET^RCDPAPLI($J($P(RCLIST(DATE,RCTRANDA),"^",3),9,2),RCLINE,62,71)
50 . . ; add marshal fee and court cost to create admin dollars
51 . . S ADMIN=$P(RCLIST(DATE,RCTRANDA),"^",4)+$P(RCLIST(DATE,RCTRANDA),"^",5)+$P(RCLIST(DATE,RCTRANDA),"^",6)
52 . . D SET^RCDPAPLI($J(ADMIN,9,2),RCLINE,71,80)
53 ;
54 ; show totals
55 S RCLINE=RCLINE+1
56 D SET^RCDPAPLI(" --------- -------- --------",RCLINE,1,80)
57 S RCLINE=RCLINE+1
58 D SET^RCDPAPLI(" TOTAL BALANCE FOR BILL",RCLINE,1,80)
59 D SET^RCDPAPLI($J($P(RCTOTAL,"^",1),9,2),RCLINE,53,62)
60 D SET^RCDPAPLI($J($P(RCTOTAL,"^",2),9,2),RCLINE,62,71)
61 D SET^RCDPAPLI($J($P(RCTOTAL,"^",3)+$P(RCTOTAL,"^",4)+$P(RCTOTAL,"^",5),9,2),RCLINE,71,80)
62 ;
63 ; compare totals to what is stored in the file
64 N RCDATA7,RCFOUT
65 S RCDATA7=$G(^PRCA(430,RCBILLDA,7))
66 ; for a write-off bill, the balance should equal all zeros, for
67 ; these bills, node 7 is the write-off amount, so for the out of
68 ; balance check to work, node 7 needs to be adjusted to all zeros
69 I $P(^PRCA(430,RCBILLDA,0),"^",8)=23 S RCDATA7="0^0^0^0^0"
70 I +$P(RCDATA7,"^",1)'=+$P(RCTOTAL,"^",1) S RCFOUT=1
71 I +$P(RCDATA7,"^",2)'=+$P(RCTOTAL,"^",2) S RCFOUT=1
72 I ($P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5))'=+$P(RCTOTAL,"^",3) S RCFOUT=1
73 I $G(RCFOUT) D
74 . S RCLINE=RCLINE+1
75 . D SET^RCDPAPLI(" ",RCLINE,1,80)
76 . S RCLINE=RCLINE+1
77 . D SET^RCDPAPLI(" STORED BALANCE FOR BILL (** INCORRECT **)",RCLINE,1,80)
78 . D SET^RCDPAPLI($J($P(RCDATA7,"^",1),9,2),RCLINE,53,62)
79 . D SET^RCDPAPLI($J($P(RCDATA7,"^",2),9,2),RCLINE,62,71)
80 . D SET^RCDPAPLI($J($P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5),9,2),RCLINE,71,80)
81 ;
82 ; set valmcnt to number of lines in the list
83 S VALMCNT=RCLINE
84 D HDR
85 Q
86 ;
87 ;
88HDR ; header code for list manager display
89 ; requires rcbillda
90 N %,DATA,RCDEBTDA,RCDPDATA
91 ;
92 D DIQ430^RCDPBPLM(RCBILLDA,".01;8;")
93 ;
94 S RCDEBTDA=$P(^PRCA(430,RCBILLDA,0),"^",9)
95 S DATA=$$ACCNTHDR^RCDPAPLM(RCDEBTDA)
96 ;
97 S %="",$P(%," ",80)=""
98 S VALMHDR(1)=$E("Bill #: "_$G(RCDPDATA(430,RCBILLDA,.01,"E"))_%,1,25)_"Account: "_$P(DATA,"^")_$P(DATA,"^",2)
99 S VALMHDR(2)=$E("Status: "_$G(RCDPDATA(430,RCBILLDA,8,"E"))_%,1,25)_$E(" Addr: "_$P(DATA,"^",4)_", "_$P(DATA,"^",7)_", "_$P(DATA,"^",8)_" "_$P(DATA,"^",9)_%,1,55)
100 Q
101 S VALMHDR(3)=" "_IORVON_$E("Bill Balance: "_$J($P(RCTOTAL,"^")+$P(RCTOTAL,"^",2)+$P(RCTOTAL,"^",3)+$P(RCTOTAL,"^",4)+$P(RCTOTAL,"^",5),0,2)_%,1,23)_IORVOFF_" Phone: "_$P(DATA,"^",10)
102 Q
103 ;
104 ;
105EXIT ; exit list manager option and clean up
106 K ^TMP("RCDPBTLM",$J),^TMP("RCDPBTLMX",$J)
107 Q
108 ;
109 ;
110SELBILL() ; select a bill
111 ; returns -1 for timeout or ^, 0 for no selection, or ien of bill
112 N %,%Y,C,DIC,DTOUT,DUOUT,RCBEFLUP,X,Y
113 N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
114 N RCY,DIR,DIRUT
115 ; allow user to get the record using bill# or ECME#
116 S DIR("A")="Select (B)ILL or (E)CME#: "
117 S DIR(0)="SA^B:BILL NUMBER;E:ECME#"
118 S DIR("B")="B"
119 D ^DIR K DIR I $D(DIRUT) Q 0
120 S RCY=Y
121 I RCY="E" Q $$SELECME
122 S DIC="^PRCA(430,",DIC(0)="QEAM",DIC("A")="Select BILL: "
123 S DIC("W")="D DICW^RCBEUBI1"
124 ; special lookup on input
125 S RCBEFLUP=1
126 D ^DIC
127 I Y<0,'$G(DUOUT),'$G(DTOUT) S Y=0
128 Q +Y
129 ;
130 ;
131GETTRANS(BILLDA) ; original amount goes first for bill
132 ; returns list of transactions in
133 ; rclist(date,tranda)=trantype ^ principle ^ interest ^ admin
134 ; returns principle balance ^ interest balance ^ admin balance
135 ; ^ marshall fee balance ^ court cost balance
136 N %,ADMBAL,AMTDISP,CCBAL,DATA1,DATE,INTBAL,MFBAL,PRINBAL,RCDPDATA,TRANDA,VALUE
137 ;
138 D DIQ430^RCDPBPLM(BILLDA,"3;60;")
139 ;
140 K RCLIST
141 S (ADMBAL,CCBAL,INTBAL,MFBAL,PRINBAL)=0
142 S PRINBAL=RCDPDATA(430,BILLDA,3,"I")
143 ; loop transaction and add to list
144 S TRANDA=0 F S TRANDA=$O(^PRCA(433,"C",BILLDA,TRANDA)) Q:'TRANDA D
145 . S DATA1=$G(^PRCA(433,TRANDA,1))
146 . S DATE=$P(DATA1,"^",9) I 'DATE Q
147 . S VALUE=$$TRANVALU(TRANDA) I VALUE="" Q
148 . S RCLIST($P(DATE,"."),TRANDA)=$P($G(^PRCA(430.3,+$P(DATA1,"^",2),0)),"^")_VALUE
149 . ;
150 . ; calculate bill's balance
151 . S PRINBAL=PRINBAL+$P(VALUE,"^",2)
152 . S INTBAL=INTBAL+$P(VALUE,"^",3)
153 . S ADMBAL=ADMBAL+$P(VALUE,"^",4)
154 . S MFBAL=MFBAL+$P(VALUE,"^",5)
155 . S CCBAL=CCBAL+$P(VALUE,"^",6)
156 ;
157 S DATE=$G(RCDPDATA(430,BILLDA,60,"I"))
158 ; check to make sure activation date is not greater than first transaction
159 S %=$O(RCLIST(0)) I DATE>% S DATE=%
160 S RCLIST(+$P(DATE,"."),0)="original amount^"_RCDPDATA(430,BILLDA,3,"I")
161 ;
162 Q PRINBAL_"^"_INTBAL_"^"_ADMBAL_"^"_MFBAL_"^"_CCBAL
163 ;
164 ;
165TRANVALU(TRANDA) ; return the transaction value as displayed (with + or - sign)
166 N TYPE,VALUE
167 S VALUE=$$TRANBAL^RCRJRCOT(TRANDA)
168 ; no dollars on transaction
169 I '$P(VALUE,"^"),'$P(VALUE,"^",2),'$P(VALUE,"^",3),'$P(VALUE,"^",4),'$P(VALUE,"^",5) Q ""
170 ; check type for payments, etc, make values (-) to subtract
171 S TYPE=$P($G(^PRCA(433,TRANDA,1)),"^",2)
172 I TYPE=2!(TYPE=8)!(TYPE=9)!(TYPE=10)!(TYPE=11)!(TYPE=14)!(TYPE=29)!(TYPE=34)!(TYPE=35)!(TYPE=41) D
173 . S $P(VALUE,"^",1)=-$P(VALUE,"^",1)
174 . S $P(VALUE,"^",2)=-$P(VALUE,"^",2)
175 . S $P(VALUE,"^",3)=-$P(VALUE,"^",3)
176 . S $P(VALUE,"^",4)=-$P(VALUE,"^",4)
177 . S $P(VALUE,"^",5)=-$P(VALUE,"^",5)
178 ;
179 ; the following transaction types should not change the bills balance
180 ; return the amount displayed in the description and 0 for value
181 ; refer to RC 3, refer to DOJ 4, reestablish 5, returned 6 and 32
182 ; repayment plan 25, amended 33, suspended 47, unsuspended 46
183 K AMTDISP
184 I TYPE=3!(TYPE=4)!(TYPE=5)!(TYPE=6)!(TYPE=25)!(TYPE=32)!(TYPE=33)!(TYPE=46)!(TYPE=47) D
185 . S AMTDISP=" ($"_$J($P(VALUE,"^")+$P(VALUE,"^",2)+$P(VALUE,"^",3)+$P(VALUE,"^",4)+$P(VALUE,"^",5),0,2)_")"
186 . S VALUE=""
187 Q $G(AMTDISP)_"^"_VALUE
188 ;
189SELECME() ;
190 ; function takes the user input of the ECME # to return a valid ien of file 430
191 ; if an invalid ECME is evaluated then the process keeps asking the user for ECME #
192 ; until a valid ECME# is entered or until the user enters a "^" or null value
193 ; output - returns the IEN of the record entry in the ACCOUNT RECEIVABLE file (#430) or "??"
194 N RCECME,RCBILL,DIR,DIRUT,Y
195 S DIR(0)="FO^7:7^I X'?1.7N W !!,""Cannot contain alpha characters"" K X"
196 S DIR("A")="Select ECME#"
197RET D ^DIR I $D(DIRUT) Q 0
198 S RCECME=$S(+Y>0:Y,1:0)
199 S RCBILL=$$REC^IBRFN(RCECME)
200 I RCBILL<0 W !!,"??" G RET
201 E W !!,$P($G(^PRCA(430,+RCBILL,0)),"^")," "
202 Q RCBILL
203 ;RCDPBTLM
Note: See TracBrowser for help on using the repository browser.