PROCEDURE rap$write_disk_order (
  order_catalog, oc: file = $required
  disk_file, df: file = $required
  list, l: file = $list
  verify_option, vo: (BY_NAME, HIDDEN) key
      (brief, b)
      (full, f)
      (manufacturing, m)
    keyend = brief
  status)


*IF $variable(rav$proc_doc,declared)<>'UNKNOWN'

"
" PURPOSE:
"   This procedure writes an order to a disk file.
"
" DESIGN:
"   The information from the order data file and the input parameters
"   on this procedure are used to write the packing list and the
"   subproducts to a disk file.  When the order data file is included,
"   a set of SCL variables is created and initialized.
"
" NOTES:
"
"
*IFEND

"$FORMAT=OFF
  VAR
    backup_file: name
    backup_status: status
    delete_status: status
    ignore_status: status
    local_status: status
    order_data: name = raf$order_data
  VAREND
"$FORMAT=ON


  include_file f=order_catalog//order_data status=local_status
  EXIT procedure WITH local_status WHEN NOT local_status.normal

  IF order_medium <> disk THEN
    local_status = $status(false, 'RA', rae$medium_and_param_mismatch, order_medium, 'DISK_FILE')
    EXIT procedure WITH local_status
  IFEND

  IF $FILE(disk_file, catalog) THEN
    local_status = $status(false, 'RA', rae$disk_file_cannot_be_catalog, disk_file)
    EXIT procedure WITH local_status
  IFEND

  create_catalog c=disk_backup_catalog status=local_status
  EXIT procedure WHEN NOT local_status.normal

" The WHEN handler is started here since it will be executed whenever the
" the procedure exits, even if the exit is because of an EXIT statement.

  WHEN exit DO
    include_command 'delete_catalog c=disk_backup_catalog do=catalog_and_contents' status=ignore_status
    EXIT procedure WITH osv$status
  WHENEND

main: ..
  BLOCK

    FOR subproduct_index = 1 TO $upperbound(subproducts) DO
      backup_file = subproducts(subproduct_index).backup_file

      verify_subproduct pc=subproducts(subproduct_index).pacs_catalog vo=verify_option ..
           sif_identifier=subproducts(subproduct_index).sif_identifier status=local_status
      EXIT main WHEN NOT local_status.normal

      BACKUP_PERMANENT_FILE bf=disk_backup_catalog//backup_file l=list.$eoi status=backup_status
        EXIT main WHEN NOT backup_status.normal

        " The following line prevents compatibility problems in the backup file.
        set_backup_options backup_file_version=1 include_data=(ud rd od) ..
               include_archive_information=false status=local_status
        EXIT main WHEN NOT local_status.normal

        exclude_file f=subproducts(subproduct_index).pacs_catalog//sif_file_name status=local_status
        EXIT main WHEN NOT local_status.normal

        backup_catalog c=subproducts(subproduct_index).pacs_catalog status=local_status
        EXIT main WHEN NOT local_status.normal

        rap$display_message mm=ram$pacs_messages mn=backup_complete t=$response mp=($string(..
              subproducts(subproduct_index).name), 'disk backup catalog') status=ignore_status

      QUIT

    FOREND

    BACKUP_PERMANENT_FILE bf=disk_file l=list.$eoi status=backup_status
      EXIT main WHEN NOT backup_status.normal

      " The following line prevents compatibility problems in the backup file.
      set_backup_options backup_file_version=1 include_data=(ud rd od) ..
             include_archive_information=false status=local_status
      EXIT main WHEN NOT local_status.normal

      backup_file f=order_catalog//packing_list_name status=local_status
      EXIT main WHEN NOT local_status.normal

      rap$display_message mm=ram$pacs_messages mn=backup_complete t=$response mp=($string(packing_list_name)..
            , $string(disk_file)) status=ignore_status

      backup_catalog c=disk_backup_catalog status=local_status
      EXIT main WHEN NOT local_status.normal

      rap$display_message mm=ram$pacs_messages mn=backup_complete t=$response mp=(('All Subproducts'), ..
            $string(disk_file)) status=ignore_status

    QUIT

  BLOCKEND main

" This procedure displays bad status on the delete_catalog command because the "
" disk catalog may be extremely large. "

  delete_catalog c=disk_backup_catalog do=catalog_and_contents status=delete_status

  IF delete_status.normal THEN
    rap$display_message mm=ram$pacs_messages mn=deleted_catalog t=$response mp='disk backup catalog' ..
          status=ignore_status
  IFEND

  CANCEL exit

  EXIT procedure WITH local_status WHEN NOT local_status.normal
  EXIT procedure WITH backup_status WHEN NOT backup_status.normal
  EXIT procedure WITH delete_status WHEN NOT delete_status.normal

PROCEND rap$write_disk_order
