home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / rspdbs.zip / RSPDBS.CBL
Text File  |  1993-09-26  |  10KB  |  255 lines
  1.        IDENTIFICATION DIVISION.
  2.        PROGRAM-ID.  SAMP04C.
  3.       ******************************************************************
  4.       *  RSPEASY - DOCTORED STORED PROCEDURE                           *
  5.       *                                                                *
  6.       *  THIS SAMPLE STORED PROCEDURE WAS WRITTEN TO USE A "STD"       *
  7.       *  OUTPUT PIPE FOR ILLUSTRATION.  IT REQUIRES NO PARAMETERS      *
  8.       *                                                                *
  9.       ******************************************************************
  10.  
  11.        ENVIRONMENT DIVISION.
  12.  
  13.        DATA DIVISION.
  14.  
  15.        WORKING-STORAGE SECTION.
  16.  
  17.       ******************************************************************
  18.       * POINTERS TO INPUT AND OUTPUT RECORD AREA.                      *
  19.       ******************************************************************
  20.        01  SAMPLE-POINTER.
  21.            10 OUTPUTPOINTER            USAGE IS POINTER.
  22.            10 INPUTPOINTER             USAGE IS POINTER.
  23.  
  24.       ******************************************************************
  25.       * SWITCHES FOR RECORD PROCESSING CONTROL.                        *
  26.       ******************************************************************
  27.        01  WS-SWITCHES.
  28.  
  29.            10 WS-ERROR-HAPPENED-SW         PIC X(01) VALUE 'N'.
  30.               88 ERROR-HAPPENED            VALUE 'Y'.
  31.               88 NO-ERROR-YET              VALUE 'N'.
  32.  
  33.       ******************************************************************
  34.       * OUTPUT RECORD DESCRIPTION.                                     *
  35.       ******************************************************************
  36.  
  37.        01  WS-OUT-DATA-MSG.
  38.            10 FILLER                       PIC X(50) VALUE
  39.            '**--> THIS IS THE FIRST HUNDRED CHARACTERS - SENT.'.
  40.            10 WS-OUT-INPUT                 PIC X(17) VALUE SPACES.
  41.            10 FILLER                       PIC X(33) VALUE
  42.                             '890123456789012345678901234567890'.
  43.            10 FILLER                       PIC X(50) VALUE
  44.            '**--> THIS IS THE 2ND   HUNDRED CHARACTERS - SENT.'.
  45.            10 FILLER                       PIC X(50) VALUE
  46.            '12345678901234567890123456789012345678901234567890'.
  47.            10 FILLER                       PIC X(50) VALUE
  48.            '**--> THIS IS THE THIRD HUNDRED CHARACTERS - SENT.'.
  49.            10 FILLER                       PIC X(50) VALUE
  50.            '12345678901234567890123456789012345678901234567890'.
  51.            10 FILLER                       PIC X(50) VALUE
  52.            '**--> THIS IS THE FOURT HUNDRED CHARACTERS - SENT.'.
  53.            10 FILLER                       PIC X(50) VALUE
  54.            '12345678901234567890123456789012345678901234567890'.
  55.            10 FILLER                       PIC X(50) VALUE
  56.            '**--> THIS IS THE FIFTH HUNDRED CHARACTERS - SENT.'.
  57.            10 FILLER                       PIC X(50) VALUE
  58.            '12345678901234567890123456789012345678901234567890'.
  59.            10 FILLER                       PIC X(50) VALUE
  60.            '**--> THIS IS THE SIXTH HUNDRED CHARACTERS - SENT.'.
  61.            10 FILLER                       PIC X(50) VALUE
  62.            '12345678901234567890123456789012345678901234567890'.
  63.            10 FILLER                       PIC X(50) VALUE
  64.            '**--> THIS IS THE 7TH   HUNDRED CHARACTERS - SENT.'.
  65.            10 FILLER                       PIC X(50) VALUE
  66.            '12345678901234567890123456789012345678901234567890'.
  67.            10 FILLER                       PIC X(50) VALUE
  68.            '**--> THIS IS THE 8TH   HUNDRED CHARACTERS - SENT.'.
  69.            10 FILLER                       PIC X(50) VALUE
  70.            '12345678901234567890123456789012345678901234567890'.
  71.            10 FILLER                       PIC X(08) VALUE
  72.            'THE END!'.
  73.  
  74.  
  75.        LINKAGE SECTION.
  76.  
  77.        01  DFHCOMMAREA.
  78.  
  79.       ******************************************************************
  80.       * LINKAGE TO CALLING PROGRAM                                     *
  81.       ******************************************************************
  82.            COPY SPAREAC.
  83.  
  84.        01  WS-INPUT-REC.
  85.            10 WS-INPUT-DATA                PIC X(17).
  86.  
  87.        01  WS-OUTPUT-REC.
  88.            10 WS-OUTPUT-DATA                PIC X(808).
  89.  
  90.        PROCEDURE DIVISION.
  91.  
  92.        000-MAIN-PROCESSING.
  93.  
  94.            PERFORM 100-INITIALIZE             THRU 100-EXIT.
  95.  
  96.            IF NO-ERROR-YET
  97.                PERFORM 500-PROCESS-I-O        THRU 500-EXIT.
  98.  
  99.            PERFORM 900-WRAP-UP                THRU 900-EXIT.
  100.  
  101.            EXEC CICS RETURN END-EXEC.
  102.            GOBACK.
  103.  
  104.        000-EXIT.
  105.            EXIT.
  106.  
  107.        100-INITIALIZE.
  108.  
  109.            MOVE 'OK' TO SPSTATUS.
  110.  
  111.       ******************************************************************
  112.       * GETMAIN OUTPUT (AND INPUT) RECORD AREA.
  113.       ******************************************************************
  114.            EXEC CICS
  115.              GETMAIN SET(INPUTPOINTER)
  116.                      LENGTH(17)
  117.            END-EXEC.
  118.            SET ADDRESS OF WS-INPUT-REC  TO INPUTPOINTER.
  119.  
  120.            PERFORM 110-OPEN-INPUT-PIPE        THRU 110-EXIT.
  121.  
  122.  
  123.            EXEC CICS
  124.              GETMAIN SET(OUTPUTPOINTER)
  125.                      LENGTH(808)
  126.            END-EXEC.
  127.            SET ADDRESS OF WS-OUTPUT-REC  TO OUTPUTPOINTER.
  128.  
  129.            PERFORM 120-OPEN-OUTPUT-PIPE   THRU 120-EXIT.
  130.  
  131.        100-EXIT.
  132.            EXIT.
  133.  
  134.        110-OPEN-INPUT-PIPE.
  135.       ******************************************************************
  136.       * OPEN THE INPUT PIPE.                                           *
  137.       ******************************************************************
  138.            MOVE 'INPUT'             TO SPMODE.
  139.            MOVE 'STD'               TO SPFORMAT.
  140.            MOVE 55                  TO SPMAXLEN.
  141.            CALL 'OPENPIPE' USING SPAREA.
  142.  
  143.       ******************************************************************
  144.       * IF OPEN FAILED, THEN ISSUE AN ERROR MESSAGE.                   *
  145.       ******************************************************************
  146.            IF SPRC NOT = '000'
  147.                MOVE 'ERROR OPENING STANDARD INPUT PIPE.' TO SPMSG
  148.                MOVE 'Y'                   TO WS-ERROR-HAPPENED-SW
  149.                PERFORM 800-DO-MESSAGE     THRU 800-EXIT.
  150.  
  151.        110-EXIT.
  152.            EXIT.
  153.  
  154.  
  155.        120-OPEN-OUTPUT-PIPE.
  156.  
  157.            MOVE  808     TO SPMAXLEN.
  158.            MOVE 'STD'    TO SPFORMAT.
  159.            MOVE 'OUTPUT' TO SPMODE.
  160.            CALL 'OPENPIPE' USING SPAREA.
  161.  
  162.       ******************************************************************
  163.       * IF OPEN FAILED, THEN ISSUE AN ERROR MESSAGE.                   *
  164.       ******************************************************************
  165.            IF SPRC NOT = '000'
  166.                MOVE 'ERROR OPENING STANDARD OUTPUT PIPE.' TO SPMSG
  167.                MOVE 'Y'                       TO WS-ERROR-HAPPENED-SW
  168.                PERFORM 800-DO-MESSAGE         THRU 800-EXIT.
  169.  
  170.        120-EXIT.
  171.            EXIT.
  172.  
  173.        500-PROCESS-I-O.
  174.  
  175.            PERFORM 540-PROCESS-DATA-RECS    THRU 540-EXIT.
  176.  
  177.        500-EXIT.
  178.            EXIT.
  179.  
  180.  
  181.        540-PROCESS-DATA-RECS.
  182.  
  183.            PERFORM 541-GET-17-INPUT             THRU 541-EXIT.
  184.  
  185.            PERFORM 542-SEND-808-RECORD          THRU 542-EXIT.
  186.  
  187.        540-EXIT.
  188.            EXIT.
  189.  
  190.        541-GET-17-INPUT.
  191.  
  192.            IF SPSTATUS = 'OK'
  193.                SET SPINTO TO ADDRESS OF WS-INPUT-REC
  194.                MOVE 17  TO SPRECLEN
  195.                CALL 'GETPIPE' USING SPAREA
  196.                IF SPRC NOT = '000'
  197.                    MOVE 'ERROR GETTING KEYWORDS' TO SPMSG
  198.                    MOVE 'Y'               TO WS-ERROR-HAPPENED-SW
  199.                    PERFORM 800-DO-MESSAGE     THRU 800-EXIT
  200.                END-IF
  201.            END-IF.
  202.  
  203.        541-EXIT.
  204.            EXIT.
  205.  
  206.  
  207.        542-SEND-808-RECORD.
  208.  
  209.            IF SPSTATUS = 'OK'
  210.                MOVE WS-INPUT-DATA          TO WS-OUT-INPUT
  211.                MOVE WS-OUT-DATA-MSG        TO WS-OUTPUT-REC
  212.                SET SPFROM TO ADDRESS OF WS-OUTPUT-REC
  213.                MOVE 808 TO SPRECLEN
  214.                CALL 'PUTPIPE' USING SPAREA
  215.                IF SPRC NOT = '000'
  216.                    MOVE 'ERROR PUTTING KEYWORDS' TO SPMSG
  217.                    MOVE 'Y'               TO WS-ERROR-HAPPENED-SW
  218.                    PERFORM 800-DO-MESSAGE     THRU 800-EXIT
  219.                END-IF
  220.            END-IF.
  221.  
  222.        542-EXIT.
  223.            EXIT.
  224.  
  225.  
  226.        800-DO-MESSAGE.
  227.       ******************************************************************
  228.       * SOMETHING FAILED, SO ISSUE AN ERROR MESSAGE AND GET OUT.       *
  229.       ******************************************************************
  230.            MOVE 'E' TO SPSTATUS.
  231.            CALL 'MESSAGE' USING SPAREA.
  232.  
  233.        800-EXIT.
  234.            EXIT.
  235.  
  236.  
  237.        900-WRAP-UP.
  238.       ******************************************************************
  239.       * CLOSE PIPES - ISSUE STATUS.                                    *
  240.       ******************************************************************
  241.  
  242.            IF SPSTATUS = 'OK'
  243.                MOVE 'INPUT' TO SPMODE
  244.                CALL 'CLOSPIPE' USING SPAREA
  245.                MOVE 'OUTPUT' TO SPMODE
  246.                CALL 'CLOSPIPE' USING SPAREA
  247.            END-IF.
  248.  
  249.  
  250.            CALL 'STATUS' USING SPAREA.
  251.  
  252.        900-EXIT.
  253.            EXIT.
  254.  
  255.