home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l360 / 3.ddi / MUDEMO.@EM / STOCKIOA.CBL < prev    next >
Encoding:
Text File  |  1991-04-08  |  17.6 KB  |  417 lines
  1.       $set ans85 noosvs mf
  2.       ************************************************************
  3.       *                                                          *
  4.       *              (C) Micro Focus Ltd. 1989                   *
  5.       *                                                          *
  6.       *                     STOCKIOA.CBL                         *
  7.       *                                                          *
  8.       *                      MULTI-USER                          *
  9.       *                      ==========                          *
  10.       *                DEMONSTRATION PROGRAM                     *
  11.       *                =====================                     *
  12.       *                                                          *
  13.       *  This program demonstrates the file and record locking   *
  14.       *     facilities of this MULTI-USER COBOL. This            *
  15.       *   subprogram, which is called by MUDEMO, locks single    *
  16.       *  records automatically. This is the default locking in   *
  17.       *          this COBOL multi-user environment.              *
  18.       *                                                          *
  19.       ************************************************************
  20.  
  21.        configuration section.
  22.        special-names.
  23.           console is crt.
  24.        input-output section.
  25.        file-control.
  26.            select stock-file assign "MUSTOCK.DAT"
  27.                 organization indexed
  28.                 access dynamic
  29.                 record key stock-key
  30.                 status file-status
  31.                 lock mode automatic.
  32.       /
  33.        data division.
  34.  
  35.       ***********************************************************
  36.       * File Definition                                         *
  37.       ***********************************************************
  38.  
  39.        file section.
  40.        fd  stock-file.
  41.        01  stock-record.
  42.            03  stock-key                        pic 9(06).
  43.            03  stock-data.
  44.                05  stock-description-1          pic x(53).
  45.                05  stock-description-2          pic x(53).
  46.                05  stock-description-3          pic x(53).
  47.                05  stock-held                   pic 9(06).
  48.                05  stock-cost                   pic 9(06)v99.
  49.       /
  50.        working-storage section.
  51.        01     stock-00   .
  52.            03    stock-00-0101 pic x(0080) value "----------------------
  53.       -    "----------------------------------------------------------".
  54.            03    stock-00-0201 pic x(0001) value "|".
  55.            03 filler           pic x(0078).
  56.            03    stock-00-0280 pic x(0001) value "|".
  57.            03    stock-00-0301 pic x(0001) value "|".
  58.            03 filler           pic x(0031).
  59.            03    stock-00-0333 pic x(0011) value " Acme Inc. ".
  60.            03 filler           pic x(0020).
  61.            03    stock-00-0364 pic x(0017) value "Date   /  /     |".
  62.            03    stock-00-0401 pic x(0001) value "|".
  63.            03 filler           pic x(0031).
  64.            03    stock-00-0433 pic x(0011) value "===========".
  65.            03 filler           pic x(0020).
  66.            03    stock-00-0464 pic x(0017) value "Time   :        |".
  67.            03    stock-00-0501 pic x(0001) value "|".
  68.            03 filler           pic x(0027).
  69.            03    stock-00-0529 pic x(0020) value "Stock Control System".
  70.            03 filler           pic x(0031).
  71.            03    stock-00-0580 pic x(0001) value "|".
  72.            03    stock-00-0601 pic x(0001) value "|".
  73.            03 filler           pic x(0027).
  74.            03    stock-00-0629 pic x(0020) value "====================".
  75.            03 filler           pic x(0031).
  76.            03    stock-00-0680 pic x(0001) value "|".
  77.            03    stock-00-0701 pic x(0001) value "|".
  78.            03 filler           pic x(0078).
  79.            03    stock-00-0780 pic x(0001) value "|".
  80.            03    stock-00-0801 pic x(0001) value "|".
  81.            03 filler           pic x(0078).
  82.            03    stock-00-0880 pic x(0001) value "|".
  83.            03    stock-00-0901 pic x(0025) value "|  Stock Code    [
  84.       -    "  ]".
  85.            03 filler           pic x(0054).
  86.            03    stock-00-0980 pic x(0001) value "|".
  87.            03    stock-00-1001 pic x(0001) value "|".
  88.            03 filler           pic x(0078).
  89.            03    stock-00-1080 pic x(0001) value "|".
  90.            03    stock-00-1101 pic x(0022) value "|  Stock Description [
  91.       -    "".
  92.            03 FILLER           PIC X(0053).
  93.            03    STOCK-00-1176 PIC X(0005) VALUE "]   |".
  94.            03    stock-00-1201 pic x(0001) value "|".
  95.            03 filler           pic x(0020).
  96.            03    stock-00-1222 pic x(0001) value "[".
  97.            03 filler           pic x(0053).
  98.            03    stock-00-1276 pic x(0005) value "]   |".
  99.            03    stock-00-1301 pic x(0001) value "|".
  100.            03 filler           pic x(0020).
  101.            03    stock-00-1322 pic x(0001) value "[".
  102.            03 filler           pic x(0053).
  103.            03    stock-00-1376 pic x(0005) value "]   |".
  104.            03    stock-00-1401 pic x(0001) value "|".
  105.            03 filler           pic x(0078).
  106.            03    stock-00-1480 pic x(0001) value "|".
  107.            03    stock-00-1501 pic x(0025) value "|  Stock Held    [
  108.       -    "  ]".
  109.            03 filler           pic x(0054).
  110.            03    stock-00-1580 pic x(0001) value "|".
  111.            03    stock-00-1601 pic x(0001) value "|".
  112.            03 filler           pic x(0078).
  113.            03    stock-00-1680 pic x(0001) value "|".
  114.            03    stock-00-1701 pic x(0028) value "|  Cost per Unit [
  115.       -    "     ]".
  116.            03 filler           pic x(0051).
  117.            03    stock-00-1780 pic x(0001) value "|".
  118.            03    stock-00-1801 pic x(0001) value "|".
  119.            03 filler           pic x(0078).
  120.            03    stock-00-1880 pic x(0001) value "|".
  121.            03    stock-00-1901 pic x(0001) value "|".
  122.            03 filler           pic x(0078).
  123.            03    stock-00-1980 pic x(0001) value "|".
  124.            03    stock-00-2101 pic x(0080) value "----------------------
  125.       -    "----------------------------------------------------------".
  126.            03    stock-00-2201 pic x(0040)
  127.                  value "-----Open Mode----Lock Mode--Last Operat".
  128.            03    stock-00-2241 pic x(0040)
  129.                  value "ion-----------Outcome------File Status--".
  130.            03 filler           pic x(1037).
  131.  
  132.        01     stock-01    redefines    stock-00   .
  133.            03 filler           pic x(0658).
  134.            03   stock-01-code           pic 9(0006).
  135.            03 filler           pic x(0158).
  136.            03   stock-01-description-1  pic x(0053).
  137.            03 filler           pic x(0027).
  138.            03   stock-01-description-2  pic x(0053).
  139.            03 filler           pic x(0027).
  140.            03   stock-01-description-3  pic x(0053).
  141.            03 filler           pic x(0103).
  142.            03   stock-01-held           pic 9(0006).
  143.            03 filler           pic x(0154).
  144.            03   stock-01-cost           pic $$$$$9.99.
  145.            03 filler           pic x(0579).
  146.            03   choice                  pic 9.
  147.  
  148.       ***********************************************************
  149.       * File Status Variables                                   *
  150.       ***********************************************************
  151.  
  152.        01  file-status.
  153.            03  status-1                 pic x.
  154.            03  status-2                 pic x.
  155.  
  156.        01  binary-status redefines file-status pic 9(04) comp.
  157.  
  158.       ***********************************************************
  159.       * Date and Time Variables                                 *
  160.       ***********************************************************
  161.  
  162.        01  date-to-day.
  163.            03  days                     pic 99.
  164.            03  filler                   pic x.
  165.            03  month                    pic 99.
  166.            03  filler                   pic x.
  167.            03  year                     pic 99.
  168.  
  169.        01  up-to-date-time.
  170.            03  hours                    pic 99.
  171.            03  filler                   pic x.
  172.            03  mins                     pic 99.
  173.  
  174.        01  temp-date.
  175.            03  temp-year                pic xx.
  176.            03  temp-month               pic xx.
  177.            03  temp-day                 pic xx.
  178.        01  temp-time.
  179.            03  temp-hours               pic 99.
  180.            03  temp-mins                pic 99.
  181.            03  temp-rest                pic 9999.
  182.  
  183.       ***********************************************************
  184.       * Information Line                                        *
  185.       ***********************************************************
  186.  
  187.        01  status-line.
  188.            03  filler                   pic x(02).
  189.            03  open-mode                pic x(14).
  190.            03  filler                   pic x(02).
  191.            03  lock-mode                pic x(09)
  192.                    value "Automatic".
  193.            03  filler                   pic x(03).
  194.            03  last-operation           pic x(11).
  195.            03  filler                   pic x(03).
  196.            03  was-it-successful        pic x(20).
  197.            03  filler                   pic x(08).
  198.            03  error-code.
  199.                05 stat-1                pic x.
  200.                05 filler                pic x.
  201.                05 stat-2                pic 9(03).
  202.  
  203.        01  hyphen-line                  pic x(80)
  204.                value all "-".
  205.  
  206.        01  yesno                        pic x.
  207.  
  208.        01    inpopt.
  209.            03   inpopt-00      pic x(0040)
  210.                  value "1.Read on Key  2.Read next  3.Start not ".
  211.            03   inpopt-01      pic x(0040)
  212.                  value "<  4.Write  5.Rewrite  6.Delete  7.Exit".
  213.  
  214.       **********************************************************
  215.       * Program for locking single records automatically       *
  216.       **********************************************************
  217.  
  218.        procedure division.
  219.        main.
  220.            initialize choice
  221.                       stock-01.
  222.            display space.
  223.            display stock-00.
  224.            display inpopt at 2301.
  225.            display "Input Choice [ ]" at 2433 upon crt-under.
  226.            open i-o stock-file.
  227.            move "---Open I-O---" to open-mode.
  228.            move "-Open I-O--" to last-operation.
  229.            perform status-check.
  230.            if was-it-successful not = "----------Successful"
  231.                move "----Closed----" to open-mode
  232.                display hyphen-line at 2201 upon crt-under
  233.                display status-line at 2201 upon crt-under
  234.                go to endit.
  235.  
  236.       ***********************************************************
  237.       * MAIN LOOP                                               *
  238.       ***********************************************************
  239.  
  240.        ent-ry.
  241.            accept temp-date from date.
  242.            perform display-date.
  243.            accept temp-time from time.
  244.            perform display-time.
  245.            display hyphen-line at 2201 upon crt-under
  246.            display status-line at 2201 upon crt-under
  247.            accept stock-01.
  248.            evaluate choice
  249.                when    1 perform read-on-key
  250.                when    2 perform read-next
  251.                when    3 perform start-not-less-than
  252.                when    4 perform write-record
  253.                when    5 perform rewrite-record
  254.                when    6 perform delete-record
  255.                when    7 go to wrap-up
  256.            end-evaluate.
  257.            go to ent-ry.
  258.  
  259.       ***********************************************************
  260.       * Close down paragraphs                                   *
  261.       ***********************************************************
  262.  
  263.        wrap-up.
  264.            close stock-file.
  265.            move "----Closed----" to open-mode.
  266.            move "------Closed" to last-operation.
  267.            perform status-check.
  268.            display hyphen-line at 2201 upon crt-under.
  269.            display status-line at 2201 upon crt-under.
  270.  
  271.        endit.
  272.            display "Do you wish to restart (Y/N) [ ]"
  273.                at 2424 upon crt-under.
  274.            accept yesno at 2454.
  275.            evaluate yesno
  276.                        when "Y"      go to main
  277.                        when "y"      go to main
  278.                        when "N"      exit program
  279.                        when "n"      exit program
  280.                        when other    go to endit
  281.            end-evaluate.
  282.  
  283.       ***********************************************************
  284.       * File Handling Routines                                  *
  285.       ***********************************************************
  286.  
  287.        read-on-key.
  288.            move "Read on key" to last-operation.
  289.            perform move-key-from-screen-to-rec.
  290.            read stock-file.
  291.            perform status-check.
  292.            perform move-from-rec-to-screen.
  293.            display stock-01.
  294.  
  295.        read-next.
  296.            move "--Read Next" to last-operation.
  297.            read stock-file next.
  298.            perform status-check.
  299.            perform move-from-rec-to-screen.
  300.            display stock-01.
  301.  
  302.        start-not-less-than.
  303.            move "Start not <" to last-operation.
  304.            perform move-key-from-screen-to-rec.
  305.            start stock-file key not less than stock-key.
  306.            perform status-check.
  307.  
  308.        write-record.
  309.            move "---Write---" to last-operation.
  310.            perform move-from-screen-to-rec.
  311.            write stock-record.
  312.            perform status-check.
  313.  
  314.        rewrite-record.
  315.            move "--Rewrite--" to last-operation.
  316.            perform move-from-screen-to-rec.
  317.            rewrite stock-record.
  318.            perform status-check.
  319.  
  320.        delete-record.
  321.            move "--Delete---" to last-operation.
  322.            perform move-key-from-screen-to-rec.
  323.            delete stock-file.
  324.            perform status-check.
  325.  
  326.       ***********************************************************
  327.       *    File Status Checking Routines.                       *
  328.       ***********************************************************
  329.  
  330.        status-check.
  331.                move status-1 to stat-1
  332.                move status-2 to stat-2
  333.            evaluate status-1
  334.                   when   "0"
  335.                move "----------Successful" to was-it-successful
  336.                   when   "1"
  337.                move "---------End of file" to was-it-successful
  338.                   when   "2"
  339.                move "---------Invalid Key" to was-it-successful
  340.                   when   "9"
  341.                perform look-up-error thru error-end
  342.            end-evaluate.
  343.       ***********************************************************
  344.       *     Look up error number                                *
  345.       ***********************************************************
  346.  
  347.        look-up-error.
  348.            move low-values to status-1.
  349.            move binary-status to stat-2.
  350.            evaluate stat-2
  351.                  when  002
  352.                move "-------File not open" to was-it-successful
  353.                  when  007
  354.                move "Disk space exhausted" to was-it-successful
  355.                  when  013
  356.                move "------File not found" to was-it-successful
  357.                  when  024
  358.                move "----------Disk error" to was-it-successful
  359.                  when  041
  360.                move "---Corrupt ISAM file" to was-it-successful
  361.                  when  065
  362.                move "---------File locked" to was-it-successful
  363.                  when  068
  364.                move "-------Record locked" to was-it-successful
  365.                  when  139
  366.                move "Record inconsistency" to was-it-successful
  367.                  when  146
  368.                move "---No current record" to was-it-successful
  369.                  when  180
  370.                move "------File malformed" to was-it-successful
  371.                  when  208
  372.                move "-------Network error" to was-it-successful
  373.                  when  213
  374.                move "------Too many locks" to was-it-successful
  375.            end-evaluate.
  376.        error-end.
  377.            exit.
  378.  
  379.  
  380.       ***********************************************************
  381.       *     Move data to and from the screen                    *
  382.       ***********************************************************
  383.  
  384.        move-key-from-screen-to-rec.
  385.           move stock-01-code to stock-key.
  386.  
  387.        move-from-screen-to-rec.
  388.           move stock-01-code to stock-key.
  389.           move stock-01-description-1 to stock-description-1.
  390.           move stock-01-description-2 to stock-description-2.
  391.           move stock-01-description-3 to stock-description-3.
  392.           move stock-01-held to stock-held.
  393.           move stock-01-cost to stock-cost.
  394.  
  395.        move-from-rec-to-screen.
  396.           move stock-key to stock-01-code.
  397.           move stock-description-1 to stock-01-description-1.
  398.           move stock-description-2 to stock-01-description-2.
  399.           move stock-description-3 to stock-01-description-3.
  400.           move stock-held to stock-01-held.
  401.           move stock-cost to stock-01-cost.
  402.  
  403.       ***********************************************************
  404.       * Date and Time Routines                                  *
  405.       ***********************************************************
  406.  
  407.        display-date.
  408.           move temp-day to days.
  409.           move temp-month to month.
  410.           move temp-year to year.
  411.           display date-to-day at 0369.
  412.  
  413.        display-time.
  414.           move temp-hours to hours.
  415.           move temp-mins to mins.
  416.           display up-to-date-time at 0469.
  417.