*copyc osd$default_pragmats
MODULE rfm$manage_rhfam_network;
?? TITLE := 'MANAGE_RHFAM_NETWORK' ??
?? NEWTITLE := '  RING BRACKETS 2DD' ??
?? NEWTITLE := '    XREF procedures', EJECT ??
*copyc amp$get_segment_pointer
*copyc amp$return
*copyc clp$build_standard_title
*copyc clp$close_display
*copyc clp$convert_integer_to_rjstring
*copyc clp$convert_integer_to_string
*copyc clp$end_scan_command_file
*copyc clp$execute_command
*copyc clp$get_set_count
*copyc clp$get_value
*copyc clp$horizontal_tab_display
*copyc clp$new_display_line
*copyc clp$open_display
*copyc clp$pop_utility
*copyc clp$push_utility
*copyc clp$put_display
*copyc clp$put_partial_display
*copyc clp$reset_for_next_display_page
*copyc clp$scan_command_file
*copyc clp$scan_parameter_list
*copyc clp$test_parameter
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$format_message
*copyc osp$get_message_level
*copyc osp$set_status_abnormal
*copyc pfp$attach
*copyc pmp$establish_condition_handler
*copyc pmp$generate_unique_name
*copyc pmp$long_term_wait
*copyc pmt$task_id
*copyc rfp$activate_rhfam_client
*copyc rfp$activate_rhfam_server
*copyc rfp$change_host_or_lid_state
*copyc rfp$change_nad_or_trunk_state
*copyc rfp$deactivate_rhfam_client
*copyc rfp$deactivate_rhfam_server
*copyc rfp$define_rhfam_client
*copyc rfp$define_rhfam_server
*copyc rfp$delete_rhfam_client
*copyc rfp$delete_rhfam_server
*copyc rfp$display_active_appl_r3
*copyc rfp$display_rhfam_clients
*copyc rfp$display_rhfam_servers
*copyc rfp$display_rhfam_elements
*copyc rfp$display_routing_info_r3
*copyc rfp$check_local_nad_test
*copyc rfp$initiate_local_nad_test
?? TITLE := '    INLINE procedures', EJECT ??
  PROCEDURE [INLINE] check_page_width (value: clt$value; display_control: clt$display_control;
    VAR status: ost$status);

    IF display_control.page_width < rfc$minimum_page_size THEN
      osp$set_status_abnormal (rfc$product_id, rfe$illegal_output_file, value.file.local_file_name,
            status);
      osp$append_status_integer (osc$status_parameter_delimiter, rfc$minimum_page_size,
        10, FALSE, status);
      status.normal := FALSE;
     IFEND;

  PROCEND check_page_width;
?? EJECT ??
*copyc rfp$verify_caller_capability
?? TITLE := '    TYPE/CONST Definitions', EJECT ??

*copyc clt$path_display_chunks

  CONST
    rfc$minimum_page_size = 72;
?? PUSH (LISTEXT := ON) ??
*copyc rfe$condition_codes
?? POP ??
?? TITLE := '    GLOBAL variables', EJECT ??
*copyc oss$job_paged_literal
  VAR
    rfv$utility_name: [STATIC, READ, oss$job_paged_literal] ost$name :=
      'MANAGE_RHFAM_NETWORK';
*copyc osv$lower_to_upper
?? TITLE := '    rfp$manage_rhfam_network', EJECT ??

  PROCEDURE [XDCL, #GATE] rfp$manage_rhfam_network (parameter_list:
    clt$parameter_list;
    VAR status: ost$status);

*copyc rfh$manage_rhfam_network

*copyc rfd$pdt_manage_rhfam_network

    VAR
      capabilities: ARRAY[1..2] OF ost$name;
?? EJECT ??
*copyc rfd$cdt_manage_rhfam_network

    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, manage_rhfam_network_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    capabilities[1] := avc$network_applic_management;
    capabilities[2] := avc$network_operation;

    rfp$verify_caller_capability (^capabilities, 'MANAGE_RHFAM_NETWORK', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$push_utility (rfv$utility_name, clc$global_command_search, manrn_command_list, NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$scan_command_file (clc$current_command_input, rfv$utility_name, 'MRN', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$pop_utility (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND rfp$manage_rhfam_network;
?? TITLE := '    activate_rhfam_client',EJECT ??
  PROCEDURE activate_rhfam_client (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copyc rfh$activate_rhfam_client
*copyc rfd$pdt_activate_rhfam_client

    VAR
      client: rft$application_name,
      capability: ARRAY[1..1] OF ost$name,
      value: clt$value;
??EJECT ??
    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, activate_rhfam_cli_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    capability[1] := avc$network_applic_management;

    rfp$verify_caller_capability (^capability, 'ACTIVATE_RHFAM_CLIENT', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('CLIENT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    client := value.name.value;

    rfp$activate_rhfam_client (client, status);

  PROCEND activate_rhfam_client;
?? TITLE := '    activate_rhfam_server',EJECT ??
  PROCEDURE activate_rhfam_server (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copyc rfh$activate_rhfam_server
*copyc rfd$pdt_activate_rhfam_server

    VAR
      server: rft$application_name,
      capability: ARRAY[1..1] OF ost$name,
      value: clt$value;
??EJECT??
    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, activate_rhfam_ser_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    capability[1] := avc$network_applic_management;

    rfp$verify_caller_capability (^capability, 'ACTIVATE_RHFAM_SERVER', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('SERVER', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    server := value.name.value;

    rfp$activate_rhfam_server (server, status);

  PROCEND activate_rhfam_server;
?? TITLE := '    change_host_state',EJECT ??
  PROCEDURE change_host_state (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copy  rfh$change_host_state

    VAR
      physical_id_list_p: ^ARRAY [1 .. *] OF rft$physical_identifier,
      all_pids_specified,
      state: BOOLEAN,
      capability: ARRAY[1..1] OF ost$name;
?? EJECT ??
    status.normal := TRUE;

    capability[1] := avc$network_operation;

    rfp$verify_caller_capability (^capability, 'CHANGE_HOST_STATE', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    rfp$change_host_state (parameter_list, physical_id_list_p, all_pids_specified, state, status);
    IF status.normal THEN
      rfp$change_host_or_lid_state (physical_id_list_p, NIL, all_pids_specified, state, status);
    IFEND;
    IF physical_id_list_p <> NIL THEN
      FREE physical_id_list_p;
    IFEND;

  PROCEND change_host_state;
?? TITLE := '    rfp$change_host_state',EJECT ??
  PROCEDURE [XDCL] rfp$change_host_state (parameter_list: clt$parameter_list;
    VAR physical_id_list_p: ^ARRAY [1 .. *] OF rft$physical_identifier;
    VAR all_pids_specified: BOOLEAN;
    VAR state: BOOLEAN;
    VAR status: ost$status);

*copy  rfh$change_host_state
*copyc rfd$pdt_change_host_state

    VAR
      i: INTEGER,
      set_count: 0 .. clc$max_value_sets,
      value: clt$value;
?? EJECT ??
    status.normal := TRUE;
    physical_id_list_p := NIL;

    clp$scan_parameter_list (parameter_list, change_host_state_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_set_count ('PHYSICAL_IDENTIFIER', set_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ALLOCATE physical_id_list_p: [1 .. set_count];
    IF physical_id_list_p = NIL THEN
      osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'default heap', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$CHANGE_HOST_STATE',
          status);
    IFEND;

    all_pids_specified := FALSE;

    FOR i := 1 TO set_count DO

      clp$get_value ('PHYSICAL_IDENTIFIER', i, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      CASE value.kind OF
      = clc$name_value =
        IF set_count > 1 THEN
          osp$set_status_abnormal (rfc$product_id, rfe$too_many_key_values, value.name.value, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, 'PHYSICAL_IDENTIFIER', status);
          RETURN;
        IFEND;
        all_pids_specified := TRUE;
        physical_id_list_p^[i] := '';
      = clc$string_value =
        #TRANSLATE (osv$lower_to_upper, value.str.value,  physical_id_list_p^[i]);
      CASEND;

    FOREND;

    clp$get_value ('STATE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF value.name.value = 'OFF' THEN
      state := TRUE;
    ELSE
      state := FALSE;
    IFEND;


  PROCEND rfp$change_host_state;
?? TITLE := '    change_lid_state',EJECT ??
  PROCEDURE change_lid_state (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copy  rfh$change_lid_state

    VAR
      logical_id_list_p: ^ARRAY [1 .. *] OF rft$logical_identifier,
      physical_id_list_p: ^ARRAY [1 .. *] OF rft$physical_identifier,
      all_pids_specified,
      state: BOOLEAN,
      capability: ARRAY[1..1] OF ost$name;
?? EJECT ??
    status.normal := TRUE;

    capability[1] := avc$network_operation;

    rfp$verify_caller_capability (^capability, 'CHANGE_LID_STATE', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    rfp$change_lid_state (parameter_list, physical_id_list_p, logical_id_list_p, all_pids_specified,
                             state, status);
    IF status.normal THEN
      rfp$change_host_or_lid_state (physical_id_list_p, logical_id_list_p, all_pids_specified, state, status);
    IFEND;

    IF physical_id_list_p <> NIL THEN
      FREE physical_id_list_p;
    IFEND;
    IF logical_id_list_p <> NIL THEN
      FREE logical_id_list_p;
    IFEND;

  PROCEND change_lid_state;
?? TITLE := '    rfp$change_lid_state',EJECT ??
  PROCEDURE [XDCL] rfp$change_lid_state (parameter_list: clt$parameter_list;
    VAR physical_id_list_p: ^ARRAY [1 .. *] OF rft$physical_identifier;
    VAR logical_id_list_p: ^ARRAY [1 .. *] OF rft$logical_identifier;
    VAR all_pids_specified: BOOLEAN;
    VAR state: BOOLEAN;
    VAR status: ost$status);

*copy  rfh$change_lid_state
*copyc rfd$pdt_change_lid_state

    VAR
      i: INTEGER,
      set_count: 0 .. clc$max_value_sets,
      value: clt$value;
?? EJECT ??
    status.normal := TRUE;
    physical_id_list_p := NIL;
    logical_id_list_p := NIL;

    clp$scan_parameter_list (parameter_list, change_lid_state_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_set_count ('PHYSICAL_IDENTIFIER', set_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ALLOCATE physical_id_list_p: [1 .. set_count];
    IF physical_id_list_p = NIL THEN
      osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'default heap', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$CHANGE_LID_STATE',
          status);
    IFEND;
    all_pids_specified := FALSE;

    FOR i := 1 TO set_count DO

      clp$get_value ('PHYSICAL_IDENTIFIER', i, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      CASE value.kind OF
      = clc$name_value =
        IF set_count > 1 THEN
          osp$set_status_abnormal (rfc$product_id, rfe$too_many_key_values, value.name.value, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, 'PHYSICAL_IDENTIFIER', status);
          RETURN;
        IFEND;
        all_pids_specified := TRUE;
        physical_id_list_p^[i] := '';
      = clc$string_value =
        #TRANSLATE (osv$lower_to_upper, value.str.value,  physical_id_list_p^[i]);
      CASEND;

    FOREND;

    clp$get_set_count ('LOGICAL_IDENTIFIER', set_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ALLOCATE logical_id_list_p: [1 .. set_count];
    IF logical_id_list_p = NIL THEN
      osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'default heap', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$CHANGE_LID_STATE',
          status);
    IFEND;

    FOR i := 1 TO set_count DO

      clp$get_value ('LOGICAL_IDENTIFIER', i, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      #TRANSLATE (osv$lower_to_upper, value.str.value,  logical_id_list_p^[i]);

    FOREND;

    clp$get_value ('STATE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF value.name.value = 'OFF' THEN
      state := TRUE;
    ELSE
      state := FALSE;
    IFEND;

  PROCEND rfp$change_lid_state;
?? TITLE := '    change_nad_state',EJECT ??
  PROCEDURE change_nad_state (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copy  rfh$change_nad_state

    VAR
      nad_list_p: ^ARRAY [1 .. *] OF rft$component_name,
      state: rft$element_state,
      capability: ARRAY[1..1] OF ost$name;
?? EJECT ??
    status.normal := TRUE;

    capability[1] := avc$network_operation;

    rfp$verify_caller_capability (^capability, 'CHANGE_NAD_STATE', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    rfp$change_nad_state (parameter_list, nad_list_p, status);
    IF status.normal THEN
      rfp$change_nad_or_trunk_state (nad_list_p, NIL, state, status);
    IFEND;
    IF nad_list_p <> NIL THEN
      FREE nad_list_p;
    IFEND;

  PROCEND change_nad_state;
?? TITLE := '    rfp$change_nad_state',EJECT ??
  PROCEDURE [XDCL] rfp$change_nad_state (parameter_list: clt$parameter_list;
    VAR nad_list_p: ^ARRAY [1 .. *] OF rft$component_name;
    VAR status: ost$status);

*copy  rfh$change_nad_state
*copyc rfd$pdt_change_nad_state

    VAR
      element_state: [STATIC, READ] ARRAY [rft$element_state] of ost$name := ['ON', 'OFF', 'DOWN'],
      i: INTEGER,
      set_count: 0 .. clc$max_value_sets,
      state: rft$element_state,
      value: clt$value;
?? EJECT ??
    status.normal := TRUE;
    nad_list_p := NIL;

    clp$scan_parameter_list (parameter_list, change_nad_state_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_set_count ('NAD', set_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ALLOCATE nad_list_p: [1 .. set_count];
    IF nad_list_p = NIL THEN
      osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'default heap', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$CHANGE_NAD_STATE',
          status);
    IFEND;

    FOR i := 1 TO set_count DO

      clp$get_value ('NAD', i, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      nad_list_p^[i] := value.name.value;
    FOREND;

    clp$get_value ('STATE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    /state_loop/
      FOR state := LOWERVALUE(rft$element_state) TO UPPERVALUE(rft$element_state) DO
        IF element_state[state] = value.name.value THEN
          EXIT /state_loop/;
        IFEND;
      FOREND /state_loop/;

  PROCEND rfp$change_nad_state;
?? TITLE := '    change_trunk_state',EJECT ??
  PROCEDURE change_trunk_state (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copy  rfh$change_trunk_state

    VAR
      nad_list_p: ^ARRAY [1 .. *] OF rft$component_name,
      trunk_list_p: ^ARRAY [1 .. *] OF rft$component_name,
      state: rft$element_state,
      capability: ARRAY[1..1] OF ost$name;
?? EJECT ??
    status.normal := TRUE;

    capability[1] := avc$network_operation;

    rfp$verify_caller_capability (^capability, 'CHANGE_TRUNK_STATE', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    rfp$change_trunk_state (parameter_list, nad_list_p, trunk_list_p, state, status);
    IF status.normal THEN
      rfp$change_nad_or_trunk_state (nad_list_p, trunk_list_p, state, status);
    IFEND;
    IF nad_list_p <> NIL THEN
      FREE nad_list_p;
    IFEND;
    IF trunk_list_p <> NIL THEN
      FREE trunk_list_p;
    IFEND;

  PROCEND change_trunk_state;
?? TITLE := '    rfp$change_trunk_state',EJECT ??
  PROCEDURE [XDCL] rfp$change_trunk_state (parameter_list: clt$parameter_list;
    VAR nad_list_p: ^ARRAY [1 .. *] OF rft$component_name;
    VAR trunk_list_p: ^ARRAY [1 .. *] OF rft$component_name;
    VAR state: rft$element_state;
    VAR status: ost$status);

*copy  rfh$change_trunk_state
*copyc rfd$pdt_change_trunk_state

    VAR
      element_state: [STATIC, READ] ARRAY [rft$element_state] of ost$name := ['ON', 'OFF', 'DOWN'],
      i: INTEGER,
      set_count: 0 .. clc$max_value_sets,
      value: clt$value;
?? EJECT ??
    status.normal := TRUE;
    nad_list_p := NIL;
    trunk_list_p := NIL;

    clp$scan_parameter_list (parameter_list, change_trunk_state_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_set_count ('NAD', set_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ALLOCATE nad_list_p: [1 .. set_count];
    IF nad_list_p = NIL THEN
      osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'default heap', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$CHANGE_TRUNK_STATE',
          status);
    IFEND;

    FOR i := 1 TO set_count DO

      clp$get_value ('NAD', i, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (value.name.value = 'ALL') AND (set_count > 1) THEN
        osp$set_status_abnormal (rfc$product_id, rfe$too_many_key_values, value.name.value, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'NAD', status);
        RETURN;
      IFEND;
      nad_list_p^[i] := value.name.value;
    FOREND;

    clp$get_set_count ('TRUNK', set_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ALLOCATE trunk_list_p: [1 .. set_count];
    IF trunk_list_p = NIL THEN
      osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'default heap', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$CHANGE_TRUNK_STATE',
          status);
    IFEND;

    FOR i := 1 TO set_count DO

      clp$get_value ('TRUNK', i, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      trunk_list_p^[i] := value.name.value;
    FOREND;

    clp$get_value ('STATE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    /state_loop/
      FOR state := LOWERVALUE(rft$element_state) TO UPPERVALUE(rft$element_state) DO
        IF element_state[state] = value.name.value THEN
          EXIT /state_loop/;
        IFEND;
      FOREND /state_loop/;

  PROCEND rfp$change_trunk_state;
?? TITLE := '    deactivate_rhfam_client',EJECT ??
  PROCEDURE deactivate_rhfam_client (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copyc rfh$deactivate_rhfam_client
*copyc rfd$pdt_deactivate_rhfam_client

    VAR
      client: rft$application_name,
      capability: ARRAY[1..1] OF ost$name,
      terminate,
      value: clt$value;
??EJECT??
    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, deact_rhfam_client_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    capability[1] := avc$network_applic_management;

    rfp$verify_caller_capability (^capability, 'DEACTIVATE_RHFAM_CLIENT', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('CLIENT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    client := value.name.value;

    clp$get_value ('TERMINATE_ACTIVE_CONNECTIONS', 1, 1, clc$low, terminate, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    rfp$deactivate_rhfam_client (client, terminate.bool.value, status);

  PROCEND deactivate_rhfam_client;
?? TITLE := '    deactivate_rhfam_server',EJECT ??
  PROCEDURE deactivate_rhfam_server (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copyc rfh$deactivate_rhfam_server
*copyc rfd$pdt_deactivate_rhfam_server

    VAR
      server: rft$application_name,
      capability: ARRAY[1..1] OF ost$name,
      terminate,
      value: clt$value;
??EJECT??
    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, deact_rhfam_server_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    capability[1] := avc$network_applic_management;

    rfp$verify_caller_capability (^capability, 'DEACTIVATE_RHFAM_SERVER', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('SERVER', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    server := value.name.value;

    clp$get_value ('TERMINATE_ACTIVE_CONNECTIONS', 1, 1, clc$low, terminate, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    rfp$deactivate_rhfam_server (server, terminate.bool.value, status);

  PROCEND deactivate_rhfam_server;
?? TITLE := '    define_rhfam_client',EJECT ??
  PROCEDURE define_rhfam_client (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copyc rfh$define_rhfam_client
*copyc rfd$pdt_define_rhfam_client

    VAR
      client: rft$application_name,
      maximum_connections: rft$application_connections,
      user_capability: ost$name,
      ring: ost$ring,
      system_wide_connection_mgmt,
      system_privilege: boolean,
      capability: ARRAY[1..1] OF ost$name,
      value: clt$value;
??EJECT??
    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, define_rhfam_client_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    capability[1] := avc$network_applic_management;

    rfp$verify_caller_capability (^capability, 'DEFINE_RHFAM_CLIENT', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('CLIENT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF value.name.value = 'ALL' THEN
      osp$set_status_abnormal (rfc$product_id, rfe$all_is_not_a_legal_name, 'CLIENT', status);
      RETURN;
    IFEND;

    client := value.name.value;

    clp$get_value ('MAXIMUM_CONNECTIONS', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    maximum_connections := value.int.value;

    clp$get_value ('USER_CAPABILITY', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF value.name.value = 'NONE' THEN
      user_capability := osc$null_name;
    ELSE
      user_capability := value.name.value;
    IFEND;

    clp$get_value ('RING', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ring := value.int.value;

    clp$get_value ('SYSTEM_PRIVILEGE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    system_privilege := value.bool.value;

    clp$get_value ('SYSTEM_WIDE_CONNECTION_MGMT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    system_wide_connection_mgmt := value.bool.value;

    rfp$define_rhfam_client (client, maximum_connections, user_capability, ring,
          system_privilege ,system_wide_connection_mgmt, status);

  PROCEND define_rhfam_client;
?? TITLE := '    define_rhfam_server',EJECT ??
  PROCEDURE define_rhfam_server (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copyc rfh$define_rhfam_server
*copyc rfd$pdt_define_rhfam_server

    VAR
      server: rft$application_name,
      rhfam_initiated: boolean,
      maximum_connections: rft$application_connections,
      user_capability: ost$name,
      ring: ost$ring,
      system_privilege: boolean,
      server_job: amt$local_file_name,
      server_job_max_connections: rft$application_connections,
      server_job_specified: boolean,
      accept_connection: boolean,
      rhfam_validates_connection_lid: boolean,
      capability: ARRAY[1..1] OF ost$name,
      value: clt$value;
??EJECT ??
    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, define_rhfam_server_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    capability[1] := avc$network_applic_management;

    rfp$verify_caller_capability (^capability, 'DEFINE_RHFAM_SERVER', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('SERVER', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF value.name.value = 'ALL' THEN
      osp$set_status_abnormal (rfc$product_id, rfe$all_is_not_a_legal_name, 'SERVER', status);
      RETURN;
    IFEND;

    server := value.name.value;

    clp$get_value ('RHFAM_INITIATED', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    rhfam_initiated := value.bool.value;

    clp$get_value ('MAXIMUM_CONNECTIONS', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    maximum_connections := value.int.value;

    clp$get_value ('USER_CAPABILITY', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF value.name.value = 'NONE' THEN
      user_capability := osc$null_name;
    ELSE
      user_capability := value.name.value;
    IFEND;

    clp$get_value ('RING', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ring := value.int.value;

    clp$get_value ('SYSTEM_PRIVILEGE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    system_privilege := value.bool.value;

    clp$get_value ('ACCEPT_CONNECTION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    accept_connection := value.bool.value;

    clp$get_value ('RHFAM_VALIDATES_CONNECTION_LID', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    rhfam_validates_connection_lid := value.bool.value;

    server_job := osc$null_name;
    server_job_max_connections := 0;

    IF rhfam_initiated THEN

      clp$test_parameter ('SERVER_JOB', server_job_specified, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF NOT server_job_specified THEN
        osp$set_status_abnormal (rfc$product_id, rfe$server_job_not_specified, server, status);
        RETURN;
      ELSE;
        clp$get_value ('SERVER_JOB', 1, 1, clc$low, value, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        server_job := value.file.local_file_name;
      IFEND;

      clp$get_value ('SERVER_JOB_MAXIMUM_CONNECTIONS', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      server_job_max_connections := value.int.value;
    IFEND;

    rfp$define_rhfam_server (server, rhfam_initiated, maximum_connections, user_capability, ring,
          system_privilege, server_job, server_job_max_connections, accept_connection,
          rhfam_validates_connection_lid, status);

  PROCEND define_rhfam_server;
?? TITLE := '    delete_rhfam_client',EJECT ??
  PROCEDURE delete_rhfam_client (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copyc rfh$delete_rhfam_client
*copyc rfd$pdt_delete_rhfam_client

    VAR
      client: rft$application_name,
      capability: ARRAY[1..1] OF ost$name,
      value: clt$value;
??EJECT??
    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, delete_rhfam_client_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    capability[1] := avc$network_applic_management;

    rfp$verify_caller_capability (^capability, 'DELETE_RHFAM_CLIENT', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('CLIENT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    client := value.name.value;

    rfp$delete_rhfam_client (client, status);

  PROCEND delete_rhfam_client;
?? TITLE := '    delete_rhfam_server',EJECT ??
  PROCEDURE delete_rhfam_server (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copyc rfh$delete_rhfam_server
*copyc rfd$pdt_delete_rhfam_server

    VAR
      server: rft$application_name,
      capability: ARRAY[1..1] OF ost$name,
      value: clt$value;
??EJECT??
    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, delete_rhfam_server_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    capability[1] := avc$network_applic_management;

    rfp$verify_caller_capability (^capability, 'DELETE_RHFAM_SERVER', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('SERVER', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    server := value.name.value;

    rfp$delete_rhfam_server (server, status);

  PROCEND delete_rhfam_server;
?? TITLE := '    display_active_appl', EJECT ??
*block
  PROCEDURE display_active_appl (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copyc rfh$display_active_applications
*copyc rfd$pdt_display_active_appl

    VAR
      display_control: clt$display_control,
      job_name_list_p: ^ARRAY [1 .. *] OF ost$name,
      application_name_list_p: ^ARRAY [1 .. *] OF rft$application_name,
      display_type: rft$application_display_type,
      i: INTEGER,
      output_open_status,
      ignore_status: ost$status,
      set_count: 0 .. clc$max_value_sets,
      value: clt$value;

*copyc clv$display_variables
*copyc clp$abort_handler
?? NEWTITLE := '      clean_up', EJECT ??
    PROCEDURE clean_up;

      VAR
        ignore_status: ost$status;

      IF output_open_status.normal THEN
        clp$close_display (display_control,ignore_status);
      IFEND;

    PROCEND clean_up;
?? OLDTITLE, EJECT ??
?? NEWTITLE := '      put_subtitle', EJECT ??
    PROCEDURE put_subtitle (VAR display_control: clt$display_control;
      VAR status: ost$status);

      { The display_active_appl command has subtitles, but they are
      { written by another routine. This is a dummy routine to keep the module
      { consistent.

    PROCEND put_subtitle;
?? OLDTITLE, EJECT ??
    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, display_active_appl_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('DISPLAY_OPTION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF (value.name.value = 'APPLICATIONS') OR (value.name.value = 'A') THEN
      display_type := rfc$adt_applications;
    ELSE
      display_type := rfc$adt_connections;
    IFEND;

    clp$get_set_count ('JOB_NAME', set_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH job_name_list_p: [1 .. set_count];

    FOR i := 1 TO set_count DO

      clp$get_value ('JOB_NAME', i, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (value.name.value = 'ALL') AND (set_count > 1) THEN
        osp$set_status_abnormal (rfc$product_id, rfe$too_many_key_values, value.name.value, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'JOB_NAME', status);
        RETURN;
      IFEND;
      job_name_list_p^[i] := value.name.value;
    FOREND;

    clp$get_set_count ('APPLICATION_NAME', set_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH application_name_list_p: [1 .. set_count];

    FOR i := 1 TO set_count DO

      clp$get_value ('APPLICATION_NAME', i, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (value.name.value = 'ALL') AND (set_count > 1) THEN
        osp$set_status_abnormal (rfc$product_id, rfe$too_many_key_values, value.name.value, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'APPLICATION_NAME',
              status);
        RETURN;
      IFEND;
      application_name_list_p^[i] := value.name.value;
    FOREND;

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  /display_appl/
    BEGIN

      output_open_status.normal := FALSE;

      pmp$establish_condition_handler (clv$abort_conditions, ^clp$abort_handler,
            ^clv$established_abort_handler, status);
      IF NOT status.normal THEN
        EXIT /display_appl/;
      IFEND;

{     A new page procedure is not specified on clp$open_display because the
{     display is generated by ring 3 code.  If a new page procedure is specified
{     it is loaded at ring 11 and causes an outward call/inward return error
{     when writing to a file other than output.

      clp$open_display (value.file, NIL, display_control, output_open_status);
      IF NOT output_open_status.normal THEN
        status := output_open_status;
        EXIT /display_appl/;
      IFEND;

      clv$titles_built := FALSE;
      clv$command_name := 'display_active_applications';

      check_page_width (value, display_control, status);
      IF NOT status.normal THEN
        EXIT /display_appl/;
      IFEND;

      rfp$display_active_appl_r3 (job_name_list_p^, application_name_list_p^, display_type,
            display_control, status);
      IF NOT status.normal THEN
        EXIT /display_appl/;
      IFEND;

    END /display_appl/;

    IF output_open_status.normal THEN
      clp$close_display (display_control, ignore_status);
    IFEND;

  PROCEND display_active_appl;
*blockend
?? TITLE := '    display_nad_status', EJECT ??
*block
  PROCEDURE display_nad_status (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copyc rfh$display_nad_status
*copyc rfd$pdt_display_nad_status

    VAR
      display_control: clt$display_control,
      display_option: rft$display_option,
      display_type: rft$element_display_type,
      local_nad_list_p: ^ARRAY [1 .. *] OF rft$component_name,
      remote_nad_list_p: ^ARRAY [1 .. *] OF rft$component_name,
      i: INTEGER,
      output_open_status,
      ignore_status: ost$status,
      set_count: 0 .. clc$max_value_sets,
      value: clt$value;

*copyc clv$display_variables
*copyc clp$abort_handler
?? NEWTITLE := '      clean_up', EJECT ??
    PROCEDURE clean_up;

      VAR
        ignore_status: ost$status;

      IF output_open_status.normal THEN
        clp$close_display (display_control,ignore_status);
      IFEND;

    PROCEND clean_up;
?? PUSH (LISTEXT := ON) ??
?? OLDTITLE, EJECT ??
?? NEWTITLE := '      put_subtitle', EJECT ??
    PROCEDURE put_subtitle (VAR display_control: clt$display_control;
      VAR status: ost$status);

      { The display_nad_status command has subtitles, but they are written
      { by another routine. This is a dummy routine to keep the module
      { consistent.

    PROCEND put_subtitle;
?? POP ??
?? OLDTITLE, EJECT ??
    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, display_nad_status_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('DISPLAY_OPTION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF (value.name.value = 'BRIEF') OR (value.name.value = 'B') THEN
      display_option := rfc$do_brief;
    ELSE
      display_option := rfc$do_full;
    IFEND;

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  /display_nad/
    BEGIN

      output_open_status.normal := FALSE;

      pmp$establish_condition_handler (clv$abort_conditions, ^clp$abort_handler,
            ^clv$established_abort_handler, status);
      IF NOT status.normal THEN
        EXIT /display_nad/;
      IFEND;

{     A new page procedure is not specified on clp$open_display because the
{     display is generated by ring 3 code.  If a new page procedure is specified
{     it is loaded at ring 11 and causes an outward call/inward return error
{     when writing to a file other than output.

      clp$open_display (value.file, NIL, display_control, output_open_status);
      IF NOT output_open_status.normal THEN
        status := output_open_status;
        EXIT /display_nad/;
      IFEND;

      clv$titles_built := FALSE;
      clv$command_name := 'display_nad_status';

      check_page_width (value, display_control, status);
      IF NOT status.normal THEN
        EXIT /display_nad/;
      IFEND;

      clp$get_set_count ('LOCAL_NAD', set_count, status);
      IF NOT status.normal THEN
        EXIT /display_nad/;
      IFEND;

    /display_local_nads/
      BEGIN

        PUSH local_nad_list_p: [1 .. set_count];
        display_type := rfc$edt_local_nads;

        FOR i := 1 TO set_count DO

          clp$get_value ('LOCAL_NAD', i, 1, clc$low, value, status);
          IF NOT status.normal THEN
            EXIT /display_nad/;
          IFEND;

          IF ((value.name.value = 'ALL') OR (value.name.value = 'NONE')) AND (set_count > 1) THEN
            osp$set_status_abnormal (rfc$product_id, rfe$too_many_key_values, value.name.value, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, 'LOCAL_NAD', status);
            EXIT /display_nad/;
          IFEND;

          IF value.name.value = 'NONE' THEN
            EXIT /display_local_nads/;
          IFEND;

          local_nad_list_p^[i] := value.name.value;
        FOREND;

        rfp$display_rhfam_elements (local_nad_list_p^, display_type, display_option, display_control,
               status);
        IF NOT status.normal THEN
          EXIT /display_nad/;
        IFEND;

      END /display_local_nads/;

      clp$get_set_count ('REMOTE_NAD', set_count, status);
      IF NOT status.normal THEN
        EXIT /display_nad/;
      IFEND;

    /display_remote_nads/
      BEGIN

        PUSH remote_nad_list_p: [1 .. set_count];
        display_type := rfc$edt_remote_nads;

        FOR i := 1 TO set_count DO

          clp$get_value ('REMOTE_NAD', i, 1, clc$low, value, status);
          IF NOT status.normal THEN
            EXIT /display_nad/;
          IFEND;

          IF ((value.name.value = 'ALL') OR (value.name.value = 'NONE')) AND (set_count > 1) THEN
            osp$set_status_abnormal (rfc$product_id, rfe$too_many_key_values, value.name.value, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, 'REMOTE_NAD', status);
            EXIT /display_nad/;
          IFEND;

          IF value.name.value = 'NONE' THEN
            EXIT /display_remote_nads/;
          IFEND;

          remote_nad_list_p^[i] := value.name.value;
        FOREND;

        rfp$display_rhfam_elements (remote_nad_list_p^, display_type, display_option, display_control,
              status);
        IF NOT status.normal THEN
          EXIT /display_nad/;
        IFEND;

      END /display_remote_nads/;

    END /display_nad/;

    IF output_open_status.normal THEN
      clp$close_display (display_control, ignore_status);
    IFEND;

  PROCEND display_nad_status;
*blockend
?? TITLE := '    display_rhfam_clients', EJECT ??
*block
  PROCEDURE display_rhfam_clients (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copyc rfh$display_rhfam_clients
*copyc rfd$pdt_display_rhfam_clients

    VAR
      display_control: clt$display_control,
      client_list_p: ^ARRAY [1 .. *] OF rft$application_name,
      i: INTEGER,
      output_open_status,
      ignore_status: ost$status,
      set_count: 0 .. clc$max_value_sets,
      value: clt$value;

*copyc clv$display_variables
*copyc clp$abort_handler
?? NEWTITLE := '      clean_up', EJECT ??
    PROCEDURE clean_up;

      VAR
        ignore_status: ost$status;

      IF output_open_status.normal THEN
        clp$close_display (display_control,ignore_status);
      IFEND;

    PROCEND clean_up;
?? PUSH (LISTEXT := ON) ??
?? OLDTITLE, EJECT ??
?? NEWTITLE := '      put_subtitle', EJECT ??
    PROCEDURE put_subtitle (VAR display_control: clt$display_control;
      VAR status: ost$status);

      { The display_rhfam_clients command has subtitles, but they are written
      { by another routine. This is a dummy routine to keep the module
      { consistent.

    PROCEND put_subtitle;
?? POP ??
?? OLDTITLE, EJECT ??
    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, display_rhfam_client_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_set_count ('CLIENT', set_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH client_list_p: [1 .. set_count];

    FOR i := 1 TO set_count DO

      clp$get_value ('CLIENT', i, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (value.name.value = 'ALL') AND (set_count > 1) THEN
        osp$set_status_abnormal (rfc$product_id, rfe$too_many_key_values, value.name.value, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'CLIENT_DEFINITION', status);
        RETURN;
      IFEND;

      client_list_p^[i] := value.name.value;
    FOREND;

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  /display_clients/
    BEGIN

      output_open_status.normal := FALSE;

      pmp$establish_condition_handler (clv$abort_conditions, ^clp$abort_handler,
            ^clv$established_abort_handler, status);
      IF NOT status.normal THEN
        EXIT /display_clients/;
      IFEND;

{     A new page procedure is not specified on clp$open_display because the
{     display is generated by ring 3 code.  If a new page procedure is specified
{     it is loaded at ring 11 and causes an outward call/inward return error
{     when writing to a file other than output.

      clp$open_display (value.file, NIL, display_control, output_open_status);
      IF NOT output_open_status.normal THEN
        status := output_open_status;
        EXIT /display_clients/;
      IFEND;

      clv$titles_built := FALSE;
      clv$command_name := 'display_rhfam_clients';

      check_page_width (value, display_control, status);
      IF NOT status.normal THEN
        EXIT /display_clients/;
      IFEND;

      rfp$display_rhfam_clients (client_list_p^, display_control, status);
      IF NOT status.normal THEN
        EXIT /display_clients/;
      IFEND;

    END /display_clients/;

    IF output_open_status.normal THEN
      clp$close_display (display_control, ignore_status);
    IFEND;

  PROCEND display_rhfam_clients;
*blockend
?? TITLE := '    display_rhfam_servers', EJECT ??
*block
  PROCEDURE display_rhfam_servers (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copyc rfh$display_rhfam_servers
*copyc rfd$pdt_display_rhfam_servers

    VAR
      display_control: clt$display_control,
      server_list_p: ^ARRAY [1 .. *] OF rft$application_name,
      i: INTEGER,
      output_open_status,
      ignore_status: ost$status,
      set_count: 0 .. clc$max_value_sets,
      value: clt$value;

*copyc clv$display_variables
*copyc clp$abort_handler
?? NEWTITLE := '      clean_up', EJECT ??
    PROCEDURE clean_up;

      VAR
        ignore_status: ost$status;

      IF output_open_status.normal THEN
        clp$close_display (display_control,ignore_status);
      IFEND;

    PROCEND clean_up;
?? PUSH (LISTEXT := ON) ??
?? OLDTITLE, EJECT ??
?? NEWTITLE := '      put_subtitle', EJECT ??
    PROCEDURE put_subtitle (VAR display_control: clt$display_control;
      VAR status: ost$status);

      { The display_rhfam_server command has subtitles, but they are written
      { by another routine. This is a dummy routine to keep the module
      { consistent.

    PROCEND put_subtitle;
?? POP ??
?? OLDTITLE, EJECT ??
    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, display_rhfam_server_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_set_count ('SERVER', set_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH server_list_p: [1 .. set_count];

    FOR i := 1 TO set_count DO

      clp$get_value ('SERVER', i, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (value.name.value = 'ALL') AND (set_count > 1) THEN
        osp$set_status_abnormal (rfc$product_id, rfe$too_many_key_values, value.name.value, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'SERVER_DEFINITION', status);
        RETURN;
      IFEND;

      server_list_p^[i] := value.name.value;
    FOREND;

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  /display_servers/
    BEGIN

      output_open_status.normal := FALSE;

      pmp$establish_condition_handler (clv$abort_conditions, ^clp$abort_handler,
            ^clv$established_abort_handler, status);
      IF NOT status.normal THEN
        EXIT /display_servers/;
      IFEND;

{     A new page procedure is not specified on clp$open_display because the
{     display is generated by ring 3 code.  If a new page procedure is specified
{     it is loaded at ring 11 and causes an outward call/inward return error
{     when writing to a file other than output.

      clp$open_display (value.file, NIL, display_control, output_open_status);
      IF NOT output_open_status.normal THEN
        status := output_open_status;
        EXIT /display_servers/;
      IFEND;

      clv$titles_built := FALSE;
      clv$command_name := 'display_rhfam_servers';

      check_page_width (value, display_control, status);
      IF NOT status.normal THEN
        EXIT /display_servers/;
      IFEND;

      rfp$display_rhfam_servers (server_list_p^, display_control, status);
      IF NOT status.normal THEN
        EXIT /display_servers/;
      IFEND;

    END /display_servers/;

    IF output_open_status.normal THEN
      clp$close_display (display_control, ignore_status);
    IFEND;

  PROCEND display_rhfam_servers;
*blockend
?? TITLE := '    display_logical_identifier', EJECT ??
  PROCEDURE display_logical_identifier (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copyc rfh$display_logical_ids
*copyc rfd$pdt_display_logical_ids

    display_routing_info (parameter_list, display_logical_id_pdt, TRUE, status);

  PROCEND display_logical_identifier;
?? TITLE := '    display_physical_path', EJECT ??
  PROCEDURE display_physical_path (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copyc rfh$display_physical_paths
*copyc rfd$pdt_display_physical_paths

    display_routing_info (parameter_list, display_phys_paths_pdt, FALSE, status);

  PROCEND display_physical_path;
?? TITLE := '    display_routing_info', EJECT ??
*block
  PROCEDURE display_routing_info (parameter_list: clt$parameter_list;
        display_routing_info_pdt: clt$parameter_descriptor_table;
        logical_id_display: BOOLEAN;
    VAR status: ost$status);

{
{     This procedure does the utility level common processing for the
{ DISPLAY_LOGICAL_IDENTIFIER and DISPLAY_PHYSICAL_PATH commands. The
{ parameters received by these command processors are passed to this
{ routine along with a boolean value to denote which command is being
{ processed.
{

    VAR
      configuration_header: ^string(rfc$config_label_length),
      display_control: clt$display_control,
      display_type: rft$routing_display_type,
      i: INTEGER,
      config_file_attach_status,
      config_file_open_status,
      output_open_status,
      ignore_status: ost$status,
      config_file_lfn: amt$local_file_name,
      config_file_id: amt$file_identifier,
      config_file_p: amt$segment_pointer,
      all_pids_specified,
      all_lids_specified,
      local_pid_specified: BOOLEAN,
      logical_id_list_p: ^ARRAY [1 .. *] OF rft$logical_identifier,
      physical_id_list_p: ^ARRAY [1 .. *] OF rft$physical_identifier,
      path: ^pft$path,
      password: pft$name,
      usage_selections: pft$usage_selections,
      share_selections: pft$share_selections,
      cycle_selector: pft$cycle_selector,
      set_count: 0 .. clc$max_value_sets,
      unique_name: ost$unique_name,
      value: clt$value;
*copyc clv$display_variables
*copyc clp$abort_handler
?? NEWTITLE := '      clean_up', EJECT ??
    PROCEDURE clean_up;

      VAR
        ignore_status: ost$status;

      IF config_file_open_status.normal THEN
        fsp$close_file (config_file_id, ignore_status);
        amp$return(config_file_lfn, ignore_status);
      ELSEIF config_file_attach_status.normal THEN
        amp$return(config_file_lfn, ignore_status);
      IFEND;

      IF output_open_status.normal THEN
        clp$close_display (display_control,ignore_status);
      IFEND;

    PROCEND clean_up;
?? PUSH (LISTEXT := ON) ??
?? OLDTITLE, EJECT ??
?? NEWTITLE := '      put_subtitle', EJECT ??
    PROCEDURE put_subtitle (VAR display_control: clt$display_control;
      VAR status: ost$status);

      { The display_logical_identifier and display_physical_paths commands
      { have subtitles, but they are written by another routine. This is a
      { dummy routine to keep the module consistent.

    PROCEND put_subtitle;
?? POP ??
?? OLDTITLE, EJECT ??
    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, display_routing_info_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_set_count ('PHYSICAL_IDENTIFIER', set_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH physical_id_list_p: [1 .. set_count];
    all_pids_specified := FALSE;
    local_pid_specified := FALSE;

    FOR i := 1 TO set_count DO

      clp$get_value ('PHYSICAL_IDENTIFIER', i, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      CASE value.kind OF
      = clc$name_value =
        IF set_count > 1 THEN
          osp$set_status_abnormal (rfc$product_id, rfe$too_many_key_values, value.name.value, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, 'PHYSICAL_IDENTIFIER', status);
          RETURN;
        IFEND;
        local_pid_specified := TRUE;
        IF value.name.value = 'ALL' THEN
          all_pids_specified := TRUE;
        IFEND;
        physical_id_list_p^[i] := '';
      = clc$string_value =
        #TRANSLATE (osv$lower_to_upper, value.str.value,  physical_id_list_p^[i]);
      CASEND;

    FOREND;

    IF logical_id_display THEN
      display_type := rfc$rdt_lids;
      clv$command_name := 'display_logical_identifier';

      clp$get_set_count ('LOGICAL_IDENTIFIER', set_count, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      PUSH logical_id_list_p: [1 .. set_count];
      all_lids_specified := FALSE;

      FOR i := 1 TO set_count DO

        clp$get_value ('LOGICAL_IDENTIFIER', i, 1, clc$low, value, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        CASE value.kind OF
        = clc$name_value =
          IF set_count > 1 THEN
            osp$set_status_abnormal (rfc$product_id, rfe$too_many_key_values, value.name.value, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, 'LOGICAL_IDENTFIER', status);
            RETURN;
          IFEND;
          IF value.name.value <> 'NONE' THEN
            all_lids_specified := TRUE;
          IFEND;
          logical_id_list_p^[i] := '';
        = clc$string_value =
          #TRANSLATE (osv$lower_to_upper, value.str.value,  logical_id_list_p^[i]);
        CASEND;

      FOREND;

    ELSE
      display_type := rfc$rdt_paths;
      clv$command_name := 'display_physical_path';
      PUSH logical_id_list_p: [1..1];
      logical_id_list_p^[1] := '';
      all_lids_specified := FALSE;
    IFEND;

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  /display_routing/
    BEGIN

      config_file_attach_status.normal := FALSE;
      config_file_open_status.normal := FALSE;
      output_open_status.normal := FALSE;

      pmp$establish_condition_handler (clv$abort_conditions, ^clp$abort_handler,
            ^clv$established_abort_handler, status);
      IF NOT status.normal THEN
        EXIT /display_routing/;
      IFEND;

{     A new page procedure is not specified on clp$open_display because the
{     display is generated by ring 3 code.  If a new page procedure is specified
{     it is loaded at ring 11 and causes an outward call/inward return error
{     when writing to a file other than output.

      clp$open_display (value.file, NIL, display_control, output_open_status);
      IF NOT output_open_status.normal THEN
        status := output_open_status;
        EXIT /display_routing/;
      IFEND;

      clv$titles_built := FALSE;

      check_page_width (value, display_control, status);
      IF NOT status.normal THEN
        EXIT /display_routing/;
      IFEND;

      clp$get_value ('DISPLAY_OPTION', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (value.name.value = 'INSTALLED') OR (value.name.value = 'I') THEN

        pmp$generate_unique_name (unique_name, status);
        IF NOT status.normal THEN
          EXIT /display_routing/;
        IFEND;

        config_file_lfn := unique_name.value;

        PUSH path : [1..4];
        path^[1] := rfc$rhfam_family_name;
        path^[2] := rfc$rhfam_master_catalog;
        path^[3] := rfc$rhfam_sub_catalog;
        path^[4] := rfc$configuration_file;
        usage_selections := $pft$usage_selections[pfc$read];
        share_selections := $pft$share_selections[pfc$read,pfc$execute];
        cycle_selector.cycle_option := pfc$highest_cycle;
        password := rfc$password;

        pfp$attach(config_file_lfn, path^, cycle_selector, password, usage_selections, share_selections,
               pfc$no_wait, config_file_attach_status);
        IF NOT config_file_attach_status.normal THEN
          status := config_file_attach_status;
          EXIT /display_routing/;
        IFEND;

        fsp$open_file (config_file_lfn, amc$segment, NIL, NIL, NIL, NIL, NIL, config_file_id,
              config_file_open_status);
        IF NOT config_file_open_status.normal THEN
          status := config_file_open_status;
          EXIT /display_routing/;
        IFEND;

        amp$get_segment_pointer (config_file_id, amc$sequence_pointer, config_file_p, status);
        IF NOT status.normal THEN
          EXIT /display_routing/;
        IFEND;
        RESET config_file_p.sequence_pointer;
        NEXT configuration_header IN config_file_p.sequence_pointer;
        IF (configuration_header = NIL) OR (configuration_header^ <> rfc$configuration_label) THEN
          osp$set_status_abnormal (rfc$product_id, rfe$not_an_rhfam_config_file,
                value.file.local_file_name, status);
          EXIT /display_routing/;
        IFEND;
      ELSE
        config_file_p.sequence_pointer := NIL;
      IFEND;

      rfp$display_routing_info_r3 (physical_id_list_p^, logical_id_list_p^, local_pid_specified,
            all_pids_specified, all_lids_specified, display_type, config_file_p.sequence_pointer,
            display_control, status);
      IF NOT status.normal THEN
        EXIT /display_routing/;
      IFEND;

    END /display_routing/;

    IF config_file_open_status.normal THEN
      fsp$close_file (config_file_id, ignore_status);
      amp$return(config_file_lfn, ignore_status);
    ELSEIF config_file_attach_status.normal THEN
      amp$return(config_file_lfn, ignore_status);
    IFEND;

    IF output_open_status.normal THEN
      clp$close_display (display_control, ignore_status);
    IFEND;

  PROCEND display_routing_info;
*blockend
?? TITLE := '    display_trunk_status', EJECT ??
*block
  PROCEDURE display_trunk_status (parameter_list: clt$parameter_list;
    VAR status: ost$status);

*copyc rfh$display_trunk_status
*copyc rfd$pdt_display_trunk_status

    VAR
      display_control: clt$display_control,
      display_option: rft$display_option,
      display_type: rft$element_display_type,
      trunk_list_p: ^ARRAY [1 .. *] OF rft$component_name,
      i: INTEGER,
      output_open_status,
      ignore_status: ost$status,
      set_count: 0 .. clc$max_value_sets,
      value: clt$value;
*copyc clv$display_variables
*copyc clp$abort_handler
?? NEWTITLE := '      clean_up', EJECT ??
    PROCEDURE clean_up;

      VAR
        ignore_status: ost$status;

      IF output_open_status.normal THEN
        clp$close_display (display_control,ignore_status);
      IFEND;

    PROCEND clean_up;
?? PUSH (LISTEXT := ON) ??
?? OLDTITLE, EJECT ??
?? NEWTITLE := '      put_subtitle', EJECT ??
    PROCEDURE put_subtitle (VAR display_control: clt$display_control;
      VAR status: ost$status);

      { The display_trunk_status command has subtitles, but they are written
      { by another routine. This is a dummy routine to keep the module
      { consistent.

    PROCEND put_subtitle;
?? POP ??
?? OLDTITLE, EJECT ??
    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, display_trunk_status_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('DISPLAY_OPTION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF (value.name.value = 'BRIEF') OR (value.name.value = 'B') THEN
      display_option := rfc$do_brief;
    ELSE
      display_option := rfc$do_full;
    IFEND;

    clp$get_set_count ('TRUNK', set_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH trunk_list_p: [1 .. set_count];
    display_type := rfc$edt_trunks;

    FOR i := 1 TO set_count DO

      clp$get_value ('TRUNK', i, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (value.name.value = 'ALL') AND (set_count > 1) THEN
        osp$set_status_abnormal (rfc$product_id, rfe$too_many_key_values, value.name.value, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'TRUNK', status);
        RETURN;
      IFEND;
      trunk_list_p^[i] := value.name.value;
    FOREND;

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  /display_trunk/
    BEGIN

      output_open_status.normal := FALSE;

      pmp$establish_condition_handler (clv$abort_conditions, ^clp$abort_handler,
            ^clv$established_abort_handler, status);
      IF NOT status.normal THEN
        EXIT /display_trunk/;
      IFEND;

{     A new page procedure is not specified on clp$open_display because the
{     display is generated by ring 3 code.  If a new page procedure is specified
{     it is loaded at ring 11 and causes an outward call/inward return error
{     when writing to a file other than output.

      clp$open_display (value.file, NIL, display_control, output_open_status);
      IF NOT output_open_status.normal THEN
        status := output_open_status;
        EXIT /display_trunk/;
      IFEND;

      clv$titles_built := FALSE;
      clv$command_name := 'display_trunk_status';

      check_page_width (value, display_control, status);
      IF NOT status.normal THEN
        EXIT /display_trunk/;
      IFEND;

      rfp$display_rhfam_elements (trunk_list_p^, display_type, display_option, display_control, status);
      IF NOT status.normal THEN
        EXIT /display_trunk/;
      IFEND;

    END /display_trunk/;

    IF output_open_status.normal THEN
      clp$close_display (display_control, ignore_status);
    IFEND;

  PROCEND display_trunk_status;
*blockend
*block
?? TITLE := '    format_nad_dump', EJECT ??
  PROCEDURE format_nad_dump (parameter_list: clt$parameter_list;
   VAR status: ost$status);

*copyc rfh$format_nad_dump
*copyc rfd$pdt_format_nad_dump

    CONST
      bytes_per_word = 2,
      words_per_item = 8,
      space_for_ascii_item = bytes_per_word * words_per_item,
      radix = 16,
      size_of_address = 4,
      spaces_bet_ad_and_display = 2,
      space_for_numeric_word = 4,
      space_for_numeric_item = words_per_item * (space_for_numeric_word + 1),
      fixed = size_of_address + spaces_bet_ad_and_display;

    VAR
      control_codes_to_space: [STATIC, READ] string (256) := '            '
            CAT '                     !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcd'
            CAT 'efghijklmnopqrstuvwxyz{|}~                                                                '
            CAT '                                                                 ',
      current_item: 1 .. 63,
      current_word: 1 .. words_per_item,
      display_address: 0 .. 0ffff(16),
      display_control: clt$display_control,
      first_item: ^cell,
      header: [STATIC, READ] string (80) := '   0    1    2    3    4    5    6    7'
            CAT '    8    9    A    B    C    D    E    F ',
      ignore_status: ost$status,
      item_ascii: ^string ( * ),
      items_per_line: 0 .. 100,
      line_buffer: ^string ( * ),
      line_index: 1 .. 256,
      micro_code_p: ^SEQ ( * ),
      nad_dump_file_id: amt$file_identifier,
      nad_dump_file_open_status,
      output_open_status,
      local_status: ost$status,
      nad_dump_file_attach: array [1 .. 3] of fst$attachment_option,
      nad_dump_file_p: amt$segment_pointer,
      page_width: amt$page_width,
      previous_line: ^string ( * ),
      repeated_lines: integer,
      word: ^0 .. 0ffff(16),
      words_this_line: 0 .. 16,
      value: clt$value;
*copyc clv$display_variables
*copyc clp$abort_handler
?? NEWTITLE := '      clean_up', EJECT ??
    PROCEDURE clean_up;

      VAR
        ignore_status: ost$status;

      IF nad_dump_file_open_status.normal THEN
        fsp$close_file (nad_dump_file_id, ignore_status);
      IFEND;

      IF output_open_status.normal THEN
        clp$close_display (display_control,ignore_status);
      IFEND;

    PROCEND clean_up;
*copyc clp$new_page_procedure
?? OLDTITLE, EJECT ??
?? NEWTITLE := '      print_subtitle', EJECT ??
    PROCEDURE print_subtitle (header: string (80);
      VAR status: ost$status);

      clp$new_display_line (display_control, 1, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$horizontal_tab_display (display_control, fixed + 1, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$put_partial_display (display_control, header(1, space_for_numeric_item * items_per_line), clc$trim,
            amc$continue, status);

    PROCEND print_subtitle;
?? OLDTITLE, EJECT ??
?? NEWTITLE := '      put_subtitle', EJECT ??
    PROCEDURE put_subtitle (VAR display_control: clt$display_control;
      VAR status: ost$status);

      print_subtitle (header,status);

    PROCEND put_subtitle;
?? OLDTITLE, EJECT ??
?? NEWTITLE := '      display_status_message', EJECT ??
    PROCEDURE display_status_message (status_message: ost$status;
      VAR display_control: clt$display_control;
      VAR status: ost$status);

      VAR
        line_counter: ost$status_message_line_count,
        line_count: ^ost$status_message_line_count,
        line_size: ^ost$status_message_line_size,
        message: ^ost$status_message,
        message_level: ost$status_message_level,
        message_width: ost$max_status_message_line,
        message_line: ^string ( * );

      osp$get_message_level (message_level, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      PUSH message;
      RESET message;
      IF display_control.page_width < LOWERVALUE (message_width) THEN
        message_width := LOWERVALUE (message_width);
      ELSEIF display_control.page_width > UPPERVALUE (message_width) THEN
        message_width := UPPERVALUE (message_width);
      ELSE
        message_width := display_control.page_width;
      IFEND;
      osp$format_message (status_message, message_level, message_width, message^,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      RESET message;
      NEXT line_count IN message;
      FOR line_counter := 1 TO line_count^ DO
        NEXT line_size IN message;
        NEXT message_line: [line_size^] IN message;
        clp$put_display (display_control, message_line^, clc$no_trim, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND;

    PROCEND display_status_message;
?? OLDTITLE ??
?? EJECT ??
    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, format_nad_dump_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  /format_dump/
    BEGIN

      nad_dump_file_open_status.normal := FALSE;
      output_open_status.normal := FALSE;

      pmp$establish_condition_handler (clv$abort_conditions, ^clp$abort_handler,
            ^clv$established_abort_handler, status);
      IF NOT status.normal THEN
        EXIT /format_dump/;
      IFEND;

      clp$open_display (value.file, ^clp$new_page_procedure, display_control, output_open_status);
      IF NOT output_open_status.normal THEN
        status := output_open_status;
        EXIT /format_dump/;
      IFEND;

      clv$titles_built := FALSE;
      clv$command_name := 'format_nad_dump';

      clp$get_value ('DUMP_FILE', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        EXIT /format_dump/;
      IFEND;
      nad_dump_file_attach [1].selector := fsc$access_and_share_modes;
      nad_dump_file_attach [1].access_modes.selector := fsc$specific_access_modes;
      nad_dump_file_attach [1].access_modes.value := $fst$file_access_options [fsc$read];
      nad_dump_file_attach [1].share_modes.selector := fsc$determine_from_access_modes;
      nad_dump_file_attach [2].selector := fsc$create_file;
      nad_dump_file_attach [2].create_file := FALSE;
      nad_dump_file_attach [3].selector := fsc$open_position;
      nad_dump_file_attach [3].open_position := amc$open_at_boi;

      fsp$open_file (value.file.local_file_name, amc$segment, ^nad_dump_file_attach, NIL, NIL, NIL,
            NIL, nad_dump_file_id, nad_dump_file_open_status);
      IF NOT nad_dump_file_open_status.normal THEN
        status := nad_dump_file_open_status;
        EXIT /format_dump/;
      IFEND;

      amp$get_segment_pointer (nad_dump_file_id, amc$sequence_pointer, nad_dump_file_p, status);
      IF NOT status.normal THEN
        EXIT /format_dump/;
      IFEND;

      micro_code_p := nad_dump_file_p.sequence_pointer;
      RESET micro_code_p;
      NEXT word IN micro_code_p;
      IF word = NIL THEN
        osp$set_status_abnormal (rfc$product_id, rfe$nad_dump_file_empty,
              value.file.local_file_name, status);
        EXIT /format_dump/;
      IFEND;
      RESET micro_code_p;

      IF display_control.page_width > 132 THEN
        page_width := 132;
      ELSEIF display_control.page_width < 40 THEN
        page_width := 40;
      ELSE
        page_width := display_control.page_width;
      IFEND;
      items_per_line := (page_width - fixed) DIV (space_for_ascii_item +
            space_for_numeric_item);
      IF items_per_line = 0 THEN
        items_per_line := 1;
        page_width := fixed + space_for_ascii_item + space_for_numeric_item;
      IFEND;

      PUSH line_buffer: [page_width];
      PUSH previous_line: [page_width];

      previous_line^ := ' ';
      repeated_lines := 0;
      display_address := 0;

    /display_items/
      WHILE TRUE DO
        NEXT word IN micro_code_p;
        IF word = NIL THEN
          EXIT /format_dump/;
        IFEND;
        first_item := word;
        RESET micro_code_p TO first_item;

        line_buffer^ := '';
        line_index := 1;
        clp$convert_integer_to_rjstring (display_address, radix, FALSE, ' ',
              line_buffer^ (line_index, size_of_address), status);
        IF NOT status.normal THEN
          EXIT /format_dump/;
        IFEND;
        line_index := line_index + size_of_address + spaces_bet_ad_and_display;
        words_this_line := 0;

      /format_numeric/
        FOR current_item := 1 TO items_per_line DO
          FOR current_word := 1 TO words_per_item DO
            NEXT word IN micro_code_p;
            IF word = NIL THEN
              EXIT /format_numeric/;
            IFEND;
            IF word^ = 0 THEN
              line_buffer^ (line_index + (space_for_numeric_word - 4), 4) :=
                '----';
            ELSE
              clp$convert_integer_to_rjstring (word^, radix, FALSE, '0',
                    line_buffer^ (line_index, space_for_numeric_word), status);
              IF NOT status.normal THEN
                EXIT /format_dump/;
              IFEND;
            IFEND;
            line_index := line_index + space_for_numeric_word + 1;
            words_this_line := words_this_line + 1;
          FOREND;
        FOREND /format_numeric/;

        RESET micro_code_p TO first_item;
        NEXT item_ascii: [words_this_line * bytes_per_word] IN micro_code_p;
        IF item_ascii = NIL THEN
          clp$put_display (display_control, previous_line^, clc$trim, status);
          EXIT /format_dump/;
        IFEND;
        #TRANSLATE (control_codes_to_space, item_ascii^, line_buffer^
              (line_index, words_this_line * bytes_per_word));
        IF line_buffer^(size_of_address + 1, * ) = previous_line^(size_of_address + 1, * ) THEN
          previous_line^ := line_buffer^;
          repeated_lines := repeated_lines + 1;
        ELSE
          IF repeated_lines > 1 THEN
            osp$set_status_abnormal (rfc$product_id, rfe$skipped_lines, '', local_status);
            osp$append_status_integer (osc$status_parameter_delimiter, repeated_lines, 10, FALSE,
                  local_status);
            display_status_message (local_status, display_control, status);
            IF NOT status.normal THEN
              EXIT /format_dump/;
            IFEND;
          ELSEIF repeated_lines = 1 THEN
            clp$put_display (display_control, previous_line^, clc$trim, status);
            IF NOT status.normal THEN
              EXIT /format_dump/;
            IFEND;
          IFEND;
          repeated_lines := 0;
          clp$put_display (display_control, line_buffer^, clc$trim, status);
          IF NOT status.normal THEN
            EXIT /format_dump/;
          IFEND;
          previous_line^ := line_buffer^;
        IFEND;
        display_address := display_address + words_this_line;
      WHILEND /display_items/;

    END /format_dump/;

    IF nad_dump_file_open_status.normal THEN
      fsp$close_file (nad_dump_file_id, ignore_status);
    IFEND;

    IF output_open_status.normal THEN
      clp$close_display (display_control, ignore_status);
    IFEND;

  PROCEND format_nad_dump;
*blockend
?? TITLE := '    quit', EJECT ??
  PROCEDURE quit (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{  PDT quit_pdt ()

?? PUSH (LISTEXT := ON) ??

  VAR
    quit_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [NIL, NIL];

?? POP ??
    clp$scan_parameter_list (parameter_list, quit_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$end_scan_command_file (rfv$utility_name, status);

  PROCEND quit;
?? TITLE := '   test_local_nad',EJECT ??
  PROCEDURE test_local_nad (parameter_list: clt$parameter_list;
  VAR status: ost$status);

*copyc rfh$test_local_nad
*copyc rfd$pdt_test_local_nad

    CONST
      gen_error_report = 'GENERATE_LCN_ERROR_REPORT ';


    VAR
      capability: ARRAY[1..1] OF ost$name,
      test_local_nad_complete: BOOLEAN,
      nad_name_s: string (31),
      nad_name: rft$component_name,
      command: ^string ( * ),
      len: integer,
      hold_status: ost$status,
      task_id: pmt$task_id,
      value: clt$value,
      wait_time : INTEGER;

?? EJECT ??
    status.normal := TRUE;

    capability[1] := avc$network_operation;

    rfp$verify_caller_capability (^capability, 'TEST_LOCAL_NAD', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$scan_parameter_list (parameter_list, test_local_nad_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('NAD', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    nad_name := value.name.value;

    rfp$initiate_local_nad_test (nad_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    test_local_nad_complete := FALSE;

  /wait_local_nad_test_complete/
    WHILE (NOT test_local_nad_complete) AND status.normal DO
      pmp$long_term_wait (500,500);
      rfp$check_local_nad_test (nad_name, test_local_nad_complete, status);

    WHILEND /wait_local_nad_test_complete/;

    IF (NOT  status.normal)   AND  (status.condition = rfe$test_nad_failure) THEN
      hold_status := status;
      stringrep(nad_name_s, len, nad_name : 31);
      PUSH command: [26+len];
      command^ := gen_error_report;
      command^(27) := nad_name_s;
      clp$execute_command (  command^, '', FALSE, '', task_id, status );
      status := hold_status;
    IFEND;

  PROCEND test_local_nad;
?? OLDTITLE ??

MODEND rfm$manage_rhfam_network;
