$set xdb IDENTIFICATION DIVISION. SQL00010 PROGRAM-ID. SQLCOB04. SQL00020 AUTHOR. BCIS--DR BECKER. SQL00030 INSTALLATION. UNT. SQL00040 DATE-WRITTEN. September, 2008. SQL00050 DATE-COMPILED. SQL00060 * SQL00070 ENVIRONMENT DIVISION. SQL00080 CONFIGURATION SECTION. SQL00090 SOURCE-COMPUTER. IBM-AT. SQL00100 OBJECT-COMPUTER. IBM-AT. SQL00110 SPECIAL-NAMES. SQL00120 C01 IS TOP-OF-PAGE. SQL00130 * SQL00140 INPUT-OUTPUT SECTION. SQL00150 FILE-CONTROL. SQL00160 * SELECT CARDIN ASSIGN TO "FILE.INFILE" * ORGANIZATION IS LINE SEQUENTIAL. SQL00170 SELECT REPOUT ASSIGN TO "FILE.OUTFILE" ORGANIZATION IS LINE SEQUENTIAL. SQL00180 * SQL00190 DATA DIVISION. SQL00200 FILE SECTION. SQL00210 * SQL00215 * COMMENT OUT THE FD CARDIN DATA * SQL00220 *FD CARDIN SQL00230 * RECORD CONTAINS 80 CHARACTERS SQL00240 * BLOCK CONTAINS 0 RECORDS SQL00250 * RECORDING MODE IS F SQL00260 * LABEL RECORDS ARE OMITTED. SQL00270 *01 CARDREC. SQL00280 * 05 FILLER PIC X(80). SQL00290 * SQL00300 FD REPOUT SQL00310 RECORD CONTAINS 120 CHARACTERS SQL00320 BLOCK CONTAINS 0 RECORDS SQL00330 RECORDING MODE IS F SQL00340 LABEL RECORDS ARE OMITTED SQL00350 DATA RECORD IS REPREC. SQL00360 01 REPREC. SQL00370 05 FILLER PIC X(120). SQL00380 * SQL00390 WORKING-STORAGE SECTION. SQL00400 * SQL00410 01 INPUT-AREA. SQL00420 05 ACTION PIC X(01). SQL00430 05 TRANS. SQL00440 10 T-LNAME PIC X(15). SQL00450 10 T-FNAME PIC X(12). SQL00460 10 T-ENO PIC X(06). SQL00470 10 T-PNO PIC X(04). SQL00480 10 T-DNO PIC X(03). SQL00490 10 FILLER PIC X(31). SQL00500 05 FILLER PIC X(08). SQL00510 * SQL00520 * REPORT HEADERS SQL00530 * SQL00540 01 REPHDR1. SQL00550 05 FILLER PIC X(29) SQL00560 VALUE '_____________________________'. SQL00570 05 FILLER PIC X(21) SQL00580 VALUE ' SQL COBOL PROBLEM '. SQL00590 05 FILLER PIC X(29) SQL00600 VALUE '_____________________________'. SQL00610 * SQL00620 01 REPHDR2IN. SQL00630 05 FILLER PIC X(06) VALUE 'ACTION'. SQL00640 05 FILLER PIC X(15) VALUE ' LNAME '. SQL00650 05 FILLER PIC X(12) VALUE ' FNAME '. SQL00660 05 FILLER PIC X(06) VALUE 'ENO '. SQL00670 05 FILLER PIC X(04) VALUE 'PNO '. SQL00680 05 FILLER PIC X(03) VALUE 'DNO'. SQL00690 * SQL00700 01 REPHDR3ST. SQL00710 05 FILLER PIC X(15) VALUE 'LASTNAME '. SQL00720 05 FILLER PIC X(15) VALUE 'MIDINIT '. SQL00730 05 FILLER PIC X(10) VALUE 'LASTNAME '. SQL00740 * SQL00750 01 REPHDR4SV. SQL00760 05 FILLER PIC X(15) VALUE 'LASTNAME '. SQL00770 05 FILLER PIC X(12) VALUE 'FIRSTNAME '. SQL00780 05 FILLER PIC X(05) VALUE 'PHONE'. SQL00790 05 FILLER PIC X(07) VALUE ' EMPNO '. SQL00800 05 FILLER PIC X(36) VALUE 'DEPARTMENT NAME'. SQL00810 05 FILLER PIC X(04) VALUE ' DNO'. SQL00820 * SQL00830 01 REPHDR5DS. SQL00840 05 FILLER PIC X(16) VALUE ' COLUMN1 '. SQL00850 05 FILLER PIC X(15) VALUE ' COLUMN2 '. SQL00860 05 FILLER PIC X(15) VALUE ' COLUMN3 '. SQL00870 * SQL00880 01 REPHDR6. SQL00890 05 FILLER PIC X(50) VALUE SQL00900 '__________________________________________________'. SQL00910 * SQL00920 * INPUT RECORD SQL00930 * SQL00940 01 REPDATA1. SQL00950 05 FILLER PIC X(05) VALUE SPACES. SQL00960 05 ACTIONR PIC X(01) VALUE SPACES. SQL00970 05 TRANSACT PIC X(72) VALUE SPACES. SQL00980 * SQL00990 * EMP DISPLAY SQL01000 * SQL01010 01 REPDATA2. SQL01020 05 FILLER PIC X(01) VALUE SPACES. SQL01030 05 RFIRSTNME PIC X(12) VALUE SPACES. SQL01040 05 FILLER PIC X(07) VALUE SPACES. SQL01050 05 RMIDINIT PIC X(01) VALUE SPACES. SQL01060 05 FILLER PIC X(12) VALUE SPACES. SQL01070 05 RLASTNAME PIC X(15) VALUE SPACES. SQL01080 * SQL01090 * VPHONE DISLAY SQL01100 * SQL01110 01 REPDATA3. SQL01120 05 FILLER PIC X(01) VALUE SPACES. SQL01130 05 RVLASTNAME PIC X(15) VALUE SPACES. SQL01140 05 RVFIRSTNME PIC X(12) VALUE SPACES. SQL01150 05 RVPHONENO PIC X(04) VALUE SPACES. SQL01160 05 FILLER PIC X(01) VALUE SPACES. SQL01170 05 RVEMPNO PIC X(06) VALUE SPACES. SQL01180 05 FILLER PIC X(01) VALUE SPACES. SQL01190 05 RVDEPTNAME PIC X(36) VALUE SPACES. SQL01200 05 RVDEPTNO PIC X(03) VALUE SPACES. SQL01210 * SQL01220 * MESSAGES SQL01310 * SQL01320 01 MSG01 PIC X(48) VALUE SQL01330 ' MSG01I - INVALID REQUEST, A-D-F-I-S-U-* VALID '. SQL01340 01 MSG02. SQL01350 05 FILLER PIC X(38) VALUE SQL01360 ' MSG02I - UPDATE COMPLETE - RECORDS = '. SQL01370 05 MSGCODE2 PIC -(9)9. SQL01380 01 MSG03 PIC X(44) VALUE SQL01390 ' MSG03 - UPDATE FAILED, EMPLOYEE NOT FOUND '. SQL01400 01 MSG04. SQL01410 05 FILLER PIC X(37) VALUE SQL01420 ' MSG04I - SQL ERROR, RETURN CODE IS: '. SQL01430 05 MSGCODE4 PIC -(9)9. SQL01440 01 MSG05 PIC X(51) VALUE SQL01450 ' MSG05I - ROLLBACK SUCCESSFUL, ALL UPDATES REMOVED '. SQL01460 01 MSG06. SQL01470 05 FILLER PIC X(43) VALUE SQL01480 ' MSG06I - ROLLBACK FAILED, RETURN CODE IS: '. SQL01490 05 MSGCODE6 PIC -(9)9. SQL01500 01 MSG07 PIC X(37) VALUE SQL01510 ' MSG07I - NO EMPLOYEE FOUND IN TABLE '. SQL01520 01 MSG08. SQL01530 05 FILLER PIC X(45) VALUE SQL01540 ' MSG08I - NON-ZERO RETURN CODE FROM DSNTIAR: '. SQL01550 05 MSGCODE8 PIC -(9)9. SQL01560 01 MSG09. SQL01570 05 FILLER PIC X(38) VALUE SQL01580 ' MSG09I - INSERT COMPLETE - RECORDS = '. SQL01590 05 MSGCODE9 PIC -(9)9. SQL01600 01 MSG10. SQL01610 05 FILLER PIC X(38) VALUE SQL01620 ' MSG10I - DELETE COMPLETE - RECORDS = '. SQL01630 05 MSGCODE10 PIC -(9)9. SQL01640 01 MSG11 PIC X(38) VALUE SQL01650 ' MSG11I - NO DEPARTMENT RECORD FOUND '. SQL01660 * SQL01670 * WORKAREAS SQL01680 * SQL01690 01 WORK-VARIABLES. SQL01700 05 INPUT-SWITCH PIC X VALUE 'Y'. SQL01710 88 NOMORE-INPUT VALUE 'N'. SQL01720 05 NOT-FOUND PIC S9(9) COMP VALUE +100. SQL01730 05 LAST-VDEPTNAME PIC X(36). SQL01731 05 WSALARY PIC S9(07)V99 USAGE COMP-3 VALUE ZEROS. SQL01732 05 WBONUS PIC S9(07)V99 USAGE COMP-3 VALUE ZEROS. SQL01733 05 WCOMM PIC S9(07)V99 USAGE COMP-3 VALUE ZEROS. SQL01734 05 WTOTAL PIC S9(08)V99 USAGE COMP-3 VALUE ZEROS. SQL01735 * SQL01740 * PROVIDE A SQL COMMUNICATION AREA SQL01750 * SQL01760 EXEC SQL INCLUDE SQLCA END-EXEC. SQL01770 * SQL01780 * INCLUDE COBOL DECLARES FOR VPHONE & EMP SQL01790 * SQL01800 EXEC SQL BEGIN DECLARE SECTION END-EXEC. SQL01810 * SQL01820 * COBOL DECLARATION FOR TABLE EMP SQL01830 * SQL01840 01 EMPNO PIC X(6). SQL01850 01 FIRSTNME. SQL01860 49 FIRSTNME-LEN PIC S9(04) USAGE COMP. SQL01870 49 FIRSTNME-TEXT PIC X(12). SQL01880 01 MIDINIT PIC X(01). SQL01890 01 LASTNAME. SQL01900 49 LASTNAME-LEN PIC S9(04) USAGE COMP. SQL01910 49 LASTNAME-TEXT PIC X(15). SQL01920 01 WORKDEPT PIC X(03). SQL01930 01 PHONENO PIC X(04). SQL01940 01 HIREDATE PIC X(10). SQL01950 01 JOB PIC X(08). SQL01960 01 EDLEVEL PIC S9(04) USAGE COMP. SQL01970 01 SEX PIC X(01). SQL01980 01 BIRTHDATE PIC X(10). SQL01990 01 SALARY PIC S9(07)V99 USAGE COMP-3. SQL02000 01 BONUS PIC S9(07)V99 USAGE COMP-3. SQL02010 01 COMM PIC S9(07)V99 USAGE COMP-3. SQL02020 * SQL02030 * COBOL DECLARATION FOR VIEW VPHONE SQL02040 * SQL02050 01 VLASTNAME. SQL02060 49 VLASTNAME-LEN PIC S9(04) USAGE COMP. SQL02070 49 VLASTNAME-TEXT PIC X(15). SQL02080 01 VFIRSTNME. SQL02090 49 VFIRSTNME-LEN PIC S9(04) USAGE COMP. SQL02100 49 VFIRSTNME-TEXT PIC X(12). SQL02110 01 VPHONENO PIC X(04). SQL02120 01 VEMPNO PIC X(06). SQL02130 01 VDEPTNAME. SQL02140 49 VDEPTNAME-LEN PIC S9(04) USAGE COMP. SQL02150 49 VDEPTNAME-TEXT PIC X(36). SQL02160 01 VDEPTNO PIC X(03). SQL02170 * SQL02180 * DEFINE AN ACTION INDICATOR FOR NULL VARIABLES SQL02190 * SQL02200 01 PIND PIC S9(04) USAGE COMP. SQL02210 01 PINDM PIC S9(04) USAGE COMP. SQL02210 01 PINDX PIC S9(04) USAGE COMP. SQL02210 * SQL02220 * SQL02320 * SQL HOST VARIABLES FOR INPUT TRANSACTION SQL02330 * SQL02340 01 LNAME PIC X(15). SQL02350 01 FNAME PIC X(12). SQL02360 01 ENO PIC X(06). SQL02370 01 PNO PIC X(04). SQL02380 01 DNO PIC X(03). SQL02390 01 TOTAL-SALARY PIC S9(08)V99 USAGE COMP-3. SQL02391 * SQL02400 EXEC SQL END DECLARE SECTION END-EXEC. SQL02410 * SQL02420 PROCEDURE DIVISION. SQL02430 000-MAIN-CONTROL SECTION. SQL02500 * SQL02440 * DEFINE SQL ERROR HANDLING STATEMENTS SQL02450 * SQL02460 EXEC SQL WHENEVER SQLERROR GO TO :900-DBERROR END-EXEC. SQL02470 EXEC SQL WHENEVER SQLWARNING GO TO :900-DBERROR END-EXEC. SQL02480 * SQL02490 PERFORM 100-OPEN-FILE. SQL02510 WRITE REPREC FROM REPHDR1 SQL02530 AFTER ADVANCING TOP-OF-PAGE. SQL02540 WRITE REPREC FROM REPDATA1 SQL02543 AFTER ADVANCING 1 LINE. SQL02544 PERFORM 360-FETCH-LIST-VEMP. SQL02550 PERFORM 400-PROGRAM-END. SQL02570 STOP RUN. SQL02580 * SQL02590 100-OPEN-FILE SECTION. SQL02600 OPEN OUTPUT REPOUT. SQL02620 * SQL02630 400-PROGRAM-END SECTION. SQL02940 EXEC SQL ROLLBACK WORK END-EXEC. SQL02950 CLOSE REPOUT. SQL02970 * SQL02980 * SQL04070 360-FETCH-LIST-VEMP SECTION. SQL04080 WRITE REPREC FROM REPHDR4SV SQL04090 AFTER ADVANCING 2 LINES. SQL04100 * SQL04110 * DECLARE CURSOR FOR RETRIEVING INFORMATION SQL04120 * THIS IS WHERE YOU WILL WANT TO CREATE A NEW VIEW * THAT SELECTS ALL THE DATA YOU WISH TO INCLUDE IN THIS PROGRAM * HINT: CREATE A NEW VIEW IN YOUR DB2 DATABASE=> e.g., VSALARY * CONSIDER USING SQL TO CALCULATE: * TSALARY= (SALARY + BONUS + COMM) * BE SURE TO CHANGE THE LOCATION SETTINGS IN THE VIEW BELOW. * SQL04130 EXEC SQL DECLARE VCUR CURSOR FOR SQL04140 SELECT VLASTNAME, VFIRSTNME, VPHONENO, VEMPNO, SQL04150 VDEPTNAME, VDEPTNO FROM BECKER.ASSIGN.VPHONE SQL04160 ORDER BY VDEPTNAME, VLASTNAME, VFIRSTNME SQL04180 END-EXEC. SQL04190 * SQL04200 * INITIALIZE THE VARIABLE TEXT FIELDS * SQL04220 MOVE SPACES TO VLASTNAME-TEXT. SQL04640 MOVE SPACES TO VFIRSTNME-TEXT. SQL04640 MOVE SPACES TO VDEPTNAME-TEXT. SQL04650 * * OPEN CURSOR AND FETCH FIRST ROW SQL04210 EXEC SQL OPEN VCUR END-EXEC. SQL04230 * EXEC SQL FETCH VCUR INTO SQL04240 :VLASTNAME, :VFIRSTNME, :VPHONENO:PIND, :VEMPNO, SQL04250 :VDEPTNAME, :VDEPTNO SQL04260 END-EXEC. SQL04270 IF SQLCODE = NOT-FOUND SQL04280 WRITE REPREC FROM MSG07 SQL04290 AFTER ADVANCING 2 LINES SQL04300 ELSE SQL04310 * MOVE VDEPTNAME TO LAST-VDEPTNAME, * ADD VSALARY TO WSALARY. PERFORM 365-PRINT-AND-GET1 SQL04320 UNTIL SQLCODE IS NOT EQUAL TO ZERO SQL04330 END-IF. SQL04340 * SQL04350 * SQL CODE TO CLOSE CURSOR SQL04360 * SQL04370 EXEC SQL CLOSE VCUR END-EXEC. SQL04380 * SQL04390 365-PRINT-AND-GET1 SECTION. SQL04400 * SQL04410 * TEST FOR NULL PHONE SQL04420 * SQL04430 IF PIND < 0 MOVE 'NONE' TO VPHONENO. SQL04440 PERFORM 367-PRINT-A-LINE. SQL04450 * SQL04460 * GET NEXT ROW SQL04470 * SQL04480 EXEC SQL FETCH VCUR INTO SQL04490 :VLASTNAME, :VFIRSTNME, :VPHONENO:PIND, :VEMPNO, SQL04500 :VDEPTNAME, :VDEPTNO SQL04510 END-EXEC. SQL04520 DISPLAY SQLCODE. SQL04625 * IF VDEPTNAME NOT = LAST-VEPTNAME ... * PRINT LAST DEPARTMENT-TOTAL-SALARY * PRINT NEW PAGE... RESET SUBTOTALS * SQL04530 367-PRINT-A-LINE SECTION. SQL04540 MOVE SPACES TO REPDATA3. SQL04630 MOVE VLASTNAME-TEXT TO RVLASTNAME. SQL04550 MOVE VFIRSTNME-TEXT TO RVFIRSTNME. SQL04560 MOVE VPHONENO TO RVPHONENO. SQL04570 MOVE VEMPNO TO RVEMPNO. SQL04580 MOVE VDEPTNAME-TEXT TO RVDEPTNAME. SQL04590 MOVE VDEPTNO TO RVDEPTNO. SQL04600 WRITE REPREC FROM REPDATA3 SQL04610 AFTER ADVANCING 1 LINES. SQL04620 DISPLAY SQLCODE, REPDATA3. SQL04625 MOVE SPACES TO REPDATA3. SQL04630 MOVE SPACES TO VLASTNAME-TEXT. SQL04640 MOVE SPACES TO VFIRSTNME-TEXT. SQL04640 MOVE SPACES TO VDEPTNAME-TEXT. SQL04650 * SQL04660 * SQL05030 380-INPUT-ERROR SECTION. WRITE REPREC FROM MSG01 AFTER ADVANCING 2 LINES. * 900-DBERROR SECTION. SQL05040 MOVE SQLCODE TO MSGCODE4. SQL05050 WRITE REPREC FROM MSG04 SQL05060 AFTER ADVANCING 2 LINES. SQL05070 DISPLAY 'UNEXPECTED SQL ERROR RETURNED' UPON CONSOLE. SQL05080 DISPLAY 'CHANGES WILL BE BACKED OUT' UPON CONSOLE. SQL05090 DISPLAY 'SEE REPORT FOR FAILING TRANSACTION' UPON CONSOLE. SQL05100 DISPLAY 'UNEXPECTED SQL ERROR RETURNED'. SQL05110 DISPLAY 'SQLCODE: ', SQLCODE. SQL05120 DISPLAY 'SQLERRM: ', SQLERRM. SQL05130 DISPLAY 'SQLERRP: ', SQLERRP. SQL05140 DISPLAY 'SQLERRD: ', SQLERRD(1). SQL05150 DISPLAY 'SQLWARN0: ', SQLWARN0. SQL05160 DISPLAY 'SQLWARN1: ', SQLWARN1. SQL05170 DISPLAY 'SQLWARN2: ', SQLWARN2. SQL05180 DISPLAY 'SQLWARN3: ', SQLWARN3. SQL05190 DISPLAY 'SQLWARN4: ', SQLWARN4. SQL05200 DISPLAY 'SQLWARN5: ', SQLWARN5. SQL05210 DISPLAY 'SQLWARN6: ', SQLWARN6. SQL05220 DISPLAY 'SQLWARN7: ', SQLWARN7. SQL05230 DISPLAY 'SQLWARN8: ', SQLWARN8. SQL05240 DISPLAY 'SQLWARN9: ', SQLWARN9. SQL05250 DISPLAY 'SQLWARNA: ', SQLWARNA. SQL05260 * SQL05270 * IGNORE ERRORS DURING ROLLBACK TO AVOID LOOP SQL05280 * SQL05290 EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC. SQL05300 EXEC SQL WHENEVER SQLWARNING CONTINUE END-EXEC. SQL05310 EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC. SQL05320 * SQL05330 EXEC SQL ROLLBACK WORK END-EXEC. SQL05340 IF SQLCODE = ZERO SQL05350 WRITE REPREC FROM MSG05 SQL05360 AFTER ADVANCING 2 LINES SQL05370 ELSE SQL05390 MOVE SQLCODE TO MSGCODE6 SQL05400 WRITE REPREC FROM MSG06 SQL05410 AFTER ADVANCING 2 LINES SQL05420 END-IF. SQL05430 PERFORM 400-PROGRAM-END. SQL05440 DISPLAY 'SQL ERROR RETURNED; LAST STMT EXECUTED LINE 564'. SQL05110 STOP RUN.