home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / o22516d1.zip / DSDEMO.@IP / CUSTIO.CCP < prev    next >
Text File  |  1992-07-29  |  8KB  |  239 lines
  1.        IDENTIFICATION DIVISION.
  2.        PROGRAM-ID. CUSTIO.
  3.        ENVIRONMENT DIVISION.
  4.        WORKING-STORAGE SECTION.
  5.        77  ARRAY-IND                   PIC 9(4) COMP.
  6.  
  7.       ****************************************************************
  8.        01 CONSOLE-MESSAGE PIC X(25).
  9.       ****************************************************************
  10.       *                                                              *
  11.       * WORKING STORAGE COPY OF THE DATA PASSED IN DFHCOMMAREA.      *
  12.       *                                                              *
  13.       ****************************************************************
  14.  
  15.        COPY COMMAREA.
  16.  
  17.        LINKAGE SECTION.
  18.        01  DFHCOMMAREA  PIC X.
  19.  
  20.        PROCEDURE DIVISION.
  21.        100-START SECTION.
  22.       *    MOVE 'CUSTIO START' TO CONSOLE-MESSAGE
  23.       *    EXEC CICS WRITE OPERATOR
  24.       *        TEXT(CONSOLE-MESSAGE)
  25.       *        TEXTLENGTH(25)
  26.       *        NOHANDLE
  27.       *    END-EXEC
  28.       *
  29.       *
  30.       * MOVE THE DATA PASSED INTO WORKING STORAGE
  31.       *
  32.  
  33.            MOVE DFHCOMMAREA(1:EIBCALEN) TO COMM-AREA(1:EIBCALEN).
  34.  
  35.            EXEC CICS HANDLE CONDITION
  36.                DISABLED(CUSTFILE-DISABLED-ERROR)
  37.                DUPKEY(CUSTFILE-DUPREC-ERROR)
  38.                DUPREC(CUSTFILE-DUPREC-ERROR)
  39.                FILENOTFOUND(CUSTFILE-FILENOTFOUND-ERROR)
  40.                ILLOGIC(CUSTFILE-ILLOGIC-ERROR)
  41.                INVREQ(CUSTFILE-INVREQ-ERROR)
  42.                IOERR(CUSTFILE-IOERR-ERROR)
  43.                ISCINVREQ(CUSTFILE-ISCINVREQ-ERROR)
  44.                LENGERR(CUSTFILE-LENGTH-ERROR)
  45.                NOTAUTH(CUSTFILE-NOTAUTH-ERROR)
  46.                NOTFND(CUSTFILE-NOTFND-ERROR)
  47.                NOSPACE(CUSTFILE-NOSPACE-ERROR)
  48.                NOTOPEN(CUSTFILE-OPEN-ERROR)
  49.                SYSIDERR(CUSTFILE-SYSIDERR-ERROR)
  50.            END-EXEC
  51.            .
  52.       *---------------------------------------------------------------*
  53.  
  54.        PROGRAM-BODY SECTION.
  55.            EVALUATE TRUE
  56.                WHEN COMM-DELETE-FLAG-TRUE
  57.                    PERFORM DELETE-RECORD
  58.                WHEN COMM-LOAD-FLAG-TRUE
  59.                    PERFORM LOAD-RECORD
  60.                WHEN COMM-SAVE-FLAG-TRUE
  61.                    PERFORM SAVE-RECORD
  62.            END-EVALUATE
  63.            .
  64.  
  65.       *--------------------------------------------------------------*
  66.        PROGRAM-TERMINATE SECTION.
  67.       *    MOVE 'CUSTIO END' TO CONSOLE-MESSAGE
  68.       *    EXEC CICS WRITE OPERATOR
  69.       *        TEXT(CONSOLE-MESSAGE)
  70.       *        TEXTLENGTH(25)
  71.       *        NOHANDLE
  72.       *    END-EXEC
  73.       *
  74.       * MOVE ALL OF THE DATA, UPDATED IN WORKING STORAGE, BACK INTO
  75.       * DFHCOMMAREA FOR RETURNING TO THE CALLING PROGRAM
  76.       *
  77.            MOVE COMM-AREA(1:EIBCALEN) TO DFHCOMMAREA(1:EIBCALEN).
  78.  
  79.  
  80.            EXEC CICS RETURN
  81.            END-EXEC
  82.            .
  83.       *--------------------------------------------------------------*
  84.  
  85.        DELETE-RECORD SECTION.
  86.            EXEC CICS DELETE
  87.                FILE('CUSTFILE')
  88.                RIDFLD(FILE-C-CODE)
  89.                KEYLENGTH(5)
  90.            END-EXEC
  91.            MOVE 'SUCCESSFUL DELETE' TO COMM-MESSAGE
  92.            MOVE 2 TO COMM-RETURN
  93.            INITIALIZE CUSTOMER-RECORD
  94.            .
  95.  
  96.       *---------------------------------------------------------------*
  97.  
  98.        LOAD-RECORD SECTION.
  99.            EXEC CICS READ
  100.                 FILE('CUSTFILE')
  101.                 INTO(CUSTOMER-RECORD)
  102.                 RIDFLD(FILE-C-CODE)
  103.                 KEYLENGTH(5)
  104.                 EQUAL
  105.            END-EXEC
  106.            .
  107.       *---------------------------------------------------------------*
  108.  
  109.        SAVE-RECORD SECTION.
  110.            EXEC CICS WRITE
  111.                FILE('CUSTFILE')
  112.                FROM(CUSTOMER-RECORD)
  113.                LENGTH(284)
  114.                RIDFLD(FILE-C-CODE)
  115.                KEYLENGTH(5)
  116.            END-EXEC
  117.            MOVE 'SUCCESSFUL SAVE' TO COMM-MESSAGE
  118.            MOVE 2 TO COMM-RETURN
  119.            .
  120.  
  121.       *---------------------------------------------------------------*
  122.       *                                                               *
  123.       *  ALL CODE WHICH FOLLOWS DEALS WITH CICS/OS2 ERRORS AND        *
  124.       *  THE PASSING OF A MESSAGE BACK TO CCIECI1.                    *
  125.       *                                                               *
  126.       *---------------------------------------------------------------*
  127.  
  128.        CUSTFILE-DISABLED-ERROR SECTION.
  129.            MOVE 'CICS/OS2 CUSTFILE DISABLED' TO COMM-MESSAGE
  130.            MOVE 1 TO COMM-RETURN
  131.            PERFORM PROGRAM-TERMINATE
  132.            .
  133.       *---------------------------------------------------------------*
  134.  
  135.        CUSTFILE-DUPREC-ERROR SECTION.
  136.            EXEC CICS DELETE
  137.                FILE('CUSTFILE')
  138.                RIDFLD(FILE-C-CODE)
  139.                KEYLENGTH(5)
  140.            END-EXEC
  141.            EXEC CICS WRITE
  142.                FILE('CUSTFILE')
  143.                FROM(CUSTOMER-RECORD)
  144.                LENGTH(284)
  145.                RIDFLD(FILE-C-CODE)
  146.                KEYLENGTH(5)
  147.            END-EXEC
  148.            MOVE 'SUCCESSFUL SAVE' TO COMM-MESSAGE
  149.            MOVE 2 TO COMM-RETURN
  150.            PERFORM PROGRAM-TERMINATE
  151.            .
  152.       *---------------------------------------------------------------*
  153.  
  154.        CUSTFILE-FILENOTFOUND-ERROR SECTION.
  155.            MOVE 'CICS/OS2 CUSTFILE FILENOTFOUND ERROR' TO COMM-MESSAGE
  156.            MOVE 1 TO COMM-RETURN
  157.            PERFORM PROGRAM-TERMINATE
  158.            .
  159.  
  160.       *---------------------------------------------------------------*
  161.  
  162.        CUSTFILE-ILLOGIC-ERROR SECTION.
  163.            MOVE 'CICS/OS2 CUSTFILE ILLOGIC ERROR' TO COMM-MESSAGE
  164.            MOVE 1 TO COMM-RETURN
  165.            PERFORM PROGRAM-TERMINATE
  166.            .
  167.  
  168.       *---------------------------------------------------------------*
  169.  
  170.        CUSTFILE-INVREQ-ERROR SECTION.
  171.            MOVE 'CICS/OS2 CUSTFILE INVREQ ERROR' TO COMM-MESSAGE
  172.            MOVE 1 TO COMM-RETURN
  173.            PERFORM PROGRAM-TERMINATE
  174.            .
  175.  
  176.       *---------------------------------------------------------------*
  177.  
  178.        CUSTFILE-IOERR-ERROR SECTION.
  179.            MOVE 'CICS/OS2 CUSTFILE IOERR' TO COMM-MESSAGE
  180.            MOVE 1 TO COMM-RETURN
  181.            PERFORM PROGRAM-TERMINATE
  182.            .
  183.  
  184.       *---------------------------------------------------------------*
  185.  
  186.        CUSTFILE-ISCINVREQ-ERROR SECTION.
  187.            MOVE 'CICS/OS2 CUSTFILE ISCINVREQ' TO COMM-MESSAGE
  188.            MOVE 1 TO COMM-RETURN
  189.            PERFORM PROGRAM-TERMINATE
  190.            .
  191.  
  192.       *---------------------------------------------------------------*
  193.  
  194.        CUSTFILE-LENGTH-ERROR SECTION.
  195.            MOVE 'CICS/OS2 CUSTFILE LENGTH ERROR' TO COMM-MESSAGE
  196.            MOVE 1 TO COMM-RETURN
  197.            PERFORM PROGRAM-TERMINATE
  198.            .
  199.  
  200.       *---------------------------------------------------------------*
  201.  
  202.        CUSTFILE-NOTAUTH-ERROR SECTION.
  203.            MOVE 'CICS/OS2 CUSTFILE NOTAUTH ERROR' TO COMM-MESSAGE
  204.            MOVE 1 TO COMM-RETURN
  205.            PERFORM PROGRAM-TERMINATE
  206.            .
  207.  
  208.       *---------------------------------------------------------------*
  209.  
  210.        CUSTFILE-NOTFND-ERROR SECTION.
  211.            MOVE 'CICS/OS2 CUSTFILE RECORD NOTFND ERROR' TO COMM-MESSAGE
  212.            MOVE 2 TO COMM-RETURN
  213.            PERFORM PROGRAM-TERMINATE
  214.            .
  215.  
  216.       *---------------------------------------------------------------*
  217.  
  218.        CUSTFILE-NOSPACE-ERROR SECTION.
  219.            MOVE 'CICS/OS2 CUSTFILE NOSPACE ERROR' TO COMM-MESSAGE
  220.            MOVE 1 TO COMM-RETURN
  221.            PERFORM PROGRAM-TERMINATE
  222.            .
  223.  
  224.       *---------------------------------------------------------------*
  225.  
  226.        CUSTFILE-OPEN-ERROR SECTION.
  227.            MOVE 'CICS/OS2 CUSTFILE OPEN ERROR' TO COMM-MESSAGE
  228.            MOVE 1 TO COMM-RETURN
  229.            PERFORM PROGRAM-TERMINATE
  230.            .
  231.  
  232.       *---------------------------------------------------------------*
  233.  
  234.        CUSTFILE-SYSIDERR-ERROR SECTION.
  235.            MOVE 'CICS/OS2 CUSTFILE SYSISERR ERROR' TO COMM-MESSAGE
  236.            MOVE 1 TO COMM-RETURN
  237.            PERFORM PROGRAM-TERMINATE
  238.            .
  239.