1
2
3
4
5
6
7
8
9
10
11 misc: charge: proc;
12
13 dcl descn char (168) aligned,
14 en char (32),
15 (char8, char8a) char (8) aligned init (""),
16 (date1, date2) fixed bin(71),
17 instr char(28),
18 pamt pic "(7)$v.99cr",
19 (i, j, n) fixed bin,
20 time fixed bin (71),
21 ap ptr,
22 al fixed bin,
23 bchr char (al) unaligned based (ap),
24 acredit bit(1) aligned init("1"b),
25 amt float bin,
26 proj char (12) aligned,
27 pp ptr,
28 (p1,p2 ) ptr,
29 miscfilep ptr,
30 ec fixed bin(35);
31
32 dcl (null, addr, rel, bin, fixed, dec, round, substr, verify, search) builtin;
33
34 dcl movew(nmove) fixed bin based,
35 (nmove, lomh, lome) fixed bin;
36
37 dcl clock_ entry () returns (fixed bin (71)),
38 get_wdir_ entry () returns (char (168)),
39 cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin),
40 ioa_ entry options (variable),
41 date_time_ entry (fixed bin (71), char (*) aligned),
42 convert_date_to_binary_$relative entry(char(*),fixed bin(71), fixed bin(71), fixed bin(35)),
43 com_err_ entry options (variable),
44 hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1),
45 fixed bin (2), ptr, fixed bin(35)),
46 hcs_$make_seg entry(char(*),char(*),char(*),fixed bin(5),ptr,fixed bin(35)),
47 hcs_$terminate_noname entry (ptr, fixed bin(35)),
48 hcs_$delentry_seg entry(ptr, fixed bin(35)),
49 ask_$ask_clr entry options (variable),
50 ask_$ask_flo entry options (variable),
51 ask_$ask_int entry options (variable),
52 ask_ entry options (variable),
53 ask_$ask_line entry options (variable);
54
55
56 %include miscfile;
57
58 %include projfile;
59
60
61
62 acredit="0"b;
63
64 credit: entry;
65
66 en = "projfile";
67 call hcs_$initiate ((get_wdir_ ()), en, "", 0, 1, pp, ec);
68 if pp = null then do;
69 er: call com_err_ (ec, "misc", en);
70 return;
71 end;
72 en = "miscfile";
73 call hcs_$initiate ((get_wdir_ ()), en, "", 0, 1, miscfilep, ec);
74 if miscfilep = null then go to er;
75
76 time = clock_ ();
77
78 main1: call ask_$ask_clr;
79 main: call ask_ ("^/Project^-", proj);
80 if proj = "x" then go to exit;
81
82 do i = 1 to nproj;
83 if proj = id (i) then go to found;
84 end;
85 call ioa_ ("misc: project ""^a"" not in projfile.", proj);
86 go to main1;
87
88 found:
89
90
91
92 call ask_$ask_flo ("amount^-", amt);
93
94 call ask_$ask_line ("desc^-", descn);
95 if descn = "x" then go to main;
96
97 n_misc (i) = n_misc (i) + 1;
98 if acredit then amt=-amt;
99 misc_charges (i) = misc_charges (i) + amt;
100
101 misc_ents = misc_ents + 1;
102 j = misc_ents;
103
104 mproj (j) = proj;
105 mdate (j) = time;
106 mamt (j) = amt;
107 mdesc (j) = descn;
108
109 go to main;
110
111 exit: call hcs_$terminate_noname (miscfilep, ec);
112 call hcs_$terminate_noname (pp, ec);
113
114 return;
115
116
117
118 print_misc: entry;
119
120 bug: en = "x";
121 en = "miscfile";
122 call hcs_$initiate ((get_wdir_ ()), en, "", 0, 1, miscfilep, ec);
123 if miscfilep = null then go to er;
124
125 mainp: call ask_$ask_clr;
126 mainp1: call ask_("^/Project^-", proj);
127 mainp2: call ask_$ask_line("dates^-",instr);
128 if instr="all"
129 then do;
130 date1=mdate(1);
131 date2=mdate(misc_ents);
132 end;
133 else do;
134 i=verify(instr,"/0123456789");
135 j=search(substr(instr,i+1),"0123456789")+i;
136 time=mdate(1)-86400000000;
137 call convert_date_to_binary_$relative(substr(instr,1,i-1)||" 0000.",date1,time,ec);
138 if ec^=0
139 then do;
140 call ioa_("Illegal date ^a",substr(instr,1,i-1));
141 go to mainp2;
142 end;
143 if j>i
144 then call convert_date_to_binary_$relative(substr(instr,j)||" 2400.",date2,mdate(1),ec);
145 else date2=date1+86400000000;
146 if ec^=0
147 then do;
148 call ioa_("Illegal date ^a",substr(instr,j));
149 go to mainp2;
150 end;
151 end;
152
153 amt = 0.0e0;
154 n=0;
155 do i = 1 to misc_ents while(mdate(i)<=date2);
156 call date_time_ (mdate (i), char8);
157 if (proj="all"&mproj(i)^="")|proj=mproj(i)
158 then if mdate(i)>=date1
159 then do;
160 if char8 = char8a then char8 = "";
161 else char8a = char8;
162 pamt=round(fixed(dec(mamt(i)),14,8),2);
163 call ioa_ ("^8a ^5d ^12a ^12a ^a", char8, i, mproj (i), pamt, mdesc (i));
164 amt = amt + mamt (i);
165 n=n+1;
166 end;
167 end;
168 if n=0
169 then call ioa_("No entries matching project and date");
170 else if proj="all"&instr="all"
171 then do;
172 pamt=round(fixed(dec(amt),14,8),2);
173 call ioa_("^/Total:^24x ^12a^/^d entries in ""miscfile""",pamt,n);
174 end;
175
176 call hcs_$terminate_noname (miscfilep, ec);
177 return;
178
179
180
181 print_all_miscs: entry;
182
183 en = "miscfile";
184 call hcs_$initiate ((get_wdir_ ()), en, "", 0, 1, miscfilep, ec);
185 if miscfilep = null then go to er;
186
187 amt = 0.0e0;
188 n=0;
189 do i = 1 to misc_ents;
190 if mproj(i)^=""
191 then do;
192 call date_time_ (mdate (i), char8);
193 if char8 = char8a then char8 = "";
194 else char8a = char8;
195 pamt=round(fixed(dec(mamt(i)),14,8),2);
196 call ioa_ ("^8a ^5d ^12a ^12a ^a", char8, i, mproj (i), pamt, mdesc (i));
197 amt = amt + mamt (i);
198 n=n+1;
199 end;
200 end;
201 pamt=round(fixed(dec(amt),14,8),2);
202 call ioa_("^/Total:^24x ^12a^/^d entries in ""miscfile""",pamt,n);
203 call hcs_$terminate_noname (miscfilep, ec);
204 return;
205
206
207
208 reset_misc: entry;
209
210 en = "projfile";
211 call hcs_$initiate ((get_wdir_ ()), en, "", 0, 1, pp, ec);
212 if pp = null then go to er;
213 do i = 1 to nproj;
214 misc_charges (i) = 0.0e0;
215 n_misc (i) = 0;
216 end;
217
218 call hcs_$terminate_noname (pp, ec);
219 return;
220
221
222
223 dmisc: entry;
224
225 en = "projfile";
226 call hcs_$initiate ((get_wdir_ ()), en, "", 0, 1, pp, ec);
227 if pp=null then go to er;
228 en = "miscfile";
229 call hcs_$initiate ((get_wdir_ ()), en, "", 0, 1, miscfilep, ec);
230 if miscfilep=null then go to er;
231
232
233 maind: call ask_$ask_clr;
234 maind1: call ask_("^/Project^-",proj);
235 if proj="x" then go to exit;
236 do i=1 to nproj;
237 if proj=id(i) then go to foundd;
238 end;
239 call ioa_("misc: project ""^a"" not in projfile.",proj);
240 go to maind;
241
242 foundd: call ask_$ask_int("Number^-",j);
243 if j>misc_ents|j<1
244 then do;
245 call ioa_("Entry number ^d not in miscfile",j);
246 go to maind;
247 end;
248 if mproj(j)=""&mamt(j)=0.0e0
249 then do;
250 call ioa_("Entry number ^d has already been deleted",j);
251 go to maind;
252 end;
253 if mproj(j)^=proj
254 then do;
255 call ioa_("Entry number ^d not charged to project ^a",j,proj);
256 go to maind;
257 end;
258 n_misc(i)=n_misc(i)-1;
259 misc_charges(i)=misc_charges(i)-mamt(j);
260 if n_misc(i)=0 then misc_charges(i)=0.0e0;
261 mamt(j)=0;
262 mproj(j)="";
263 go to maind;
264
265 end misc;