DSN8MPF
THIS MODULE HANDLES THE DETAIL OPERATIONS FOR AN EMPLOYEE, SUCH AS DISPLAY, ADD(INSERT), UPDATE, AND ERASE(DELETE) IN THE MAJOR SYSTEM ORGANIZATION.
DSN8MPF: PROC; 00010000
/********************************************************************* 00020000
* * 00030000
* MODULE NAME = DSN8MPF * 00040000
* * 00050000
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION PROGRAM * 00060000
* DETAIL EMPLOYEE MODULE * 00070000
* PL/I * 00080000
* ORGANIZATION * 00090000
* * 00100000
* COPYRIGHT = 5740-XYR (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 AN EMPLOYEE, 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-EM-EI,EN,DI,DN * 00240000
* .O-A-EM-EI,EN,DI * 00250000
* .O-U-EM-EI,EN,DI,DN * 00260000
* .O-E-EM-EI,EN,DI,DN * 00270000
* * 00280000
* MODULE TYPE = * 00290000
* PROCESSOR = DB2 PRECOMPILER, PL/I OPTIMIZER * 00300000
* MODULE SIZE = SEE LINK-EDIT * 00310000
* ATTRIBUTES = REUSABLE * 00320000
* * 00330000
* ENTRY POINT = DSN8MPF * 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 = OUTAREA .OUTPUT * 00460000
* DESCRIPTION = SECONDARY SELECTION OUTPUT * 00470000
* * 00480000
* SYMBOLIC LABEL/NAME = .MAXSEL * 00490000
* DESCRIPTION = 1-13 NUMBER OF SELECTIONS * 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 = OUTAREA .OUTPUT * 00620000
* DESCRIPTION = SCREEN DETAIL OUTPUT * 00630000
* * 00640000
* SYMBOLIC LABEL/NAME = PCONVSTA.PREV * 00650000
* DESCRIPTION = 'D' OR ' ' DEPENDING ON STEP NO. 00660000
* * 00670000
* EXIT-NORMAL = * 00680000
* * 00690000
* EXIT-ERROR = * 00700000
* * 00710000
* RETURN CODE = NONE * 00720000
* * 00730000
* ABEND CODES = NONE * 00740000
* * 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
* EXTERNAL REFERENCES = * 00870000
* ROUTINES/SERVICES = * 00880000
* DSN8MPG - ERROR MESSAGE ROUTINE * 00890000
* * 00900000
* DATA-AREAS = * 00910000
* DSN8MPCA - SAMPLE COMMON AREA * 00920000
* * 00930000
* CONTROL-BLOCKS = * 00940000
* SQLCA - SQL COMMUNICATION AREA * 00950000
* * 00960000
* TABLES = * 00970000
* VDEPT = DEPARTMENT TABLE VIEW * 00980000
* VEMP = EMPLOYEE TABLE VIEW * 00990000
* VOPTVAL = VALID OPTIONS TABLE VIEW * 01000000
* VDSPTXT = DISPLAY TEXTS TABLE VIEW * 01010000
* * 01020000
* CHANGE-ACTIVITY = * 01030000
* - ADD CHECKS FOR REFERENTIAL INTEGRITY VIOLATIONS V2R1 * 01035000
* * 01040000
* *PSEUDOCODE* * 01060000
* * 01070000
* PROCEDURE * 01080000
* DECLARATIONS. * 01090000
* * 01100000
* INITIALIZATION. * 01110000
* .CHECK IF OPTION IS VALID FOR THIS MODULE * 01120000
* MAJOR SYSTEM = 'O' AND OBJFLD = 'EM' * 01130002
* IF NOT, RETURN WITH ERROR MSG 611E OPTION NOT SUPPORTED. * 01140000
* * 01150000
* STEP-1. * 01160000
* .FILL IN TEXT LINES (HEADER,INFORMATION AND PFK) * 01170000
* FROM VOPTVAL DEPENDING ON ACTION REQUIRED. * 01180000
* .IF NOT ADD, SAVE EMPLOYEE ID, DEPENDING ON MAXSEL. * 01190000
* IF MAXSEL=1 EMPL-ID IS ON THE FIRST DETAIL LINE, * 01200000
* IF MAXSEL>1 THE INPUT DATA CONTAINS THE DETAIL LINE NUMBER. * 01210000
* .GET DEPARTMENT AND EMPLOYEE FIELD NAMES, * 01220000
* FROM VDSPTXT. * 01230000
* .IF DISPLAY OR DELETE ACTION, * 01240000
* PROTECT EVERY DETAIL INPUT FIELD. * 01250000
* .IF ADD OR UPDATE ACTION, * 01260000
* PROTECT EMPLOYEE-ID AND ALL DEPARTMENT FIELDS, * 01270000
* POSITION THE SCREEN CURSOR TO EMPLOYEE NAME FIELD. * 01280000
* .IF ADD, UNPROTECT EMPLOYEE-ID FIELD, * 01290000
* MOVE USER INPUT TO CORRESPONDING OUTPUT DATA FIELD, * 01300000
* PREV='D' AND RETURN. * 01310000
* .AND FOR DISPLAY, UPDATE AND ERASE, * 01320000
* FETCH EMPLOYEE AND DEPARTMENT CURRENT VALUES, * 01330000
* PREV='D' AND RETURN. * 01340000
* OR MSG 'EMPLOYEE NOT FOUND' AND RETURN. * 01350000
* * 01360000
* STEP-2. * 01370000
* .IF ADD, DO IT AND MSG * 01380000
* EITHER 'EMPLOYEE ADDED SUCCESSFULLY' * 01390000
* OR 'EMPLOYEE EXISTS ALREADY, ADD NOT DONE' * 01400000
* PREV=' ' AND RETURN. * 01410000
* .IF UPDATE, DO IT AND MSG * 01420000
* EITHER 'EMPLOYEE UPDATED SUCCESSFULLY' * 01430000
* OR 'EMPLOYEE DOES NOT EXIST, UPDATE NOT DONE' * 01440000
* RETURN. * 01450000
* .IF ERASE, DO IT AND MSG * 01460000
* EITHER 'EMPLOYEE ERASED SUCCESSFULLY' * 01470000
* OR 'EMPLOYEE DOES NOT EXIST, ERASE NOT DONE' * 01480000
* PREV=' ' AND RETURN. * 01490000
* .OR MSG 611E OPTION NOT SUPPORTED * 01500000
* RETURN. * 01510000
* END. * 01520000
* * 01530000
*--------------------------------------------------------------------/ 01540000
01550000
/********************************************************/ 01560000
/* ** FIELDS SENT TO MESSAGE ROUTINE */ 01570000
/********************************************************/ 01580000
01590000
DCL MODULE CHAR (07) INIT ('DSN8MPF'); 01600000
DCL OUTMSG CHAR (69); 01610000
01620000
DCL DSN8MPG EXTERNAL ENTRY; 01630000
01640000
/*********************************************************/ 01650000
/* ** CHECKS IF OPTION IS VALID */ 01660000
/*********************************************************/ 01670000
01680000
/* INITIALIZE VARIABLES */ 01690000
MAJOR='DSN8MPF'; 01700000
MINOR=' '; 01710000
01720000
/* IS OPTION VALID? */ 01730000
/* MAJOR SYSTEM - O */ 01740000
/* OBJFLD - EM */ 01750002
01760000
IF INAREA.MAJSYS^='O' | INAREA.OBJFLD^='EM' THEN 01770002
DO; 01780000
I=1; /* OPTION NOT VALID */ 01790000
GOTO MPFNSUP; /* GO TO ERROR ROUTINE */ 01800000
END; 01810000
01820000
IF INAREA.ACTION ='D' THEN /* ACTION - DISPLAY */ 01830000
GOTO MPF1_STEP; 01840000
01850000
IF COMPARM.NEWREQ ='N' THEN /* NOT NEW REQUEST */ 01860000
GOTO MPF2_STEP; 01870000
01880000
IF COMPARM.NEWREQ^='Y' THEN /* INVALID OPTION */ 01890000
DO; /* GO TO ERROR ROUTINE */ 01900000
I=2; 01910000
GOTO MPFNSUP; 01920000
END; 01930000
01940000
/*********************************************************/ 01950000
/* ** FETCHES AND PROTECTS FIELDS FOR A CERTAIN REQUEST */ 01960000
/*********************************************************/ 01970000
01980000
MPF1_STEP: 01990000
MINOR='STEP-1'; 02000000
/* FETCH FIELDS FOR */ 02010000
/* A CERTAIN REQUEST */ 02020000
EXEC SQL SELECT * 02030000
INTO :POPTVAL FROM VOPTVAL 02040000
WHERE MAJSYS='O' 02050000
AND ACTION=:INAREA.ACTION AND OBJFLD='EM' 02060002
AND SRCHCRIT='EI' AND SCRTYPE='D'; 02070000
02080000
IF SQLCODE=100 THEN /* ERROR ? */ 02090000
DO; 02100000
OUTAREA.MSG=OPTNF; 02110000
RETURN; 02120000
END; 02130000
/* FILL IN TEXT LINES */ 02140000
OUTAREA.TITLE =POPTVAL.HEADTXT; /* HEADING INFORMATION */ 02150000
OUTAREA.MSG =POPTVAL.INFOTXT; /* MESSAGE INFORMATION */ 02160000
OUTAREA.PFKTEXT=POPTVAL.PFKTXT; /* PFKEY INFORMATION */ 02170000
02180000
IF INAREA.ACTION='A' THEN /* ACTION - ADD */ 02190000
GOTO MPF010; 02200000
02210000
IF MAXSEL=1 THEN /* SAVE ONLY EMPLOYEE */ 02220000
/* ID ON FIRST DETAIL */ 02230000
/* LINE IN SECONDARY SEL */ 02240000
DO; 02250000
PEMP.EMPNO=MGRNUM(1); 02260000
GOTO MPF010; 02270000
END; 02280000
02290000
IF MAXSEL < 1 THEN /* NO EMPLOYEES */ 02300000
DO; /* PRINT ERROR MESSAGE */ 02310000
I=3; 02320000
GOTO MPFNSUP; 02330000
END; 02340000
02350000
IF VERIFY(DAT1,'0123456789')^=0 THEN /* NON NUMERIC VERIFICATION */ 02360000
DO; /* FOR DAT1 */ 02370000
I=4; 02380000
GOTO MPFNSUP; 02390000
END; 02400000
02410000
IF VERIFY(DAT2,'0123456789')^=0 THEN /* NUMERIC VERIFICATION */ 02420000
DO; /* FOR DAT2 */ 02430000
DAT2=DAT1; 02440000
DAT1='0'; 02450000
END; 02460000
02470000
/* INPUT DATA CONTAINS */ 02480000
/* THE DETAIL LINE NO. */ 02490000
I=DATAP; 02500000
02510000
IF I>MAXSEL THEN /* INVALID SECONDARY SEL */ 02520000
DO; /* PRINT ERROR MESSAGE */ 02530000
I=5; 02540000
GOTO MPFNSUP; 02550000
END; 02560000
02570000
PEMP.EMPNO=MGRNUM(I); /* SAVE EMPLOYEE ID */ 02580000
02590000
MPF010: 02600000
OUTPUT=' '; /* MOVE BLANKS TO OUTPUT FIELD*/ 02610000
02620000
EXEC SQL OPEN DH; /* OPEN DH CURSOR */ 02630000
02640000
/* GET MANAGER AND DEPARTMENT */ 02650000
/* FIELD NAMES */ 02653000
DO I=1 TO 10; 02656000
EXEC SQL FETCH DH INTO :PDSPTXT.DSPLINE, :PDSPTXT.LINENO; 02660000
IF SQLCODE=100 THEN 02670000
LEAVE; 02680000
FIELD1(I)=DSPLINE; 02690000
END; 02700000
02710000
EXEC SQL CLOSE DH; /* CLOSE DH CURSOR */ 02720000
IF I=1 THEN /* NO TEXT AVAILABLE */ 02730000
DO; 02740000
OUTAREA.MSG=DSPNF; 02750000
RETURN; 02760000
END; 02770000
/* PROTECT THE MODIFIABLE */ 02780000
/* ATTRIBUTE FIELDS */ 02785000
DO I=1 TO 15; 02790000
UNSPEC(ATTR1(I))='00000000'B; /* REPLACE PROTECTED */ 02800000
UNSPEC(ATTR2(I))='11100001'B; /* PRE-MODIFIED */ 02810000
END; 02820000
/* IF DISPLAY OR ERASE ACTION */ 02830000
/* PROTECT EVERY DETAIL */ 02840000
/* INPUT FIELD */ 02850000
02860000
IF INAREA.ACTION='D' | INAREA.ACTION='E' THEN 02870000
GOTO MPF030; 02880000
/* IF UPDATE OR ADD ACTION */ 02890000
/* PROTECT DEPARTMENT-ID */ 02900000
/* AND MANAGER FIELDS */ 02910000
IF INAREA.ACTION='U' THEN 02920000
GOTO MPF022; 02930000
IF INAREA.ACTION^='A' THEN 02940000
DO; 02950000
/* IF ADD, UNPROTECT */ 02960000
/* DEPARTMENT-ID FIELD */ 02970000
I=6; 02980000
GOTO MPFNSUP; 02990000
END; 03000000
IF INAREA.SEARCH='EI' THEN /* EMPLOYEE-ID */ 03010000
DO; 03020000
FIELD2(6)=DATA6; 03030000
EXEC SQL SELECT EMPNO INTO :PEMP.EMPNO 03040000
FROM VEMP WHERE EMPNO=:DATA6; 03050000
03060000
IF SQLCODE=0 THEN /* DOES EMPLOYEE EXIST */ 03070000
DO; /* ALREADY ? */ 03075000
CALL DSN8MPG (MODULE, '005E', OUTMSG); 03080000
GOTO MPFMSG; 03085000
END; 03090000
ELSE 03095000
GOTO MPF020; 03100000
END; 03105000
03110000
IF INAREA.SEARCH='EN' THEN /* EMPLOYEE NAME */ 03120000
DO; 03130000
FIELD2(9)=DATA15; 03140000
GOTO MPF020; 03150000
END; 03160000
03170000
IF INAREA.SEARCH^='DI' THEN /* MUST BE DEPARTMENT ID */ 03180000
DO; /* ELSE PRINT MESSAGE */ 03190000
I=7; 03200000
GOTO MPFNSUP; 03210000
END; 03220000
03230000
FIELD2(10)=DATA3; 03240000
03250000
MPF020: /* REPLACE UNPROTECTED */ 03260000
UNSPEC(ATTR2(6))='11000001'B; /* PRE-MODIFIED */ 03270000
03280000
MPF022: 03290000
DO I=7 TO 10; 03300000
UNSPEC(ATTR2(I))='11000001'B; 03310000
END; 03320000
03330000
UNSPEC(ATTR1(7))='11000000'B; /* CURSOR POSITION */ 03340000
03350000
IF INAREA.ACTION='A' THEN /* ACTION - ADD */ 03360000
GOTO MPFRET1; /* GO TO RETURN ROUTINE */ 03370000
03380000
/*********************************************************/ 03390000
/* * ADDS, UPDATES, OR ERASES AND PRINTS MESSAGE */ 03400000
/*********************************************************/ 03410000
03420000
MPF030: 03430000
FIELD2(6)=PEMP.EMPNO; /* GET EMPLOYEE ID */ 03440000
03450000
EXEC SQL SELECT * /* FETCH EMPLOYEE INFO. */ 03460000
INTO :PEMP.EMPNO, 03462000
:PEMP.FIRSTNME, 03465000
:PEMP.MIDINIT, 03468000
:PEMP.LASTNAME, 03471000
:PEMP.WORKDEPT:NULL_IND1 03474000
FROM VEMP 03477000
WHERE EMPNO=:PEMP.EMPNO; 03480000
03490000
IF SQLCODE=100 THEN 03500000
DO; 03510000
CALL DSN8MPG (MODULE, '001I', OUTMSG); /* EMPLOYEE NOT FOUND */ 03520000
GOTO MPFMSG; /* GO TO MESSAGE ROUTINE*/ 03530000
END; 03540000
03550000
IF NULL_IND1 = -1 THEN 03560000
DO; 03564000
PEMP.WORKDEPT = ' '; 03568000
DO I = 2 TO 4; 03572000
FIELD2(I) = ' '; 03576000
END; 03580000
END; 03584000
FIELD2(1)=PEMP.WORKDEPT; /* GET WK. DEPT ID */ 03588000
FIELD2(7)=PEMP.FIRSTNME; /* GET FIRST NAME */ 03592000
FIELD2(8)=PEMP.MIDINIT; /* GET MIDDLE INITIAL */ 03596000
FIELD2(9)=PEMP.LASTNAME; /* GET LAST NAME */ 03600000
FIELD2(10)=PEMP.WORKDEPT; /* GET WK. DEPT NAME */ 03605000
03610000
EXEC SQL SELECT * /* FETCH DEPARTMENT INFO. */ 03620000
INTO :PDEPT.DEPTNO, 03623000
:PDEPT.DEPTNAME, 03626000
:PDEPT.MGRNO:NULL_IND1, 03629000
:PDEPT.ADMRDEPT 03632000
FROM VDEPT 03636000
WHERE DEPTNO=:PEMP.WORKDEPT; 03640000
03650000
IF SQLCODE=100 THEN /* DEPARTMENT NOT FOUND */ 03660000
GOTO MPFRET1; /* GO TO RETURN ROUTINE */ 03670000
03680000
IF NULL_IND1 = -1 THEN 03690000
PDEPT.MGRNO = ' '; 03696000
FIELD2(2)=PDEPT.DEPTNAME; /* GET DEPARTMENT NAME */ 03702000
FIELD2(3)=PDEPT.MGRNO; /* GET MANAGER ID */ 03708000
FIELD2(4)=PDEPT.ADMRDEPT; /* GET ADMINSTRAT. DEPT */ 03714000
03720000
MPFRET1: /* RETURN ROUTINE */ 03730000
PREV='D'; 03740000
RETURN; /* RETURN */ 03750000
03760000
1MPF2_STEP: 03770000
MINOR='STEP-2'; 03780000
EXEC SQL WHENEVER SQLERROR CONTINUE; 03790000
DO I=1 TO 15; 03800000
UNSPEC(ATTR1(I))='00000000'B; /* REPLACE PROTECTED */ 03810000
UNSPEC(ATTR2(I))='11100001'B; /* PRE-MODIFIED */ 03820000
FIELD2(I)=TRANDATA(I); 03830000
END; 03840000
PEMP.EMPNO=TRANDATA(6); 03850000
03860000
IF INAREA.ACTION = 'E' THEN 03870000
GOTO MPF050; 03880000
03890000
DO I=LENGTH(TRANDATA(7)) TO 1 BY -1 /* VAR CHAR REAL LENGTH */ 03900000
UNTIL(SUBSTR(TRANDATA(7),I,1)^=''); 03910000
END; 03920000
03930000
PEMP.FIRSTNME = SUBSTR(TRANDATA(7),1,I); 03940000
PEMP.MIDINIT=TRANDATA(8); 03950000
03960000
DO I=LENGTH(TRANDATA(9)) TO 1 BY -1 /* VAR CHAR REAL LENGTH */ 03970000
UNTIL(SUBSTR(TRANDATA(9),I,1)^=''); 03980000
END; 03990000
04000000
PEMP.LASTNAME = SUBSTR(TRANDATA(9),1,I); 04010000
PEMP.WORKDEPT=TRANDATA(10); 04020000
IF TRANDATA(10) = ' ' THEN /* DETERMINE IF WORKDEPT */ 04022000
NULL_IND1 = -1; /* IS NULL */ 04024000
ELSE 04026000
NULL_IND1 = 0; 04028000
04030000
/*********************************************************/ 04040000
/* ** INSERT (ADD) */ 04050000
/*********************************************************/ 04060000
04070000
IF INAREA.ACTION ^= 'A' THEN /* IF ACTION IS NOT ADD */ 04080000
GOTO MPF040; /* SKIP THIS ROUTINE */ 04090000
04100000
/* PERFORM INSERT (ADD) */ 04110000
EXEC SQL INSERT INTO VEMP 04120000
(EMPNO,FIRSTNME,MIDINIT,LASTNAME,WORKDEPT) 04130000
VALUES(:PEMP.EMPNO,:PEMP.FIRSTNME,:PEMP.MIDINIT, 04140000
:PEMP.LASTNAME,:PEMP.WORKDEPT:NULL_IND1); 04150000
IF SQLCODE=0 THEN 04160000
DO; 04170000
PREV=' '; 04180000
CALL DSN8MPG (MODULE, '002I', OUTMSG); 04190000
/* EMPLOYEE SUCCESSFULLY ADDED*/ 04200000
GO TO MPF041; /* PRINT CONFIRMATION MESSAGE */ 04210000
END; 04220000
04230000
IF SQLCODE = -530 THEN 04231000
DO; /* INVALID DEPARTMENT NUMBER */ 04232000
CALL DSN8MPG (MODULE, '200E',OUTMSG); 04233000
/* ADD NOT DONE */ 04234000
GO TO MPFMSG; /* PRINT ERROR MESSAGE */ 04235000
END; 04236000
04238000
IF SQLCODE=-803 THEN 04240000
MPF038: DO; /* EMPLOYEE ALREADY EXISTS */ 04250000
CALL DSN8MPG (MODULE, '005E', OUTMSG); 04260000
/* ADD NOT DONE */ 04270000
GO TO MPFMSG; /* PRINT ERROR MESSAGE */ 04280000
END; 04290000
04300000
GO TO DB_ERROR; /* GO TO SQL ERROR ROUTINE */ 04310000
04330000
/*********************************************************/ 04340000
/* ** UPDATE */ 04350000
/*********************************************************/ 04360000
04370000
MPF040: 04380000
IF INAREA.ACTION ^= 'U' THEN /* IF ACTION IS NOT UPDATE */ 04390000
DO; 04400000
I=8; 04410000
GOTO MPFNSUP; /* GO TO MESSAGE ROUTINE */ 04420000
END; 04430000
04440000
/* PERFORM UPDATE */ 04450000
EXEC SQL UPDATE VEMP 04460000
SET FIRSTNME = :PEMP.FIRSTNME, 04470000
MIDINIT = :PEMP.MIDINIT, 04476000
LASTNAME = :PEMP.LASTNAME, 04482000
WORKDEPT = :PEMP.WORKDEPT:NULL_IND1 04488000
WHERE EMPNO = :PEMP.EMPNO; 04494000
04500000
IF SQLCODE=0 THEN 04501000
DO; /* EMPLOYEE SUCCESSFULLY */ 04502000
CALL DSN8MPG (MODULE, '004I', OUTMSG); 04503000
/* UPDATED */ 04504000
GO TO MPF041; /* PRINT CONFIRMATION MESSAGE */ 04505000
END; 04506000
04508000
IF SQLCODE=100 THEN 04510000
DO; /* EMPLOYEE DOES NOT EXIST */ 04520000
CALL DSN8MPG (MODULE, '007E', OUTMSG); 04530000
/* UPDATE NOT DONE */ 04540000
GO TO MPFMSG; /* PRINT ERROR MESSAGE */ 04550000
END; 04560000
04570000
IF SQLCODE = -530 THEN 04580000
DO; /* INVALID WORKDEPT */ 04585000
CALL DSN8MPG (MODULE, '203E',OUTMSG); 04590000
/* NOT UPDATED */ 04595000
GO TO MPFMSG; /* PRINT ERROR MESSAGE */ 04600000
END; 04605000
04610000
GO TO DB_ERROR; /* GO TO SQL ERROR ROUTINE */ 04613000
04616000
MPF041: 04620000
FIELD2(1)=PEMP.WORKDEPT; /* IN CASE WORK DEPT UPDATED */ 04630000
04640000
/* FETCH DEPARTMENT */ 04650000
EXEC SQL SELECT * /* INFORMATION */ 04652000
INTO :PDEPT.DEPTNO, 04655000
:PDEPT.DEPTNAME, 04658000
:PDEPT.MGRNO:NULL_IND1, 04661000
:PDEPT.ADMRDEPT 04664000
FROM VDEPT 04667000
WHERE DEPTNO=:PEMP.WORKDEPT; 04670000
04680000
IF SQLCODE=0 THEN /* ERROR ? */ 04690000
DO; 04700000
IF NULL_IND1 = -1 THEN 04710000
PDEPT.MGRNO = ' '; 04716000
FIELD2(2)=PDEPT.DEPTNAME; /* UPDATE DEPARTMENT NAME */ 04722000
FIELD2(3)=PDEPT.MGRNO; /* UPDATE DEPT MANAGER ID */ 04729000
FIELD2(4)=PDEPT.ADMRDEPT; /* UPDATE ADMINSTRAT. DEPT */ 04736000
GO TO MPFMSG; /* GO TO MESSAGE ROUTINE */ 04743000
END; 04750000
04760000
DO I=2 TO 4; /* PUT SPACES AT END OF FIELD */ 04770000
FIELD2(I)=' '; 04780000
END; 04790000
04800000
GO TO MPFMSG; /* GO TO MESSAGE ROUTINE */ 04810000
04820000
/*********************************************************/ 04830000
/* ** ERASE */ 04840000
/*********************************************************/ 04850000
04860000
MPF050: /* PERFORM ERASE (DELETE) */ 04870000
EXEC SQL DELETE FROM VEMP WHERE EMPNO=:PEMP.EMPNO; 04880000
04890000
IF SQLCODE=0 THEN /* EMPLOYEE SUCCESSFULLY */ 04900000
DO; /* ERASED */ 04910000
PREV=' '; 04920000
CALL DSN8MPG (MODULE, '003I', OUTMSG); 04930000
GO TO MPFMSG; /* PRINT CONFIRMATION MESSAGE */ 04940000
END; 04960000
04970000
IF SQLCODE=100 THEN /* EMPLOYEE DOES NOT EXIST */ 04980000
DO; /* ERASE NOT DONE */ 04990000
CALL DSN8MPG (MODULE, '006E', OUTMSG); 05000000
GO TO MPFMSG; /* PRINT ERROR MESSAGE */ 05010000
END; 05030000
05040000
IF SQLCODE=-532 THEN /* EMPLOYEE HAS DEPENDENT ROWS*/ 05041000
DO; /* ERASE NOT DONE */ 05042000
CALL DSN8MPG (MODULE, '202E', OUTMSG); 05043000
GO TO MPFMSG; /* PRINT ERROR MESSAGE */ 05044000
END; 05045000
05046000
GO TO DB_ERROR; /* GO TO SQL ERROR ROUTINE */ 05047000
05048000
/*********************************************************/ 05050000
/* ** PRINT ERROR MESSAGE */ 05060000
/*********************************************************/ 05070000
05080000
MPFNSUP: 05090000
/* NO VALID SELECTIONS APPLY */ 05100000
CALL DSN8MPG (MODULE, '069E', OUTMSG); 05110000
05120000
MPFMSG: 05130000
PCONVSTA.MSG = OUTMSG; /* PRINT MESSAGE TEXT */ 05140000
PCONVSTA.PREV = ' '; /* REMOVE PREVIOUS INDICATION */ 05150000
05160000
RETURN; /* RETURN */ 05170000
END DSN8MPF; 05180000
05181000