1 /* ***********************************************************
 2    *                                                         *
 3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
 4    *                                                         *
 5    * Copyright (c) 1972 by Massachusetts Institute of        *
 6    * Technology and Honeywell Information Systems, Inc.      *
 7    *                                                         *
 8    *********************************************************** */
 9 
10 
11 lv_attached: proc;
12 
13 /* LV_ATTACHED - true if user mounted vol */
14 
15 dcl  ec fixed bin (35),
16      nactsw bit (1) init ("0"b),
17      ap ptr, al fixed bin,
18      ap1 ptr, al1 fixed bin,
19      bchr char (al) based (ap),
20      return_value char (al1) varying based (ap1),
21      answer char (5) var,
22      i fixed bin,
23      lvid bit (36);
24 
25 dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
26 dcl  cu_$af_arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
27 dcl  cu_$af_return_arg entry (fixed bin, ptr, fixed bin, fixed bin (35));
28 dcl  error_table_$not_act_fnc fixed bin (35) ext;
29 dcl  active_fnc_err_ entry options (variable);
30 dcl  com_err_ entry options (variable);
31 dcl  ioa_ entry options (variable);
32 dcl  hcs_$lv_attached entry (bit (36), fixed bin (35));
33 dcl  mdc_$find_lvid entry (char (*), bit (36), fixed bin (35));
34 
35           call cu_$af_arg_ptr (1, ap, al, ec);
36           if ec ^= 0 & ec = error_table_$not_act_fnc then do;
37                call cu_$arg_ptr (1, ap, al, ec);
38                nactsw = "1"b;
39           end;
40           if ec ^= 0 then do;
41 er:            if nactsw then call com_err_ (ec, "lv_attached", "");
42                else call active_fnc_err_ (ec, "lv_attached", "");
43                return;
44           end;
45           call mdc_$find_lvid (bchr, lvid, ec);
46           if ec = 0 then call hcs_$lv_attached (lvid, ec);
47           if ec = 0 then answer = "true";
48           else answer = "false";
49           if nactsw then call ioa_ ("^a", answer);
50           else do;
51                call cu_$af_return_arg (i, ap1, al1, ec);
52                if ec ^= 0 then go to er;
53                return_value = answer;
54           end;
55 
56      end;