home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / viscobv6.zip / vac22os2 / ibmcobol / samples / winestr / winestr.cbl < prev    next >
Text File  |  1997-03-22  |  5KB  |  129 lines
  1.       * --------------------------------------------- *
  2.       *  WINESTR.CBL
  3.       *     Main program for the Wine Store sample.
  4.       *     Version 2
  5.       * --------------------------------------------- *
  6.  
  7.        IDENTIFICATION DIVISION.
  8.        PROGRAM-ID. "Winestr".
  9.  
  10.        ENVIRONMENT DIVISION.
  11.        Configuration Section.
  12.        Repository.
  13.             CLASS SOMObject is "SOMObject"
  14.             CLASS TheOrder is "WineOrder"
  15.             CLASS Bottle is "Bottle"
  16.             CLASS FileRW is "FileRW"
  17.             CLASS UserInterface is "UserInterface".
  18.  
  19.        DATA DIVISION.
  20.        Working-Storage Section.
  21.       * ------------------------- Objects
  22.        01  orderObj       Usage Object Reference TheOrder.
  23.        01  userObj        Usage Object Reference UserInterface.
  24.        01  bottleObj      Usage Object Reference Bottle.
  25.        01  fileObj        Usage Object Reference FileRW.
  26.       * ------------------------- Data Items
  27.        01  Max-Items                   PIC 9(4)  COMP Value 64.
  28.        01  Seed                        PIC 9(2).
  29.        01  Order-Number                PIC 9(5).
  30.        01  Order-Date                  PIC X(10) Value "00/00/0000".
  31.        77  Item-Type                   PIC X(20).
  32.        77  Item-Cost                   PIC 9(3)V99.
  33.        77  Total-Cost                  PIC 9(7)V99.
  34.        77  Action                      PIC X(10).
  35.        77  Flag                        PIC X(4).
  36.        77  Today                       PIC X(21).
  37.        01  WS-Random-Val               PIC 9V9(5).
  38.        01  WS-Items.
  39.            05 WS-Count                 PIC 9(4).
  40.            05 WS-Item   Occurs 1 to 64 times
  41.                         Depending on WS-Count
  42.                         Indexed by WS-Index.
  43.               10 WS-Type               PIC X(20).
  44.               10 WS-Cost               PIC 9(3)V99.
  45.        01  WS-Parms.
  46.            05 Item-Count               PIC S9(8)  COMP.
  47.            05 WS-Flag                  PIC X.
  48.               88 Successful                      Value "0".
  49.               88 Failure                         Value "1".
  50.  
  51.        PROCEDURE DIVISION.
  52.       * --------------------------------------
  53.       *   Instantiate the UserInterface class
  54.       *     somNew is inherited from SOMObject
  55.       * --------------------------------------
  56.            Invoke UserInterface "somNew" Returning userObj.
  57.       * --------------------------------------
  58.       *   Get the current date and generate a
  59.       *     random number for the order
  60.       * --------------------------------------
  61.            Move Function Current-date to Today.
  62.            Move Today(1:4) to Order-Date (7:4).
  63.            Move Today(5:2) to Order-Date (1:2).
  64.            Move Today(7:2) to Order-Date (4:2).
  65.            Move Today(13:2) to Seed.
  66.            Compute WS-Random-Val = Function Random(Seed).
  67.            Compute Order-Number = WS-Random-Val * 10000.
  68.            Move Zero to Item-Count.
  69.  
  70.            Invoke TheOrder "somNew" Returning orderObj.
  71.            Invoke orderObj "SetOrderNumber" Using Order-Number.
  72.            Invoke orderObj "SetOrderDate" Using Order-Date.
  73.  
  74.            Invoke userObj "WriteWelcome".
  75.            Invoke userObj "readAction" Returning Action.
  76.  
  77.            Perform until Action = "END"
  78.                         or Item-Count >= Max-Items
  79.               Evaluate Action(1:3)
  80.                 When "ADD"
  81.                   Invoke userObj "ReadType" Returning Item-Type
  82.                   Invoke userObj "ReadCost" Returning Item-Cost
  83.                   Invoke orderObj "addBottle"
  84.                                   Using Item-Type Item-Cost
  85.                                   Returning WS-Parms
  86.                   If WS-Flag = "1"
  87.                      Display " ====> Problem adding to the order"
  88.                   End-If
  89.                   Invoke userObj "WriteMessage" using WS-Flag
  90.                 When "DEL"
  91.                  If Item-Count > 0
  92.                     Invoke userObj "ReadType" Returning Item-Type
  93.                     Invoke userObj "ReadCost" Returning Item-Cost
  94.                     Invoke orderObj "DeleteBottle"
  95.                                   Using Item-Type Item-Cost WS-Parms
  96.                  Else
  97.                     Display "  Sorry, nothing to delete "
  98.                  End-if
  99.                When Other
  100.                  Continue
  101.               End-Evaluate
  102.               Invoke UserObj "ReadAction" Returning Action
  103.            End-Perform.
  104.  
  105.            If Item-Count = 0
  106.               Then Goback.
  107.  
  108.            If Action(1:3) is not = "End"
  109.               Invoke orderObj "CalculateCost" Returning Total-Cost
  110.               Invoke orderObj "GetOrderNumber" Returning Order-Number
  111.               Invoke orderObj "GetOrderDate" Returning Order-Date
  112.               Invoke userObj "WriteOutput"
  113.                               Using Total-Cost Order-Number Order-Date
  114.               Invoke orderObj "DescribeOrder" Returning WS-Items
  115.               Invoke userObj "WriteBottle" Using WS-Items
  116.               Invoke FileRW "somNew" Returning fileObj
  117.               Invoke fileObj "XternOrder" Using orderObj
  118.            End-If.
  119.            Display "  ...... Thank you for your support".
  120.            Invoke fileObj "somFree".
  121.            Invoke orderObj "somFree".
  122.            Invoke userObj "somFree".
  123.  
  124.            Goback.
  125.  
  126.        END PROGRAM "Winestr".
  127.  
  128.  
  129.