home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l360 / 3.ddi / MUDEMO.@EM / MUDEMO.CBL next >
Encoding:
Text File  |  1991-04-08  |  5.9 KB  |  144 lines
  1.       $set ans85 noosvs mf
  2.       ************************************************************
  3.       *                                                          *
  4.       *              (C) Micro Focus Ltd. 1989                   *
  5.       *                                                          *
  6.       *                      MUDEMO.CBL                          *
  7.       *                                                          *
  8.       *                      MULTI-USER                          *
  9.       *                      ==========                          *
  10.       *                 DEMONSTRATION PROGRAM                    *
  11.       *                 =====================                    *
  12.       *                                                          *
  13.       *  This program demonstrates the file and record locking   *
  14.       *  facilities of this COBOL system.   This is the          *
  15.       *  main program in a suite of programs that demonstrate    *
  16.       *  how to use this COBOL in a multi-user environment.      *
  17.       *                                                          *
  18.       ************************************************************
  19.  
  20.        configuration section.
  21.        special-names.
  22.           console is crt.
  23.  
  24.        data division.
  25.  
  26.        working-storage section.
  27.        01  mudemo01-00   .
  28.            03 filler           pic x(0407).
  29.            03 mudemo01-00-0608 pic x(0060) value "This is a demonstratio
  30.       -    "n program for use with COBOL.        ".
  31.            03 FILLER           PIC X(0100).
  32.            03 MUDEMO01-00-0808 PIC X(0058) VALUE "This program demonstra
  33.       -    "tes how multi-user COBOL can        ".
  34.            03 filler           pic x(0102).
  35.            03 mudemo01-00-1008 pic x(0028) value "lock both records and
  36.       -    "files.".
  37.            03 FILLER           PIC X(0212).
  38.            03 MUDEMO01-00-1308 PIC X(0062) VALUE "the program allows an
  39.       -    "indexed file to be opened in a number of".
  40.            03 filler           pic x(0098).
  41.            03 mudemo01-00-1508 pic x(0046) value "modes, which demonstra
  42.       -    "te the locking facility.".
  43.            03 FILLER           PIC X(0114).
  44.            03 MUDEMO01-00-1708 PIC X(0063) VALUE "for more information o
  45.       -    "n locking refer to the Operating Guide.  ".
  46.            03 filler           pic x(0097).
  47.            03 mudemo01-00-1908 pic x(0007) value "       ".
  48.            03 filler           pic x(0146).
  49.            03 mudemo01-00-2101 pic x(0080) value "----------------------
  50.       -    "----------------------------------------------------------".
  51.  
  52.        01  options.
  53.            03  filler                   pic x(02).
  54.            03  option-1                 pic x(07)
  55.                    value "1.Input".
  56.            03  filler                   pic x(02).
  57.            03  option-2                 pic x(25)
  58.                    value "2.I-O Lock Mode Automatic".
  59.            03  filler                   pic x(02).
  60.            03  option-3                 pic x(22)
  61.                    value "3.I-O Lock Mode Manual".
  62.            03  filler                   pic x(02).
  63.            03  option-4                 pic x(08)
  64.                    value "4.Output".
  65.            03  filler                   pic x(02).
  66.            03  option-5                 pic x(06)
  67.                    value "5.Exit".
  68.  
  69.  
  70.        01  date-to-day.
  71.            03  days                     pic 99.
  72.            03  filler                   pic x.
  73.            03  month                    pic 99.
  74.            03  filler                   pic x.
  75.            03  year                     pic 99.
  76.  
  77.        01  up-to-date-time.
  78.            03  hours                    pic 99.
  79.            03  filler                   pic x.
  80.            03  mins                     pic 99.
  81.  
  82.        01  temp-date.
  83.            03  temp-year                pic xx.
  84.            03  temp-month               pic xx.
  85.            03  temp-day                 pic xx.
  86.        01  temp-time.
  87.            03  temp-hours               pic 99.
  88.            03  temp-mins                pic 99.
  89.            03  temp-rest                pic 9999.
  90.  
  91.        01  choice                       pic 9 value 0.
  92.  
  93.       **********************************************************
  94.       * Main Program                                           *
  95.       **********************************************************
  96.  
  97.        procedure division.
  98.        ent-ry.
  99.            display space
  100.            display mudemo01-00
  101.            perform display-date
  102.            perform display-time
  103.            display options at 2201
  104.            display "INPUT CHOICE [ ]" at 2431 upon crt-under.
  105.  
  106.        re-enter-choice.
  107.            accept choice at 2445.
  108.            evaluate choice
  109.              when 1        call "STOCKIN"
  110.                            cancel "STOCKIN"
  111.              when 2        call "STOCKIOA"
  112.                            cancel "STOCKIOA"
  113.              when 3        call "STOCKIOM"
  114.                            cancel "STOCKIOM"
  115.              when 4        call "STOCKOUT"
  116.                            cancel "STOCKOUT"
  117.              when 5        go to endit
  118.              when other    go to re-enter-choice
  119.            end-evaluate.
  120.            go to ent-ry.
  121.  
  122.        endit.
  123.            stop run.
  124.  
  125.  
  126.       ***********************************************************
  127.       * Date and Time Routines                                  *
  128.       ***********************************************************
  129.  
  130.        display-date.
  131.           accept temp-date from date.
  132.           move   temp-day to days.
  133.           move   temp-month to month.
  134.           move   temp-year to year.
  135.           display "Date   /  /" at 0164.
  136.           display date-to-day at 0169.
  137.  
  138.        display-time.
  139.           accept temp-time from time.
  140.           move   temp-hours to hours.
  141.           move   temp-mins to mins.
  142.           display "Time   :" at 0264.
  143.           display up-to-date-time at 0269.
  144.