PROCEDURE qcp$make_correction_ds_tape (
  external_vsn, evsn, ev: any of
      string 1..6
      name 1..6
    anyend = $optional
  recorded_vsn, rvsn, rv: any of
      string 1..6
      name 1..6
    anyend = $optional
  type, t: any of
      key
        mt9$1600
        mt9$6250
        mt18$38000
      keyend
    anyend = mt9$6250
  product_files, pf: (HIDDEN) list of file = $optional
  output, o: file = $output
  removable_media_group, rmg: (BY_NAME, ADVANCED) any of
      key
        none
      keyend
      name
    anyend = osd$reqmt_removable_media_group, none
  unload_deadstart_tape, udt: boolean = TRUE
  status)

*copyc dst$deadstart_record_lists

  crev ignore k=status

      IF $file($value(output) open_position) = '$BOI' THEN
        rewind_file $value(output) status=ignore
        ofile = $string($value(output))//'.$ASIS'
      ELSE
        ofile = $string($value(output))
      IFEND

 putl ' '  o=$fname(ofile)
 put_line '     Generate Correction Deadstart Tape'  o=$fname(ofile)



  TYPE
    files_record: RECORD
      name: string 0 .. $max_name
      file_id: string 1 .. 17
    RECEND
  TYPEND

   crev deadstart_base k=string v='$system.qcu_maintenance'
   crev deadstart_catalog k=string
   crev id_path k=string v= deadstart_base//'.identification'

   detf $fname(id_path) status=ignore

  VAR
    work: string
    block_type: name
    deadstart_tape: string 0 .. $max_name = $unique
    file_count: integer
    file_id: string 0 .. $max_name
    file_name: file
    file_name_string: string
    ignore_status: status
    index: integer
    local_status: status
    record_type: name
    temp_product_list: list 0 .. $max_list of file
    total_deadstart_file_count: integer
  VAREND

  IF $specified(product_files) THEN
    total_deadstart_file_count = deadstart_file_count + $size(product_files)
  ELSE
    total_deadstart_file_count = deadstart_file_count
  IFEND

  VAR
    deadstart_files: ARRAY 1 .. total_deadstart_file_count OF files_record
  VAREND

  FOR index = 1 TO total_deadstart_file_count DO
    deadstart_files(index).name = $unique
  FOREND

    IF NOT $file($fname(deadstart_base),catalog) THEN
      putl ' '                                        o=$fname(ofile//'.$eoi')
      putl '                     STOP' o=$fname(ofile//'.$eoi')
      putl '      No deadstart catalog material is currently'   o=$fname(ofile//'.$eoi')
      putl '      available. It will be necessary to issue the' o=$fname(ofile//'.$eoi')
      putl '      Generate_correction_system (GENCS) command'   o=$fname(ofile//'.$eoi')
      putl '      to create new deadstart catalog material '    o=$fname(ofile//'.$eoi')
      putl '      prior to reissueing this command.'            o=$fname(ofile//'.$eoi')
      putl ' '                                                  o=$fname(ofile//'.$eoi')
      EXIT_PROC
    IFEND

  crevdt_block: BLOCK
    attach_file f=$fname(id_path) op=$asis
    accl work i=$fname(id_path)
    deadstart_catalog = deadstart_base//'.'//work//'.deadstart_catalog'
    detf $fname(id_path) status=ignore
    display_catalog c=$fname(deadstart_catalog) o=$null status=local_status
    EXIT crevdt_block WHEN NOT local_status.normal

    IF NOT $specified(external_vsn) AND NOT $specified(recorded_vsn) THEN
      IF removable_media_group = 'NONE' THEN
        local_status = $status(FALSE, 'DS', dse$vsn_required)
        EXIT crevdt_block
      IFEND
    IFEND

    " Acquire the deadstart files.


    file_count = 1
    acquire_files: FOR index = 1 TO deadstart_file_count DO
      IF index = deadstart_file_count THEN
        IF $specified(product_files) THEN
          temp_product_list = product_files
          WHILE NOT $nil(temp_product_list) DO
            file_name = $first(temp_product_list)
            temp_product_list = $rest(temp_product_list)
            attach_file f=file_name lfn=$name(deadstart_files(file_count).name) am=(read execute) ..
                  sm=(read execute) status=local_status
            EXIT crevdt_block WHEN NOT local_status.normal
            file_id = $strrep($first($reverse($path_elements(file_name))))
            IF $size(file_id) > 17 THEN
              deadstart_files(file_count).file_id = file_id(1, 17)
            ELSE
              deadstart_files(file_count).file_id = file_id
            IFEND
            file_count = file_count + 1
          WHILEND
        IFEND
      IFEND

      IF deadstart_file_list(index).site_catalog = '' THEN
        file_name_string = $string(deadstart_catalog)//'.'//deadstart_file_list(index).tape_name
      ELSE
        file_name_string = $string(deadstart_catalog)//'.'//deadstart_file_list(index).site_catalog//'.'// ..
              deadstart_file_list(index).tape_name
      IFEND
      attach_file f=$fname(file_name_string) lfn=$name(deadstart_files(file_count).name) am=(read execute) ..
            sm=(read execute) status=local_status
      IF NOT local_status.normal THEN
        IF deadstart_file_list(index).site_required THEN
          EXIT crevdt_block
        ELSE
          CYCLE acquire_files
        IFEND
      IFEND
      deadstart_files(file_count).file_id = deadstart_file_list(index).tape_name
      file_count = file_count + 1
    FOREND acquire_files


    " Request the deadstart tape.

    IF NOT $specified(external_vsn) AND NOT $specified(recorded_vsn) THEN
      request_magnetic_tape f=$fname(deadstart_tape) r=TRUE ..
            t=type rmg=removable_media_group status=local_status
    ELSEIF NOT $specified(external_vsn) THEN
      request_magnetic_tape f=$fname(deadstart_tape) rvsn=recorded_vsn r=TRUE ..
            t=type rmg=removable_media_group status=local_status
    ELSEIF NOT $specified(recorded_vsn) THEN
      request_magnetic_tape f=$fname(deadstart_tape) evsn=external_vsn r=TRUE ..
            t=type rmg=removable_media_group status=local_status
    ELSE
      request_magnetic_tape f=$fname(deadstart_tape) evsn=external_vsn ..
            rvsn=recorded_vsn r=TRUE t=type rmg=removable_media_group ..
            status=local_status
    IFEND
    EXIT crevdt_block WHEN NOT local_status.normal

    set_file_attribute f=$fname(deadstart_tape) flt=labelled status=local_status
    EXIT crevdt_block WHEN NOT local_status.normal

    IF type = 'MT18$38000' THEN
       maxbl=32640
    ELSE
       maxbl=4128
    IFEND

    " Copy the deadstart files to the deadstart tape.

    putl ' '                                                    o=$fname(ofile//'.$eoi')
    put_line l='     Move files to the deadstart tape.'   o=$fname(ofile//'.$eoi')
    putl ' '                                              o=$fname(ofile//'.$eoi')


    FOR index = 1 TO (file_count - 1) DO
      get_block_and_record_type i=$fname(deadstart_files(index).name) bt=block_type rt=record_type ..
            status=local_status
      EXIT crevdt_block WHEN NOT local_status.normal
      change_tape_label_attributes f=$fname(deadstart_tape) fsp=next_file rl=TRUE ..
            fi=deadstart_files(index).file_id bt=block_type rt=record_type status=local_status
      EXIT crevdt_block WHEN NOT local_status.normal
      put_line l='     Copy '//deadstart_files(index).file_id o=$response
      copy_file i=$fname(deadstart_files(index).name) o=$fname(deadstart_tape) status=local_status
      EXIT crevdt_block WHEN NOT local_status.normal
    FOREND

    putl ' '  o=$fname(ofile//'.$eoi')
    put_line l=' Deadstart tape written.' o=$fname(ofile//'.$eoi')

  BLOCKEND crevdt_block

  detach_file f=$fname(deadstart_tape) uv=unload_deadstart_tape status=ignore_status

  FOR index = 1 TO total_deadstart_file_count DO
    detach_file f=$fname(deadstart_files(index).name) status=ignore_status
  FOREND

  EXIT PROCEDURE WITH local_status WHEN NOT local_status.normal

PROCEND qcp$make_correction_ds_tape
