DSN8MCE
THIS MODULE HANDLES THE DETAIL OPERATIONS FOR A DEPARTMENT SUCH AS DISPLAY, ADD(INSERT), UPDATE, AND ERASE(DELETE) IN THE MAJOR SYSTEM ORGANIZATION.
******* DSN8MCE - DETAIL DEPARTMENT MODULE - COBOL ************ 00010000
* 00020000
* MODULE NAME = DSN8MCE 00030000
* 00040000
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION 00050000
* DETAIL DEPARTMENT 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 A DEPARTMENT SUCH AS DISPLAY, ADD(INSERT), 00160000
* UPDATE, AND ERASE(DELETE) IN THE MAJOR SYSTEM 00170000
* ORGANIZATION. 00180000
* 00190000
* NOTES = 00200000
* DEPENDENCIES = NONE 00210000
* RESTRICTIONS = THE VALID OPTIONS ARE: 00220000
* .O-D-DE-DI,DN,MI,MN 00230000
* .O-A-DE-DI,DN,MI 00240000
* .O-U-DE-DI,DN,MI,MN 00250000
* .O-E-DE-DI,DN,MI,MN 00260000
* 00270000
* MODULE TYPE = 00280000
* PROCESSOR = DB2 PRECOMPILER, COBOL COMPILER 00290000
* MODULE SIZE = SEE LINK-EDIT 00300000
* ATTRIBUTES = REUSABLE 00310000
* 00320000
* ENTRY POINT = DSN8MCE 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 = ' ' OR 'D' PREVIOUS REQUEST 00430000
* 00440000
* SYMBOLIC LABEL/NAME = COMPARM .NEWREQ 00450000
* DESCRIPTION = 'Y' OR 'N' NEW REQUEST 00460000
* 00470000
* SYMBOLIC LABEL/NAME = INAREA 00480000
* DESCRIPTION = USER INPUT 00490000
* 00500000
* SYMBOLIC LABEL/NAME = .MAXSEL 00510000
* DESCRIPTION = 1-13 NUMBER OF SELECTIONS 00520000
* 00530000
* SYMBOLIC LABEL/NAME = OUTAREA .OUTPUT0 00540000
* DESCRIPTION = SECONDARY SELECTION OUTPUT 00550000
* 00560000
* OUTPUT = PARAMETERS EXPLICITLY RETURNED: 00570000
* COMMON AREA. 00580000
* 00590000
* SYMBOLIC LABEL/NAME = PCONVSTA.PREV 00600000
* DESCRIPTION = 'D' OR ' ' DEPENDING ON STEP NO. 00610000
* 00620000
* SYMBOLIC LABEL/NAME = OUTAREA.OUTPUT0 00630000
* DESCRIPTION = SCREEN DETAIL OUTPUT 00640000
* 00650000
* 00660000
* EXIT-NORMAL = 00670000
* 00680000
* EXIT-ERROR = 00690000
* 00700000
* RETURN CODE = NONE 00710000
* 00720000
* ABEND CODES = NONE 00730000
* 00740000
* ERROR-MESSAGES = 00750000
* DSN8011I DEPARTMENT NOT FOUND 00760000
* DSN8012I DEPARTMENT SUCCESSFULLY ADDED 00770000
* DSN8013I DEPARTMENT SUCCESSFULLY ERASED 00780000
* DSN8014I DEPARTMENT SUCCESSFULLY UPDATED 00790000
* DSN8015E DEPARTMENT EXISTS ALREADY, ADD NOT DONE 00800000
* DSN8016E DEPARTMENT DOES NOT EXIST, ERASE NOT DONE 00810000
* DSN8017E DEPARTMENT DOES NOT EXIST, UPDATE NOT DONE 00820000
* DSN8069E NO VALID SELECTIONS QUALIFY FOR THIS REQUEST 00830000
* DSN8210E INVALID MGRNO, DEPARTMENT NOT ADDED 00840000
* DSN8212E DEPARTMENT NUMBER HAS DEPENDENT ROWS, NOT ERASED 00850000
* DSN8213E INVALID ADMIN DEPT ID, DEPARTMENT NOT ADDED 00860000
* DSN8214E INVALID MANAGER ID, DEPARTMENT NOT UPDATED 00870000
* DSN8215E INVALID ADMIN DEPT ID, DEPARTMENT NOT UPDATED 00880000
* 00890000
* EXTERNAL REFERENCES = 00900000
* ROUTINES/SERVICES = 00910000
* DSN8MCG - ERROR MESSAGE ROUTINE 00920000
* 00930000
* DATA-AREAS = 00940000
* DSN8MCCA - SAMPLE COMMON AREA 00950000
* 00960000
* CONTROL-BLOCKS = 00970000
* SQLCA - SQL COMMUNICATION AREA 00980000
* 00990000
* TABLES = 01000000
* VDEPT = DEPARTMENT TABLE VIEW 01010000
* VEMP = EMPLOYEE TABLE VIEW 01020000
* VOPTVAL = VALID OPTIONS TABLE VIEW 01030000
* VDSPTXT = DISPLAY TEXTS TABLE VIEW 01040000
* 01050000
* CHANGE-ACTIVITY = 01060000
* - ADD CHECKS FOR REFERENTIAL INTEGRITY VIOLATIONS V2R1 01070000
* 01080000
* *PSEUDOCODE* 01090000
* 01100000
* PROCEDURE 01110000
* DECLARATIONS. 01120000
* 01130000
* INITIALIZATION. 01140000
* .CHECK IF OPTION IS VALID FOR THIS MODULE 01150000
* MAJOR SYSTEM = 'O' AND OBJFLD = 'DE' 01160003
* IF NOT, RETURN WITH ERROR MSG 069E INVALID REQUEST. 01170000
* 01180000
* STEP-1. 01190000
* .FILL IN TEXT LINES (HEADER,INFORMATION AND PFK) 01200000
* FROM VOPTVAL DEPENDING ON ACTION REQUIRED. 01210000
* .IF NOT ADD, SAVE DEPARTMENT ID, DEPENDING ON MAXSEL. 01220000
* IF MAXSEL=1 DEPT-ID IS ON THE FIRST DETAIL LINE, 01230000
* IF MAXSEL>1 THE INPUT DATA CONTAINS THE DETAIL LINE 01240000
* NUMBER 01250000
* .GET DEPARTMENT AND MANAGER FIELD NAMES, 01260000
* FROM PDSPTXT. 01270000
* .IF DISPLAY OR DELETE ACTION, 01280000
* PROTECT EVERY DETAIL INPUT FIELD. 01290000
* .IF ADD OR UPDATE ACTION, 01300000
* PROTECT DEPARTMENT-ID AND ALL MANAGER FIELDS, 01310000
* POSITION THE SCREEN CURSOR TO DEPARTMENT NAME FIELD. 01320000
* .IF ADD, UNPROTECT DEPARTMENT-ID FIELD, 01330000
* MOVE USER INPUT TO CORRESPONDING OUTPUT DATA FIELD, 01340000
* PREV='D' AND RETURN. 01350000
* .AND FOR DISPLAY, UPDATE AND ERASE, 01360000
* FETCH DEPARTMENT AND MANAGER CURRENT VALUES, 01370000
* PREV='D' AND RETURN. 01380000
* OR MSG 'DEPARTMENT NOT FOUND' AND RETURN. 01390000
* 01400000
* STEP-2. 01410000
* .IF ADD, DO IT AND MSG 01420000
* EITHER 'DEPARTMENT ADDED SUCCESSFULLY' 01430000
* OR 'DEPARTMENT EXISTS ALREADY, ADD NOT DONE' 01440000
* PREV=' ' AND RETURN. 01450000
* .IF UPDATE, DO IT AND MSG 01460000
* EITHER 'DEPARTMENT UPDATED SUCCESSFULLY' 01470000
* OR 'DEPARTMENT DOES NOT EXIST, UPDATE NOT DONE' 01480000
* RETURN. 01490000
* .IF ERASE, DO IT AND MSG 01500000
* EITHER 'DEPARTMENT ERASED SUCCESSFULLY' 01510000
* OR 'DEPARTMENT DOES NOT EXIST, ERASE NOT DONE' 01520000
* PREV=' ' AND RETURN. 01530000
* .OR MSG 069E INVALID REQUEST 01540000
* RETURN. 01550000
* END. 01560000
* 01570000
*---------------------------------------------------------------* 01580000
01590000
DSN8MCE. 01600000
* 01610000
****************************************************** 01620000
* CHECKS IF OPTION IS VALID 01630000
****************************************************** 01640000
01650000
* **INITIALIZE VARIABLES 01660000
MOVE 'DSN8MCE' TO MAJOR. 01670000
MOVE SPACES TO MINOR. 01680000
* **IS OPTION VALID? 01690000
* **MAJOR SYSTEM-O 01700000
* **OBJFLD-DE 01710003
IF MAJSYS OF INAREA NOT = 'O' OR 01720000
OBJFLD OF INAREA NOT = 'DE' THEN 01730003
MOVE 1 TO I 01740000
GO TO MCENSUP. 01750000
IF ACTION OF INAREA = 'D' THEN 01760000
GO TO MCE1-STEP. 01770000
IF NEWREQ = 'N' THEN 01780000
GO TO MCE2-STEP. 01790000
IF NEWREQ NOT = 'Y' THEN 01800000
MOVE 2 TO I 01810000
GO TO MCENSUP. 01820000
****************************************************** 01830000
* FETCHES AND PROTECTS FIELDS FOR A CERTAIN REQUEST 01840000
****************************************************** 01850000
01860000
MCE1-STEP. 01870000
* **FETCH FIELDS FOR 01880000
* **A CERTAIN REQUEST 01890000
MOVE 'STEP-1' TO MINOR. 01900000
01910000
EXEC SQL SELECT * 01920000
INTO :POPTVAL FROM VOPTVAL 01930000
WHERE MAJSYS='O' 01940000
AND ACTION=:INAREA.ACTION 01950000
AND OBJFLD='DE' 01960003
AND SCRTYPE='D' 01970000
END-EXEC. 01980000
01990000
* **ERROR? 02000000
IF SQLCODE = +100 THEN 02010000
MOVE OPTNF TO MSG OF OUTAREA 02020000
GO TO END-DSN8MCE. 02030000
02040000
* **FILL IN TEXT LINES 02050000
* **(HEADER, MESSAGE, PFKEYS) 02060000
MOVE HEADTXT OF POPTVAL TO HTITLE. 02070000
MOVE INFOTXT OF POPTVAL TO MSG OF OUTAREA. 02080000
MOVE PFKTXT OF POPTVAL TO PFKTEXT OF OUTAREA. 02090000
02100000
* **SAVE DEPARTMENT ID 02110000
* **ON FIRST DETAIL LINE 02120000
IF ACTION OF INAREA = 'A' THEN 02130000
GO TO MCE010. 02140000
IF MAXSEL = 1 THEN 02150000
MOVE DEPTNUM(1) TO DEPTNO OF PDEPT 02160000
GO TO MCE010. 02170000
IF MAXSEL < 1 THEN 02180000
MOVE 3 TO I 02190000
GO TO MCENSUP. 02200000
IF DAT1 NOT NUMERIC THEN 02210000
MOVE 4 TO I 02220000
GO TO MCENSUP. 02230000
IF DAT2 NOT NUMERIC THEN 02240000
MOVE DAT1 TO DAT2 02250000
MOVE '0' TO DAT1. 02260000
* **INPUT DATA CONTAINS 02270000
* **THE DETAIL LINE NO. 02280000
MCE005. 02290000
MOVE DATA2 TO I. 02300000
IF I > MAXSEL THEN 02310000
MOVE 5 TO I 02320000
GO TO MCENSUP. 02330000
* **SAVE DEPARTMENT ID 02340000
MOVE DEPTNUM(I) TO DEPTNO OF PDEPT. 02350000
02360000
MCE010. 02370000
MOVE 0 TO I. 02380000
* **CLEAR FIELD WITH BLANKS 02390000
MCE012. 02400000
ADD 1 TO I. 02410000
MOVE SPACES TO LINE0(I). 02420000
* **MCE012 LOOP 02430000
MCE-LOOP12. 02440000
PERFORM MCE012 02450000
UNTIL I > 14. 02460000
* **OPEN DH CURSOR 02470000
EXEC SQL OPEN DH END-EXEC. 02480000
MOVE 0 TO I. 02490000
* **GET DEPARTMENT & 02500000
* **MANAGER FIELD NAMES 02510000
* **FROM DISPLAY LINE 02520000
MCE014. 02530000
ADD 1 TO I. 02540000
EXEC SQL FETCH DH 02550000
INTO :PDSPTXT.DSPLINE, :PDSPTXT.LINENO END-EXEC. 02560000
02570000
IF SQLCODE NOT = +100 THEN 02580000
MOVE DSPLINE TO FIELD1(I) 02590000
IF I < 10 THEN 02600000
GO TO MCE014. 02610000
02620000
MCE015. 02630000
* **CLOSE DH CURSOR 02640000
EXEC SQL CLOSE DH END-EXEC. 02650000
IF I = 1 THEN 02660000
MOVE DSPNF TO MSG OF OUTAREA 02670000
GO TO END-DSN8MCE. 02680000
02690000
* **PROTECT THE MODIFIABLE 02700000
* **ATTRIBUTE FIELDS 02710000
02720000
* **REPLACE PROTECTED 02730000
* **PRE-MODIFIED ; 02740000
* **+225 = X'00E1' 02750000
MOVE 0 TO I. 02760000
MCE016. 02770000
ADD 1 TO I. 02780000
MOVE +225 TO ATTR(I). 02790000
02800000
* **MCE016 LOOP 02810000
MCE-LOOP16. 02820000
PERFORM MCE016 02830000
UNTIL I > 14. 02840000
02850000
* **IF DISPLAY OR ERASE ACTION 02860000
* **PROTECT EVERY DETAIL 02870000
* **INPUT FIELD 02880000
02890000
IF ACTION OF INAREA = 'D' OR ACTION OF INAREA = 'E' THEN 02900000
GO TO MCE030. 02910000
02920000
* **IF UPDATE OR ADD ACTION 02930000
* **PROTECT DEPARTMENT-ID 02940000
* **AND MANAGER FIELDS 02950000
02960000
IF ACTION OF INAREA = 'U' THEN 02970000
GO TO MCE022. 02980000
IF ACTION OF INAREA NOT = 'A' THEN 02990000
MOVE 6 TO I 03000000
GO TO MCENSUP. 03010000
* **IF ADD 03020000
* **UNPROTECT DEPT-ID FIELD 03030000
03040000
IF SRCH OF INAREA = 'DI' THEN 03050000
MOVE DATA3 TO FIELD2(1) 03060000
EXEC SQL SELECT DEPTNO INTO :PDEPT.DEPTNO 03070000
FROM VDEPT WHERE DEPTNO=:DATA3 03080000
END-EXEC 03090000
03100000
* **DOES DEPARTMENT 03110000
* **EXIST ALREADY? 03120000
IF SQLCODE = 0 THEN 03130000
MOVE '015E' TO MSGCODE 03140000
GO TO MCEMSG 03150000
ELSE 03160000
GO TO MCE020. 03170000
* **DEPARTMENT NAME 03180000
IF SRCH OF INAREA = 'DN' THEN 03190000
MOVE DATA36 TO FIELD2(2) 03200000
GO TO MCE020. 03210000
03220000
* **MANAGER ID 03230000
IF SRCH OF INAREA NOT = 'MI' THEN 03240000
MOVE 7 TO I 03250000
GO TO MCENSUP. 03260000
MOVE DATA6 TO FIELD2(3). 03270000
03280000
* **REPLACE UNPROTECTED 03290000
* **PRE-MODIFIED 03300000
* **+193 = X'00C1' 03310000
MCE020. 03320000
MOVE +193 TO ATTR(1). 03330000
MCE022. 03340000
MOVE 1 TO I. 03350000
MCE024. 03360000
ADD 1 TO I. 03370000
MOVE +193 TO ATTR(I). 03380000
* **MCE024 LOOP 03390000
MCE-LOOP24. 03400000
PERFORM MCE024 03410000
UNTIL I > 3. 03420000
03430000
* **CURSOR POSITION 03440000
* ** -16191 = X'C0C1' 03450000
MOVE -16191 TO ATTR(2). 03460000
03470000
IF ACTION OF INAREA = 'A' THEN 03480000
GO TO MCERET1. 03490000
MCE030. 03500000
****************************************************** 03510000
* ADDS, UPDATES, OR ERASES AND PRINTS MESSAGE 03520000
****************************************************** 03530000
MOVE DEPTNO OF PDEPT TO FIELD2(1). 03540000
MOVE SPACES TO DEPTNAME-TEXT OF PDEPT. 03550000
03560000
* **FETCH DEPARTMENT 03570000
03580000
EXEC SQL SELECT * 03590000
INTO :PDEPT.DEPTNO, 03600000
:PDEPT.DEPTNAME, 03610000
:PDEPT.MGRNO:NULLIND1, 03620000
:PDEPT.ADMRDEPT 03630000
FROM VDEPT 03640000
WHERE DEPTNO=:PDEPT.DEPTNO 03650000
END-EXEC. 03660000
03670000
* **DEPARTMENT NOT FOUND 03680000
IF SQLCODE = +100 THEN 03690000
MOVE '011I' TO MSGCODE 03700000
GO TO MCEMSG. 03710000
03720000
MOVE DEPTNAME-TEXT OF PDEPT TO FIELD2(2). 03730000
MOVE MGRNO OF PDEPT TO FIELD2(3), FIELD2(6). 03740000
MOVE ADMRDEPT OF PDEPT TO FIELD2(4). 03750000
MOVE SPACES TO FIRSTNME-TEXT OF PEMP, 03760000
LASTNAME-TEXT OF PEMP. 03770000
03780000
IF NULLIND1 = -1 THEN 03790000
MOVE ' ' TO MGRNO OF PDEPT 03800000
GO TO MCERET1. 03810000
03820000
* **FETCH MANAGER 03830000
EXEC SQL SELECT * 03840000
INTO :PEMP.EMPNO, 03850000
:PEMP.FIRSTNME, 03860000
:PEMP.MIDINIT, 03870000
:PEMP.LASTNAME, 03880000
:PEMP.WORKDEPT:NULLIND1 03890000
FROM VEMP 03900000
WHERE EMPNO=:PDEPT.MGRNO 03910000
END-EXEC. 03920000
03930000
* **MANAGER NOT FOUND 03940000
IF SQLCODE = +100 THEN 03950000
GO TO MCERET1. 03960000
* **MANAGER FOUND 03970000
IF NULLIND1 = -1 THEN 03980000
MOVE ' ' TO WORKDEPT OF PEMP. 03990000
MOVE FIRSTNME-TEXT OF PEMP TO FIELD2(7). 04000000
MOVE MIDINIT OF PEMP TO FIELD2(8). 04010000
MOVE LASTNAME-TEXT OF PEMP TO FIELD2(9). 04020000
MOVE WORKDEPT OF PEMP TO FIELD2(10). 04030000
04040000
MCERET1. 04050000
* **RETURN 04060000
MOVE 'D' TO PREV. 04070000
GO TO END-DSN8MCE. 04080000
04090000
MCE2-STEP. 04100000
MOVE 'STEP-2' TO MINOR. 04110000
MOVE 0 TO I. 04120000
04130000
MCE032. 04140000
ADD 1 TO I. 04150000
MOVE +225 TO ATTR(I). 04160000
MOVE TRANDATA(I) TO FIELD2(I). 04170000
* **MCE032 LOOP 04180000
MCE-LOOP32. 04190000
PERFORM MCE032 04200000
UNTIL I > 14. 04210000
04220000
MOVE TRANDATA(1) TO DEPTNO OF PDEPT. 04230000
IF ACTION OF INAREA = 'E' THEN 04240000
GO TO MCE050. 04250000
MOVE TRANDATA(2) TO DEPTNAME-TEXT OF PDEPT, WORK. 04260000
MOVE 36 TO I. 04270000
04280000
* **CALCULATE DEPARTMENT LENGTH 04290000
04300000
MCE034. 04310000
IF WRK(I) = ' ' THEN 04320000
SUBTRACT 1 FROM I 04330000
IF I > 1 THEN 04340000
GO TO MCE034. 04350000
04360000
MCE035. 04370000
MOVE I TO DEPTNAME-LEN OF PDEPT. 04380000
MOVE TRANDATA(3) TO MGRNO OF PDEPT. 04390000
* **DETERMINE IF NULL MGRNO 04400000
IF MGRNO OF PDEPT = ' ' THEN 04410000
MOVE -1 TO NULLIND1 04420000
ELSE 04430000
MOVE 0 TO NULLIND1. 04440000
MOVE TRANDATA(4) TO ADMRDEPT OF PDEPT. 04450000
****************************************************** 04460000
* **INSERT 04470000
****************************************************** 04480000
IF ACTION OF INAREA NOT = 'A' THEN 04490000
GO TO MCE040. 04500000
04510000
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC. 04520000
04530000
* **PERFORM INSERT 04540000
EXEC SQL INSERT INTO VDEPT 04550000
(DEPTNO,DEPTNAME,MGRNO,ADMRDEPT) 04560000
VALUES(:PDEPT.DEPTNO,:PDEPT.DEPTNAME, 04570000
:PDEPT.MGRNO:NULLIND1,:PDEPT.ADMRDEPT) 04580000
END-EXEC. 04590000
04600000
04610000
* **DEPARTMENT SUCCESSFULLY ADDED 04620000
IF SQLCODE = 0 THEN 04630000
MOVE ' ' TO PREV 04640000
MOVE '012I' TO MSGCODE 04650000
GO TO MCE041. 04660000
04670000
* **DEPARTMENT EXISTS ALREADY, 04680000
* **ADD NOT DONE 04690000
MCE038. 04700000
IF SQLCODE = -803 THEN 04710000
MOVE '015E' TO MSGCODE 04720000
GO TO MCEMSG. 04730000
04740000
IF SQLCODE NOT = -530 THEN 04750000
GO TO DB-ERROR. 04760000
04770000
MOVE SQLERRM TO CONSTRAINTS. 04780000
* **INVALID MGRNO, DEPARTMENT 04790000
* **NOT ADDED 04800000
IF REF-CONSTRAINT = MGRNO-CONSTRAINT THEN 04810000
MOVE '210E' TO MSGCODE 04820000
* **INVALID ADMRDEPT, DEPARTMENT 04830000
* **NOT ADDED 04840000
ELSE 04850000
MOVE '213E' TO MSGCODE. 04860000
GO TO MCEMSG. 04870000
04880000
MCE040. 04890000
****************************************************** 04900000
* ** UPDATE 04910000
****************************************************** 04920000
IF ACTION OF INAREA NOT = 'U' THEN 04930000
MOVE 8 TO I 04940000
GO TO MCENSUP. 04950000
04960000
* **PERFORM UPDATE 04970000
EXEC SQL UPDATE VDEPT 04980000
SET DEPTNAME=:PDEPT.DEPTNAME, 04990000
MGRNO=:PDEPT.MGRNO:NULLIND1, 05000000
ADMRDEPT=:PDEPT.ADMRDEPT 05010000
WHERE DEPTNO=:PDEPT.DEPTNO 05020000
END-EXEC. 05030000
05040000
* **DEPARTMENT SUCCESSFULLY 05050000
* **UPDATED 05060000
IF SQLCODE = 0 THEN 05070000
MOVE '014I' TO MSGCODE 05080000
GO TO MCE041. 05090000
05100000
* **DEPARTMENT DOES NOT EXIST, 05110000
* **UPDATE NOT DONE 05120000
IF SQLCODE = +100 THEN 05130000
MOVE '017E' TO MSGCODE 05140000
GO TO MCEMSG. 05150000
05160000
IF SQLCODE NOT = -530 THEN 05170000
GO TO DB-ERROR. 05180000
05190000
MOVE SQLERRM TO CONSTRAINTS. 05200000
05210000
* **INVALID MGRNO, 05220000
* **NOT UPDATED 05230000
IF REF-CONSTRAINT = MGRNO-CONSTRAINT THEN 05240000
MOVE '214E' TO MSGCODE 05250000
ELSE 05260000
MOVE '215E' TO MSGCODE. 05270000
GO TO MCEMSG. 05280000
05290000
MCE041. 05300000
MOVE MGRNO OF PDEPT TO FIELD2(6). 05310000
MOVE SPACES TO FIRSTNME-TEXT OF PEMP, 05320000
LASTNAME-TEXT OF PEMP. 05330000
05340000
EXEC SQL SELECT * 05350000
INTO :PEMP.EMPNO, 05360000
:PEMP.FIRSTNME, 05370000
:PEMP.MIDINIT, 05380000
:PEMP.LASTNAME, 05390000
:PEMP.WORKDEPT:NULLIND1 05400000
FROM VEMP 05410000
WHERE EMPNO=:PDEPT.MGRNO:NULLIND1 05420000
END-EXEC. 05430000
05440000
* **DEPARTMENT NOT FOUND 05450000
IF SQLCODE NOT = 0 THEN 05460000
GO TO MCE043. 05470000
05480000
* **DEPARTMENT FOUND 05490000
IF NULLIND1 = -1 THEN 05500000
MOVE ' ' TO WORKDEPT OF PEMP. 05510000
MOVE FIRSTNME-TEXT OF PEMP TO FIELD2(7). 05520000
MOVE MIDINIT OF PEMP TO FIELD2(8). 05530000
MOVE LASTNAME-TEXT OF PEMP TO FIELD2(9). 05540000
MOVE WORKDEPT OF PEMP TO FIELD2(10) 05550000
GO TO MCEMSG. 05560000
05570000
MCE043. 05580000
MOVE 6 TO I. 05590000
* **PUT SPACES AT END OF FIELD 05600000
MCE042. 05610000
ADD 1 TO I. 05620000
MOVE SPACES TO FIELD2(I). 05630000
05640000
* **MCE042 LOOP 05650000
MCE-LOOP42. 05660000
PERFORM MCE042 05670000
UNTIL I > 9. 05680000
GO TO MCEMSG. 05690000
05700000
MCE050. 05710000
****************************************************** 05720000
* **ERASE 05730000
****************************************************** 05740000
* **PERFORM ERASE 05750000
EXEC SQL DELETE FROM VDEPT 05760000
WHERE DEPTNO=:PDEPT.DEPTNO 05770000
END-EXEC. 05780000
* **DEPARTMENT SUCCESSFULLY ERASED 05790000
IF SQLCODE = 0 THEN 05800000
MOVE ' ' TO PREV 05810000
MOVE '013I' TO MSGCODE 05820000
GO TO MCEMSG. 05830000
* **DEPARTMENT DOES NOT EXIST, 05840000
* **ERASE NOT DONE 05850000
IF SQLCODE = +100 THEN 05860000
MOVE '016E' TO MSGCODE 05870000
GO TO MCEMSG. 05880000
05890000
* **DEPARTMENT HAS DEPENDENT ROWS, 05900000
* **ERASE NOT DONE 05910000
IF SQLCODE = -532 THEN 05920000
MOVE '212E' TO MSGCODE 05930000
GO TO MCEMSG. 05940000
05950000
* **ERROR - INVALID REQUEST 05960000
05970000
MCENSUP. 05980000
MOVE '069E' TO MSGCODE. 05990000
****************************************************** 06000000
* **PRINT MESSAGE 06010000
****************************************************** 06020000
MCEMSG. 06030000
CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG. 06040000
MOVE OUTMSG TO MSGTXT OF MSG. 06050000
06060000
END-DSN8MCE. 06070000
06080000
06090000