home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
o22516d1.zip
/
DSDEMO.@IP
/
CUSTIO.CCP
< prev
next >
Wrap
Text File
|
1992-07-29
|
8KB
|
239 lines
IDENTIFICATION DIVISION.
PROGRAM-ID. CUSTIO.
ENVIRONMENT DIVISION.
WORKING-STORAGE SECTION.
77 ARRAY-IND PIC 9(4) COMP.
****************************************************************
01 CONSOLE-MESSAGE PIC X(25).
****************************************************************
* *
* WORKING STORAGE COPY OF THE DATA PASSED IN DFHCOMMAREA. *
* *
****************************************************************
COPY COMMAREA.
LINKAGE SECTION.
01 DFHCOMMAREA PIC X.
PROCEDURE DIVISION.
100-START SECTION.
* MOVE 'CUSTIO START' TO CONSOLE-MESSAGE
* EXEC CICS WRITE OPERATOR
* TEXT(CONSOLE-MESSAGE)
* TEXTLENGTH(25)
* NOHANDLE
* END-EXEC
*
*
* MOVE THE DATA PASSED INTO WORKING STORAGE
*
MOVE DFHCOMMAREA(1:EIBCALEN) TO COMM-AREA(1:EIBCALEN).
EXEC CICS HANDLE CONDITION
DISABLED(CUSTFILE-DISABLED-ERROR)
DUPKEY(CUSTFILE-DUPREC-ERROR)
DUPREC(CUSTFILE-DUPREC-ERROR)
FILENOTFOUND(CUSTFILE-FILENOTFOUND-ERROR)
ILLOGIC(CUSTFILE-ILLOGIC-ERROR)
INVREQ(CUSTFILE-INVREQ-ERROR)
IOERR(CUSTFILE-IOERR-ERROR)
ISCINVREQ(CUSTFILE-ISCINVREQ-ERROR)
LENGERR(CUSTFILE-LENGTH-ERROR)
NOTAUTH(CUSTFILE-NOTAUTH-ERROR)
NOTFND(CUSTFILE-NOTFND-ERROR)
NOSPACE(CUSTFILE-NOSPACE-ERROR)
NOTOPEN(CUSTFILE-OPEN-ERROR)
SYSIDERR(CUSTFILE-SYSIDERR-ERROR)
END-EXEC
.
*---------------------------------------------------------------*
PROGRAM-BODY SECTION.
EVALUATE TRUE
WHEN COMM-DELETE-FLAG-TRUE
PERFORM DELETE-RECORD
WHEN COMM-LOAD-FLAG-TRUE
PERFORM LOAD-RECORD
WHEN COMM-SAVE-FLAG-TRUE
PERFORM SAVE-RECORD
END-EVALUATE
.
*--------------------------------------------------------------*
PROGRAM-TERMINATE SECTION.
* MOVE 'CUSTIO END' TO CONSOLE-MESSAGE
* EXEC CICS WRITE OPERATOR
* TEXT(CONSOLE-MESSAGE)
* TEXTLENGTH(25)
* NOHANDLE
* END-EXEC
*
* MOVE ALL OF THE DATA, UPDATED IN WORKING STORAGE, BACK INTO
* DFHCOMMAREA FOR RETURNING TO THE CALLING PROGRAM
*
MOVE COMM-AREA(1:EIBCALEN) TO DFHCOMMAREA(1:EIBCALEN).
EXEC CICS RETURN
END-EXEC
.
*--------------------------------------------------------------*
DELETE-RECORD SECTION.
EXEC CICS DELETE
FILE('CUSTFILE')
RIDFLD(FILE-C-CODE)
KEYLENGTH(5)
END-EXEC
MOVE 'SUCCESSFUL DELETE' TO COMM-MESSAGE
MOVE 2 TO COMM-RETURN
INITIALIZE CUSTOMER-RECORD
.
*---------------------------------------------------------------*
LOAD-RECORD SECTION.
EXEC CICS READ
FILE('CUSTFILE')
INTO(CUSTOMER-RECORD)
RIDFLD(FILE-C-CODE)
KEYLENGTH(5)
EQUAL
END-EXEC
.
*---------------------------------------------------------------*
SAVE-RECORD SECTION.
EXEC CICS WRITE
FILE('CUSTFILE')
FROM(CUSTOMER-RECORD)
LENGTH(284)
RIDFLD(FILE-C-CODE)
KEYLENGTH(5)
END-EXEC
MOVE 'SUCCESSFUL SAVE' TO COMM-MESSAGE
MOVE 2 TO COMM-RETURN
.
*---------------------------------------------------------------*
* *
* ALL CODE WHICH FOLLOWS DEALS WITH CICS/OS2 ERRORS AND *
* THE PASSING OF A MESSAGE BACK TO CCIECI1. *
* *
*---------------------------------------------------------------*
CUSTFILE-DISABLED-ERROR SECTION.
MOVE 'CICS/OS2 CUSTFILE DISABLED' TO COMM-MESSAGE
MOVE 1 TO COMM-RETURN
PERFORM PROGRAM-TERMINATE
.
*---------------------------------------------------------------*
CUSTFILE-DUPREC-ERROR SECTION.
EXEC CICS DELETE
FILE('CUSTFILE')
RIDFLD(FILE-C-CODE)
KEYLENGTH(5)
END-EXEC
EXEC CICS WRITE
FILE('CUSTFILE')
FROM(CUSTOMER-RECORD)
LENGTH(284)
RIDFLD(FILE-C-CODE)
KEYLENGTH(5)
END-EXEC
MOVE 'SUCCESSFUL SAVE' TO COMM-MESSAGE
MOVE 2 TO COMM-RETURN
PERFORM PROGRAM-TERMINATE
.
*---------------------------------------------------------------*
CUSTFILE-FILENOTFOUND-ERROR SECTION.
MOVE 'CICS/OS2 CUSTFILE FILENOTFOUND ERROR' TO COMM-MESSAGE
MOVE 1 TO COMM-RETURN
PERFORM PROGRAM-TERMINATE
.
*---------------------------------------------------------------*
CUSTFILE-ILLOGIC-ERROR SECTION.
MOVE 'CICS/OS2 CUSTFILE ILLOGIC ERROR' TO COMM-MESSAGE
MOVE 1 TO COMM-RETURN
PERFORM PROGRAM-TERMINATE
.
*---------------------------------------------------------------*
CUSTFILE-INVREQ-ERROR SECTION.
MOVE 'CICS/OS2 CUSTFILE INVREQ ERROR' TO COMM-MESSAGE
MOVE 1 TO COMM-RETURN
PERFORM PROGRAM-TERMINATE
.
*---------------------------------------------------------------*
CUSTFILE-IOERR-ERROR SECTION.
MOVE 'CICS/OS2 CUSTFILE IOERR' TO COMM-MESSAGE
MOVE 1 TO COMM-RETURN
PERFORM PROGRAM-TERMINATE
.
*---------------------------------------------------------------*
CUSTFILE-ISCINVREQ-ERROR SECTION.
MOVE 'CICS/OS2 CUSTFILE ISCINVREQ' TO COMM-MESSAGE
MOVE 1 TO COMM-RETURN
PERFORM PROGRAM-TERMINATE
.
*---------------------------------------------------------------*
CUSTFILE-LENGTH-ERROR SECTION.
MOVE 'CICS/OS2 CUSTFILE LENGTH ERROR' TO COMM-MESSAGE
MOVE 1 TO COMM-RETURN
PERFORM PROGRAM-TERMINATE
.
*---------------------------------------------------------------*
CUSTFILE-NOTAUTH-ERROR SECTION.
MOVE 'CICS/OS2 CUSTFILE NOTAUTH ERROR' TO COMM-MESSAGE
MOVE 1 TO COMM-RETURN
PERFORM PROGRAM-TERMINATE
.
*---------------------------------------------------------------*
CUSTFILE-NOTFND-ERROR SECTION.
MOVE 'CICS/OS2 CUSTFILE RECORD NOTFND ERROR' TO COMM-MESSAGE
MOVE 2 TO COMM-RETURN
PERFORM PROGRAM-TERMINATE
.
*---------------------------------------------------------------*
CUSTFILE-NOSPACE-ERROR SECTION.
MOVE 'CICS/OS2 CUSTFILE NOSPACE ERROR' TO COMM-MESSAGE
MOVE 1 TO COMM-RETURN
PERFORM PROGRAM-TERMINATE
.
*---------------------------------------------------------------*
CUSTFILE-OPEN-ERROR SECTION.
MOVE 'CICS/OS2 CUSTFILE OPEN ERROR' TO COMM-MESSAGE
MOVE 1 TO COMM-RETURN
PERFORM PROGRAM-TERMINATE
.
*---------------------------------------------------------------*
CUSTFILE-SYSIDERR-ERROR SECTION.
MOVE 'CICS/OS2 CUSTFILE SYSISERR ERROR' TO COMM-MESSAGE
MOVE 1 TO COMM-RETURN
PERFORM PROGRAM-TERMINATE
.