DSN8MCF
THIS MODULE HANDLES THE DETAIL OPERATIONS FOR AN EMPLOYEE SUCH AS DISPLAY, ADD(INSERT), UPDATE, AND ERASE(DELETE) IN THE MAJOR SYSTEM ORGANIZATION.
************* DSN8MCF - DETAIL EMPLOYEE MODULE - COBOL ***********00010000
* 00020000
* MODULE NAME = DSN8MCF 00030000
* 00040000
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION 00050000
* DETAIL EMPLOYEE MODULE 00060000
* COBOL 00070000
* ORGANIZATION 00080000
* 00090000
* LICENSED MATERIALS - PROPERTY OF IBM 00100000
* 5615-DB2 00106000
* (C) COPYRIGHT 1982, 2013 IBM CORP. ALL RIGHTS RESERVED. 00113000
* 00120000
* STATUS = VERSION 11 00127000
* 00134000
* 00142000
* FUNCTION = THIS MODULE HANDLES THE DETAIL OPERATIONS 00150000
* FOR AN EMPLOYEE SUCH AS DISPLAY, ADD(INSERT), 00160000
* UPDATE, AND ERASE(DELETE) IN THE MAJOR 00170000
* SYSTEM ORGANIZATION. 00180000
* 00190000
* NOTES = 00200000
* DEPENDENCIES = NONE 00210000
* RESTRICTIONS = THE VALID OPTIONS ARE: 00220000
* .O-D-EM-EI,EN,DI,DN 00230000
* .O-A-EM-EI,EN,DI 00240000
* .O-U-EM-EI,EN,DI,DN 00250000
* .O-E-EM-EI,EN,DI,DN 00260000
* 00270000
* MODULE TYPE = 00280000
* PROCESSOR = DB2 PRECOMPILER, COBOL COMPILER 00290000
* MODULE SIZE = SEE LINK-EDIT 00300000
* ATTRIBUTES = REUSABLE 00310000
* 00320000
* ENTRY POINT = 00330000
* PURPOSE = SEE FUNCTION 00340000
* LINKAGE = MODULE CALLED BY 00350000
* .DSN8MCA FOR DISPLAY, AND FIRST STEP UPDATE OR ERASE 00360000
* .DSN8IC2 FOR FIRST STEP ADD, AND ALL SECOND STEPS. 00370000
* 00380000
* INPUT = PARAMETERS EXPLICITLY PASSED TO THIS FUNCTION: 00390000
* COMMON AREA. 00400000
* 00410000
* SYMBOLIC LABEL/NAME = PCONVSTA.PREV 00420000
* DESCRIPTION = 'D' OR ' ' PREVIOUS REQUEST 00430000
* 00440000
* SYMBOLIC LABEL/NAME = .MAXSEL 00450000
* DESCRIPTION = 1-13 NUMBER OF SELECTIONS 00460000
* 00470000
* SYMBOLIC LABEL/NAME = OUTAREA.OUTPUT0 00480000
* DESCRIPTION = SECONDARY SELECTION OUTPUT 00490000
* 00500000
* SYMBOLIC LABEL/NAME = COMPARM .NEWREQ 00510000
* DESCRIPTION = 'Y' OR 'N' NEW REQUEST 00520000
* 00530000
* SYMBOLIC LABEL/NAME = INAREA 00540000
* DESCRIPTION = USER INPUT 00550000
* 00560000
* 00570000
* OUTPUT = PARAMETERS EXPLICITLY RETURNED: 00580000
* COMMON AREA. 00590000
* 00600000
* SYMBOLIC LABEL/NAME = OUTAREA.OUTPUT0 00610000
* DESCRIPTION = SCREEN DETAIL OUTPUT 00620000
* 00630000
* SYMBOLIC LABEL/NAME = PCONVSTA.PREV 00640000
* DESCRIPTION = 'D' OR ' ' DEPENDING ON 00650000
* STEP NUMBER 00660000
* 00670000
* 00680000
* EXIT-NORMAL = 00690000
* 00700000
* EXIT-ERROR = 00710000
* 00720000
* RETURN CODE = NONE 00730000
* 00740000
* ABEND CODES = NONE 00750000
* 00760000
* ERROR-MESSAGES = 00770000
* DSN8001I EMPLOYEE NOT FOUND 00780000
* DSN8002I EMPLOYEE SUCCESSFULLY ADDED 00790000
* DSN8003I EMPLOYEE SUCCESSFULLY ERASED 00800000
* DSN8004I EMPLOYEE SUCCESSFULLY UPDATED 00810000
* DSN8005E EMPLOYEE EXISTS ALREADY, ADD NOT DONE 00820000
* DSN8006E EMPLOYEE DOES NOT EXIST, ERASE NOT DONE 00830000
* DSN8007E EMPLOYEE DOES NOT EXIST, UPDATE NOT DONE 00840000
* DSN8069E NO VALID SELECTIONS QUALIFY FOR THIS REQUEST 00850000
* DSN8200E INVALID DEPARTMENT NUMBER, EMPLOYEE NOT INSERTED 00852000
* DSN8202E EMPLOYEE NUMBER HAS DEPENDENT ROWS, NOT ERASED 00854000
* DSN8203E INVALID WORK DEPT, EMPLOYEE NOT UPDATED 00857000
* 00860000
* 00870000
* EXTERNAL REFERENCES = 00880000
* ROUTINES/SERVICES = 00890000
* DSN8MCG - ERROR MESSAGE ROUTINE 00900000
* 00910000
* DATA-AREAS = 00920000
* DSN8MCCA - SAMPLE COMMON AREA 00930000
* 00940000
* CONTROL-BLOCKS = 00950000
* SQLCA - SQL COMMUNICATION AREA 00960000
* 00970000
* TABLES = 00980000
* VDEPT = DEPARTMENT TABLE VIEW 00990000
* VEMP = EMPLOYEE TABLE VIEW 01000000
* VOPTVAL = VALID OPTIONS TABLE VIEW 01010000
* VDSPTXT = DISPLAY TEXTS TABLE VIEW 01020000
* 01030000
* CHANGE-ACTIVITY = 01040000
* - ADD CHECKS FOR REFERENTIAL INTEGRITY VIOLATIONS V2R1 01045000
* 01050000
* *PSEUDOCODE* 01070000
* 01080000
* PROCEDURE 01090000
* DECLARATIONS. 01100000
* 01110000
* INITIALIZATION. 01120000
* .CHECK IF OPTION IS VALID FOR THIS MODULE 01130000
* MAJOR SYSTEM = 'O' AND OBJFLD = 'EM' 01140003
* IF NOT, RETURN WITH ERROR MSG 069E INVALID REQUEST. 01150000
* 01160000
* STEP-1. 01170000
* .FILL IN TEXT LINES (HEADER,INFORMATION AND PFK) 01180000
* FROM VOPTVAL DEPENDING ON ACTION REQUIRED. 01190000
* .IF NOT ADD, SAVE EMPLOYEE ID, DEPENDING ON MAXSEL. 01200000
* IF MAXSEL=1 EMPL-ID IS ON THE FIRST DETAIL LINE, 01210000
* IF MAXSEL>1 THE INPUT DATA CONTAINS THE DETAIL LINE 01220000
* NUMBER. 01230000
* .GET DEPARTMENT AND EMPLOYEE FIELD NAMES, 01240000
* FROM VDSPTXT. 01250000
* .IF DISPLAY OR DELETE ACTION, 01260000
* PROTECT EVERY DETAIL INPUT FIELD. 01270000
* .IF ADD OR UPDATE ACTION, 01280000
* PROTECT EMPLOYEE-ID AND ALL DEPARTMENT FIELDS, 01290000
* POSITION THE SCREEN CURSOR TO EMPLOYEE NAME FIELD. 01300000
* .IF ADD, UNPROTECT EMPLOYEE-ID FIELD, 01310000
* MOVE USER INPUT TO CORRESPONDING OUTPUT DATA FIELD, 01320000
* PREV='D' AND RETURN. 01330000
* .AND FOR DISPLAY, UPDATE AND ERASE, 01340000
* FETCH EMPLOYEE AND DEPARTMENT CURRENT VALUES, 01350000
* PREV='D' AND RETURN. 01360000
* OR MSG 'EMPLOYEE NOT FOUND' AND RETURN. 01370000
* 01380000
* STEP-2. 01390000
* .IF ADD, DO IT AND MSG 01400000
* EITHER 'EMPLOYEE ADDED SUCCESSFULLY' 01410000
* OR 'EMPLOYEE EXISTS ALREADY, ADD NOT DONE' 01420000
* PREV=' ' AND RETURN. 01430000
* .IF UPDATE, DO IT AND MSG 01440000
* EITHER 'EMPLOYEE UPDATED SUCCESSFULLY' 01450000
* OR 'EMPLOYEE DOES NOT EXIST, UPDATE NOT DONE' 01460000
* RETURN. 01470000
* .IF ERASE, DO IT AND MSG 01480000
* EITHER 'EMPLOYEE ERASED SUCCESSFULLY' 01490000
* OR 'EMPLOYEE DOES NOT EXIST, ERASE NOT DONE' 01500000
* PREV=' ' AND RETURN. 01510000
* .OR MSG 069E INVALID REQUEST. 01520000
* RETURN. 01530000
* END. 01540000
* 01550000
***************************************************************** 01560000
01570000
DSN8MCF. 01580000
01590000
***************************************************************** 01600000
* CHECKS IF OPTION IS VALID 01610000
***************************************************************** 01620000
* **INITIALIZE VARIABLES 01630000
MOVE 'DSN8MCF' TO MAJOR. 01640000
MOVE SPACES TO MINOR. 01650000
* **IS OPTION VALID? 01660000
* **MAJOR SYSTEM-O 01670000
* **OBJFLD-EM 01680003
IF MAJSYS OF INAREA NOT = 'O' OR 01690000
OBJFLD OF INAREA NOT = 'EM' THEN 01700003
MOVE 1 TO I 01710000
GO TO MCFNSUP. 01720000
IF ACTION OF INAREA = 'D' THEN 01730000
GO TO MCF1-STEP. 01740000
IF NEWREQ = 'N' THEN 01750000
GO TO MCF2-STEP. 01760000
IF NEWREQ NOT = 'Y' THEN 01770000
MOVE 2 TO I 01780000
GO TO MCFNSUP. 01790000
01800000
***************************************************************** 01810000
* FETCHES AND PROTECTS FIELDS FOR A CERTAIN COMMAND 01820000
***************************************************************** 01830000
MCF1-STEP. 01840000
MOVE 'STEP-1' TO MINOR. 01850000
* **FETCH FIELDS FOR 01860000
* **A CERTAIN REQUEST 01870000
EXEC SQL SELECT * 01880000
INTO :POPTVAL FROM VOPTVAL 01890000
WHERE MAJSYS='O' 01900000
AND ACTION=:INAREA.ACTION 01910000
AND OBJFLD='EM' 01920003
AND SCRTYPE='D' 01930000
AND SRCHCRIT='EI' 01940000
END-EXEC. 01950000
* **ERROR? 01960000
IF SQLCODE = +100 THEN 01970000
MOVE OPTNF TO MSG OF OUTAREA 01980000
GO TO END-DSN8MCF. 01990000
02000000
* **FILL IN TEXT LINES 02010000
* **(HEADING,MESSAGE,PFKEYS) 02020000
MOVE HEADTXT OF POPTVAL TO HTITLE. 02030000
MOVE INFOTXT OF POPTVAL TO MSG OF OUTAREA. 02040000
MOVE PFKTXT OF POPTVAL TO PFKTEXT OF OUTAREA. 02050000
02060000
* **SAVE EMPLOYEE ID 02070000
* **ON FIRST DETAIL LINE 02080000
IF ACTION OF INAREA = 'A' THEN 02090000
GO TO MCF010. 02100000
IF MAXSEL = 1 THEN 02110000
MOVE MGRNUM(1) TO EMPNO OF PEMP 02120000
GO TO MCF010. 02130000
IF MAXSEL < 1 THEN 02140000
MOVE 3 TO I 02150000
GO TO MCFNSUP. 02160000
IF DAT1 NOT NUMERIC THEN 02170000
MOVE 4 TO I 02180000
GO TO MCFNSUP. 02190000
IF DAT2 NOT NUMERIC THEN 02200000
MOVE DAT1 TO DAT2 02210000
MOVE '0' TO DAT1. 02220000
02230000
* **INPUT DATA CONTAINS 02240000
* **THE DETAIL LINE NO. 02250000
MCF005. 02260000
MOVE DATA2 TO I. 02270000
IF I > MAXSEL THEN 02280000
MOVE 5 TO I 02290000
GO TO MCFNSUP. 02300000
* **SAVE EMPLOYEE ID 02310000
MOVE MGRNUM(I) TO EMPNO OF PEMP. 02320000
02330000
* **CLEAR FIELD WITH BLANKS 02340000
MCF010. 02350000
MOVE 0 TO I. 02360000
MCF012. 02370000
ADD 1 TO I. 02380000
MOVE SPACES TO LINE0(I). 02390000
* **MCF012 LOOP 02400000
MCF-LOOP12. 02410000
PERFORM MCF012 02420000
UNTIL I > 14. 02430000
* **OPEN DH CURSOR 02440000
EXEC SQL OPEN DH END-EXEC. 02450000
MOVE 0 TO I. 02460000
02470000
* **GET DEPARTMENT & 02480000
* **EMPLOYEE FIELD NAMES 02490000
* **FROM DISPLAY LINE 02500000
MCF014. 02510000
ADD 1 TO I. 02520000
EXEC SQL FETCH DH 02530000
INTO :PDSPTXT.DSPLINE, :PDSPTXT.LINENO 02540000
END-EXEC. 02550000
02560000
IF SQLCODE NOT = +100 THEN 02570000
MOVE DSPLINE TO FIELD1(I) 02580000
IF I < 10 THEN 02590000
GO TO MCF014. 02600000
02610000
MCF015. 02620000
* **CLOSE DH CURSOR 02630000
EXEC SQL CLOSE DH END-EXEC. 02640000
02650000
IF I = 1 THEN 02660000
MOVE DSPNF TO MSG OF OUTAREA 02670000
GO TO END-DSN8MCF. 02680000
* **PROTECT THE MODIFIABLE 02690000
* **ATTRIBUTE FIELDS 02700000
02710000
* **REPLACE PROTECTED PRE-MODIFIED 02720000
* **+225 = X'00E1' 02730000
MOVE 0 TO I. 02740000
02750000
MCF016. 02760000
ADD 1 TO I. 02770000
MOVE +225 TO ATTR(I). 02780000
02790000
* **MCF016 LOOP 02800000
MCF-LOOP16. 02810000
PERFORM MCF016 02820000
UNTIL I > 14. 02830000
* **IF DISPLAY OR ERASE ACTION 02840000
* **PROTECT EVERY DETAIL 02850000
* **INPUT FIELD 02860000
IF ACTION OF INAREA = 'D' OR 02870000
ACTION OF INAREA = 'E' THEN 02880000
GO TO MCF030. 02890000
02900000
* **IF UPDATE OR ADD ACTION 02910000
* **PROTECT EMPLOYEE-ID 02920000
* **AND DEPARTMENT FIELDS 02930000
IF ACTION OF INAREA = 'U' THEN 02940000
GO TO MCF022. 02950000
IF ACTION OF INAREA NOT = 'A' THEN 02960000
MOVE 6 TO I 02970000
GO TO MCFNSUP. 02980000
* **IF ADD 02990000
* **UNPROTECT EMPLOYEE ID FIELD 03000000
IF SRCH OF INAREA = 'EI' THEN 03010000
MOVE DATA6 TO FIELD2(6) 03020000
EXEC SQL SELECT EMPNO INTO :PEMP.EMPNO 03030000
FROM VEMP WHERE EMPNO=:DATA6 03040000
END-EXEC 03050000
03060000
* **DOES EMPLOYEE 03070000
* **EXIST ALREADY? 03080000
IF SQLCODE = 0 THEN 03090000
MOVE '005E' TO MSGCODE 03100000
GO TO MCFMSG 03105000
ELSE 03110000
GO TO MCF020. 03120000
03130000
* **EMPLOYEE NAME 03140000
IF SRCH OF INAREA = 'EN' THEN 03150000
MOVE DATA15 TO FIELD2(9) 03160000
GO TO MCF020. 03170000
* **DEPARTMENT ID 03180000
IF SRCH OF INAREA NOT = 'DI' THEN 03190000
MOVE 7 TO I 03200000
GO TO MCFNSUP. 03210000
MOVE DATA3 TO FIELD2(10). 03220000
03230000
* **REPLACE UNPROTECTED 03240000
* **PRE-MODIFIED 03246000
* **+193 = X'00C1' 03253000
MCF020. 03260000
MOVE +193 TO ATTR(6). 03270000
MCF022. 03280000
MOVE 6 TO I. 03290000
MCF024. 03300000
ADD 1 TO I. 03310000
MOVE +193 TO ATTR(I). 03320000
* **MCF024 LOOP 03330000
MCF-LOOP24. 03340000
PERFORM MCF024 03350000
UNTIL I > 9. 03360000
03370000
* **CURSOR POSITION 03380000
* ** -16191 = X'C0C1' 03390000
MOVE -16191 TO ATTR(7). 03400000
IF ACTION OF INAREA = 'A' THEN 03410000
GO TO MCFRET1. 03420000
***************************************************************** 03430000
* ADDS, UPDATES, OR ERASES AND PRINTS A MESSAGE 03440000
***************************************************************** 03450000
MCF030. 03460000
MOVE EMPNO OF PEMP TO FIELD2(6). 03470000
MOVE SPACES TO FIRSTNME-TEXT OF PEMP, 03480000
LASTNAME-TEXT OF PEMP. 03490000
03500000
* **FETCH EMPLOYEE 03510000
EXEC SQL SELECT * 03520000
INTO :PEMP.EMPNO, 03530000
:PEMP.FIRSTNME, 03531000
:PEMP.MIDINIT, 03532000
:PEMP.LASTNAME, 03534000
:PEMP.WORKDEPT:NULLIND1 03536000
FROM VEMP 03538000
WHERE EMPNO=:PEMP.EMPNO 03540000
END-EXEC. 03550000
03560000
* **EMPLOYEE NOT FOUND 03570000
IF SQLCODE = +100 THEN 03580000
MOVE '001I' TO MSGCODE 03590000
GO TO MCFMSG. 03600000
03610000
IF NULLIND1 = -1 THEN 03613000
MOVE ' ' TO WORKDEPT OF PEMP. 03616000
MOVE WORKDEPT OF PEMP TO FIELD2(1), FIELD2(10). 03620000
MOVE FIRSTNME-TEXT OF PEMP TO FIELD2(7). 03630000
MOVE MIDINIT OF PEMP TO FIELD2(8). 03640000
MOVE LASTNAME-TEXT OF PEMP TO FIELD2(9). 03650000
MOVE SPACES TO DEPTNAME-TEXT OF PDEPT. 03660000
03670000
* **FETCH DEPARTMENT 03680000
EXEC SQL SELECT * 03690000
INTO :PDEPT.DEPTNO, 03700000
:PDEPT.DEPTNAME, 03702000
:PDEPT.MGRNO:NULLIND1, 03704000
:PDEPT.ADMRDEPT 03706000
FROM VDEPT 03708000
WHERE DEPTNO=:PEMP.WORKDEPT 03710000
END-EXEC. 03720000
03730000
* **DEPARTMENT NOT FOUND 03740000
IF SQLCODE = +100 THEN 03745000
GO TO MCFRET1. 03750000
03755000
* **DEPARTMENT FOUND 03760000
IF NULLIND1 = -1 THEN 03765000
MOVE ' ' TO MGRNO OF PDEPT. 03770000
MOVE DEPTNAME-TEXT OF PDEPT TO FIELD2(2). 03775000
MOVE MGRNO OF PDEPT TO FIELD2(3). 03780000
MOVE ADMRDEPT OF PDEPT TO FIELD2(4). 03785000
03790000
MCFRET1. 03800000
* **RETURN 03810000
MOVE 'D' TO PREV. 03820000
GO TO END-DSN8MCF. 03830000
03840000
MCF2-STEP. 03850000
MOVE 'STEP-2' TO MINOR. 03860000
MOVE 0 TO I. 03870000
MCF032. 03880000
ADD 1 TO I. 03890000
MOVE +225 TO ATTR(I). 03900000
MOVE TRANDATA(I) TO FIELD2(I). 03910000
* **MCF032 LOOP 03920000
MCF-LOOP32. 03930000
PERFORM MCF032 03940000
UNTIL I > 14. 03950000
03960000
MOVE TRANDATA(6) TO EMPNO OF PEMP. 03970000
IF ACTION OF INAREA = 'E' THEN 03980000
GO TO MCF050. 03990000
MOVE TRANDATA(7) TO FIRSTNME-TEXT OF PEMP, WORK. 04000000
MOVE 12 TO I. 04010000
04020000
* **CALCULATE FIRST NAME 04030000
* **LENGTH 04040000
MCF034. 04050000
IF WRK(I) = ' ' THEN 04060000
SUBTRACT 1 FROM I 04070000
IF I > 1 THEN 04080000
GO TO MCF034. 04090000
04100000
MCF035. 04110000
MOVE I TO FIRSTNME-LEN OF PEMP. 04120000
MOVE TRANDATA(8) TO MIDINIT OF PEMP. 04130000
MOVE TRANDATA(9) TO LASTNAME-TEXT OF PEMP, WORK. 04140000
MOVE 15 TO I. 04150000
04160000
* **CALCULATE LAST NAME 04170000
* **LENGTH 04180000
MCF036. 04190000
IF WRK(I) = ' ' THEN 04200000
SUBTRACT 1 FROM I 04210000
IF I > 1 THEN 04220000
GO TO MCF036. 04230000
04240000
MCF037. 04250000
MOVE I TO LASTNAME-LEN OF PEMP. 04260000
MOVE TRANDATA(10) TO WORKDEPT OF PEMP. 04270000
* **DETERMINE IF NULL WORKDEPT 04271000
IF WORKDEPT OF PEMP = ' ' THEN 04272000
MOVE -1 TO NULLIND1 04274000
ELSE 04276000
MOVE 0 TO NULLIND1. 04278000
IF ACTION OF INAREA NOT = 'A' THEN GO TO MCF040. 04280000
04290000
***************************************************************** 04300000
* ** INSERT 04310000
***************************************************************** 04320000
04330000
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC. 04340000
04350000
* **PERFORM INSERT 04360000
EXEC SQL INSERT INTO VEMP 04370000
(EMPNO,FIRSTNME,MIDINIT,LASTNAME,WORKDEPT) 04380000
VALUES(:PEMP.EMPNO,:PEMP.FIRSTNME,:PEMP.MIDINIT, 04390000
:PEMP.LASTNAME,:PEMP.WORKDEPT:NULLIND1) 04400000
END-EXEC. 04410000
04420000
* **EMPLOYEE SUCCESSFULLY ADDED 04425000
IF SQLCODE = 0 THEN 04430000
MOVE ' ' TO PREV 04470000
MOVE '002I' TO MSGCODE 04480000
GO TO MCF041. 04490000
04500000
* **EMPLOYEE EXISTS ALREADY, 04510000
* **ADD NOT DONE 04515000
04520000
MCF038. 04560000
IF SQLCODE = -803 THEN 04570000
MOVE '005E' TO MSGCODE 04572000
GO TO MCFMSG. 04574000
04576000
IF SQLCODE NOT = -530 THEN GO TO DB-ERROR. 04578000
04580000
* **INVALID DEPARTMENT NUMBER- 04582000
* **NOT ADDED 04584000
MOVE '200E' TO MSGCODE 04587000
GO TO MCFMSG. 04590000
04595000
MCF040. 04600000
***************************************************************** 04610000
* ** UPDATE 04620000
***************************************************************** 04630000
IF ACTION OF INAREA NOT = 'U' THEN 04640000
MOVE 8 TO I 04650000
GO TO MCFNSUP. 04660000
* **PERFORM UPDATE 04670000
EXEC SQL UPDATE VEMP 04680000
SET FIRSTNME=:PEMP.FIRSTNME,MIDINIT=:PEMP.MIDINIT, 04690000
LASTNAME=:PEMP.LASTNAME, 04700000
WORKDEPT=:PEMP.WORKDEPT:NULLIND1 04705000
WHERE EMPNO=:PEMP.EMPNO 04710000
END-EXEC. 04720000
04730000
* **EMPLOYEE DOES NOT EXIST, 04733000
* **UPDATE NOT DONE 04736000
IF SQLCODE = +100 THEN 04740000
MOVE '007E' TO MSGCODE 04790000
GO TO MCFMSG. 04800000
04810000
* **INVALID DEPTNO 04820000
* **EMPLOYEE NOT UPDATED 04822000
IF SQLCODE = -530 THEN 04824000
MOVE '203E' TO MSGCODE 04826000
GO TO MCFMSG. 04828000
04830000
* **EMPLOYEE SUCCESSFULLY UPDATED 04833000
04836000
MOVE '004I' TO MSGCODE. 04840000
MCF041. 04850000
MOVE WORKDEPT OF PEMP TO FIELD2(1). 04860000
MOVE SPACES TO DEPTNAME-TEXT OF PDEPT. 04870000
EXEC SQL SELECT * 04880000
INTO :PDEPT.DEPTNO, 04890000
:PDEPT.DEPTNAME, 04892000
:PDEPT.MGRNO:NULLIND1, 04894000
:PDEPT.ADMRDEPT 04896000
FROM VDEPT 04898000
WHERE DEPTNO=:PEMP.WORKDEPT 04900000
END-EXEC. 04910000
04920000
* **DEPARTMENT NOT FOUND 04930000
IF SQLCODE NOT = 0 THEN 04933000
GO TO MCF043. 04936000
04940000
* **DEPARTMENT FOUND 04944000
IF NULLIND1 = -1 THEN 04948000
MOVE ' ' TO MGRNO OF PDEPT. 04952000
MOVE DEPTNAME-TEXT OF PDEPT TO FIELD2(2). 04956000
MOVE MGRNO OF PDEPT TO FIELD2(3). 04960000
MOVE ADMRDEPT OF PDEPT TO FIELD2(4). 04964000
GO TO MCFMSG. 04968000
04972000
MCF043. 04976000
MOVE 1 TO I. 04980000
* **PUT SPACES AT END OF FIELD 04990000
MCF042. 05000000
ADD 1 TO I. 05010000
MOVE SPACES TO FIELD2(I). 05020000
* **MCF042 LOOP 05030000
MCF-LOOP42. 05040000
PERFORM MCF042 05050000
UNTIL I > 3. 05060000
GO TO MCFMSG. 05070000
MCF050. 05080000
***************************************************************** 05090000
* ** ERASE 05100000
***************************************************************** 05110000
* **PERFORM ERASE 05120000
EXEC SQL DELETE FROM VEMP 05130000
WHERE EMPNO=:PEMP.EMPNO 05140000
END-EXEC. 05150000
05160000
* **EMPLOYEE SUCCESSFULLY ERASED 05170000
IF SQLCODE = 0 THEN 05180000
MOVE ' ' TO PREV 05190000
MOVE '003I' TO MSGCODE 05200000
GO TO MCFMSG. 05205000
05210000
* **EMPLOYEE DOES NOT EXIST, 05220000
* **ERASE NOT DONE 05230000
IF SQLCODE = +100 THEN 05240000
MOVE '006E' TO MSGCODE 05250000
GO TO MCFMSG. 05255000
05260000
* **EMPLOYEE HAS DEPENDENT ROWS, 05270000
* **ERASE NOT DONE 05272000
IF SQLCODE = -532 THEN 05274000
MOVE '202E' TO MSGCODE 05277000
GO TO MCFMSG. 05280000
05290000
* **ERROR - INVALID REQUEST 05300000
05310000
MCFNSUP. 05320000
MOVE '069E' TO MSGCODE. 05330000
***************************************************************** 05340000
* ** PRINT MESSAGE 05350000
***************************************************************** 05360000
MCFMSG. 05370000
CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG. 05380000
MOVE OUTMSG TO MSGTXT OF MSG. 05390000
05400000
END-DSN8MCF. 05410000
05411000