Cobol CICS DB2 Program

000100***************************************************************** 000100**************************************** **************************00010001 *00010001 000200* *00020001 000300* PROGRAM TITLE: WORKING WITH CURSORS IN DB2 *00030001 000600* *00060001 000700* PROGRAM OVERVIEW: *00070001 000800* ----------------------------------------------------------------------------------------------------------------- *00080001 000900* | THIS PROGRAM DETALS WITH THE CONCEPT OF COBOL-CICS-DB2 |*00090001 001000* ----------------------------------------------------------------------------------------------------------------- *00100001 001100* *00110001 001200* PROGRAMS CALLED : NONE *00120001 001300* *00130001 001400**************************************** 001400**************** ************************************************* **************************00140001 *00140001 001500* 00150001 001600 IDENTIFICATION DIVISION. 00160000 001700 PROGRAM-ID. PY021. 00170000 002000* 00200002 002100**************************************** 002100**************** ************************************************* **************************00210002 *00210002 002200*** DATA DIVISION ***00220002 002300**************************************** 002300**************** ************************************************* **************************00230002 *00230002 002400* 00240002 002500 DATA DIVISION. 00250000 002600* 00260002 002700**************************************** 002700**************** ************************************************* **************************00270002 *00270002 002800*** DATA DIVISION ***00280002 002900**************************************** 002900**************** ************************************************* **************************00290002 *00290002 003000* 00300002 003100 WORKING-STORAGE SECTION. 00310000 003210* 00321003 003300 01 WS-STDSTID PIC 9(9) VALUE ZERO. 00330002 003310* 00331003 003400 01 WS-STD-NULL PIC S9(4) USAGE COMP. 00340002 003410* 00341003 003500 01 WS-MENU PIC 9(5). 00350003 003510* 00351003 003600 01 WS-MESSAGE PIC X(20) VALUE "HELLO". 00360003 003610* 00361003 003700 01 WS-COMMAREA PIC X(5) VALUE ZERO. 00370003 003710* 00371003 003800 01 WS-NAME PIC X(25). 00380003 003810* 00381003 003900 COPY DFHAID. 00390000 004000 COPY MY0021. 00400000 004100 COPY DFHATTR. 00410000 004200 EXEC SQL 00420000 004300 INCLUDE S29995 00430003 004400 END-EXEC. 00440000 004500 EXEC SQL 00450000 004600 INCLUDE SQLCA 00460003 004700 END-EXEC. 00470000 004900 LINKAGE SECTION. 00490000 005100 00510000 005200 01 DFHCOMMAREA. 00520000 005300 05 WS-SUBMENU PIC X(5). 00530000 005310* 00531003 005320**************************************** 005320**************** ************************************************* **************************00532003 *00532003 005330*** DATA DIVISION ***00533003 005340**************************************** 005340**************** ************************************************* **************************00534003 *00534003 005350* 00535003 005500 PROCEDURE DIVISION. 00550000 005700 00570000

005800 A000-FIRST-PARA. 005900 MOVE DFHCOMMAREA TO WS-COMMAREA. 006000 IF EIBCALEN = 0 006100 PERFORM B000-SEND-PARA 006200 MOVE 'EEEEE' TO WS-COMMAREA 006300 PERFORM B001-RETURN-PARA 006400 ELSE 006500 PERFORM C000-RECEIVE-PARA 006600 EVALUATE EIBAID 006700 WHEN DFHENTER 006800 PERFORM C100-GETSTDNO-PARA 006900 PERFORM C210-VALIDATE-PARA 007000 PERFORM C220-WRITE-PARA 007100 PERFORM B001-RETURN-PARA 007200 WHEN DFHPF3 007300 PERFORM D000-HANDLE-F3-PARA 007400 WHEN DFHPF5 007500 PERFORM D001-HANDLE-F5-PARA 007600 WHEN DFHPF6 007700 PERFORM D002-HANDLE-F6-PARA 007800 WHEN OTHER 007900 MOVE LOW-VALUES TO ADDSTDO 008000 MOVE "INVALID KEY PRESSED" 008010 TO ADDMSG2O 008100 PERFORM B000-SEND-PARA 008200 END-EVALUATE 008300 PERFORM B001-RETURN-PARA 008400 END-IF 008410 . 008500*-----------------------* 008600*SEND MAP PARA. 008700*-----------------------* 008800 B000-SEND-PARA. 008900 MOVE LOW-VALUE TO ADDSTDI. 009000 EXEC CICS SEND 009100 MAP('ADDSTD') 009200 MAPSET('MY0021') 009300 ERASE 009400 FREEKB 009500 END-EXEC 009510 . 009600*-----------------------* 009700*RETURN MAP PARA. 009800*-----------------------* 009900 B001-RETURN-PARA. 010000 EXEC CICS RETURN 010100 TRANSID('Y021') 010200 COMMAREA(WS-COMMAREA) 010300 END-EXEC 010310 . 010400*-----------------------* 010500*RECEIVE MAP PARA. 010600*-----------------------* 010700 C000-RECEIVE-PARA. 010800 EXEC CICS RECEIVE 010900 MAP('ADDSTD') 011000 MAPSET('MY0021') 011100 END-EXEC 011110 . 011200*-----------------------*

00580003 00590003 00600003 00610003 00620003 00630003 00640000 00650003 00660000 00670003 00680003 00690003 00700003 00710003 00720003 00730003 00740003 00750003 00760003 00770003 00780003 00790003 00800003 00801003 00810003 00820003 00830003 00840003 00841003 00850000 00860000 00870000 00880003 00890000 00900000 00910003 00920003 00930003 00940003 00950003 00951003 00960000 00970000 00980000 00990003 01000000 01010003 01020003 01030003 01031003 01040000 01050000 01060000 01070003 01080000 01090003 01100003 01110003 01111003 01120000

011300*AUTO GENARATION PARA. 01130000 011400*-----------------------* 01140000 011500 C100-GETSTDNO-PARA. 01150003 011600 EXEC SQL 01160000 011700 SELECT MAX(STID) 01170003 011800 INTO :WS-STID:WS-STD-NULL 01180003 011900 FROM STUDENT 01190003 012000 END-EXEC 01200003 012010 . 01201003 012100 IF WS-STD-NULL = -1 01210000 012200 THEN 01220000 012300 COMPUTE WS-STDSTID = 200000000 01230003 012400 ELSE 01240000 012500 COMPUTE WS-STDSTID = WS-STID + 1 01250003 012600 END-IF 01260003 012610 . 01261003 012700 01270000 012800*C2000-ADDSTD-PARA. 01280000 012900*----------------------------------------------------------------*01290000 013000* INPUT VALIDATION *01300000 013100*----------------------------------------------------------------*01310000 013200 C210-VALIDATE-PARA. 01320003 013300 IF (SDNAMEL = 0) THEN 01330003 013500 MOVE "ENTER ATLEAST ONE CHARACTER FOR NAME" 01350003 013510 TO ADDMSG1O 01351003 013600 MOVE "MAKE CHANGES AND PRESS ENTER" 01360003 013610 TO ADDMSG2O 01361003 013700 MOVE -1 TO SDNAMEL 01370000 013800 PERFORM C210-SENDFINAL-PARA 01380003 013900 PERFORM B001-RETURN-PARA 01390003 014000 END-IF. 01400000 014100 01410000 014200 IF ( SDMAILL = 0 ) 01420000 014300 THEN 01430000 014400 MOVE "ENTER ATLEAST ONE CHARACTER FOR MAIL" 01440003 014410 TO ADDMSG1O 01441003 014500 MOVE "MAKE CHANGES AND PRESS ENTER" 01450003 014510 TO ADDMSG2O 01451003 014600 MOVE -1 TO SDMAILL 01460000 014700 MOVE ATTR-PXMBL TO SDNAMEA 01470003 014800 PERFORM C210-SENDFINAL-PARA 01480003 014900 PERFORM B001-RETURN-PARA 01490003 015000 END-IF. 01500000 015100 01510000 015200 IF (SDBTCHL = 0) THEN 01520003 015400 MOVE "ENTER ATLEAST ONE CHARECTER FOR BATCH" 01540003 015410 TO ADDMSG1O 01541003 015500 MOVE "MAKE CHANGES AND PRESS ENTER" 01550003 015510 TO ADDMSG2O 01551003 015600 MOVE ATTR-PXMBL TO SDNAMEA 01560003 015700 MOVE ATTR-PXMBL TO SDMAILA 01570003 015800 MOVE -1 TO SDBTCHL 01580003 015900 PERFORM C210-SENDFINAL-PARA 01590003 016000 PERFORM B001-RETURN-PARA 01600003 016100 END-IF. 01610000 016200*-----------------------* 01620000 016300*FINAL MAP SEND PARA. 01630000 016400*-----------------------* 01640000 016500 C210-SENDFINAL-PARA. 01650003 016600 EXEC CICS SEND 01660000

016700 MAP('ADDSTD') 016800 MAPSET('MY0021') 016900 ERASE 017000 CURSOR 017100 FREEKB 017200 END-EXEC. 017300*-----------------------* 017400*WRITE TO TABLE PARA. 017500*-----------------------* 017600 C220-WRITE-PARA. 017700 MOVE SDNAMEL TO WS-SNAME-LEN. 017800 MOVE SDMAILL TO WS-SEMAIL-LEN. 017900 MOVE SDBTCHL TO WS-BATCH-LEN. 018000 MOVE SDNAMEI TO WS-SNAME-TEXT. 018100 MOVE SDMAILI TO WS-SEMAIL-TEXT. 018200 MOVE SDBTCHI TO WS-BATCH-TEXT. 018300 MOVE WS-STDSTID TO WS-STID. 018400 018500 EXEC SQL 018600 INSERT INTO STUDENT 018700 VALUES(:WS-STID,:WS-SNAME,:WS-SEMAIL,:WS-BATCH) 018800 END-EXEC. 018900 IF SQLCODE = 0 019000 THEN 019100 MOVE "SUCCESS" TO MSGO 019200 PERFORM C2300-SUCESS-WRITE-PARA 019300 PERFORM C2210-SUCESS-SEND-MAP-PARA 019400 PERFORM B0001-RETURN-PARA 019500 ELSE 019600 PERFORM C2400-FAIL-WRITE-PARA 019700 PERFORM B0001-RETURN-PARA 019800 END-IF 019810 . 019900*-----------------------* 020000*WRITE TO MAP PARA. 020100*-----------------------* 020200 C230-SUCESS-WRITE-PARA. 020300 MOVE WS-STDSTID TO SSSTIDO . 020400 MOVE WS-SNAME-TEXT TO SSNAMEO . 020500 MOVE WS-SEMAIL-TEXT TO SSMAILO . 020600 MOVE WS-BATCH-TEXT TO SSBTCHO . 020700*-----------------------* 020800*ERROR HANDLING PARA. 020900*-----------------------* 021000 C240-FAIL-WRITE-PARA. 021100 EVALUATE TRUE 021200 WHEN SQLCODE = -551 021300 MOVE ' NO PERMISSION OT ACCESS THE TABLE' 021310 TO MSGO 021400 WHEN SQLCODE = -204 021500 MOVE 'THE TABLE DOES NOT EXIST' TO MSGO 021510 TO MSGO 021600 WHEN OTHER 021700 MOVE ' SOME DATABASE ERROR' TO MSGO 021710 TO MSGO 021800 END-EVALUATE 021900 EXEC CICS SEND TEXT 022000 FROM(WS-MESSAGE) 022100 ERASE 022200 END-EXEC.

01670003 01680003 01690003 01700003 01710003 01720000 01730000 01740000 01750000 01760003 01770003 01780003 01790003 01800003 01810003 01820003 01830003 01840000 01850000 01860003 01870003 01880000 01890003 01900000 01910003 01920003 01930003 01940003 01950000 01960003 01970003 01980003 01981003 01990000 02000000 02010000 02020003 02030003 02040003 02050003 02060003 02070000 02080000 02090000 02100003 02110000 02120003 02130003 02131003 02140003 02150003 02151003 02160003 02170003 02171003 02180000 02190000 02200003 02210003 02220000

022300 EXEC CICS RETURN 022400 TRANSID('Y021') 022500 COMMAREA(WS-COMMAREA) 022600 END-EXEC. 022700*-----------------------* 022800*SEND MAP PARA. 022900*-----------------------* 023000 C220-SUCESS-SEND-MAP-PARA. 023100 EXEC CICS SEND 023200 MAP('SUCSTD') 023300 MAPSET('MY0021') 023400 FREEKB 023500 ERASE 023600 END-EXEC 023610 . 023700*-----------------------* 023800*HANDLING F3. 023900*-----------------------* 024000 D000-HANDLE-F3-PARA. 024100 MOVE "THANK YOU" 024200 EXEC CICS SEND TEXT 024300 FROM(WS-MESSAGE) 024400 ERASE 024500 FREEKB 024600 END-EXEC. 024700 EXEC CICS RETURN 024800 END-EXEC 024810 . 024900*-----------------------* 025000*HANDLING F5. 025100*-----------------------* 025200 D001-HANDLE-F5-PARA. 025300 MOVE SPACES 025400 PERFORM B0000-SEND-PARA 025500 PERFORM B0001-RETURN-PARA 025510 . 025600*-----------------------* 025700*HANDLING F6. 025800*-----------------------* 025900 D002-HANDLE-F6-PARA. 026000 EXEC CICS XCTL 026100 PROGRAM('PY025') 026200 END-EXEC 026300 .

TO WS-MESSAGE

TO ADDSTDO

02230000 02240003 02250003 02260000 02270000 02280000 02290000 02300003 02310000 02320003 02330003 02340003 02350003 02360003 02361003 02370000 02380000 02390000 02400003 02410003 02420000 02430003 02440003 02450003 02460000 02470000 02480003 02481003 02490000 02500000 02510000 02520003 02530003 02540000 02550003 02551003 02560000 02570000 02580000 02590003 02600000 02610003 02620003 02630003