DSN8CP2
2 次選択処理または詳細処理 (あるいはその両方) のための経路指定機能。2 次選択モジュール DSN8MPA DSN8MPM を呼び出し、詳細モジュール DSN8MPD DSN8MPE DSN8MPF DSN8MPT DSN8MPV DSN8MPW DSN8MPX DSN8MPZ を呼び出し、DSN8MP1 (SQL1) から呼び出されます。
DSN8CP2: PROC(COMMPTR) OPTIONS(MAIN); /* SQL 2 FOR CICS AND PLI */ 00010000
%PAGE; 00020000
/********************************************************************* 00030000
* * 00040000
* MODULE NAME = DSN8CP2 * 00050000
* * 00060000
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION * 00070000
* SQL 2 COMMON MODULE * 00080000
* CICS * 00090000
* PL/I * 00100000
* ORGANIZATION APPLICATION * 00110000
* * 00120000
* LICENSED MATERIALS - PROPERTY OF IBM * 00130000
* 5695-DB2 * 00136000
* (C) COPYRIGHT 1982, 1995 IBM CORP. ALL RIGHTS RESERVED. * 00143000
* * 00150000
* STATUS = VERSION 4 * 00160000
* * 00170000
* FUNCTION = ROUTER FOR SECONDARY SELECTION AND/OR DETAIL PROCESSING 00180000
* CALLS SECONDARY SELECTION MODULES * 00190000
* DSN8MPA DSN8MPM * 00200000
* CALLS DETAIL MODULES * 00210000
* DSN8MPD DSN8MPE DSN8MPF * 00220000
* DSN8MPT DSN8MPV DSN8MPW DSN8MPX DSN8MPZ * 00230000
* CALLED BY DSN8MP1 (SQL1) * 00240000
* * 00250000
* NOTES = NONE * 00260000
* * 00270000
* MODULE TYPE = BLOCK OF PL/I CODE * 00280000
* PROCESSOR = DB2 PRECOMPILER, PL/I OPTIMIZER * 00290000
* MODULE SIZE = SEE LINKEDIT * 00300000
* ATTRIBUTES = REUSABLE * 00310000
* * 00320000
* ENTRY POINT = DSN8CP2 * 00330000
* PURPOSE = SEE FUNCTION * 00340000
* LINKAGE = NONE * 00350000
* INPUT = * 00360000
* * 00370000
* SYMBOLIC LABEL/NAME = COMMPTR * 00380000
* DESCRIPTION = POINTER TO COMMAREA * 00390000
* (COMMUNICATION AREA) * 00400000
* * 00410000
* OUTPUT = * 00420000
* * 00430000
* SYMBOLIC LABEL/NAME = COMMPTR * 00440000
* DESCRIPTION = POINTER TO COMMAREA * 00450000
* (COMMUNICATION AREA) * 00460000
* * 00470000
* EXIT-NORMAL = * 00480000
* * 00490000
* EXIT-ERROR = IF SQLERROR OR SQLWARNING, SQL WHENEVER CONDITION * 00500000
* SPECIFIED IN DSN8CP2 WILL BE RAISED AND PROGRAM * 00510000
* WILL GO TO THE LABEL DB_ERROR. * 00520000
* * 00530000
* * 00540000
* RETURN CODE = NONE * 00550000
* * 00560000
* ABEND CODES = NONE * 00570000
* * 00580000
* ERROR-MESSAGES = * 00590000
* DSN8062E-AN OBJECT WAS NOT SELECTED * 00600000
* DSN8066E-UNSUPPORTED PFK OR LOGIC ERROR * 00620000
* DSN8072E-INVALID SELECTION ON SECONDARY SCREEN * 00630000
* * 00640000
* EXTERNAL REFERENCES = NONE * 00650000
* ROUTINES/SERVICES = 10 MODULES LISTED ABOVE * 00660000
* DSN8MPG - ERROR MESSAGE ROUTINE * 00670000
* * 00680000
* DATA-AREAS = * 00690000
* DSN8MPA - SECONDARY SELECTION FOR ORGANIZATION * 00700000
* DSN8MPAD - DECLARE ADMINISTRATIVE DETAIL * 00710000
* DSN8MPAE - CURSOR EMPLOYEE LIST * 00720000
* DSN8MPAL - CURSOR ADMINISTRATION LIST * 00730000
* DSN8MPA2 - DECLARE ADMINISTRATIVE DETAIL * 00740000
* DSN8MPCA - DECLARE SQL COMMON AREA * 00750000
* DSN8MPD - DEPARTMENT STRUCTURE DETAIL * 00760000
* DSN8MPDA - CURSOR ADMINISTRATION LIST * 00770000
* DSN8MPDH - CURSOR FOR DISPLAY TEXT FROM * 00780000
* TDSPTXT TABLE * 00790000
* DSN8MPDM - DECLARE DEPARTMENT MANAGER * 00800000
* DSN8MPDP - DELCLARE DEPARTMENT * 00810000
* DSN8MPDT - DECLARE DISPLAY TEXT * 00820000
* DSN8MPE - DEPARTMENT DETAIL * 00830000
* DSN8MPEM - DECLARE EMPLOYEE * 00840000
* DSN8MPED - DECLARE EMPLOYEE-DEPARTMENT * 00845000
* DSN8MPF - EMPLOYEE DETAIL * 00850000
* DSN8MPOV - DECLARE OPTION VALIDATION * 00860000
* DSN8MPXX - ERROR HANDLER * 00870000
* * 00880000
* CONTROL-BLOCKS = * 00890000
* SQLCA - SQL COMMUNICATION AREA * 00900000
* * 00910000
* TABLES = NONE * 00920000
* * 00930000
* CHANGE-ACTIVITY = NONE * 00940000
* * 00950000
* * 00960000
* *PSEUDOCODE* * 00970000
* * 00980000
* THIS MODULE DETERMINES WHICH SECONDARY SELECTION AND/OR * 00990000
* DETAIL MODULE(S) ARE TO BE CALLED IN THE CICS/PL/I * 01000000
* ENVIRONMENT. * 01010000
* * 01020000
* WHAT HAS HAPPENED SO FAR?.............THE SUBSYSTEM * 01030000
* DEPENDENT MODULE (IMS,CICS,TSO) OR (SQL 0) HAS * 01040000
* READ THE INPUT SCREEN, FORMATTED THE INPUT AND PASSED CONTROL * 01050000
* TO SQL 1. SQL 1 PERFORMS VALIDATION ON THE SYSTEM DEPENDENT * 01060000
* FIELDS (MAJOR SYSTEM, ACTION, OBJECT, SEARCH CRITERIA). IF * 01070000
* ALL SYSTEM FIELDS ARE VALID SQL 1 PASSED CONTROL TO THIS * 01080000
* MODULE. PASSED PARAMETERS CONSIST ONLY OF A POINTER WHICH * 01090000
* POINTS TO A COMMUNICATION CONTROL AREA USED TO COMMUNICATE * 01100000
* BETWEEN SQL 0 , SQL 1, SQL 2 AND THE SECONDARY SELECTION * 01110000
* AND DETAIL MODULES. * 01120000
* * 01130000
* WHAT IS INCLUDED IN THIS MODULE?............. * 01140000
* ALL SECONDARY SELECTION AND DETAIL MODULES ARE 'INCLUDED'. * 01150000
* ALL VARIABLES KNOWN IN THIS PROCEDURE ARE KNOWN IN THE * 01160000
* SUB PROCEDURES. ALL SQL CURSOR DEFINITIONS AND * 01170000
* SQL 'INCLUDES' ARE DONE IN THIS PROCEDURE. BECAUSE OF THE * 01180000
* RESTRICTION THAT CURSOR HOST VARIABLES MUST BE DECLARED BEFORE* 01190000
* THE CURSOR DEFINITION ALL CURSOR HOST VARIABLES ARE DECLARED * 01200000
* IN THIS PROCEDURE. * 01210000
* * 01220000
* PROCEDURE * 01230000
* IF ANSWER TO DETAIL SCREEN & DETAIL PROCESSOR * 01240000
* IS NOT WILLING TO ACCEPT AN ANSWER THEN * 01250000
* NEW REQUEST* * 01260000
* * 01270000
* ELSE * 01280000
* IF ANSWER TO A SECONDARY SELECTION THEN * 01290000
* DETERMINE IF NEW REQUEST. * 01300000
* * 01310000
* * 01320000
* CASE (NEW REQUEST) * 01330000
* * 01340000
* SUBCASE ('ADD') * 01350000
* DETAIL PROCESSOR * 01360000
* RETURN TO SQL 1 * 01370000
* ENDSUB * 01380000
* * 01390000
* SUBCASE ('ERASE','DISPLAY','UPDATE') * 01400000
* CALL SECONDARY SELECTION * 01410000
* IF # OF POSSIBLE CHOICES IS ^= 1 THEN * 01420000
* RETURN TO SQL 1 * 01430000
* ELSE * 01440000
* CALL THE DETAIL PROCESSOR * 01450000
* RETURN TO SQL 1 * 01460000
* ENDSUB * 01470000
* * 01480000
* ENDCASE * 01490000
* * 01500000
* IF ANSWER TO SECONDARY SELECTION AND A SELECTION HAS * 01510000
* ACTUALLY BEEN MADE THEN * 01520000
* VALID SELECTION #? * 01530000
* IF IT IS VALID THEN * 01540000
* CALL DETAIL PROCESSOR * 01550000
* RETURN TO SQL 1 * 01560000
* ELSE * 01570000
* PRINT ERROR MSG * 01580000
* RETURN TO SQL 1. * 01590000
* * 01600000
* IF ANSWER TO SECONDARY SELECTION THEN * 01610000
* CALL SECONDARY SELECTION * 01620000
* RETURN TO SQL 1. * 01630000
* * 01640000
* IF ANSWER TO DETAIL THEN * 01650000
* CALL DETAIL PROCESSOR * 01660000
* RETURN TO SQL 1. * 01670000
* * 01680000
* END. * 01690000
* * 01700000
* *EXAMPLE- A ROW IS SUCCESSFULLY ADDED, THE OPERATOR RECEIVES* 01710000
* THE SUCCESSFULLY ADDED MESSAGE AND JUST HITS ENTER. * 01720000
*-------------------------------------------------------------------*/ 01730000
01740000
/* INCLUDE DECLARES */ 01750000
01760000
EXEC SQL INCLUDE DSN8MPCA; /*COMMUNICATION AREA BETWEEN MODULES */ 01770000
EXEC SQL INCLUDE SQLCA; /*SQL COMMUNICATION AREA */ 01780000
/* ORGANIZATION */ 01790000
EXEC SQL INCLUDE DSN8MPDP; /* DCLGEN FOR DEPARTMENT */ 01800000
EXEC SQL INCLUDE DSN8MPEM; /* DCLGEN FOR EMPLOYEE */ 01810000
EXEC SQL INCLUDE DSN8MPED; /* DCLGEN FOR EMPLOYEE-DEPARTMENT */ 01815000
EXEC SQL INCLUDE DSN8MPDM; /* DCLGEN FOR DEPARTMENT/MANAGER */ 01820000
EXEC SQL INCLUDE DSN8MPAD; /* DCLGEN FOR ADMINISTRATION DETAIL */ 01830000
EXEC SQL INCLUDE DSN8MPA2; /* DCLGEN FOR ADMINISTRATION DETAIL */ 01840000
/* PROGRAMMING TABLES */ 01850000
EXEC SQL INCLUDE DSN8MPOV; /* DCLGEN FOR OPTION VALIDATION */ 01860000
EXEC SQL INCLUDE DSN8MPDT; /* DCLGEN FOR DISPLAY TEXT TABLE */ 01870000
01880000
/* CURSORS */ 01890000
EXEC SQL INCLUDE DSN8MPAL; /* MAJSYS O - SEC SEL FOR DS AND DE */ 01900000
EXEC SQL INCLUDE DSN8MPAE; /* MAJSYS O - SEC SEL FOR EM */ 01910000
EXEC SQL INCLUDE DSN8MPDA; /* MAJSYS O - DETAIL FOR DS */ 01920000
EXEC SQL INCLUDE DSN8MPDH; /* PROG TABLES - DISPLAY HEADINGS */ 01930000
01940000
DCL VERIFY BUILTIN; 01950000
DCL UNSPEC BUILTIN; 01960000
DCL DSN8MPG EXTERNAL ENTRY; 01970000
01980000
/****************************************************************/ 01990000
/* ** DCLGENS AND INITIALIZATIONS */ 02000000
/****************************************************************/ 02010000
02020000
DCL STRING BUILTIN; 02030000
DCL J FIXED BIN; 02040000
DCL SAVE_CONVID CHAR(16); 02050000
/* DECLARE CONTROL FLAGS */ 02060000
DCL ( SENDBIT, ENDBIT, NEXTBIT, ON, OFF) BIT(1); 02070000
02080000
/*******************************************/ 02090000
/* FIELDS SENT TO MESSAGE ROUTINE */ 02100000
/*******************************************/ 02110000
02120000
DCL MODULE CHAR (07) INIT('DSN8CP2'); 02130000
DCL OUTMSG CHAR (69); 02140000
02150000
/*********************************************************/ 02160000
/* SQL RETURN CODE HANDLING */ 02170000
/*********************************************************/ 02180000
02190000
EXEC SQL WHENEVER SQLERROR GO TO DB_ERROR; 02200000
EXEC SQL WHENEVER SQLWARNING GO TO DB_ERROR; 02210000
02220000
/*********************************************************/ 02230000
/* INITIALIZATIONS */ 02240000
/*********************************************************/ 02250000
02260000
DSN8_MODULE_NAME.MAJOR='DSN8CP2'; 02270000
DSN8_MODULE_NAME.MINOR=' '; 02280000
02290000
/***********************************************************/ 02300000
/* DETERMINES WHETHER NEW REQUEST OR NOT */ 02310000
/***********************************************************/ 02320000
02330000
/* IF 'NO ANSWER POSSIBLE' SET BY DETAIL PROCESSOR THEN FORCE A */ 02340000
/* NEW REQUEST. */ 02350000
02360000
IF PCONVSTA.PREV = ' ' THEN 02370000
COMPARM.NEWREQ = 'Y'; 02380000
02390000
/* IF ANSWER TO SECONDARY SELECTION THEN DETERMINE IF REALLY A */ 02400000
/* NEW REQUEST. IT WILL BE CONSIDERED A NEW REQUEST IF POSITIONS*/ 02410000
/* 3 TO 60 ARE NOT ALL BLANK AND THE ENTERED DATA IF NOT 'NEXT' */ 02420000
02430000
IF COMPARM.NEWREQ = 'N' & PCONVSTA.PREV = 'S' & 02440000
SUBSTR(COMPARM.DATA,3,58) ^= ' ' & 02450000
COMPARM.PFKIN ^= '08' 02460000
THEN COMPARM.NEWREQ = 'Y'; 02470000
02480000
/***********************************************************/ 02490000
/* IF NEW REQUEST AND ACTION IS 'ADD' THEN */ 02500000
/* CALL DETAIL PROCESSOR */ 02510000
/* ELSE CALL SECONDARY SELECTION */ 02520000
/***********************************************************/ 02530000
02540000
IF COMPARM.NEWREQ='Y' THEN 02550000
DO; 02560000
IF COMPARM.ACTION = 'A' THEN 02570000
DO; 02580000
CALL DETAIL; /*CALL DETAIL PROCESSOR */ 02590000
GO TO EXIT; /* RETURN */ 02600000
END; 02610000
02620000
CALL SECSEL; /*CALL SECONDARY SELECTION*/ 02630000
02640000
IF MAXSEL = 1 THEN /* IF NO. OF CHOICES = 1 */ 02650000
CALL DETAIL; /* CALL DETAIL PROCESSOR */ 02660000
GO TO EXIT; /* RETURN */ 02670000
END; 02680000
02690000
/* IF ANSWER TO SECONDARY SELECTION AND NOT A SCROLLING REQUEST */ 02700000
/* (INPUT NOT EQUAL TO 'NEXT') AND THE POSITIONS */ 02710000
/* 1 TO 2 IN INPUT DATA FIELD NOT EQUAL TO POSITIONS 1 TO 2 */ 02720000
/* IN OUTPUT DATA FIELD THEN SEE IF VALID SELECTION. */ 02730000
02740000
/***********************************************************/ 02750000
/* DETERMINES IF VALID SELECTION NUMBER */ 02760000
/***********************************************************/ 02770000
02780000
IF PCONVSTA.PREV ^= 'S' THEN GO TO IP201; /* TO SECONDARY SEL */ 02790000
02800000
IF PCONVSTA.MAXSEL < 1 THEN GO TO IP201; /* NO VALID CHOICES */ 02810000
02820000
IF COMPARM.PFKIN = '08' THEN GO TO IP201; /* SCROLL REQUEST */ 02830000
02840000
IF SUBSTR(COMPARM.DATA,1,2) = SUBSTR(PCONVSTA.DATA,1,2) 02850000
THEN GO TO IP201; /* NO CHANGE ON INPUT SCREEN */ 02860000
02870000
IF SUBSTR(COMPARM.DATA,2,1) = ' ' THEN /* SECOND CHAR BLANK */ 02880000
IF VERIFY(SUBSTR(COMPARM.DATA,1,1),'123456789') = 0 THEN 02890000
DO; 02900000
SUBSTR(COMPARM.DATA,2,1) = SUBSTR(COMPARM.DATA,1,1); 02910000
SUBSTR(COMPARM.DATA,1,1) = '0'; 02920000
END; 02930000
02940000
IF VERIFY(SUBSTR(COMPARM.DATA,1,2),'0123456789') = 0 & 02950000
SUBSTR(COMPARM.DATA,1,2) > '00' THEN 02960000
02970000
IF SUBSTR(COMPARM.DATA,1,2) <= PCONVSTA.MAXSEL THEN 02980000
DO; 02990000
COMPARM.NEWREQ = 'Y'; /*TELL DETAIL PROCESSOR NEW REQ */ 03000000
CALL DETAIL; /* CALL DETAIL PROCESSOR*/ 03010000
GO TO EXIT; /* RETURN*/ 03020000
END; 03030000
03040000
/*INVALID SELECTION NO.*/ 03050000
/*PRINT ERROR MESSAGE */ 03060000
CALL DSN8MPG (MODULE, '072E', OUTMSG); 03070000
PCONVSTA.MSG= OUTMSG; 03080000
03090000
03100000
GO TO EXIT; /* RETURN */ 03110000
03120000
/***********************************************************/ 03130000
/* DETERMINES WHETHER SECONDARY SELECTION OR DETAIL */ 03140000
/***********************************************************/ 03150000
03160000
/* MUST BE ANY ANSWER TO EITHER SEC SEL OR DETAIL */ 03170000
IP201: 03180000
03190000
IF PCONVSTA.PREV = 'S' THEN 03200000
DO; 03210000
CALL SECSEL; /*SECONDARY SELECTION*/ 03220000
GO TO EXIT; /* RETURN */ 03230000
END; 03240000
03250000
IF PCONVSTA.PREV = 'D' THEN 03260000
DO; 03270000
CALL DETAIL; /* DETAIL PROCESSOR */ 03280000
GO TO EXIT; /* RETURN */ 03290000
END; 03300000
03310000
/*LOGIC ERROR */ 03320000
CALL DSN8MPG (MODULE, '066E', OUTMSG); 03330000
PCONVSTA.MSG= OUTMSG; /*PRINT ERROR MESSAGE*/ 03340000
GO TO EXIT; 03350000
03360000
EXEC SQL INCLUDE DSN8MPXX; /*HANDLES SQL ERRORS*/ 03370000
GO TO EXIT; 03380000
03390000
/************************************************************/ 03400000
/* CALLS SECONDARY SELECTION AND RETURNS TO SQL 1 */ 03410000
/* NOTE - SAME SECONDARY SELECTION MODULE FOR DS, DE AND EM */ 03420000
/************************************************************/ 03430000
03440000
SECSEL: PROC; /*CALL APPROPRIATE SECONDARY SEL */ 03450000
PCONVSTA.LASTSCR = 'DSN8001'; /* NOTE GENERAL MAP */ 03460000
03470000
IF COMPARM.OBJFLD='DS' THEN /*ADMINISTRATIVE */ 03480003
DO; /*DEPARTMENT STRUCTURE */ 03490000
CALL DSN8MPA; 03500000
RETURN; 03510000
END; 03520000
03530000
IF COMPARM.OBJFLD='DE' THEN /*INDIVIDUAL DEPARTMENT*/ 03540003
DO; /*PROCESSING */ 03550000
CALL DSN8MPA; 03560000
RETURN; 03570000
END; 03580000
03590000
IF COMPARM.OBJFLD='EM' THEN /*INDIVIDUAL EMPLOYEE */ 03600003
DO; /*PROCESSING */ 03610000
CALL DSN8MPA; 03620000
RETURN; 03630000
END; 03640000
/*MISSING SECONDARY SEL*/ 03650000
/*PRINT ERROR MESSAGE */ 03660000
CALL DSN8MPG (MODULE, '062E', OUTMSG); 03670000
PCONVSTA.MSG= OUTMSG; /*PRINT ERROR MESSAGE*/ 03680000
03690000
GO TO EXIT; /*RETURN */ 03700000
END SECSEL; 03710000
03720000
/**********************************************************/ 03730000
/* CALLS DETAIL PROCESSOR AND RETURNS TO SQL 1 */ 03740000
/**********************************************************/ 03750000
03760000
DETAIL: PROC; /* CALL APPROPRIATE DETAIL MODULE */ 03770000
PCONVSTA.LASTSCR = 'DSN8002'; /* NOTE DETAIL MAP */ 03780000
03790000
SELECT (COMPARM.OBJFLD); 03800003
03810000
WHEN('DS') CALL DSN8MPD; /*DEPARTMENT STRUCTURE */ 03820000
03830000
WHEN('DE') CALL DSN8MPE; /*DEPARTMENT*/ 03840000
03850000
WHEN('EM') CALL DSN8MPF; /*EMPLOYEE*/ 03860000
03870000
/*MISSING DETAIL MODULE*/ 03880000
OTHERWISE /*PRINT ERROR MESSAGE */ 03890000
DO; 03900000
CALL DSN8MPG (MODULE, '062E', OUTMSG); 03910000
PCONVSTA.MSG= OUTMSG; 03920000
END; 03930000
END; 03940000
END DETAIL; 03950000
03960000
/*RETURNS TO SQL 1*/ 03970000
EXIT: EXEC CICS RETURN; 03980000
03990000
EXEC SQL INCLUDE DSN8MPA; /* SEC SEL - ADMIN STRUCTURE */ 04000000
EXEC SQL INCLUDE DSN8MPD; /* DETAIL - ADMIN STRUCTURE */ 04010000
EXEC SQL INCLUDE DSN8MPE; /* DETAIL - DEPARTMENTS */ 04020000
EXEC SQL INCLUDE DSN8MPF; /* DETAIL - EMPLOYEES */ 04030000
END DSN8CP2; 04040000