home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / SRPI.ZIP / SRPI / SRPI_CBL / BSAMPL.CBL next >
Text File  |  1991-09-04  |  11KB  |  224 lines
  1.       **********************-PROLOGUE-*********************************
  2.       *                                                               *
  3.       * MODULE NAME = BSAMPL.CBL                                      *
  4.       *                                                               *
  5.       * DESCRIPTIVE NAME = COBOL Sample Program                       *
  6.       *                                                               *
  7.       * STATUS=    Extended Services Version 1.0 Modification 0       *
  8.       *                                                               *
  9.       * COPYRIGHT= (C) COPYRIGHT IBM CORP. 1988, 1991                 *
  10.       *            LICENSED MATERIAL - PROGRAM PROPERTY OF IBM        *
  11.       *            ALL RIGHTS RESERVED                                *
  12.       *                                                               *
  13.       * FUNCTION = Invoke a hypothetical server via the COBOL         *
  14.       *            INTERFACE routines.                                *
  15.       *                                                               *
  16.       *            This sample program reads a customer record        *
  17.       *            from a data base, examines the customer's          *
  18.       *            balance and writes the customer record to          *
  19.       *            a file containing customer records if the          *
  20.       *            balance is greater than zero.                      *
  21.       *                                                               *
  22.       * NOTES =                                                       *
  23.       *                                                               *
  24.       *   RESTRICTIONS = This sample program is provided solely as    *
  25.       *                  an example of how the COBOL interface        *
  26.       *                  routines can be used to invoke a server.     *
  27.       *                                                               *
  28.       * MODULE TYPE = Microfocus COBOL Compiler Version xxxx          *
  29.       *********************-END PROLOGUE-******************************
  30.  
  31.        ID DIVISION.
  32.          PROGRAM-ID. BSAMPL.
  33.        ENVIRONMENT DIVISION.
  34.        DATA DIVISION.
  35.        WORKING-STORAGE SECTION.
  36.  
  37.       *****************************************************************
  38.       *             Working Storage Section                           *
  39.       *****************************************************************
  40.       *  BSERVER          Server Name                                 *
  41.       *  BOPER            Default Operator Name                       *
  42.       *  QPALOG           Log the Transaction                         *
  43.       *  QPACOM           Commit the Transaction                      *
  44.       *  BFUNCT1          Function Code : Get Record                  *
  45.       *  BFUNCT2          Function Code : Update Accounts             *
  46.       *  BRCOK            Server Return Code OK                       *
  47.       *  BLSTR            Last Record                                 *
  48.       *  BQPARMS-SIZE     Request Parameters Record Size              *
  49.       *  CUST-REC-SIZE    Customer Record Size                        *
  50.       *                                                               *
  51.       *  BRETCOD          SRPI Return Code                            *
  52.       *                                                               *
  53.       *  BQPARMS-RECORD   Request Parameters                          *
  54.       *  QPAFLAGS         Processing Flags                            *
  55.       *  QPAOPER          Requesting Operator                         *
  56.       *****************************************************************
  57.  
  58.        77  BSERVER            PIC X(8)             VALUE "IBMabase".
  59.        77  BOPER              PIC X(8)             VALUE "ADMIN".
  60.        77  QPALOG             PIC 9(4)     COMP-5  VALUE H'01'.
  61.        77  QPACOM             PIC 9(4)     COMP-5  VALUE H'02'.
  62.        77  BFUNC1             PIC 9(4)     COMP-5  VALUE  IS 1.
  63.        77  BFUNC2             PIC 9(4)     COMP-5  VALUE  IS 2.
  64.        77  BRCOK              PIC 9(9)     COMP-5  VALUE H'00000000'.
  65.        77  BLSTR              PIC 9(9)     COMP-5  VALUE H'00000004'.
  66.        77  BQPARMS-SIZE       PIC 9(4)     COMP-5  VALUE IS 9.
  67.        77  CUST-REC-SIZE      PIC 9(4)     COMP-5  VALUE IS 109.
  68.  
  69.        01  BRETCOD            PIC S9(9)    COMP-5.
  70.  
  71.        01  BQPARMS-RECORD.
  72.            05 QPAFLAGS         PIC X(1).
  73.            05 QPAOPER          PIC X(8).
  74.  
  75.       *****************************************************************
  76.       *             Working Storage Section                           *
  77.       *****************************************************************
  78.       *  CUSTOMER-RECORD  Customer Record                             *
  79.       *  CUSTOMER-NAME    Customer Name                               *
  80.       *  CUSTOMER-ADDR    Street Address                              *
  81.       *  CUSTOMER-CITY    City                                        *
  82.       *  CUSTOMER-STAT    State                                       *
  83.       *  CUSTOMER-ZIP     Zip Code                                    *
  84.       *  CUSTOMER-ACCT    Account Number                              *
  85.       *  CUSTOMER-BAL     Balance                                     *
  86.       *****************************************************************
  87.  
  88.        01  CUSTOMER-RECORD.
  89.            05 CUSTOMER-NAME    PIC X(25).
  90.            05 CUSTOMER-ADDR    PIC X(25).
  91.            05 CUSTOMER-CITY    PIC X(15).
  92.            05 CUSTOMER-STAT    PIC X(15).
  93.            05 CUSTOMER-ZIP     PIC X(9).
  94.            05 CUSTOMER-ACCT    PIC X(16).
  95.            05 CUSTOMER-BAL     PIC S9(9) COMP-5.
  96.  
  97.         COPY UUBCPRB.
  98.       ***********************-PSEUDOCODE-******************************
  99.       *                     PROC (MAIN)                               *
  100.       *                    1. SET PROCESSING OPTION = COMMIT          *
  101.       *                          TRANSACTION                          *
  102.       *                    1. SET REQUESTING OPERATOR ID              *
  103.       *                    1. INITIALIZE SERVER RETURN CODE           *
  104.       *                    1. INITIALIZE SRPI RETURN CODE             *
  105.       *                    1. DO UNTIL SERVER RETURN CODE IS LAST     *
  106.       *                           RECORD OR SRPI RETURN CODE NOT GOOD *
  107.       *                    1. ENDWHILE                                *
  108.       *                     ENDPROC (MAIN)                            *
  109.       *********************-END PSEUDOCODE-****************************
  110.        PROCEDURE DIVISION.
  111.        100-MAIN.
  112.  
  113.  
  114.       *******   SET PROCESSING OPTION = COMMIT TRANSACTION
  115.            MOVE QPACOM TO QPAFLAGS.
  116.  
  117.       *******   SET REQUESTING OPERATOR ID
  118.            MOVE BOPER TO QPAOPER.
  119.  
  120.       *******   INITIALIZE SERVER RETURN CODE
  121.            MOVE BRCOK TO UERSERVRC.
  122.  
  123.       *******   INITIALIZE SRPI RETURN CODE
  124.            MOVE UERERROK TO BRETCOD.
  125.  
  126.       *******   DO UNTIL SERVER RETURN CODE IS LAST
  127.       *******       RECORD OR SRPI RETURN CODE IS NOT GOOD
  128.            PERFORM 200-INIT-AND-SEND UNTIL
  129.              ((UERSERVRC  EQUAL BLSTR) OR (BRETCOD NOT EQUAL UERERROK)).
  130.  
  131.        STOP RUN.
  132.  
  133.        100-EXIT.
  134.  
  135.            EXIT.
  136.  
  137.       ***********************-PSEUDOCODE-******************************
  138.       *                     PROC (INIT-AND-SEND)                      *
  139.       *                    1. INITIALIZE THE CPRB STRUCTURE           *
  140.       *                           <INIT_SEND_REQ_PARMS>               *
  141.       *                    1. MOVE SERVER NAME AND FUNCTION           *
  142.       *                           (GET RECORD) INTO CPRB STRUCTURE    *
  143.       *                    1. SET CPRB REQUEST PARAMETERS BUFFER      *
  144.       *                          INFORMATION                         *
  145.       *                    1. SET CPRB REPLY DATA BUFFER INFORMATION  *
  146.       *                    1. SEND THE REQUEST TO THE SERVER          *
  147.       *                    1. IF THE SERVER RETURN CODE IS GOOD AND   *
  148.       *                           IF THE SRPI RETURN CODE IS GOOD AND *
  149.       *                           IF THE ACCOUNT BALANCE IS POSITIVE  *
  150.       *                    2. . SET CPRB FUNCTION = UPDATE            *
  151.       *                           ACCOUNTS RECEIVABLE                 *
  152.       *                    2. . SET CPRB REQUEST DATA = CUSTOMER      *
  153.       *                           RECORD                              *
  154.       *                    2. . UPDATE THE ACCOUNTS RECEIVABLE        *
  155.       *                           FILE <SENDREQUEST>                  *
  156.       *                    1. ENDIF                                   *
  157.       *                     ENDPROC (INIT-AND-SEND)                   *
  158.       *********************-END PSEUDOCODE-****************************
  159.  
  160.        200-INIT-AND-SEND.
  161.  
  162.       *******   INITIALIZE THE CPRB STRUCTURE <INIT_SEND_REQ_PARMS>
  163.            CALL '__INIT_SEND_REQ_PARMS' USING UERCPRB.
  164.  
  165.       *******   MOVE SERVER NAME  INTO CPRB STRUCTURE
  166.            MOVE BSERVER TO UERSERVER.
  167.  
  168.       *******   MOVE FUNCTION (GET RECORD)INTO CPRB STRUCTURE
  169.            MOVE BFUNC1 TO UERFUNCT.
  170.  
  171.       *******   SET CPRB REQUEST PARAMETERS BUFFER INFORMATION
  172.            MOVE BQPARMS-SIZE TO UERQPARML.
  173.  
  174.       *******   SET CPRB REQUEST PARAMETERS BUFFER INFORMATION
  175.            SET UERQPARMAD TO ADDRESS OF BQPARMS-RECORD.
  176.  
  177.       *******   SET CPRB REPLY DATA BUFFER INFORMATION
  178.            MOVE CUST-REC-SIZE TO UERRDATAL.
  179.  
  180.       *******   SET CPRB REPLY DATA BUFFER INFORMATION
  181.            SET UERRDATAAD TO ADDRESS OF CUSTOMER-RECORD.
  182.  
  183.       *******   SEND THE REQUEST TO THE SERVER <SENDREQUEST>
  184.            MOVE BSERVER TO UERSERVER.
  185.  
  186.            CALL '__SENDREQUEST' USING UERCPRB.
  187.  
  188.  
  189.       *******   RETURN SRPI RETURN CODE TO MAIN
  190.            MOVE UERRETCODE TO BRETCOD.
  191.  
  192.       *******   IF THE SRPI RETURN CODE IS GOOD
  193.            IF BRETCOD = UERERROK
  194.  
  195.       *******   IF THE SERVER RETURN CODE IS GOOD
  196.              IF UERSERVRC = BRCOK
  197.  
  198.       *******   IF THE ACCOUNT BALANCE IS POSITIVE
  199.                IF CUSTOMER-BAL > 0
  200.  
  201.       *******   SET CPRB FUNCTION = UPDATE ACCOUNTS RECEIVABLE
  202.                   MOVE BFUNC2 TO UERFUNCT
  203.  
  204.       *******   SET CPRB REQUEST DATA = CUSTOMER RECORD
  205.                   MOVE CUST-REC-SIZE TO UERQDATAL
  206.  
  207.       *******   SET CPRB REQUEST DATA = CUSTOMER RECORD
  208.                   SET UERQDATAAD TO ADDRESS OF CUSTOMER-RECORD
  209.  
  210.       *******   UPDATE THE ACCOUNTS RECEIVABLE
  211.       *******     FILE <SENDREQUEST>
  212.  
  213.                   CALL '__SENDREQUEST' USING UERCPRB
  214.  
  215.  
  216.       *******   RETURN SRPI RETURN CODE TO MAIN
  217.                   MOVE UERRETCODE TO BRETCOD.
  218.  
  219.        200-INIT-AND-SEND-EXIT.
  220.  
  221.            EXIT.
  222.  
  223.            END PROGRAM BSAMPL.
  224.