DSN8MCA
THIS MODULE PRODUCES A SECONDARY SELECTION SCREEN FOR OBJECTS IN MAJOR SYSTEM 'O' (ORGANIZATION) CALLED BY DSN8IC2 (SQL2 MAINLINE) .
* DSN8MCA - SQL 2 SECONDARY SELECTION FOR MAJOR SYSTEM O - COBOL *00010000
* 00020000
* MODULE NAME = DSN8MCA 00030000
* 00040000
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION 00050000
* SQL 2 SECONDARY SELECTION 00060000
* CICS 00070000
* COBOL 00080000
* ORGANIZATION 00090000
* 00100000
* LICENSED MATERIALS - PROPERTY OF IBM 00110000
* 5615-DB2 00120000
* (C) COPYRIGHT 1982, 2013 IBM CORP. ALL RIGHTS RESERVED. 00140000
* 00160000
* STATUS = VERSION 11 00162000
* 00164000
* 00167000
* FUNCTION = THIS MODULE PRODUCES A SECONDARY SELECTION SCREEN 00170000
* FOR OBJECTS IN MAJOR SYSTEM 'O' (ORGANIZATION) 00180004
* CALLED BY DSN8IC2 (SQL2 MAINLINE) 00190000
* 00200000
* NOTES = NONE 00210000
* 00220000
* 00230000
* MODULE TYPE = BLOCK OF COBOL CODE 00240000
* PROCESSOR = DB2 PRECOMPILER, COBOL COMPILER 00250000
* MODULE SIZE = SEE LINKEDIT 00260000
* ATTRIBUTES = REUSABLE 00270000
* 00280000
* ENTRY POINT = DSN8MCA 00290000
* PURPOSE = SEE FUNCTION 00300000
* LINKAGE = NONE 00310000
* INPUT = 00320000
* SYMBOLIC LABEL/NAME = COMMPTR 00330000
* DESCRIPTION = POINTER TO COMMAREA 00340000
* (COMMUNICATION AREA) 00350000
* 00360000
* OUTPUT = 00370000
* SYMBOLIC LABEL/NAME = COMMPTR 00380000
* DESCRIPTION = POINTER TO COMMAREA 00390000
* (COMMUNICATION AREA) 00400000
* 00410000
* EXIT-NORMAL = END OF CODE BLOCK 00420000
* 00430000
* EXIT-ERROR = IF SQL ERROR OR SQL WARNING, 00440000
* SQL WHENEVER CONDITION 00450000
* SPECIFIED IN DSN8IC2 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 00550004
* DSN8069E - NO VALID SELECTIONS QUALIFY FOR THIS REQUEST 00560000
* DSN8074E - DATA IS TOO LONG FOR SEARCH CRITERIA 00570000
* 00580000
* EXTERNAL REFERENCES = 00590000
* ROUTINES/SERVICES = 00600000
* DSN8MCG - ERROR MESSAGE ROUTINE 00610000
* 00620000
* DATA-AREAS = 00630000
* COMMAREA - PGM COMMUNICATION AREA 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 00750003
* 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 INFO MESSAGE 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
DSN8MCA. 01270000
01280000
MOVE 'DSN8MCA' TO MAJOR. 01290000
MOVE SPACES TO MINOR. 01300000
01310000
***************************************************************** 01320000
* **INITIALIZE CONTROL FIELDS 01330000
***************************************************************** 01340000
MOVE 'S' TO PREV OF LASTPOS. 01350000
MOVE 0 TO MAXSEL OF LASTPOS. 01360000
MOVE 0 TO I. 01370000
01380000
* **BLANK OUT LINE 01390000
MCA010. 01400000
ADD 1 TO I. 01410000
MOVE SPACES TO LINE0(I). 01420000
01430000
* **MCA010 LOOP 01440000
MCA-LOOP10. 01450000
PERFORM MCA010 01460000
UNTIL I > 14. 01470000
01480000
***************************************************************** 01490000
* **DETERMINE IF NEW REQUEST 01500000
***************************************************************** 01510000
01520000
* **NEW REQUEST 01530000
IF NEWREQ OF COMPARM = 'Y' THEN 01540000
* ** INITIALIZE MINIMUM 01550000
* ** VALUES 01560000
MOVE LOW-VALUES TO DIMIN, EIMIN 01570000
* ** ASSIGN FIELD VALUES 01580000
* ** FOR LIKE SQL SELECT 01590000
MOVE 1 TO LDEPTNOL, LDEPTNAML, LMGRNOL, LMGRNAMEL, 01600000
LEMPNOL, LEMPNAMEL 01610000
MOVE PERCENT TO LDEPTNOD, LDEPTNAMD, LMGRNOD, LMGRNAMED, 01620000
LEMPNOD, LEMPNAMED. 01630000
01640000
***************************************************************** 01650000
* **RETRIEVES HEADING LINE, PFKEY DESCRIPTION, INFO MESSAGE, 01660000
* **& POINTER INTO TABLE OF DETAIL HEADING TEXT 01670000
***************************************************************** 01680000
MCA020. 01690000
* **RETRIEVE INFORMATION 01700000
EXEC SQL SELECT HEADTXT, INFOTXT, PFKTXT, DSPINDEX 01710000
INTO :POPTVAL.HEADTXT, :POPTVAL.INFOTXT, 01720000
:POPTVAL.PFKTXT, :POPTVAL.DSPINDEX 01730000
FROM VOPTVAL 01740000
WHERE MAJSYS = :INAREA.MAJSYS 01750000
AND ACTION = :INAREA.ACTION 01760000
AND OBJFLD = :INAREA.OBJFLD 01770003
AND SRCHCRIT = :INAREA.SRCH 01780000
AND SCRTYPE = 'S' 01790000
01800000
* **ERROR? 01810000
END-EXEC. 01820000
IF SQLCODE = +100 THEN 01830000
MOVE ' ' TO PREV OF LASTPOS 01840000
MOVE OPTNF TO MSG OF OUTAREA 01850000
STRING MAJSYS OF INAREA SPACE, ACTION OF INAREA SPACE, 01860000
OBJFLD OF INAREA SPACE, SRCH OF INAREA SPACE, 01870003
'S' DELIMITED BY SIZE 01880000
INTO MSGMOD2 01890000
GO TO END-DSN8MCA. 01900000
01910000
* **OBTAIN INFORMATION 01920000
MOVE HEADTXT OF POPTVAL TO HTITLE. 01930000
MOVE INFOTXT OF POPTVAL TO MSG OF OUTAREA. 01940000
MOVE PFKTXT OF POPTVAL TO PFKTEXT OF OUTAREA. 01950000
01960000
***************************************************************** 01970000
* **RETRIEVES TEXT DESCRIPTION LINES 01980000
***************************************************************** 01990000
* **TRY TO 02000000
* **RETRIEVE INFORMATION 02010000
EXEC SQL SELECT DSPLINE 02020000
INTO :PDSPTXT.DSPLINE 02030000
FROM VDSPTXT 02040000
WHERE DSPINDEX = :POPTVAL.DSPINDEX 02050000
AND LINENO ='01' 02060000
END-EXEC. 02070000
02080000
* **ERROR? 02090000
IF SQLCODE = +100 THEN 02100000
MOVE ' ' TO PREV OF LASTPOS 02110000
MOVE DSPNF TO MSG OF OUTAREA 02120000
STRING 'INDX ', DSPINDEX OF POPTVAL, ' L01', 02130000
DELIMITED BY SIZE 02140000
INTO MSGMOD2 02150000
GO TO END-DSN8MCA. 02160000
02170000
* **OBTAIN INFORMATION 02180000
MOVE DSPLINE TO LINE0(1). 02190000
02200000
******************************************************************02210000
* ** ASSIGN DATA VALUE FROM SCREEN FOR 'LIKE' PROCESSING 02220000
* **NOTE THAT ALL THE FOLLOWING SEARCH CRITERIA MAY NOT BE 02230000
* **SUPPORTED IN ALL SITUATIONS - HOWEVER SQL 1 WILL ONLY 02240000
* **PERMIT VALID ENTRIES TO BE PASSED. 02250000
******************************************************************02260000
02270000
MOVE 60 TO I. 02280000
* **SKIPS END BLANKS 02290000
MCA022. 02300000
IF DATAIN1(I) = SPACE THEN 02310000
SUBTRACT 1 FROM I 02320000
IF I > 0 THEN 02330000
GO TO MCA022. 02340000
02350000
MCA024. 02360000
IF SRCH OF INAREA = 'DI' THEN 02370000
* **DEPARTMENT ID 02380000
MOVE I TO LDEPTNOL 02390000
MOVE DATAIN TO LDEPTNOD 02400000
IF I > 3 THEN GO TO MCA025 02410000
ELSE GO TO MCA001. 02420000
IF SRCH OF INAREA = 'DN' THEN 02430000
* **DEPARTMENT NAME 02440000
MOVE I TO LDEPTNAML 02450000
MOVE DATAIN TO LDEPTNAMD 02460000
IF I > 36 THEN GO TO MCA025 02470000
ELSE GO TO MCA001. 02480000
IF SRCH OF INAREA = 'MI' THEN 02490000
* **MANAGER ID 02500000
MOVE I TO LMGRNOL 02510000
MOVE DATAIN TO LMGRNOD 02520000
IF I > 6 THEN GO TO MCA025 02530000
ELSE GO TO MCA001. 02540000
IF SRCH OF INAREA = 'MN' THEN 02550000
* **MANAGER NAME 02560000
MOVE I TO LMGRNAMEL 02570000
MOVE DATAIN TO LMGRNAMED 02580000
IF I > 15 THEN GO TO MCA025 02590000
ELSE GO TO MCA001. 02600000
IF SRCH OF INAREA = 'EI' THEN 02610000
* **EMPLOYEE ID 02620000
MOVE I TO LEMPNOL 02630000
MOVE DATAIN TO LEMPNOD 02640000
IF I > 6 THEN GO TO MCA025 02650000
ELSE GO TO MCA001. 02660000
IF SRCH OF INAREA = 'EN' THEN 02670000
* **EMPLOYEE NAME 02680000
MOVE I TO LEMPNAMEL 02690000
MOVE DATAIN TO LEMPNAMED 02700000
IF I > 15 THEN GO TO MCA025 02710000
ELSE GO TO MCA001. 02720000
02730000
* **UNSUPPORTED SEARCH 02740000
* **CRITERIA FOR OBJFLD 02750003
* **PRINT ERROR MESSAGE 02760000
MOVE '067E' TO MSGCODE. 02770000
CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG. 02780000
MOVE OUTMSG TO MSGTEXT OF MSG. 02790000
GO TO END-DSN8MCA. 02800000
02810000
* **DATA TOO LONG 02820000
* **PRINT ERROR MESSAGE 02830000
MCA025. 02840000
MOVE '074E' TO MSGCODE. 02850000
CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG. 02860000
MOVE OUTMSG TO MSGTEXT OF MSG. 02870000
MOVE ' ' TO PREV OF LASTPOS. 02880000
GO TO END-DSN8MCA. 02890000
02900000
******************************************************************02910000
* ** OPEN CURSORS 02920000
******************************************************************02930000
MCA001. 02940000
* **OPEN EMPLOYEE 02950000
* **CURSOR 02960000
IF OBJFLD OF INAREA = 'EM' THEN 02970003
EXEC SQL OPEN EMA END-EXEC 02980000
* **OPEN DEPARTMENT 02990000
* **CURSOR 03000000
ELSE 03010000
IF OBJFLD OF INAREA = 'DE' THEN 03020003
EXEC SQL OPEN DEA END-EXEC 03030000
* **OPEN ALA 03040000
* **CURSOR 03050000
ELSE 03060000
EXEC SQL OPEN ALA END-EXEC. 03070000
03080000
MCA030. 03090000
MOVE 1 TO I. 03100000
03110000
******************************************************************03120000
* ** FETCH FROM THE APPROPRIATE CURSOR 03130000
******************************************************************03140000
MCA031. 03150000
* **EMPLOYEE 03160000
IF OBJFLD OF INAREA = 'EM' THEN 03170003
MOVE SPACES TO DEPTNAME-TEXT IN PDEPT, 03180000
FIRSTNME-TEXT IN PEMP, 03190000
LASTNAME-TEXT IN PEMP 03200000
EXEC SQL FETCH EMA 03210000
INTO :PDEPT.DEPTNO:NULLIND1, 03220000
:PDEPT.DEPTNAME, 03230000
:PDEPT.MGRNO:NULLIND2, 03240000
:FINITIAL:NULLIND3, 03250000
:PEMP.MIDINIT:NULLIND4, 03260000
:PEMP.LASTNAME:NULLIND5 03270000
END-EXEC 03280000
03290000
* **DEPARTMENT 03300000
ELSE 03310000
IF OBJFLD OF INAREA = 'DE' THEN 03320003
MOVE SPACES TO DEPTNAME-TEXT IN PDEPT, 03330000
FIRSTNME-TEXT IN PEMP, 03340000
LASTNAME-TEXT IN PEMP 03350000
EXEC SQL FETCH DEA 03360000
INTO :PDEPT.DEPTNO:NULLIND1, 03370000
:PDEPT.DEPTNAME, 03380000
:PDEPT.MGRNO:NULLIND2, 03390000
:FINITIAL:NULLIND3, 03400000
:PEMP.MIDINIT:NULLIND4, 03410000
:PEMP.LASTNAME:NULLIND5 03420000
END-EXEC 03430000
03440000
* **NOT DEPARTMENT 03450000
* **OR EMPLOYEE 03460000
ELSE 03470000
MOVE SPACES TO DEPTNAME-TEXT IN PDEPT, 03480000
FIRSTNME-TEXT IN PEMP, 03490000
LASTNAME-TEXT IN PEMP 03500000
EXEC SQL FETCH ALA 03510000
INTO :PDEPT.DEPTNO:NULLIND1, 03520000
:PDEPT.DEPTNAME, 03530000
:PDEPT.MGRNO:NULLIND2, 03540000
:FINITIAL:NULLIND3, 03550000
:PEMP.MIDINIT:NULLIND4, 03560000
:PEMP.LASTNAME:NULLIND5 03570000
END-EXEC. 03580000
03590000
* ** GET INFORMATION 03600000
MCA032. 03610000
IF SQLCODE = +100 THEN GO TO MCA004. 03620000
03630000
* ** CHECK FOR NULL 03640000
IF NULLIND1 = -1 THEN 03650000
MOVE ' ' TO DEPTNO OF PDEPT. 03660000
IF NULLIND2 = -1 THEN 03670000
MOVE ' ' TO MGRNO OF PDEPT. 03680000
IF NULLIND3 = -1 THEN 03690000
MOVE ' ' TO FINITIAL. 03700000
IF NULLIND4 = -1 THEN 03710000
MOVE ' ' TO MIDINIT OF PEMP. 03720000
IF NULLIND5 = -1 THEN 03730000
MOVE ' ' TO LASTNAME OF PEMP. 03740000
03750000
MOVE DEPTNO OF PDEPT TO DEPTNUM OF BGMC1(I). 03760000
MOVE DEPTNAME-TEXT OF PDEPT TO DEPTNA OF BGMC1(I). 03770000
MOVE MGRNO OF PDEPT TO MGRNUM OF BGMC1(I). 03780000
MOVE FINITIAL TO MGRFIN OF BGMC1(I). 03790000
MOVE MIDINIT OF PEMP TO MGRSIN OF BGMC1(I). 03800000
MOVE LASTNAME-TEXT OF PEMP TO MGRLNAM OF BGMC1(I). 03810000
MOVE I TO LINENO OF BGMC1(I). 03820000
ADD 1 TO MAXSEL. 03830000
ADD 1 TO I. 03840000
IF I NOT = 13 THEN 03850000
GO TO MCA031. 03860000
03870000
* **SAVE MINIMUM 03880000
* **EMPLOYEE NO. 03890000
IF OBJFLD OF INAREA = 'EM' THEN 03900003
MOVE MGRNO OF PDEPT TO EIMIN 03910000
ELSE 03920000
* **SAVE MINIMUM 03930000
* **DEPARTMENT NO. 03940000
MOVE DEPTNO OF PDEPT TO DIMIN. 03950000
03960000
MCA004. 03970000
03980000
* **NO SELECTIONS QUALIFY 03990000
* **FOR THIS REQUEST 04000000
* **PRINT ERROR MESSAGE 04010000
04020000
IF SQLCODE NOT = +100 OR MAXSEL > 0 THEN GO TO MCA090. 04030000
MOVE '069E' TO MSGCODE. 04040000
CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG. 04050000
MOVE OUTMSG TO MSGTEXT OF OUTAREA. 04060000
MOVE ' ' TO PREV OF LASTPOS. 04070000
04080000
04090000
***************************************************************** 04100000
* **CLOSE CURSORS AND RETURN 04110000
***************************************************************** 04120000
MCA090. 04130000
* **CLOSE EMPLOYEE 04140000
* **CURSOR 04150000
IF OBJFLD OF INAREA = 'EM' THEN 04160003
EXEC SQL CLOSE EMA END-EXEC 04170000
* **CLOSE DEPARTMENT 04180000
* **CURSOR 04190000
ELSE 04200000
IF OBJFLD OF INAREA = 'DE' THEN 04210003
EXEC SQL CLOSE DEA END-EXEC 04220000
* **CLOSE ALA 04230000
* **CURSOR 04240000
ELSE 04250000
EXEC SQL CLOSE ALA END-EXEC. 04260000
04270000
* **RETURN 04280000
END-DSN8MCA. 04290000