DSN8MPZ
THIS MODULE HANDLES, IN THE MAJOR SYSTEM PROJECT, THE DETAIL OPERATIONS FOR A PROJECT, SUCH AS DISPLAY, ADD(INSERT), UPDATE, AND ERASE(DELETE), DEPENDING ON A SEARCH CRITERIA, SUCH AS PROJECT ID, PROJECT NAME, RESPONSIBLE ID, RESPONSIBLE NAME, OR DEPARTMENT ID.
DSN8MPZ: PROC; /* PROJECT DETAIL MODULE */ 00010000
/* */ 00020000
/* */ 00030000
/********************************************************************* 00040000
* * 00050000
* MODULE NAME = DSN8MPZ * 00060000
* * 00070000
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION * 00080000
* DETAIL PROJECT MODULE * 00090000
* PL/I * 00100000
* PROJECT * 00110000
* * 00120000
* COPYRIGHT = 5740-XYR (C) COPYRIGHT IBM CORP 1982, 1989 * 00130000
* REFER TO COPYRIGHT INSTRUCTIONS FORM NUMBER G120-2083 * 00140000
* * 00150000
* STATUS = VERSION 2 RELEASE 2, LEVEL 0 * 00160000
* * 00170000
* FUNCTION = THIS MODULE HANDLES, IN THE MAJOR SYSTEM PROJECT, * 00180000
* THE DETAIL OPERATIONS FOR A PROJECT, SUCH AS * 00190000
* DISPLAY, ADD(INSERT), UPDATE, AND ERASE(DELETE), * 00200000
* DEPENDING ON A SEARCH CRITERIA, SUCH AS * 00210000
* PROJECT ID, PROJECT NAME, * 00220000
* RESPONSIBLE ID, RESPONSIBLE NAME, * 00230000
* OR DEPARTMENT ID. * 00240000
* * 00250000
* NOTES = * 00260000
* DEPENDENCIES = NONE * 00270000
* RESTRICTIONS = THE VALID OPTIONS ARE: * 00280000
* .P-D-PR-PI,PN,DI,RI,RN * 00290000
* .P-A-PR-PI,PN,DI,RI * 00300000
* .P-U-PR-PI,PN,DI,RI,RN * 00310000
* .P-E-PR-PI,PN,DI,RI,RN * 00320000
* * 00330000
* MODULE TYPE = * 00340000
* PROCESSOR = DB2 PRECOMPILER, PL/I OPTIMIZER * 00350000
* MODULE SIZE = SEE LINK-EDIT * 00360000
* ATTRIBUTES = REUSABLE * 00370000
* * 00380000
* ENTRY POINT = DSN8MPZ * 00390000
* PURPOSE = SEE FUNCTION * 00400000
* LINKAGE = MODULE CALLED BY * 00410000
* .DSN8MPM FOR DISPLAY, AND FIRST STEP UPDATE OR ERASE * 00420000
* .DSN8IP2 FOR FIRST STEP ADD, AND ALL SECOND STEPS. * 00430000
* * 00440000
* INPUT = PARAMETERS EXPLICITLY PASSED TO THIS FUNCTION: * 00450000
* COMMON AREA. * 00460000
* * 00470000
* SYMBOLIC LABEL/NAME = OUTAREA .OUTPUT * 00480000
* DESCRIPTION = SECONDARY SELECTION OUTPUT * 00490000
* * 00500000
* SYMBOLIC LABEL/NAME = COMPARM .NEWREQ * 00510000
* DESCRIPTION = 'Y' OR 'N' NEW REQUEST * 00520000
* * 00530000
* SYMBOLIC LABEL/NAME = .MAXSEL * 00540000
* DESCRIPTION = 1-13 NUMBER OF SELECTIONS * 00550000
* * 00560000
* SYMBOLIC LABEL/NAME = INAREA * 00570000
* DESCRIPTION = USER INPUT * 00580000
* * 00590000
* SYMBOLIC LABEL/NAME = PCONVSTA.PREV * 00600000
* DESCRIPTION = ' ' OR 'D' PREVIOUS REQUEST * 00610000
* * 00620000
* OUTPUT = PARAMETERS EXPLICITLY RETURNED: * 00630000
* COMMON AREA. * 00640000
* * 00650000
* SYMBOLIC LABEL/NAME = PCONVSTA.PREV * 00660000
* DESCRIPTION = 'D' OR ' ' DEPENDING ON STEP NO. 00670000
* * 00680000
* SYMBOLIC LABEL/NAME = OUTAREA .OUTPUT * 00690000
* DESCRIPTION = SCREEN DETAIL OUTPUT * 00700000
* * 00710000
* EXIT-NORMAL = * 00720000
* * 00730000
* EXIT-ERROR = * 00740000
* * 00750000
* RETURN CODE = NONE * 00760000
* * 00770000
* ABEND CODES = NONE * 00780000
* * 00790000
* * 00800000
* ERROR-MESSAGES = * 00810000
* DSN8031I PROJECT NOT FOUND * 00820000
* DSN8032I PROJECT SUCCESSFULLY ADDED * 00830000
* DSN8033I PROJECT SUCCESSFULLY ERASED * 00840000
* DSN8034I PROJECT SUCCESSFULLY UPDATED * 00850000
* DSN8035E PROJECT EXISTS ALREADY, ADD NOT DONE * 00860000
* DSN8036E PROJECT DOES NOT EXIST, ERASE NOT DONE * 00870000
* DSN8037E PROJECT DOES NOT EXIST, UPDATE NOT DONE * 00880000
* DSN8069E NO VALID SELECTIONS QUALIFY FOR THIS REQUEST * 00890000
* DSN8230E INVALID DEPARTMENT NUMBER, PROJECT NOT ADDED * 00900000
* DSN8231E INVALID RESPONSIBLE ID, PROJECT NOT ADDED * 00910000
* DSN8233E PROJECT NUMBER HAS DEPENDENT ROWS, NOT ERASED * 00920000
* DSN8235E INVALID MAJOR PROJECT ID, PROJECT NOT ADDED * 00930000
* DSN8236E INVALID ASSOCIATE DEPT ID, PROJECT NOT UPDATED * 00940000
* DSN8237E INVALID RESPONSIBLE ID, PROJECT NOT UPDATED * 00950000
* DSN8238E INVALID MAJOR PROJECT ID, PROJECT NOT UPDATED * 00960000
* * 00970000
* EXTERNAL REFERENCES = * 00980000
* ROUTINES/SERVICES = * 00990000
* DSN8MPG - ERROR MESSAGE ROUTINE * 01000000
* * 01010000
* DATA-AREAS = * 01020000
* DSN8MPCA - SAMPLE COMMON AREA * 01030000
* * 01040000
* CONTROL-BLOCKS = * 01050000
* SQLCA - SQL COMMUNICATION AREA * 01060000
* * 01070000
* TABLES = * 01080000
* VPROJ = PROJECT TABLE VIEW * 01090000
* VDEPT = DEPARTMENT TABLE VIEW * 01100000
* VEMP = EMPLOYEE TABLE VIEW * 01110000
* VOPTVAL = VALID OPTIONS TABLE VIEW * 01120000
* VDSPTXT = DISPLAY TEXTS TABLE VIEW * 01130000
* * 01140000
* CHANGE-ACTIVITY = * 01150000
* - ADD CHECKS FOR REFERENTIAL INTEGRITY VIOLATIONS V2R1 * 01160000
* * 01170000
* *PSEUDOCODE* * 01180000
* PROCEDURE * 01190000
* DECLARATIONS. * 01200000
* * 01210000
* INITIALIZATION. * 01220000
* .CHECK IF OPTION IS VALID FOR THIS MODULE * 01230000
* MAJOR SYSTEM = 'P' AND OBJFLD = 'PR' * 01240002
* IF NOT, RETURN WITH ERROR MSG 002E OPTION NOT SUPPORTED. * 01250000
* * 01260000
* STEP-1. * 01270000
* .FILL IN TEXT LINES (HEADER,INFORMATION AND PFK) * 01280000
* FROM VOPTVAL DEPENDING ON ACTION REQUIRED. * 01290000
* .IF NOT ADD, SAVE PROJECT ID, DEPENDING ON MAXSEL. * 01300000
* IF MAXSEL=1 PROJ-ID IS ON THE FIRST DETAIL LINE, * 01310000
* IF MAXSEL>1 THE INPUT DATA CONTAINS THE DETAIL LINE NUMBER. * 01320000
* .GET PROJECT FIELD NAMES, * 01330000
* FROM VDSPTXT. * 01340000
* .IF DISPLAY OR DELETE ACTION, * 01350000
* PROTECT EVERY DETAIL INPUT FIELD. * 01360000
* .IF ADD OR UPDATE ACTION, * 01370000
* PROTECT PROJECT-ID AND ALL NON PROJECT FIELDS, * 01380000
* POSITION THE SCREEN CURSOR TO PROJECT NAME FIELD. * 01390000
* .IF ADD, UNPROTECT PROJECT-ID FIELD, * 01400000
* MOVE USER INPUT TO CORRESPONDING OUTPUT DATA FIELD, * 01410000
* PREV='D' AND RETURN. * 01420000
* .AND FOR DISPLAY, UPDATE AND ERASE, * 01430000
* FETCH PROJECT, DEPARTMENT AND RESPONSIBLE CURRENT VALUES, * 01440000
* PREV='D' AND RETURN. * 01450000
* OR MSG 'PROJECT NOT FOUND' AND RETURN. * 01460000
* * 01470000
* STEP-2. * 01480000
* .IF ADD, DO IT AND MSG * 01490000
* EITHER 'PROJECT ADDED SUCCESSFULLY' * 01500000
* OR 'PROJECT EXISTS ALREADY, ADD NOT DONE' * 01510000
* PREV=' ' AND RETURN. * 01520000
* .IF UPDATE, DO IT AND MSG * 01530000
* EITHER 'PROJECT UPDATED SUCCESSFULLY' * 01540000
* OR 'PROJECT DOES NOT EXIST, UPDATE NOT DONE' * 01550000
* RETURN. * 01560000
* .IF ERASE, DO IT AND MSG * 01570000
* EITHER 'PROJECT ERASED SUCCESSFULLY' * 01580000
* OR 'PROJECT DOES NOT EXIST, ERASE NOT DONE' * 01590000
* PREV=' ' AND RETURN. * 01600000
* .OR MSG 069E NO VALID SELECTIONS QUALIFY FOR THIS REQUEST * 01610000
* RETURN. * 01620000
* END. * 01630000
* * 01640000
*-------------------------------------------------------------------*/ 01650000
DCL MODATR CHAR(1); 01660000
01670000
/********************************************************/ 01680000
/* ** FIELDS SENT TO MESSAGE ROUTINE */ 01690000
/********************************************************/ 01700000
01710000
DCL MODULE CHAR (07) INIT ('DSN8MPZ'); 01720000
DCL OUTMSG CHAR (69); 01730000
01740000
/*********************************************************************/01750000
/* BUILTIN ROUTINE DECLARATION */01760000
/*********************************************************************/01770000
01780000
DCL SUBSTR BUILTIN; 01790000
01800000
/*********************************************************************/01810000
/* CONSTRAINT NAME FOR DEPARTMENT NUMBER */01820000
/*********************************************************************/01830000
01840000
DCL EMPNO_CONSTRAINT CHAR(8) STATIC INIT('RPE'); 01850000
DCL DEPTNO_CONSTRAINT CHAR(8) STATIC INIT('RPD'); 01860000
01870000
/*********************************************************/ 01880000
/* ** CHECKS IF OPTION IS VALID */ 01890000
/*********************************************************/ 01900000
01910000
/* INITIALIZE VARIABLES */ 01920000
MAJOR='DSN8MPZ'; 01930000
MINOR=' '; 01940000
01950000
/* IS OPTION VALID? */ 01960000
/* MAJOR SYSTEM - P */ 01970000
/* OBJFLD - PR */ 01980002
01990000
02000000
IF INAREA.MAJSYS^='P' | INAREA.OBJFLD^='PR' THEN 02010002
DO; 02020000
I=1; /* OPTION NOT VALID */ 02030000
GOTO MPZNSUP; /* GO TO ERROR ROUTINE */ 02040000
END; 02050000
02060000
IF INAREA.ACTION ='D' THEN /* ACTION - DISPLAY */ 02070000
GOTO MPZ1_STEP; 02080000
02090000
IF COMPARM.NEWREQ ='N' THEN /* NOT NEW REQUEST */ 02100000
GOTO MPZ2_STEP; 02110000
02120000
IF COMPARM.NEWREQ^='Y' THEN /* INVALID OPTION */ 02130000
DO; /* GO TO ERROR ROUTINE */ 02140000
I=2; 02150000
GOTO MPZNSUP; 02160000
END; 02170000
02180000
/*********************************************************/ 02190000
/* ** FETCHES AND PROTECTS FIELDS FOR A CERTAIN REQUEST */ 02200000
/*********************************************************/ 02210000
02220000
MPZ1_STEP: 02230000
MINOR='STEP-1'; 02240000
/* FETCH FIELDS FOR */ 02250000
/* A CERTAIN REQUEST */ 02260000
EXEC SQL SELECT * 02270000
INTO :POPTVAL FROM VOPTVAL 02280000
WHERE MAJSYS = 'P' 02290000
AND ACTION = :INAREA.ACTION 02300000
AND OBJFLD = 'PR' 02310002
AND SRCHCRIT = 'PI' 02320000
AND SCRTYPE = 'D'; 02330000
02340000
IF SQLCODE=100 THEN /* ERROR ? */ 02350000
DO; 02360000
OUTAREA.MSG=OPTNF; 02370000
RETURN; 02380000
END; 02390000
02400000
OUTAREA.TITLE =POPTVAL.HEADTXT; /* HEADING INFORMATION */ 02410000
OUTAREA.MSG =POPTVAL.INFOTXT; /* MESSAGE INFORMATION */ 02420000
OUTAREA.PFKTEXT=POPTVAL.PFKTXT; /* PFKEY INFORMATION */ 02430000
02440000
IF INAREA.ACTION='A' THEN /* ACTION - ADD */ 02450000
GOTO MPZ010; 02460000
02470000
IF MAXSEL=1 THEN /* SAVE ONLY INFORMATION */ 02480000
/* ON FIRST DETAIL */ 02490000
/* LINE IN SECONDARY SEL */ 02500000
DO; 02510000
PPROJ.PROJNO=DSN8MP2_POS.PROJNUM(1); 02520000
GOTO MPZ010; 02530000
END; 02540000
02550000
IF MAXSEL < 1 THEN /* NO EMPLOYEES */ 02560000
DO; /* PRINT ERROR MESSAGE */ 02570000
I=3; 02580000
GOTO MPZNSUP; 02590000
END; 02600000
02610000
02620000
IF MAXSEL=1 THEN /* SAVE ONLY INFORMATION */ 02630000
GOTO MPZ010; /* ON FIRST DETAIL */ 02640000
/* LINE IN SECONDARY SEL */ 02650000
02660000
02670000
02680000
IF VERIFY(DAT1,'0123456789')^=0 THEN /* NON NUMERIC VERIFICATION */ 02690000
DO; /* FOR DAT1 */ 02700000
I=4; 02710000
GOTO MPZNSUP; 02720000
END; 02730000
02740000
IF VERIFY(DAT2,'0123456789')^=0 THEN /* NUMERIC VERIFICATION */ 02750000
DO; /* FOR DAT2 */ 02760000
DAT2=DAT1; 02770000
DAT1='0'; 02780000
END; 02790000
02800000
/* INPUT DATA CONTAINS */ 02810000
/* THE DETAIL LINE NO. */ 02820000
I=DATAP; 02830000
02840000
IF I>MAXSEL THEN /* INVALID SECONDARY SEL */ 02850000
DO; /* PRINT ERROR MESSAGE */ 02860000
I=5; 02870000
GOTO MPZNSUP; 02880000
END; 02890000
02900000
PPROJ.PROJNO=DSN8MP2_POS.PROJNUM(I); 02910000
02920000
MPZ010: /* LET'S GET FIELD NAMES */ 02930000
OUTPUT=' '; /* CLEAR OUTPUT FIELD */ 02940000
EXEC SQL OPEN DH; /* OPEN DH CURSOR */ 02950000
02960000
DO I=1 TO 13; 02970000
EXEC SQL FETCH DH INTO :PDSPTXT.DSPLINE, :PDSPTXT.LINENO; 02980000
IF SQLCODE=100 THEN 02990000
LEAVE; 03000000
FIELD1(I)=DSPLINE; 03010000
END; 03020000
03030000
EXEC SQL CLOSE DH; /* CLOSE DH CURSOR */ 03040000
03050000
IF I=1 THEN /* NO TEXT AVAILABLE */ 03060000
DO; 03070000
OUTAREA.MSG=DSPNF; 03080000
RETURN; 03090000
END; 03100000
03110000
/* PROTECT THE MODIFIABLE ATTRIBUTE FIELDS */ 03120000
DO I=1 TO 15; 03130000
UNSPEC(ATTR1(I))='00000000'B; 03140000
UNSPEC(ATTR2(I))='11100001'B; /* REPLACE PROTECTED PRE-MODIFIED */ 03150000
END; 03160000
/* IF DISPLAY OR ERASE ACTION */ 03170000
/* PROTECT EVERY DETAIL */ 03180000
/* INPUT FIELD */ 03190000
IF INAREA.ACTION='D' | INAREA.ACTION='E' THEN 03200000
GOTO MPZ030; 03210000
03220000
/* IF UPDATE OR ADD ACTION */ 03230000
/* PROTECT PROJECT-ID */ 03240000
/* AND RESPONSIBLE FIELDS */ 03250000
03260000
IF INAREA.ACTION='U' THEN 03270000
GOTO MPZ022; 03280000
03290000
/* IF ADD, UNPROTECT */ 03300000
/* PROJECT-ID FIELD */ 03310000
IF INAREA.ACTION^='A' THEN 03320000
DO; 03330000
I=6; 03340000
GOTO MPZNSUP; 03350000
END; 03360000
03370000
IF INAREA.SEARCH='PI' THEN /* PROJECT ID */ 03380000
DO; 03390000
03400000
FIELD2(1)=DATA6; 03410000
03420000
EXEC SQL SELECT PROJNO /* FETCH PROJECT INFORMATION */ 03430000
INTO :PPROJ.PROJNO 03440000
FROM VPROJ WHERE PROJNO=:DATA6; 03450000
03460000
IF SQLCODE=0 THEN 03470000
GOTO MPZ038; 03480000
GOTO MPZ020; 03490000
END; 03500000
03510000
IF INAREA.SEARCH='PN' THEN /* PROJECT NAME */ 03520000
DO; 03530000
FIELD2(2)=DATA24; 03540000
GOTO MPZ020; 03550000
END; 03560000
03570000
IF INAREA.SEARCH='DI' THEN /* DEPARTMENT ID */ 03580000
DO; 03590000
FIELD2(3)=DATA3; 03600000
GOTO MPZ020; 03610000
END; 03620000
03630000
IF INAREA.SEARCH^='RI' THEN /* RESPONSIBLE ID */ 03640000
DO; 03650000
I=7; 03660000
GOTO MPZNSUP; 03670000
END; 03680000
03690000
FIELD2(5)=DATA6; 03700000
03710000
/* ALLOW THE PROJECT ID, ACTIVITY ID, AND PARTICIPANT */ 03720000
/* TO BE UPDATED FOR AN ADD */ 03730000
MPZ020: 03740000
UNSPEC(ATTR2(1))='11000001'B; /* REPLACE UNPROTECTED PRE-MODIFIED */ 03750000
03760000
MPZ022: 03770000
UNSPEC(MODATR)='11000001'B; 03780000
DO I=2 TO 3; 03790000
ATTR2(I)=MODATR; 03800000
END; 03810000
ATTR2(5)=MODATR; 03820000
DO I=9 TO 12; 03830000
ATTR2(I)=MODATR; 03840000
END; 03850000
UNSPEC(ATTR1(1))='11000000'B; /* CURSOR POSITION */ 03860000
03870000
IF INAREA.ACTION='A' THEN /* ACTION - ADD */ 03880000
GOTO MPZRET1; /* GO TO RETURN ROUTINE */ 03890000
03900000
MPZ030: 03910000
03920000
/*********************************************************/ 03930000
/* * ADDS, UPDATES, OR ERASES AND PRINTS MESSAGE */ 03940000
/*********************************************************/ 03950000
03960000
FIELD2(1)=PPROJ.PROJNO; /* GET PROJECT ID */ 03970000
03980000
EXEC SQL SELECT * /* FETCH PROJECT INFORMATION */ 03990000
INTO :PPROJ:PNULLS_INDS FROM VPROJ 04000000
WHERE PROJNO=:PPROJ.PROJNO; 04010000
04020000
IF SQLCODE=100 THEN 04030000
DO; 04040000
CALL DSN8MPG (MODULE, '031I', OUTMSG); /* PROJECT NOT FOUND */ 04050000
GOTO MPZMSG; /* PRINT ERROR MESSAGE */ 04060000
END; 04070000
04080000
FIELD2(2)=PPROJ.PROJNAME; /* PROJECT NAME */ 04090000
FIELD2(3)=PPROJ.DEPTNO; /* DEPARTMENT ID */ 04100000
FIELD2(5)=PPROJ.RESPEMP; /* RESPONSIBLE EMPLOYEE */ 04110000
FIELD2(9)=PRSTAFF; /* PROJECT STAFFING */ 04120000
04130000
/********************************************************************/ 04140000
/* IF THE NULL INDICATOR OF THE START DATE IS 0, THE VALUE IS NOT */ 04150000
/* NULL. USE THE RETRIEVED VALUE IN THE OUTPUT FIELD. IF THE NULL */ 04160000
/* INDICATOR IS -1 THEN THE VALUE IS NULL. FILL THE OUTPUT FIELD */ 04170000
/* WITH BLANKS. */ 04180000
/********************************************************************/ 04190000
04200000
IF PNULLS_INDS(6) = 0 THEN 04210000
FIELD2(10)=PRSTDATE; /* PROJECT START DATE */ 04220000
ELSE 04230000
FIELD2(10)= BLKDATE; 04240000
IF PNULLS_INDS(7) = 0 THEN 04250000
FIELD2(11)=PRENDATE; /* PROJECT END DATE */ 04260000
ELSE 04270000
FIELD2(11)= BLKDATE; 04280000
FIELD2(12)=PPROJ.MAJPROJ; /* MAJOR PROJECT */ 04290000
04300000
EXEC SQL SELECT DEPTNAME /* FETCH DEPARTMENT INFORMATION */ 04310000
INTO :PDEPT.DEPTNAME 04320000
FROM VDEPT 04330000
WHERE DEPTNO=:PPROJ.DEPTNO; 04340000
04350000
IF SQLCODE=100 THEN /* DEPARTMENT INFORMATION */ 04360000
GOTO MPZ032; /* NOT FOUND */ 04370000
04380000
FIELD2(4)=PDEPT.DEPTNAME; /* GET DEPARTMENT NAME */ 04390000
04400000
MPZ032: 04410000
EXEC SQL SELECT FIRSTNME, /* FETCH EMPLOYEE INFORMATION */ 04420000
MIDINIT, 04430000
LASTNAME 04440000
INTO :PEMP.FIRSTNME, :PEMP.MIDINIT, :PEMP.LASTNAME 04450000
FROM VEMP 04460000
WHERE EMPNO=:PPROJ.RESPEMP; 04470000
04480000
IF SQLCODE=100 THEN /* EMPLOYEE INFORMATION */ 04490000
GOTO MPZ034; /* NOT FOUND */ 04500000
04510000
FIELD2(6)=PEMP.FIRSTNME; /* EMPLOYEE FIRST NAME */ 04520000
FIELD2(7)=PEMP.MIDINIT; /* EMPLOYEE MIDDLE INITIAL */ 04530000
FIELD2(8)=PEMP.LASTNAME; /* EMPLOYEE LAST NAME */ 04540000
04550000
MPZ034: 04560000
EXEC SQL SELECT PROJNAME /* FETCH PROJECT INFORMATION */ 04570000
INTO :PPROJ.PROJNAME 04580000
FROM VPROJ 04590000
WHERE PROJNO=:PPROJ.MAJPROJ; 04600000
04610000
IF SQLCODE=100 THEN /* EMPLOYEE NOT FOUND */ 04620000
GOTO MPZRET1; /* GO TO RETURN ROUTINE */ 04630000
04640000
FIELD2(13)=PPROJ.PROJNAME; /* GET PROJECT NAME */ 04650000
04660000
MPZRET1: /* RETURN ROUTINE */ 04670000
PREV='D'; 04680000
RETURN; /* RETURN */ 04690000
04700000
1MPZ2_STEP: 04710000
MINOR='STEP-2'; 04720000
DO I=1 TO 15; 04730000
UNSPEC(ATTR1(I))='00000000'B; 04740000
UNSPEC(ATTR2(I))='11100001'B; /* REPLACE PROTECTED PRE-MODIFIED */ 04750000
FIELD2(I)=TRANDATA(I); 04760000
END; 04770000
PPROJ.PROJNO=TRANDATA(1); 04780000
04790000
IF INAREA.ACTION = 'E' THEN 04800000
GOTO MPZ050; 04810000
04820000
DO I=LENGTH(TRANDATA(2)) TO 1 BY -1 /* VAR CHAR REAL LENGTH */ 04830000
UNTIL(SUBSTR(TRANDATA(2),I,1)^=''); 04840000
END; 04850000
04860000
PPROJ.PROJNAME = SUBSTR(TRANDATA(2),1,I); 04870000
PPROJ.DEPTNO=TRANDATA(3); 04880000
PPROJ.RESPEMP =TRANDATA(5); 04890000
04900000
IF VERIFY(TRANDATA(9),'0123456789. ') = 0 &/* DATA IS NUMERIC */ 04910000
TRANDATA(9) ^= ' ' THEN /* AND NOT ALL BLANKS */ 04920000
PRSTAFF =TRANDATA(9); /* USE THE ENTERED DATA */ 04930000
04940000
ELSE /* DATA ISN'T NUMERIC */ 04950000
PRSTAFF = 0; /* CHOOSE A NUMBER */ 04960000
04970000
/********************************************************************/ 04980000
/* IF THE INPUT VALUE IS BLANK, SET THE NULL INDICATOR TO -1 TO */ 04990000
/* INDICATE THE FIELD CONTAINS A NULL VALUE. OTHERWISE SET THE */ 05000000
/* NULL INDICATOR TO 0. */ 05010000
/********************************************************************/ 05020000
05030000
IF TRANDATA(10) = ' ' THEN /* DATA IS BLANK */ 05040000
DO; 05050000
NULL_IND1 = -1; /* SET THE NULL INDICATOR */ 05060000
PRSTDATE = BLKDATE; /* ARBITRARY VALUE IS SET */ 05070000
END; 05080000
ELSE 05090000
DO; 05100000
NULL_IND1 = 0; /* SET THE NULL INDICATOR */ 05110000
PRSTDATE=TRANDATA(10); /* USE THE ENTERRED DATA */ 05120000
END; 05130000
05140000
/********************************************************************/ 05150000
/* IF THE INPUT VALUE IS BLANK, SET THE NULL INDICATOR TO -1 TO */ 05160000
/* INDICATE THE FIELD CONTAINS A NULL VALUE. OTHERWISE SET THE */ 05170000
/* NULL INDICATOR TO 0. */ 05180000
/********************************************************************/ 05190000
05200000
IF TRANDATA(11) = ' ' THEN /* DATA IS BLANK */ 05210000
DO; 05220000
NULL_IND2 = -1; /* SET THE NULL INDICATOR */ 05230000
PRENDATE = BLKDATE; /* ARBITRARY VALUE IS SET */ 05240000
END; 05250000
ELSE 05260000
DO; 05270000
NULL_IND2 = 0; /* SET THE NULL INDICATOR */ 05280000
PRENDATE=TRANDATA(11); /* USE THE ENTERRED DATA */ 05290000
END; 05300000
05310000
/********************************************************************/ 05320000
/* IF THE INPUT VALUE IS BLANK, SET THE NULL INDICATOR TO -1 TO */ 05330000
/* INDICATE THE FIELD CONTAINS A NULL VALUE. OTHERWISE SET THE */ 05340000
/* NULL INDICATOR TO 0. */ 05350000
/********************************************************************/ 05360000
05370000
PPROJ.MAJPROJ =TRANDATA(12); 05380000
IF TRANDATA(12) = ' ' THEN /* DATA IS BLANK */ 05390000
DO; 05400000
NULL_IND3 = -1; /* SET THE NULL INDICATOR */ 05410000
END; 05420000
ELSE 05430000
DO; 05440000
NULL_IND3 = 0; /* SET THE NULL INDICATOR */ 05450000
END; 05460000
05470000
05480000
/*********************************************************/ 05490000
/* ** INSERT (ADD) */ 05500000
/*********************************************************/ 05510000
05520000
IF INAREA.ACTION ^= 'A' THEN /* IF ACTION IS NOT ADD */ 05530000
GOTO MPZ040; /* SKIP THIS ROUTINE */ 05540000
05550000
EXEC SQL WHENEVER SQLERROR CONTINUE; 05560000
/* PERFORM INSERT (ADD) */ 05570000
05580000
EXEC SQL INSERT INTO VPROJ 05590000
(PROJNO,PROJNAME,DEPTNO, 05600000
RESPEMP,PRSTAFF,PRSTDATE,PRENDATE,MAJPROJ) 05610000
VALUES(:PPROJ.PROJNO,:PPROJ.PROJNAME, 05620000
:PPROJ.DEPTNO,:PPROJ.RESPEMP, 05630000
:PRSTAFF,:PRSTDATE:NULL_IND1,:PRENDATE:NULL_IND2, 05640000
:PPROJ.MAJPROJ:NULL_IND3); 05650000
05660000
IF SQLCODE=0 THEN 05670000
DO; 05680000
PREV=' '; 05690000
CALL DSN8MPG (MODULE, '032I',OUTMSG); 05700000
/* PROJECT SUCCESSFULLY ADDED */ 05710000
GO TO MPZ041; /* PRINT CONFIRMATION MESSAGE */ 05720000
END; 05730000
05740000
IF SQLCODE = -530 THEN 05750000
DO; 05760000
SELECT (SUBSTR(SQLCA.SQLERRM,1,8)); 05770000
WHEN (DEPTNO_CONSTRAINT) 05780000
CALL DSN8MPG (MODULE, '230E',OUTMSG); /* INVALID DEPTNO */ 05790000
WHEN (EMPNO_CONSTRAINT) 05800000
CALL DSN8MPG (MODULE, '231E',OUTMSG); /* INVALID RESPEMP */ 05810000
OTHERWISE 05820000
CALL DSN8MPG (MODULE, '235E',OUTMSG); /* INVALID MAJPROJ */ 05830000
END; 05840000
/* ADD NOT DONE */ 05850000
GO TO MPZMSG; /* PRINT ERROR MESSAGE */ 05860000
END; 05870000
05880000
IF SQLCODE=-803 THEN 05890000
MPZ038: DO; 05900000
CALL DSN8MPG (MODULE, '035E', OUTMSG); /* ADD NOT DONE */ 05910000
GO TO MPZMSG; /* PRINT ERROR MESSAGE */ 05920000
END; 05930000
05940000
GO TO DB_ERROR; /* GO TO SQL ERROR ROUTINE */ 05950000
05960000
/*********************************************************/ 05970000
/* ** UPDATE */ 05980000
/*********************************************************/ 05990000
MPZ040: 06000000
IF INAREA.ACTION ^= 'U' THEN /* IF ACTION IS NOT UPDATE */ 06010000
DO; 06020000
I=8; 06030000
GOTO MPZNSUP; /* GO TO MESSAGE ROUTINE */ 06040000
END; 06050000
06060000
/* PERFORM UPDATE */ 06070000
EXEC SQL UPDATE VPROJ 06080000
SET PROJNAME=:PPROJ.PROJNAME, 06090000
DEPTNO=:PPROJ.DEPTNO, 06100000
RESPEMP=:PPROJ.RESPEMP, 06110000
PRSTAFF=:PRSTAFF, 06120000
PRSTDATE=:PRSTDATE:NULL_IND1, 06130000
PRENDATE=:PRENDATE:NULL_IND2, 06140000
MAJPROJ=:PPROJ.MAJPROJ:NULL_IND3 06150000
WHERE PROJNO=:PPROJ.PROJNO; 06160000
06170000
IF SQLCODE=0 THEN 06180000
DO; /* PROJECT SUCCESSFULLY UPDATED */ 06190000
CALL DSN8MPG (MODULE, '034I', OUTMSG); 06200000
GO TO MPZ041; /* FETCH NEW DEPT,EMP,PROJ DATA */ 06210000
END; 06220000
06230000
IF SQLCODE=100 THEN 06240000
DO; /* PROJECT DOES NOT EXIST */ 06250000
CALL DSN8MPG (MODULE, '037E', OUTMSG); /* UPDATE NOT DONE */ 06260000
GO TO MPZMSG; /* PRINT ERROR MESSAGE */ 06270000
END; 06280000
06290000
IF SQLCODE = -530 THEN 06300000
DO; /* PROJECT NUMBER HAS DEPENDENT */ 06310000
SELECT (SUBSTR(SQLCA.SQLERRM,1,8)); 06320000
WHEN (DEPTNO_CONSTRAINT) /* INVALID DEPTNO */ 06330000
CALL DSN8MPG (MODULE, '236E',OUTMSG); 06340000
WHEN (EMPNO_CONSTRAINT) /* INVALID RESPEMP */ 06350000
CALL DSN8MPG (MODULE, '237E',OUTMSG); 06360000
OTHERWISE /* INVALID MAJPROJ */ 06370000
CALL DSN8MPG (MODULE, '238E',OUTMSG); 06380000
END; 06390000
/* UPDATE NOT DONE */ 06400000
GO TO MPZMSG; /* PRINT ERROR MESSAGE */ 06410000
END; 06420000
06430000
GO TO DB_ERROR; /* GO TO SQL ERROR ROUTINE */ 06440000
06450000
MPZ041: 06460000
FIELD2(3)=PPROJ.DEPTNO; /* IN CASE DEPT-ID, RESP-ID */ 06470000
FIELD2(5)=PPROJ.RESPEMP; /* OR MAJPROJ-ID UPDATED */ 06480000
FIELD2(12)=PPROJ.MAJPROJ; 06490000
06500000
EXEC SQL SELECT DEPTNAME /* FETCH DEPARTMENT INFORMATION */ 06510000
INTO :PDEPT.DEPTNAME 06520000
FROM VDEPT 06530000
WHERE DEPTNO=:PPROJ.DEPTNO; 06540000
06550000
IF SQLCODE=0 THEN 06560000
DO; 06570000
FIELD2(4)=PDEPT.DEPTNAME; 06580000
GOTO MPZ042; 06590000
END; 06600000
06610000
FIELD2(4)=' '; 06620000
MPZ042: 06630000
EXEC SQL SELECT FIRSTNME, /* FETCH EMPLOYEE INFORMATION */ 06640000
MIDINIT, 06650000
LASTNAME 06660000
INTO :PEMP.FIRSTNME, :PEMP.MIDINIT, :PEMP.LASTNAME 06670000
FROM VEMP 06680000
WHERE EMPNO=:PPROJ.RESPEMP; 06690000
06700000
IF SQLCODE=0 THEN 06710000
DO; 06720000
FIELD2(6)=PEMP.FIRSTNME; 06730000
FIELD2(7)=PEMP.MIDINIT; 06740000
FIELD2(8)=PEMP.LASTNAME; 06750000
GOTO MPZ044; 06760000
END; 06770000
06780000
DO I=6 TO 8; 06790000
FIELD2(I)=' '; 06800000
END; 06810000
06820000
MPZ044: 06830000
06840000
EXEC SQL SELECT PROJNAME /* FETCH PROJECT INFORMATION */ 06850000
INTO :PPROJ.PROJNAME 06860000
FROM VPROJ 06870000
WHERE PROJNO=:PPROJ.MAJPROJ; 06880000
06890000
IF SQLCODE=0 THEN 06900000
DO; 06910000
FIELD2(13)=PPROJ.PROJNAME; 06920000
GOTO MPZMSG; 06930000
END; 06940000
06950000
FIELD2(13)=' '; /* CLEAR FIELD */ 06960000
06970000
GO TO MPZMSG; /* GO TO MESSAGE ROUTINE */ 06980000
06990000
/*********************************************************/ 07000000
/* ** ERASE */ 07010000
/*********************************************************/ 07020000
07030000
MPZ050: /* PERFORM ERASE (DELETE) */ 07040000
07050000
EXEC SQL DELETE FROM VPROJ WHERE PROJNO=:PPROJ.PROJNO; 07060000
07070000
IF SQLCODE=0 THEN 07080000
DO; 07090000
PREV=' '; 07100000
CALL DSN8MPG (MODULE, '033I', OUTMSG); 07110000
/* STAFFING SUCCESSFULLY ERASED */ 07120000
GO TO MPZMSG; /* PRINT CONFIRMATION MESSAGE */ 07130000
END; 07140000
07150000
IF SQLCODE=100 THEN 07160000
DO; /* PROJECT DOES NOT EXIST */ 07170000
CALL DSN8MPG (MODULE, '036E', OUTMSG); 07180000
/* ERASE NOT DONE */ 07190000
GO TO MPZMSG; /* PRINT ERROR MESSAGE */ 07200000
END; 07210000
07220000
IF SQLCODE=-532 THEN /* PROJECT HAS DEPENDENT */ 07230000
DO; /* ROWS, ERASE NOT DONE */ 07240000
CALL DSN8MPG (MODULE, '233E', OUTMSG); 07250000
GO TO MPZMSG; /* PRINT ERROR MESSAGE */ 07260000
END; 07270000
07280000
/*********************************************************/ 07290000
/* ** PRINT ERROR MESSAGE */ 07300000
/*********************************************************/ 07310000
07320000
MPZNSUP: 07330000
/* OPTION NOT SUPPORTED BY DSN8MPZ */ 07340000
CALL DSN8MPG (MODULE, '069E', OUTMSG); 07350000
07360000
/* GET MESSAGE TEXT */ 07370000
MPZMSG: 07380000
07390000
MESSAGE.MSGTXT= OUTMSG; /* PRINT MESSAGE TEXT */ 07400000
07410000
RETURN; /* RETURN */ 07420000
END DSN8MPZ; 07430000
07440000