1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23 system: proc;
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46 dcl ap ptr,
47 al fixed bin (21),
48 bchr char (al) based (ap) unal,
49 answer char (al) varying based (ap);
50
51 dcl time fixed bin (71),
52 nactsw bit (1),
53 all_switch bit (1) aligned,
54 stp_sw bit (36) aligned,
55 switch fixed bin,
56 host_num fixed binary (16),
57 ec fixed bin (35),
58 rs_number fixed bin,
59 rs_name char (32),
60 tli fixed bin (71),
61 wd char (9) aligned,
62 dn char (168),
63 j fixed bin,
64 (t1, t2) fixed bin,
65 i35 fixed bin (35),
66 string char (300) varying init ("");
67 dcl max_rs_number fixed bin;
68 dcl default_q fixed bin;
69
70 dcl error entry options (variable) variable;
71 dcl get_arg entry (fixed bin, ptr, fixed bin (21), fixed bin (35)) variable;
72
73 dcl inarg char (32) aligned;
74
75
76 dcl item (38) char (32) aligned int static options (constant) init (
77 "ARPANET_host_number",
78 "company",
79 "date_time_last_down",
80 "date_time_last_up",
81 "date_time_next_down",
82 "date_time_next_up",
83 "date_time_shift_change",
84 "date_up",
85 "default_absentee_queue",
86 "department",
87 "down_until_date",
88 "down_until_time",
89 "ds_company",
90 "ds_department",
91 "installation_id",
92 "last_down_date",
93 "last_down_reason",
94 "last_down_time",
95 "max_rate_structure_number",
96 "max_units",
97 "max_users",
98 "n_units",
99 "n_users",
100 "next_down_date",
101 "next_down_time",
102 "next_shift",
103 "rate_structure_name",
104 "rate_structure_number",
105 "reason_down",
106 "shift",
107 "shift_change_date",
108 "shift_change_time",
109 "sysid",
110 "time_up",
111 "version_id",
112 "session_type",
113 "trusted_path_login",
114 "all");
115
116 dcl error_table_$badopt fixed bin (35) ext,
117 error_table_$bad_arg fixed bin (35) ext,
118 error_table_$not_act_fnc fixed bin (35) ext;
119
120 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)),
121 cu_$af_arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)),
122 cu_$af_return_arg entry (fixed bin, ptr, fixed bin (21), fixed bin (35)),
123 cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)),
124 active_fnc_err_ entry options (variable),
125 com_err_ entry options (variable),
126 ioa_ entry options (variable),
127 date_time_$format entry (char(*), fixed bin(71), char(*), char(*)) returns(char(250) var),
128 requote_string_ entry (char (*)) returns (char (*)),
129 system_info_$installation_id entry (char (*)),
130 system_info_$sysid entry (char (*)),
131 system_info_$session entry (char (*)),
132 system_info_$trusted_path_flags entry (bit(36) aligned),
133 system_info_$version_id entry (char (*)),
134 system_info_$titles entry options (variable),
135 system_info_$users entry options (variable),
136 system_info_$timeup entry (fixed bin (71)),
137 system_info_$next_shutdown entry options (variable),
138 system_info_$next_shift_change entry options (variable),
139 system_info_$last_shutdown entry options (variable),
140 system_info_$ARPANET_host_number entry (fixed bin (16)),
141 system_info_$rs_number entry (char (*), fixed bin, fixed bin (35)),
142 system_info_$rs_name entry (fixed bin, char (*), fixed bin (35)),
143 system_info_$max_rs_number entry (fixed bin),
144 system_info_$default_absentee_queue entry (fixed bin),
145 ioa_$rsnnl entry options (variable);
146
147 dcl (hbound, ltrim, rtrim) builtin;
148
149
150
151 call cu_$af_arg_ptr (1, ap, al, ec);
152 if ec = error_table_$not_act_fnc then do;
153 error = com_err_;
154 get_arg = cu_$arg_ptr;
155 call get_arg (1, ap, al, ec);
156 nactsw = "1"b;
157 end;
158 else do;
159 error = active_fnc_err_;
160 get_arg = cu_$af_arg_ptr;
161 nactsw = "0"b;
162 end;
163 if ec ^= 0 then do;
164 er: call error (ec, "system");
165 return;
166 end;
167 inarg = bchr;
168
169 all_switch = "0"b;
170 do switch = 1 to hbound (item, 1);
171 if inarg = item (switch) then go to have_good_item;
172 end;
173 call error (error_table_$badopt, "system", """^a""", inarg);
174 return;
175
176 have_good_item:
177 if switch = hbound (item, 1)
178 then if nactsw
179 then do;
180 all_switch = "1"b;
181 switch = 1;
182 end;
183 else do;
184 call error (error_table_$bad_arg, "system", "^a", inarg);
185 end;
186
187 ok: go to case (switch);
188
189 case (15):
190 call system_info_$installation_id (dn);
191 rtrim_string:
192 string = rtrim (dn);
193 go to exit;
194 case (33):
195 call system_info_$sysid (dn);
196 go to rtrim_string;
197 case (37):
198 call system_info_$trusted_path_flags (stp_sw);
199 if stp_sw then dn = "true";
200 else dn = "false";
201 go to rtrim_string;
202
203 case (36):
204 call system_info_$session (dn);
205 go to rtrim_string;
206 case (2):
207 call system_info_$titles (dn, wd, wd, wd);
208 go to rtrim_string;
209 case (10):
210 call system_info_$titles (wd, dn, wd, wd);
211 go to rtrim_string;
212 case (13):
213 call system_info_$titles (wd, wd, dn, wd);
214 go to rtrim_string;
215 case (14):
216 call system_info_$titles (wd, wd, wd, dn);
217 go to rtrim_string;
218 case (21):
219 call system_info_$users (t1, t2, t2, t2);
220 cv_num:
221 call ioa_$rsnnl ("^d", string, j, t1);
222 go to exit;
223 case (23):
224 call system_info_$users (t2, t1, t2, t2);
225 go to cv_num;
226 case (20):
227 call system_info_$users (t2, t2, t1, t2);
228 cv_float:
229 call ioa_$rsnnl ("^.1f", string, j, t1*1e-1);
230 go to exit;
231 case (22):
232 call system_info_$users (t2, t2, t2, t1);
233 go to cv_float;
234 case (34):
235 call system_info_$timeup (tli);
236 cv_time:
237 string = date_time_$format ("time",tli,"","");
238 go to exit;
239 case (25):
240 call system_info_$next_shutdown (tli);
241 if tli = 0 then do;
242 notime: string = "none";
243 go to exit;
244 end;
245 go to cv_time;
246 case (12):
247 call system_info_$next_shutdown (time, dn, tli);
248 if time = 0 then go to notime;
249 if tli = 0 then go to notime;
250 go to cv_time;
251 case (29):
252 call system_info_$next_shutdown (tli, dn);
253 if tli = 0 then go to notime;
254 go to rtrim_string;
255 case (30):
256 call system_info_$next_shift_change (t1, tli, t2);
257 go to cv_num;
258 case (32):
259 call system_info_$next_shift_change (t1, tli, t2);
260 go to cv_time;
261 case (26):
262 call system_info_$next_shift_change (t2, tli, t1);
263 go to cv_num;
264 case (8):
265 call system_info_$timeup (tli);
266 cv_date:
267 string = date_time_$format ("date",tli,"","");
268 go to exit;
269 case (24):
270 call system_info_$next_shutdown (tli);
271 if tli = 0 then go to notime;
272 go to cv_date;
273 case (11):
274 call system_info_$next_shutdown (time, dn, tli);
275 if time = 0 then go to notime;
276 if tli = 0 then go to notime;
277 go to cv_date;
278 case (31):
279 call system_info_$next_shift_change (t1, tli, t2);
280 go to cv_date;
281 case (18):
282 call system_info_$last_shutdown (tli);
283 go to cv_time;
284 case (16):
285 call system_info_$last_shutdown (tli);
286 go to cv_date;
287 case (17):
288 call system_info_$last_shutdown (tli, dn);
289 go to rtrim_string;
290 case (1):
291 call system_info_$ARPANET_host_number (host_num);
292 t1 = host_num;
293 go to cv_num;
294 case (28):
295 string = "";
296 call get_arg (2, ap, al, ec);
297 if ec ^= 0
298 then if all_switch
299 then goto exit;
300 else go to er;
301 call system_info_$rs_number (bchr, rs_number, ec);
302 if ec ^= 0 then do;
303 call error (ec, "system", "Rate structure name ""^a"".", bchr);
304 if all_switch then goto exit;
305 else return;
306 end;
307 t1 = rs_number;
308 go to cv_num;
309 case (27):
310 call system_info_$max_rs_number (max_rs_number);
311 string = "";
312 call get_arg (2, ap, al, ec);
313 if ec = 0 then do;
314 i35 = cv_dec_check_ (bchr, ec);
315 if ec ^= 0 then do;
316 rs_nm_error: ec = error_table_$bad_arg;
317 call error (ec, "system", "Rate structure number ^a.", bchr);
318 if all_switch then goto exit;
319 else return;
320 end;
321 if i35 < 0 | i35 > max_rs_number then go to rs_nm_error;
322 rs_number = i35;
323 call system_info_$rs_name (rs_number, rs_name, ec);
324 if ec ^= 0 then goto rs_nm_error;
325 string = rtrim (ltrim (rs_name));
326 end;
327 else do rs_number = 0 to max_rs_number;
328 call system_info_$rs_name (rs_number, rs_name, ec);
329 if ec ^= 0 then go to exit;
330 if string ^= "" then string = string || " ";
331 string = string || rtrim (rs_name);
332 end;
333 go to exit;
334 case (19):
335 call system_info_$max_rs_number (rs_number);
336 t1 = rs_number;
337 go to cv_num;
338 case (4):
339 call system_info_$timeup (tli);
340 cv_date_time:
341
342
343
344
345
346 string = date_time_$format ("date_time",tli,"","");
347 go to exit;
348 case (5):
349 call system_info_$next_shutdown (tli);
350 if tli = 0 then go to notime;
351 go to cv_date_time;
352 case (6):
353 call system_info_$next_shutdown (time, dn, tli);
354 if time = 0 then go to notime;
355 if tli = 0 then go to notime;
356 go to cv_date_time;
357 case (3):
358 call system_info_$last_shutdown (tli);
359 go to cv_date_time;
360 case (7):
361 call system_info_$next_shift_change (t1, tli, t2);
362 go to cv_date_time;
363 case (9):
364 call system_info_$default_absentee_queue (default_q);
365 t1 = default_q;
366 go to cv_num;
367 case (35):
368 call system_info_$version_id (dn);
369 go to rtrim_string;
370
371 exit: if all_switch then do;
372 if string ^= "" then call ioa_ ("^a:^28t^a", item (switch), string);
373 switch = switch + 1;
374 if switch = hbound (item, 1) then return;
375 else goto ok;
376 end;
377 else if nactsw then do;
378 call ioa_ ("^a", string);
379 return;
380 end;
381 call cu_$af_return_arg (j, ap, al, ec);
382 if ec ^= 0 then go to er;
383 answer = requote_string_ ((string));
384
385 end;