
      ************************************************************************
      * Copyright (C) 1996-1999 Micro Focus International Ltd. 
      * All rights reserved.
      *  
      * This demonstration program is provided for use by users of 
      * Micro Focus products (the "Software") and may be used, 
      * modified and distributed as part of your application provided 
      * that you properly acknowledge the copyright of Micro Focus in this
      * material.
      *     
      * All conditions, warranties and undertakings, express or implied, 
      * statutory or otherwise, on the part of Micro Focus are excluded, 
      * including without limitation those of merchantability or fitness  
      * for purpose. This shall not, however, purport to exclude or 
      * restrict the liability of Micro Focus to any extent not 
      * permitted by law.
      *
      * IN NO EVENT WILL MICRO FOCUS BE LIABLE FOR ANY INDIRECT, 
      * INCIDENTAL, SPECIAL, CONSEQUENTIAL OR OTHER DAMAGES ARISING OUT 
      * OF THE USE OF THE DEMONSTRATION PROGRAM DISTRIBUTED WITH THE 
      * SOFTWARE, WHETHER OR NOT INFORMED OF THE POSSIBILITIES OF 
      * DAMAGES IN ADVANCE.  THESE LIMITATIONS APPLY TO ALL CAUSES OF 
      * ACTION, INCLUDING BREACH OF CONTRACT, BREACH OF WARRANTY, STRICT
      * LIABILITY, AND ANY ACTIONS IN TORTS.
      ************************************************************************

       configuration section.
       special-names.
          console is crt
          crt status is key-status.

       data division.

       working-storage section.
       01  locking01-00   .
           03 filler           pic x(0407).
           03 locking01-00-0608 pic x(0060) value "This program demonstr
      -    "ates file and record locking         ".
           03 FILLER           PIC X(0180).
           03 locking01-00-1308 PIC X(0062) VALUE "The program allows an
      -    " indexed file to be opened in a number of".
           03 filler           pic x(0098).
           03 locking01-00-1508 pic x(0067) value "different modes which
      -    " demonstrate the available locking facilities.".
           03 filler           pic x(0486).
           03 locking01-00-2101 pic x(0080) value all "-".

       01  options1.
           03  filler                   pic x(03).
           03  option-1                 pic x(13)
                   value "F1-Open Input".
           03  filler                   pic x(03).
           03  option-2                 pic x(31)
                   value "F2-Open I-O Lock Mode Automatic".
       01  options2.
           03  filler                   pic x(03).
           03  option-3                 pic x(28)
                   value "F3-Open I-O Lock Mode Manual".
           03  filler                   pic x(03).
           03  option-4                 pic x(14)
                   value "F4-Open Output".
           03  filler                   pic x(03).
           03  option-5                 pic x(17)
                   value "ESC-Exit      [ ]".

       01  DATE-YYMMDD.
           03  DATE-YY                 PIC 9999.
           03  DATE-MM                 PIC 99.
           03  DATE-DD                 PIC 99.
           03  TIME-HR                 PIC 99.
           03  TIME-MIN                PIC 99.
           03  TIME-SEC                PIC 99.
           03  THE-REST                PIC x(7).

       01  the-date.
           03  days                     pic 99.
           03  filler                   pic x.
           03  month                    pic 99.
           03  filler                   pic x.
           03  year                     pic 9999.

       01  the-time.
           03  hours                    pic 99.
           03  filler                   pic x.
           03  mins                     pic 99.

       01  choice                       pic x.
       01  exit-flag                    pic x.
           88 exit-selected value "Y".

       01  key-status.
           03  key-type        PIC X.
           03  key-code-1      PIC 9(2) COMP-X.
           03  key-code-2      PIC 9(2) COMP-X.

      **********************************************************
      * Main Program                                           *
      **********************************************************

       procedure division.
           perform until exit-selected
              display space
              display locking01-00
              perform display-date
              display options1 at 2001
              display options2 at 2201
              move 5 to key-code-1
              perform until key-code-1 < 5
                 accept choice AT 2267 with auto-skip no-echo

                 if key-type = "1"
                    evaluate key-code-1
                      when 0        set exit-selected to true
                      when 1        call "stockin"
                                    cancel "stockin"
                      when 2        call "stockioa"
                                    cancel "stockioa"
                      when 3        call "stockiom"
                                    cancel "stockiom"
                      when 4        call "stockout"
                                    cancel "stockout"
                    end-evaluate
                 end-if
              end-perform
           end-perform
           stop run.

      ***********************************************************
      * Date and Time Routines                                  *
      ***********************************************************

       display-date.
          move FUNCTION CURRENT-DATE TO DATE-YYMMDD
          move DATE-DD TO days
          move DATE-MM TO month
          move DATE-YY TO year
          display "Date   /  /" at 0164.
          display the-date at 0169.
          move   TIME-HR to hours.
          move   TIME-MIN to mins.
          display "Time   :" at 0264.
          display the-time at 0269.
