DSN8MPA
THIS MODULE PRODUCES SECONDARY SELECTION SCREEN FOR OBJECTS IN MAJOR SYSTEM 'O' (ORGANIZATION) CALLED BY DSN8IP2 (SQL2 MAINLINE) .
DSN8MPA: PROC; /* SECONDARY SELECTION FOR MAJSYS 'O' - OBJECTS */ 00010005
%PAGE; 00020000
/********************************************************************* 00030000
* * 00040000
* MODULE NAME = DSN8MPA * 00050000
* * 00060000
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION * 00070000
* SQL 2 SECONDARY SELECTION * 00080000
* PL/I * 00090000
* ORGANIZATION * 00100000
* * 00110000
* LICENSED MATERIALS - PROPERTY OF IBM * 00120000
* 5695-DB2 * 00130000
* (C) COPYRIGHT 1982, 1995 IBM CORP. ALL RIGHTS RESERVED. * 00140000
* * 00150000
* STATUS = VERSION 4 * 00160000
* * 00170000
* FUNCTION = THIS MODULE PRODUCES SECONDARY SELECTION SCREEN * 00180000
* FOR OBJECTS IN MAJOR SYSTEM 'O' (ORGANIZATION) * 00190004
* CALLED BY DSN8IP2 (SQL2 MAINLINE) * 00200000
* * 00210000
* NOTES = NONE * 00220000
* * 00230000
* * 00240000
* MODULE TYPE = BLOCK OF PL/I CODE * 00250000
* PROCESSOR = DB2 PRECOMPILER, PL/I OPTIMIZER * 00260000
* MODULE SIZE = SEE LINKEDIT * 00270000
* ATTRIBUTES = REUSABLE * 00280000
* * 00290000
* ENTRY POINT = DSN8MPA * 00300000
* PURPOSE = SEE FUNCTION * 00310000
* LINKAGE = NONE * 00320000
* INPUT = * 00330000
* SYMBOLIC LABEL/NAME = NONE * 00340000
* DESCRIPTION = POINTER TO COMMAREA * 00350000
* (COMMUNICATION AREA) * 00360000
* * 00370000
* OUTPUT = * 00380000
* SYMBOLIC LABEL/NAME = NONE * 00390000
* DESCRIPTION = POINTER TO COMMAREA * 00400000
* (COMMUNICATION AREA) * 00410000
* * 00420000
* EXIT-NORMAL = * 00430000
* * 00440000
* EXIT-ERROR = IF SQLERROR OR SQLWARNING, SQL WHENEVER CONDITION * 00450000
* SPECIFIED IN DSN8IP2 WILL BE RAISED AND PROGRAM * 00460000
* WILL GO TO THE LABEL DB_ERROR. * 00470000
* * 00480000
* * 00490000
* RETURN CODE = NONE * 00500000
* * 00510000
* ABEND CODES = NONE * 00520000
* * 00530000
* ERROR MESSAGES = * 00540000
* DSN8067E - UNSUPPORTED SEARCH CRITERIA FOR OBJECT * 00550005
* DSN8069E - NO VALID SELECTIONS QUALIFY FOR THIS REQUEST * 00560000
* DSN8070E - VITAL DATA IS MISSING FROM TABLE 'TOPTVAL' * 00570000
* DSN8074E - DATA IS TOO LONG FOR SEARCH CRITERIA * 00580000
* * 00590000
* EXTERNAL REFERENCES = NONE * 00600000
* ROUTINES/SERVICES = * 00610000
* DSN8MPG - ERROR MESSAGE ROUTINE * 00620000
* * 00630000
* DATA-AREAS = NONE * 00640000
* * 00650000
* CONTROL-BLOCKS = * 00660000
* SQLCA - SQL COMMUNICATION AREA * 00670000
* * 00680000
* TABLES = NONE * 00690000
* * 00700000
* CHANGE-ACTIVITY = NONE * 00710000
* * 00720000
* * 00730000
* *PSEUDOCODE* * 00740000
* /* SECONDARY SELECTION FOR MAJSYS 'O' - OBJECTS * 00750005
* 1. DS - ADMINISTRATIVE LISTING * 00760000
* 2. DE - INDIVIDUAL DEPARTMENTS * 00770000
* 3. EM - INDIVIDUAL EMPLOYEES * 00780000
* DS AND DE USE THE SAME CURSOR WHICH SELECTS DEPARTMENTS AND * 00790000
* MANAGERS. EM USES ANOTHER CURSOR WHICH SELECTS DEPARTMENTS * 00800000
* AND EMPLOYEES. THE FIELDS SELECTED BY THE TWO DIFFERENT * 00810000
* CURSORS ARE THE SAME IN NUMBER AND HAVE MATCHING * 00820000
* CHARACTERISTICS. THEREFORE IT IS POSSIBLE TO USE THE SAME * 00830000
* CODE FOR BOTH SITUATIONS MOST OF THE TIME. * 00840000
* * 00850000
* THERE ARE TWO SITUATIONS UNDER WHICH THIS MODULE CAN BE CALLED * 00860000
* 1. THE SYSTEM FIELDS HAVE CHANGED - NEW REQUEST * 00870000
* 2. AN ANSWER TO A PREVIOUS REQUEST * 00880000
* IF COMPARM.NEWREQ='Y' THEN SYSTEM FIELDS CHANGED AND * 00890000
* THIS IS A NEW REQUEST * 00900000
* * 00910000
* THIS MODULE SHOULD SET THE FOLLOWING TWO FIELDS BEFORE EXITING * 00920000
* 1. PCONVSTA.PREV='S' (FOR NEXT TIME AROUND) * 00930000
* 2. PCONVSTA.MAXSEL= NO. OF ENTRIES ON SEC SEL SCREEN BUILT * 00940000
* * 00950000
* PROCEDURE * 00960000
* INITIALIZE TWO CONTROL FIELDS * 00970000
* * 00980000
* CASE(NEW REQUEST) * 00990000
* INITIALIZE MINIMUM VALUES * 01000000
* ASSIGN FIELD VALUES FOR 'LIKE' IN SQL SELECT * 01010000
* RETRIEVE HEADING LINE,PFK DESC,AND MESSAGE INFO * 01020000
* RETRIEVE TEXT DESCRIPTION LINES * 01030000
* ENDCASE * 01040000
* * 01050000
* ASSIGN DATA VALUE FROM SCREEN FOR 'LIKE' PROCESSING * 01060000
* * 01070000
* IF 'EM' SEARCH CRITERIA THEN * 01080000
* OPEN EMPLOYEE CURSOR ASCENDING * 01090000
* ELSE * 01100000
* OPEN ADMIN ST CURSOR ASCENDING * 01110000
* * 01120000
* SET UP 'DO LOOP' VALUES * 01130000
* * 01140000
* 'FETCH' FROM THE APPROPRIATE CURSOR UP TO MAX OF 13 TIMES * 01150000
* * 01160000
* IF NO VALID ENTRIES THEN * 01170000
* SEND MESSAGE * 01180000
* * 01190000
* SAVE MIN VALUE FOR POSSIBLE SCROLLING REQUEST * 01200000
* * 01210000
* RETURN * 01220000
* * 01230000
* END. * 01240000
*-------------------------------------------------------------------*/ 01250000
01260000
/********************************************************/ 01270000
/* ** FIELDS SENT TO MESSAGE ROUTINE */ 01280000
/********************************************************/ 01290000
01300000
DCL MODULE CHAR (07) INIT ('DSN8MPA'); 01310000
DCL OUTMSG CHAR (69); 01320000
01330000
/*****************************************************************/ 01340000
/* ** SET MODULE IDENTIFICATION FIELDS */ 01350000
/*****************************************************************/ 01360000
01370000
DSN8_MODULE_NAME.MAJOR='DSN8MPA'; /* GET MODULE NAME */ 01380000
DSN8_MODULE_NAME.MINOR=' '; 01390000
01400000
/*****************************************************************/ 01410000
/* ** SET MODULE IDENTIFICATION FIELDS */ 01420000
/*****************************************************************/ 01430000
01440000
DCL I FIXED BIN(15); 01450000
DCL LENGTH BUILTIN; 01460000
DCL LOW BUILTIN; 01470000
DCL DSN8MPG EXTERNAL ENTRY; 01480000
01490000
/*****************************************************************/ 01500000
/* ** INITIALIZE CONTROL FIELDS */ 01510000
/*****************************************************************/ 01520000
01530000
PCONVSTA.PREV='S'; /* FOR NEXT TIME AROUND */ 01540000
PCONVSTA.MAXSEL=0; /* MAX NO OF CHOICES */ 01550000
PCONVSTA.OUTPUT=' '; /* BLANKS OUT LINES */ 01560000
01570000
/****************************************************************/ 01580000
/* ** DETERMINE IF NEW REQUEST */ 01590000
/****************************************************************/ 01600000
/* IF NEW REQUEST THEN */ 01610000
/* 1. INITIALIZE MINIMUM VALUES */ 01620000
/* 2. ASSIGN FIELD VALUES FOR 'LIKE' IN SQL SELECT */ 01630000
01640000
01650000
IF COMPARM.NEWREQ='Y' THEN /* NEW REQUEST? */ 01660000
MPA000: DO; 01670000
01680000
DIMIN=LOW(3); /* INITIALIZE MINIMUM */ 01690000
EIMIN=LOW(6); /* VALUES */ 01700000
01710000
/* ASSIGN FIELD VALUES FOR*/ 01720000
/* 'LIKE' IN SQL SELECT */ 01730000
LDEPTNO ='%'; /*DEPT ID LENGTH */ 01740000
LDEPTNAM='%'; /*DEPT NAME LENGTH */ 01750000
LMGRNO ='%'; /*MANAGER ID LENGTH */ 01760000
LMGRNAME='%'; /*MANAGER NAME LENGTH */ 01770000
LEMPNO ='%'; /* EMPLOYEE ID LENGTH */ 01780000
LEMPNAME='%'; /* EMPLOYEE NAME LENGTH */ 01790000
END MPA000; 01800000
01810000
/***************************************************************/ 01820000
/* ** RETRIEVES HEADING LINE, PFKEY DESCRIPTION, MESSAGE INFO,*/ 01830000
/* ** & POINTER INTO TABLE OF DETAIL HEADING TEXT */ 01840000
/***************************************************************/ 01850000
01860000
/*RETRIEVE HEADING, PFK*/ 01870000
/*DESC, MESSAGE INFO */ 01880000
01890000
EXEC SQL SELECT HEADTXT, INFOTXT, PFKTXT, DSPINDEX 01900000
INTO :POPTVAL.HEADTXT, :POPTVAL.INFOTXT, :POPTVAL.PFKTXT, 01910000
:POPTVAL.DSPINDEX 01920000
FROM VOPTVAL 01930000
WHERE MAJSYS = :INAREA.MAJSYS AND ACTION = :INAREA.ACTION 01940000
AND OBJFLD = :INAREA.OBJFLD AND SRCHCRIT = :INAREA.SEARCH 01950003
AND SCRTYPE = 'S'; 01960000
01970000
IF SQLCODE=+100 THEN /* ERROR ? */ 01980000
DO; /* YES, MISSING INFO */ 01990000
02000000
/* TABLE ENTRY MISSING */ 02010000
/* PRINT ERROR MESSAGE */ 02020000
02030000
PCONVSTA.PREV=' '; /* NOT SEC SEL - ERROR */ 02040000
CALL DSN8MPG (MODULE, '070E', OUTMSG); 02050000
PCONVSTA.MSG= OUTMSG; 02060000
RETURN; 02070000
END; 02080000
02090000
/* OBTAIN INFORMATION */ 02100000
PCONVSTA.TITLE = POPTVAL.HEADTXT;/* OBTAIN HEADING */ 02110000
PCONVSTA.MSG = POPTVAL.INFOTXT;/* OBTAIN MESSAGE INFO. */ 02120000
PCONVSTA.PFKTEXT=POPTVAL.PFKTXT; /* OBTAIN PFKEY DESCRIPTION*/ 02130000
02140000
/*************************************************************/ 02150000
/* ** RETRIEVES TEXT DESCRIPTION LINES */ 02160000
/*************************************************************/ 02170000
02180000
/* TRY TO RETRIEVE */ 02190000
/* INFORMATION */ 02200000
EXEC SQL SELECT DSPLINE 02210000
INTO :PDSPTXT.DSPLINE 02220000
FROM VDSPTXT 02230000
WHERE DSPINDEX = :POPTVAL.DSPINDEX AND LINENO ='01'; 02240000
02250000
IF SQLCODE=+100 THEN /* ERROR ? */ 02260000
DO; /* YES */ 02270000
02280000
/* MISSING ENTRY IN TABLE */ 02290000
/* PRINT ERROR MESSAGE */ 02300000
02310000
CALL DSN8MPG (MODULE, '070E', OUTMSG); 02320000
PCONVSTA.MSG= OUTMSG; 02330000
PCONVSTA.PREV=' '; /* NOT SEC SEL - ERROR */ 02340000
RETURN; 02350000
END; 02360000
02370000
PCONVSTA.OUTPUT.LINE(1) = PDSPTXT.DSPLINE; /* RETRIEVAL */ 02380000
02390000
/**************************************************************/ 02400000
/* ** ASSIGN DATA VALUE FROM SCREEN FOR 'LIKE' PROCESSING */ 02410000
/* ** NOTE THAT ALL THE FOLLOWING SEARCH CRITERIA MAY NOT BE */ 02420000
/* ** SUPPORTED IN ALL SITUATIONS - HOWEVER SQL 1 WILL ONLY */ 02430000
/* ** PERMIT VALID ENTRIES TO BE PASSED. */ 02440000
/**************************************************************/ 02450000
02460000
DO I = LENGTH(COMPARM.DATA) TO 1 BY -1 02470000
UNTIL(SUBSTR(COMPARM.DATA,I,1)^=''); 02480000
END; 02490000
02500000
SELECT (PCONVSTA.SEARCH); 02510000
WHEN ('DI') 02520000
DO; 02530000
LDEPTNO = SUBSTR(COMPARM.DATA,1,I); /* DEPARTMENT ID */ 02540000
IF I > LENGTH(LDEPTNO) THEN GOTO MPA003; 02550000
END; 02560000
02570000
WHEN ('DN') 02580000
DO; 02590000
LDEPTNAM = SUBSTR(COMPARM.DATA,1,I); /* DEPARTMENT NAME */ 02600000
IF I > LENGTH(LDEPTNAM) THEN GOTO MPA003; 02610000
END; 02620000
02630000
WHEN ('MI') 02640000
DO; 02650000
LMGRNO = SUBSTR(COMPARM.DATA,1,I); /* MANAGER ID */ 02660000
IF I > LENGTH(LMGRNO) THEN GOTO MPA003; 02670000
END; 02680000
02690000
WHEN ('MN') 02700000
DO; 02710000
LMGRNAME = SUBSTR(COMPARM.DATA,1,I); /* MANAGER NAME */ 02720000
IF I > LENGTH(LMGRNAME) THEN GOTO MPA003; 02730000
END; 02740000
02750000
WHEN ('EI') 02760000
DO; 02770000
LEMPNO = SUBSTR(COMPARM.DATA,1,I); /* EMPLOYEE ID */ 02780000
IF I > LENGTH(LEMPNO) THEN GOTO MPA003; 02790000
END; 02800000
02810000
WHEN ('EN') 02820000
DO; 02830000
LEMPNAME = SUBSTR(COMPARM.DATA,1,I); /* EMPLOYEE NAME */ 02840000
IF I > LENGTH(LEMPNAME) THEN GOTO MPA003; 02850000
END; 02860000
02870000
OTHERWISE 02880000
/*NOT DEPARTMENT OR */ 02890000
/*EMPLOYEE OR MANAGER*/ 02900000
/*PRINT ERROR MESSAGE*/ 02910000
DO; 02920000
CALL DSN8MPG (MODULE, '067E', OUTMSG); 02930000
PCONVSTA.MSG= OUTMSG; 02940000
RETURN; 02950000
END; 02960000
02970000
END; /* OF SELECT CLAUSE */ 02980000
GO TO MPA003E; /* SKIP PAST THE ERROR CODE */ 02990000
03000000
/* DATA TOO LONG */ 03010000
MPA003: /* PRINT ERROR MESSAGE */ 03020000
DO; 03030000
CALL DSN8MPG (MODULE, '074E', OUTMSG); 03040000
PCONVSTA.MSG= OUTMSG; 03050000
PCONVSTA.PREV=' '; /* NOT SEC SEL - ERROR */ 03060000
RETURN; 03070000
END; 03080000
03090000
MPA003E: 03100000
03110000
/************************************************************/ 03120000
/* ** OPEN CURSORS AND GET THE LIST OF DEPARTMENTS OR */ 03130000
/* ** EMPLOYEES */ 03140000
/************************************************************/ 03150000
03160000
SELECT(COMPARM.OBJFLD); 03170003
03180000
WHEN('DS') EXEC SQL OPEN ALA; /*OPEN DEPARTMENT STRUCTURE */ 03190000
/*CURSOR */ 03200000
03210000
WHEN('DE') EXEC SQL OPEN DEA; /*OPEN DEPARTMENT INDIVIDUAL */ 03220000
/*CURSOR */ 03230000
03240000
WHEN('EM') EXEC SQL OPEN EMA; /*OPEN EMPLOYEE INDIVIDUAL */ 03250000
/*CURSOR */ 03260000
03270000
END; 03280000
03290000
/**************************************************************/ 03300000
/* ** FETCH FROM THE APPROPRIATE CURSOR */ 03310000
/**************************************************************/ 03320000
03330000
DO I=1 TO 13; 03340000
SELECT(COMPARM.OBJFLD); 03350003
03360000
/* DEPARTMENT STRUCTURE */ 03370000
WHEN('DS') EXEC SQL FETCH ALA 03380000
INTO :PDEPT.DEPTNO:NULL_IND1, 03390000
:PDEPT.DEPTNAME, 03400000
:PDEPT.MGRNO:NULL_IND2, 03410000
:FINITIAL:NULL_IND3, 03420000
:PEMP.MIDINIT:NULL_IND4, 03430000
:PEMP.LASTNAME:NULL_IND5; 03440000
03450000
/* INDIVIDUAL DEPARTMENT */ 03460000
WHEN('DE') EXEC SQL FETCH DEA 03470000
INTO :PDEPT.DEPTNO:NULL_IND1, 03480000
:PDEPT.DEPTNAME, 03490000
:PDEPT.MGRNO:NULL_IND2, 03500000
:FINITIAL:NULL_IND3, 03510000
:PEMP.MIDINIT:NULL_IND4, 03520000
:PEMP.LASTNAME:NULL_IND5; 03530000
03540000
/* INDIVIDUAL EMPLOYEE */ 03550000
WHEN('EM') EXEC SQL FETCH EMA 03560000
INTO :PDEPT.DEPTNO:NULL_IND1, 03570000
:PDEPT.DEPTNAME, 03580000
:PDEPT.MGRNO:NULL_IND2, 03590000
:FINITIAL:NULL_IND3, 03600000
:PEMP.MIDINIT:NULL_IND4, 03610000
:PEMP.LASTNAME:NULL_IND5; 03620000
END; 03630000
03640000
IF SQLCODE=+100 THEN GO TO MPA004; /* NO SELECTIONS QUALIFY */ 03650000
/* FOR THIS REQUEST */ 03660000
03670000
IF NULL_IND1 = -1 THEN /* CHECK FOR NULL VALUES */ 03680000
PDEPT.DEPTNO = ' '; 03690000
IF NULL_IND2 = -1 THEN 03700000
PDEPT.MGRNO = ' '; 03710000
IF NULL_IND3 = -1 THEN 03720000
FINITIAL = ' '; 03730000
IF NULL_IND4 = -1 THEN 03740000
PEMP.MIDINIT = ' '; 03750000
IF NULL_IND5 = -1 THEN 03760000
PEMP.LASTNAME = ' '; 03770000
03780000
/* GET INFORMATION */ 03790000
DSN8MP1_POS.DEPTNUM(I) = PDEPT.DEPTNO; /* DEPT ID */ 03800000
DSN8MP1_POS.DEPTNA(I) = PDEPT.DEPTNAME; /* DEPT NAME */ 03810000
DSN8MP1_POS.MGRNUM(I) = PDEPT.MGRNO; /* MANAGER ID */ 03820000
DSN8MP1_POS.MGRFIN(I) = FINITIAL; /* FIRST NAME */ 03830000
DSN8MP1_POS.MGRSIN(I) = PEMP.MIDINIT; /* MIDDLE INITIAL */ 03840000
DSN8MP1_POS.MGRLNAM(I) = PEMP.LASTNAME; /* LAST NAME */ 03850000
DSN8MP1_POS.LINENO(I) = I; /* LINE NUMBER */ 03860000
MAXSEL=MAXSEL + 1; 03870000
END; 03880000
03890000
SELECT(COMPARM.OBJFLD); 03900003
/*SAVE MINIMUM */ 03910000
/*DEPARTMENT ID*/ 03920000
WHEN('DS') DIMIN=PDEPT.DEPTNO; 03930000
WHEN('DE') DIMIN=PDEPT.DEPTNO; 03940000
/*SAVE MINIMUM */ 03950000
/*EMPLOYEE ID */ 03960000
WHEN('EM') EIMIN=PDEPT.MGRNO; 03970000
END; 03980000
03990000
/************************************************************/ 04000000
/* ** ANY SELECTIONS QUALIFY FOR THIS REQUEST? */ 04010000
/************************************************************/ 04020000
04030000
/*NO SELECTIONS QUALIFY*/ 04040000
/*FOR THIS REQUEST */ 04050000
/*PRINT ERROR MESSAGE */ 04060000
MPA004: 04070000
IF SQLCODE=+100 & MAXSEL=0 THEN /* ERROR SITUATION? */ 04080000
DO; /* YES, ISSUE MESSAGE */ 04090000
CALL DSN8MPG (MODULE, '069E', OUTMSG); 04100000
PCONVSTA.MSG = OUTMSG; 04110000
PCONVSTA.PREV=' '; /* NOT SEC SEL - ERROR */ 04120000
04130000
END; 04140000
04150000
/************************************************************/ 04160000
/* ** CLOSE CURSORS AND RETURN */ 04170000
/************************************************************/ 04180000
04190000
SELECT(COMPARM.OBJFLD); 04200003
04210000
WHEN('DS') EXEC SQL CLOSE ALA; /* CLOSE DEPARTMENT STRUCTURE */ 04220000
/* CURSOR */ 04230000
04240000
WHEN('DE') EXEC SQL CLOSE DEA; /* CLOSE INDIVIDUAL DEPARTMENT*/ 04250000
/* CURSOR */ 04260000
04270000
WHEN('EM') EXEC SQL CLOSE EMA; /* CLOSE INDIVIDUAL EMPLOYEE */ 04280000
/* CURSOR */ 04290000
04300000
END; 04310000
04320000
END DSN8MPA; /* RETURN */ 04330000