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