DSN8IC2
ROUTER FOR SECONDARY SELECTION AND/OR DETAIL PROCESSING CALLS SECONDARY SELECTION MODULES DSN8MCA DSN8MCM CALLS DETAIL MODULES DSN8MCD DSN8MCE DSN8MCF DSN8MCT DSN8MCV DSN8MCW DSN8MCX DSN8MCZ CALLED BY DSN8IC1 (SQL1) .
IDENTIFICATION DIVISION. 00010000
*----------------------- 00020000
PROGRAM-ID. DSN8IC2. 00030000
00040000
******* DSN8IC2 - SQL 2 COMMON MODULE FOR IMS - COBOL ****** 00050000
* 00060000
* MODULE NAME = DSN8IC2 00070000
* 00080000
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION 00090000
* SQL 2 COMMON MODULE 00100000
* IMS 00110000
* COBOL 00120000
* 00130000
* LICENSED MATERIALS - PROPERTY OF IBM 00132000
* 5615-DB2 00134000
* (C) COPYRIGHT 1995, 2013 IBM CORP. ALL RIGHTS RESERVED 00137000
* 00140000
* STATUS = VERSION 11 00150000
* 00200000
* 00203000
* 00206000
* FUNCTION = ROUTER FOR SECONDARY SELECTION AND/OR 00210000
* DETAIL PROCESSING 00220000
* CALLS SECONDARY SELECTION MODULES 00230000
* DSN8MCA DSN8MCM 00240000
* CALLS DETAIL MODULES 00250000
* DSN8MCD DSN8MCE DSN8MCF 00260000
* DSN8MCT DSN8MCV DSN8MCW DSN8MCX DSN8MCZ 00270000
* CALLED BY DSN8IC1 (SQL1) 00280000
* 00290000
* NOTES = NONE 00300000
* 00310000
* 00320000
* MODULE TYPE = 00330000
* PROCESSOR = DB2 PRECOMPILER, COBOL COMPILER 00340000
* MODULE SIZE = SEE LINKEDIT 00350000
* ATTRIBUTES = REUSABLE 00360000
* 00370000
* ENTRY POINT = DSN8IC2 00380000
* PURPOSE = SEE FUNCTION 00390000
* LINKAGE = NONE 00400000
* INPUT = POINTER TO COMMAREA (COMMUNICATION AREA) 00410000
* 00420000
* SYMBOLIC LABEL/NAME = COMMAREA 00430000
* DESCRIPTION = COMMUNICATION AREA PASSED BETWEEN 00440000
* MODULES 00450000
* 00460000
* OUTPUT = POINTER TO COMMAREA (COMMUNICATION AREA) 00470000
* 00480000
* SYMBOLIC LABEL/NAME = COMMAREA 00490000
* DESCRIPTION = COMMUNICATION AREA PASSED BETWEEN 00500000
* MODULES 00510000
* 00520000
* EXIT-NORMAL = 00530000
* 00540000
* EXIT-ERROR = IF SQLERROR OR SQLWARNING, SQL WHENEVER 00550000
* CONDITION SPECIFIED IN DSN8IC2 WILL BE RAISED 00560000
* AND PROGRAM WILL GO TO THE LABEL DB-ERROR. 00570000
* 00580000
* 00590000
* RETURN CODE = NONE 00600000
* 00610000
* ABEND CODES = NONE 00620000
* 00630000
* ERROR-MESSAGES = 00640000
* DSN8062E-AN OBJECT WAS NOT SELECTED 00650000
* DSN8066E-UNSUPPORTED PFK OR LOGIC ERROR 00660000
* DSN8072E-INVALID SELECTION ON SECONDARY SCREEN 00670000
* 00680000
* 00690000
* EXTERNAL REFERENCES = 00700000
* ROUTINES/SERVICES = 10 MODULES LISTED ABOVE 00710000
* DSN8MCG - ERROR MESSAGE ROUTINE 00720000
* 00730000
* DATA-AREAS = 00740000
* DSN8MCA - SECONDARY SELECTION FOR 00750000
* DSN8MCD - DEPARTMENT STRUCTURE DETAIL 00760000
* DSN8MCE - DEPARTMENT DETAIL 00770000
* DSN8MCF - EMPLOYEE DETAIL 00780000
* ORGANIZATION 00790000
* DSN8MCAD - DECLARE ADMINISTRATION DETAIL 00800000
* DSN8MCAE - CURSOR EMPLOYEE LIST 00810000
* DSN8MCAL - CURSOR ADMINISTRATION LIST 00820000
* DSN8MCA2 - DECLARE ADMINISTRATION DETAIL 00830000
* DSN8MCC2 - SQL COMMON AREA PART 2 00840000
* DSN8MCDA - CURSOR ADMINISTRATION DETAIL 00850000
* DSN8MCDH - CURSOR FOR DISPLAY TEXT FROM 00860000
* TDSPTXT TABLE 00870000
* DSN8MCDP - DECLARE DEPARTMENT 00880000
* DSN8MCEM - DECLARE EMPLOYEE 00890000
* DSN8MCED - DECLARE EMPLOYEE-DEPARTMENT 00900000
* DSN8MCDM - DECLARE DEPARTMENT MANAGER 00910000
* DSN8MCAD - DECLARE ADMINISTRATION DETAIL 00920000
* DSN8MCA2 - DECLARE ADMINISTRATION DETAIL 00930000
* DSN8MCOV - DECLARE OPTION VALIDATION 00940000
* DSN8MCDT - DECLARE DISPLAY TEXT 00950000
* DSN8MCCA - SQL COMMON AREA 00960000
* DSN8MCXX - ERROR HANDLER 00970000
* 00980000
* CONTROL-BLOCKS = 00990000
* SQLCA - SQL COMMUNICATION AREA 01000000
* 01010000
* TABLES = NONE 01020000
* 01030000
* CHANGE-ACTIVITY = 01040000
* - ADD NEW VARIABLES FOR REFERENTIAL INTEGRITY V2R1 01050000
* 01060000
* *PSEUDOCODE* 01070000
* 01080000
* THIS MODULE DETERMINES WHICH SECONDARY SELECTION AND/OR 01090000
* DETAIL MODULE(S) ARE TO BE CALLED FOR THE IMS/COBOL ENVIRONMENT 01100000
* 01110000
* WHAT HAS HAPPENED SO FAR?.............. THE SUBSYSTEM 01120000
* DEPENDENT MODULE (IMS,CICS) (SQL 0) HAS READ THE 01130000
* INPUT SCREEN, FORMATTED THE INPUT, AND PASSED CONTROL 01140000
* TO SQL 1. SQL 1 PERFORMS VALIDATION ON THE SYSTEM DEPENDENT 01150000
* FIELDS (MAJOR SYSTEM, ACTION, OBJECT, SEARCH CRITERIA). IF 01160000
* ALL SYSTEM FIELDS ARE VALID, SQL 1 PASSED CONTROL TO THIS 01170000
* MODULE. PASSED PARAMETERS CONSIST ONLY OF A POINTER WHICH 01180000
* POINTS TO A COMMUNICATION CONTROL AREA USED TO COMMUNICATE 01190000
* BETWEEN SQL 0 , SQL 1, SQL 2, AND THE SECONDARY SELECTION 01200000
* AND DETAIL MODULES. 01210000
* 01220000
* WHAT IS INCLUDED IN THIS MODULE?............ 01230000
* ALL SECONDARY SELECTION AND DETAIL MODULES ARE 'INCLUDED'. 01240000
* ALL VARIABLES KNOWN IN THIS PROCEDURE ARE KNOWN IN THE 01250000
* SUB PROCEDURES. ALL SQL CURSOR DEFINITIONS AND 01260000
* SQL 'INCLUDES' ARE DONE IN THIS PROCEDURE. ALL CURSOR HOST 01270000
* VARIABLES ARE DECLARED IN THIS PROCEDURE BECAUSE OF THE 01280000
* RESTRICTION THAT CURSOR HOST VARIABLES MUST BE DECLARED BEFORE 01290000
* THE CURSOR DEFINITION. 01300000
* 01310000
* PROCEDURE 01320000
* IF ANSWER TO DETAIL SCREEN & DETAIL PROCESSOR 01330000
* IS NOT WILLING TO ACCEPT AN ANSWER THEN 01340000
* NEW REQUEST* 01350000
* 01360000
* ELSE 01370000
* IF ANSWER TO A SECONDARY SELECTION THEN 01380000
* DETERMINE IF NEW REQUEST. 01390000
* 01400000
* CASE (NEW REQUEST) 01410000
* 01420000
* SUBCASE ('ADD') 01430000
* DETAIL PROCESSOR 01440000
* RETURN TO SQL 1 01450000
* ENDSUB 01460000
* 01470000
* SUBCASE ('DISPLAY','ERASE','UPDATE') 01480000
* CALL SECONDARY SELECTION 01490000
* IF # OF POSSIBLE CHOICES IS ^= 1 THEN 01500000
* RETURN TO SQL 1 01510000
* ELSE 01520000
* CALL THE DETAIL PROCESSOR 01530000
* RETURN TO SQL 1. 01540000
* ENDSUB 01550000
* 01560000
* ENDCASE 01570000
* 01580000
* IF ANSWER TO SECONDARY SELECTION AND A SELECTION HAS 01590000
* ACTUALLY BEEN MADE THEN 01600000
* VALID SELECTION #? 01610000
* IF IT IS VALID THEN 01620000
* CALL DETAIL PROCESSOR 01630000
* RETURN TO SQL 1 01640000
* ELSE 01650000
* PRINT ERROR MSG 01660000
* RETURN TO SQL 1. 01670000
* 01680000
* IF ANSWER TO SECONDARY SELECTION THEN 01690000
* CALL SECONDARY SELECTION 01700000
* RETURN TO SQL 1. 01710000
* 01720000
* IF ANSWER TO DETAIL THEN 01730000
* CALL DETAIL PROCESSOR 01740000
* RETURN TO SQL 1. 01750000
* 01760000
* END. 01770000
* 01780000
* *EXAMPLE- A ROW IS SUCCESSFULLY ADDED, THE OPERATOR RECEIVES 01790000
* THE SUCCESSFULLY ADDED MESSAGE AND JUST HITS ENTER. 01800000
*----------------------------------------------------------- 01810000
/ 01820000
01830000
ENVIRONMENT DIVISION. 01840000
*-------------------------- 01850000
01860000
DATA DIVISION. 01870000
*------------------- 01880000
WORKING-STORAGE SECTION. 01890000
01900000
******************************************************* 01910000
* FIELD SENT TO MESSAGE ROUTINE 01920000
******************************************************* 01930000
01 MSGCODE PIC X(04). 01940000
01 OUTMSG PIC X(69). 01950000
01960000
*************************************** 01970000
* NULL INDICATOR * 01980000
*************************************** 01990000
01 NULLIND1 PIC S9(4) COMP-4. 02000000
01 NULLIND2 PIC S9(4) COMP-4. 02010000
01 NULLIND3 PIC S9(4) COMP-4. 02020000
01 NULLIND4 PIC S9(4) COMP-4. 02030000
01 NULLIND5 PIC S9(4) COMP-4. 02040000
01 NULLARRY. 02050000
03 NULLARRY1 PIC S9(4) USAGE COMP OCCURS 13 TIMES. 02060000
02070000
EXEC SQL INCLUDE SQLCA END-EXEC. 02080000
02090000
EXEC SQL INCLUDE DSN8MCC2 END-EXEC. 02100000
EXEC SQL INCLUDE DSN8MCDP END-EXEC. 02110000
EXEC SQL INCLUDE DSN8MCEM END-EXEC. 02120000
EXEC SQL INCLUDE DSN8MCDM END-EXEC. 02130000
EXEC SQL INCLUDE DSN8MCAD END-EXEC. 02140000
EXEC SQL INCLUDE DSN8MCA2 END-EXEC. 02150000
EXEC SQL INCLUDE DSN8MCOV END-EXEC. 02160000
EXEC SQL INCLUDE DSN8MCDT END-EXEC. 02170000
EXEC SQL INCLUDE DSN8MCED END-EXEC. 02180000
02190000
01 CONSTRAINTS. 02200000
03 PARM-LENGTH PIC S9(4) COMP-4. 02210000
03 REF-CONSTRAINT PIC X(08). 02220000
03 FILLER PIC X(62). 02230000
01 MGRNO-CONSTRAINT PIC X(08) VALUE 'RDE '. 02240000
02250000
LINKAGE SECTION. 02260000
01 COMMAREA. 02270000
EXEC SQL INCLUDE DSN8MCCA END-EXEC. 02280000
02290000
PROCEDURE DIVISION USING COMMAREA. 02300000
*------------------ 02310000
******************************************************* 02320000
* SQL ERROR CODE HANDLING 02330000
******************************************************* 02340000
EXEC SQL WHENEVER SQLERROR GO TO DB-ERROR END-EXEC 02350000
EXEC SQL WHENEVER SQLWARNING GO TO DB-ERROR END-EXEC. 02360000
02370000
EXEC SQL INCLUDE DSN8MCAE END-EXEC. 02380000
EXEC SQL INCLUDE DSN8MCAL END-EXEC. 02390000
EXEC SQL INCLUDE DSN8MCDH END-EXEC. 02400000
EXEC SQL INCLUDE DSN8MCDA END-EXEC. 02410000
02420000
******************************************************* 02430000
* INITIALIZATIONS 02440000
******************************************************* 02450000
02460000
MOVE 'DSN8IC2' TO MAJOR. 02470000
MOVE SPACES TO MINOR. 02480000
02490000
02500000
IF NEWREQ OF COMPARM = 'Y' THEN GO TO IC2008. 02510000
02520000
******************************************************* 02530000
* DETERMINES WHETHER NEW REQUEST OR NOT 02540000
******************************************************* 02550000
IC2005. 02560000
IF PREV OF PCONVSTA = ' ' THEN 02570000
MOVE 'Y' TO NEWREQ OF COMPARM. 02580000
02590000
IF NEWREQ OF COMPARM = 'N' AND PREV OF PCONVSTA = 'S' 02600000
AND DATA01 NOT = ' ' 02610000
AND DATAIN NOT = 'NEXT' 02620000
THEN MOVE 'Y' TO NEWREQ OF COMPARM. 02630000
02640000
IF NEWREQ OF COMPARM NOT = 'Y' THEN GO TO IC2010. 02650000
******************************************************* 02660000
* IF NEW REQUEST AND ACTION IS 'ADD' THEN 02670000
* CALL DETAIL PROCESSOR 02680000
* ELSE CALL SECONDARY SELECTION 02690000
******************************************************* 02700000
IC2008. 02710000
IF ACTION OF INAREA = 'A' THEN 02720000
* **DETAIL PROCESSOR 02730000
GO TO DETAIL0. 02740000
* **SECONDARY SELECTION 02750000
PERFORM SECSEL THRU END-SECSEL. 02760000
* **IF NO. OF CHOICES = 1 02770000
* **GO TO DETAIL PROCESSOR 02780000
IF MAXSEL = 1 THEN GO TO DETAIL0. 02790000
GO TO EXIT0. 02800000
******************************************************* 02810000
* DETERMINE IF VALID SELECTION NUMBER GIVEN 02820000
******************************************************* 02830000
IC2010. 02840000
* **VALID SELECTION NO. GIVEN 02850000
IF PREV OF PCONVSTA NOT = 'S' 02860000
OR MAXSEL < 1 02870000
OR DATAIN = 'NEXT' 02880000
OR DATA2 = DATO2 THEN GO TO IC201. 02890000
* 02900000
IF DAT1 NUMERIC AND DAT2 = ' ' THEN 02910000
MOVE DAT1 TO DAT2 02920000
MOVE '0' TO DAT1. 02930000
02940000
* **DETAIL SELECTION GIVEN 02950000
IF DATA2 NUMERIC 02960000
AND DATA2 > '00' AND DATA2 NOT > MAXSEL THEN 02970000
MOVE 'Y' TO NEWREQ OF COMPARM 02980000
GO TO DETAIL0. 02990000
03000000
* **INVALID SELECTION NO. 03010000
* **PRINT ERROR MESSAGE 03020000
MOVE '072E' TO MSGCODE. 03030000
CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG. 03040000
MOVE OUTMSG TO MSG OF OUTAREA. 03050000
GO TO EXIT0. 03060000
03070000
******************************************************* 03080000
* DETERMINES WHETHER SECONDARY SELECTION OR DETAIL 03090000
******************************************************* 03100000
IC201. 03110000
* **SECONDARY SELECTION 03120000
IF PREV OF PCONVSTA = 'S' THEN 03130000
PERFORM SECSEL THRU END-SECSEL 03140000
GO TO EXIT0. 03150000
03160000
* **DETAIL PROCESSOR 03170000
IF PREV OF PCONVSTA = 'D' THEN GO TO DETAIL0. 03180000
03190000
* **LOGIC ERROR 03200000
* **PRINT ERROR MESSAGE 03210000
MOVE '066E' TO MSGCODE. 03220000
CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG. 03230000
MOVE OUTMSG TO MSG OF OUTAREA. 03240000
GO TO EXIT0. 03250000
03260000
*********************************************************** 03270000
* CALLS SECONDARY SELECTION PROCESSOR AND RETURNS TO SQL 1 03280000
*********************************************************** 03290000
SECSEL. 03300000
MOVE 'DSN8001 ' TO LASTSCR IN PCONVSTA. 03310000
IF OBJFLD OF INAREA = 'DS' THEN 03320001
* **ADMINISTRATIVE 03330000
* **DEPARTMENT STRUCTURE 03340000
PERFORM DSN8MCA THRU END-DSN8MCA 03350000
ELSE 03360000
IF OBJFLD OF INAREA = 'DE' THEN 03370001
* **INDIVIDUAL DEPARTMENT 03380000
* **PROCESSING 03390000
PERFORM DSN8MCA THRU END-DSN8MCA 03400000
ELSE 03410000
IF OBJFLD OF INAREA = 'EM' THEN 03420001
* **INDIVIDUAL EMPLOYEE 03430000
* **PROCESSING 03440000
PERFORM DSN8MCA THRU END-DSN8MCA 03450000
ELSE 03460000
* **ERROR MESSAGE 03470000
* **UNSUPPORTED SEARCH 03480000
* **CRITERIA FOR OBJECT 03490000
MOVE '062E' TO MSGCODE 03500000
CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG 03510000
MOVE OUTMSG TO MSG OF OUTAREA 03520000
GO TO EXIT0. 03530000
END-SECSEL. 03540000
03550000
******************************************************* 03560000
* CALLS DETAIL PROCESSOR AND RETURNS TO SQL 1 03570000
******************************************************* 03580000
DETAIL0. 03590000
MOVE 'DSN8002 ' TO LASTSCR IN PCONVSTA. 03600000
03610000
IF OBJFLD OF INAREA = 'DS' THEN 03620001
* **ADMINISTRATIVE 03630000
* **DEPARTMENT STRUCTURE 03640000
PERFORM DSN8MCD THRU END-DSN8MCD 03650000
ELSE 03660000
IF OBJFLD OF INAREA = 'DE' THEN 03670001
* **INDIVIDUAL DEPARTMENT 03680000
* **PROCESSING 03690000
PERFORM DSN8MCE THRU END-DSN8MCE 03700000
ELSE 03710000
IF OBJFLD OF INAREA = 'EM' THEN 03720001
* **INDIVIDUAL EMPLOYEE 03730000
* **PROCESSING 03740000
PERFORM DSN8MCF THRU END-DSN8MCF 03750000
ELSE 03760000
* **ERROR MESSAGE 03770000
* **UNSUPPORTED SEARCH 03780000
* **CRITERIA FOR OBJECT 03790000
MOVE '062E' TO MSGCODE 03800000
CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG 03810000
MOVE OUTMSG TO MSG OF OUTAREA. 03820000
GO TO EXIT0. 03830000
* **HANDLES ERRORS 03840000
* **RETURN TO SQL 1 03850000
EXEC SQL INCLUDE DSN8MCXX END-EXEC. 03860000
EXIT0. GOBACK. 03870000
03880000
EXEC SQL INCLUDE DSN8MCA END-EXEC. 03890000
EXEC SQL INCLUDE DSN8MCD END-EXEC. 03900000
EXEC SQL INCLUDE DSN8MCE END-EXEC. 03910000
EXEC SQL INCLUDE DSN8MCF END-EXEC. 03920000
03930000