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