DSN8SP3
THIS MODULE LISTS EMPLOYEE PHONE NUMBERS AND UPDATES THEM IF DESIRED.
DSN8SP3: PROC OPTIONS (MAIN);
/*********************************************************************
* *
* MODULE NAME = DSN8SP3 *
* *
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION *
* PHONE APPLICATION *
* ISPF *
* PL/I *
* *
* COPYRIGHT = 5665-DB2 (C) COPYRIGHT IBM CORP 1982, 1991 *
* SEE COPYRIGHT INSTRUCTIONS *
* LICENSED MATERIALS - PROPERTY OF IBM *
* *
* STATUS = VERSION 2 RELEASE 3, LEVEL 0 *
* *
* FUNCTION = THIS MODULE LISTS EMPLOYEE PHONE NUMBERS AND *
* UPDATES THEM IF DESIRED. *
* *
* NOTES = *
* DEPENDENCIES = TWO ISPF PANELS ARE REQUIRED: *
* DSN8SSL AND DSN8SSN *
* RESTRICTIONS = NONE *
* *
* MODULE TYPE = PL/I PROC OPTIONS(MAIN) *
* PROCESSOR = DB2 PRECOMPILER, PL/I OPTIMIZER *
* MODULE SIZE = SEE LINKEDIT *
* ATTRIBUTES = REENTRANT *
* *
* ENTRY POINT = DSN8SP3 *
* PURPOSE = SEE FUNCTION *
* LINKAGE = INVOKED FROM ISPF *
* *
* INPUT = PARAMETERS EXPLICITLY PASSED TO THIS FUNCTION: *
* INPUT-MESSAGE: *
* *
* SYMBOLIC LABEL/NAME = DSN8SSL *
* DESCRIPTION = PHONE MENU 1 (SELECT) *
* *
* SYMBOLIC LABEL/NAME = DSN8SSN *
* DESCRIPTION = PHONE MENU 2 (LIST) *
* *
* SYMBOLIC LABEL/NAME = VPHONE *
* DESCRIPTION = VIEW OF TELEPHONE INFORMATION *
* *
* SYMBOLIC LABEL/NAME = VEMPLP *
* DESCRIPTION = VIEW OF EMPLOYEE INFORMATION *
* *
* OUTPUT = PARAMETERS EXPLICITLY RETURNED: *
* OUTPUT-MESSAGE: *
* *
* SYMBOLIC LABEL/NAME = DSN8SSL *
* DESCRIPTION = PHONE MENU 1 (SELECT) *
* *
* SYMBOLIC LABEL/NAME = DSN8SSN *
* DESCRIPTION = PHONE MENU 2 (LIST) *
* *
* EXIT-NORMAL = RETURN CODE 0 NORMAL COMPLETION *
* *
* EXIT-ERROR = *
* *
* RETURN CODE = NONE *
* *
* ABEND CODES = NONE *
* *
* *
* ERROR-MESSAGES = *
* DSN8004I - EMPLOYEE SUCCESSFULLY UPDATED *
* DSN8008I - NO EMPLOYEE FOUND IN TABLE *
* DSN8060E - SQL ERROR, RETURN CODE IS: *
* DSN8079E - CONNECTION TO DB2 NOT ESTABLISHED *
* *
* EXTERNAL REFERENCES = *
* ROUTINES/SERVICES = *
* DSN8MPG - ERROR MESSAGE ROUTINE *
* ISPLINK - ISPF SERVICES ROUTINE *
* *
* DATA-AREAS = *
* NONE *
* *
* CONTROL-BLOCKS = *
* SQLCA - SQL COMMUNICATION AREA *
* *
* TABLES = NONE *
* *
* *
* CHANGE-ACTIVITY: *
* *
* CHECK SQLERRP FOR NON-BLANKS TO ENSURE CONNECTION V2R3 *
* HAS BEEN ESTABLISHED. ISSUE 079E IF NOT. *
* *
* *PSEUDOCODE* *
* *
* PROCEDURE *
* DO WHILE NOT EXIT-PRESSED *
* CALL GET-TYPE *
* CALL GET-LIST *
* CALL DISPLAY-LIST *
* *
* GET_TYPE: *
* IF LASTNAME IS '*' *
* TYPE = 'ALL' *
* ELSE *
* IF LASTNAME CONTAINS '%' *
* TYPE = 'GENERIC' *
* ELSE *
* TYPE = 'SPECIFIC' *
* *
* GET_LIST: *
* CASE (TYPE) *
* SUBCASE ('ALL') *
* GET ALL EMPLOYEES *
* SUBCASE ('GENERIC') *
* GET GENERIC EMPLOYEES *
* SUBCASE ('GENERIC') *
* GET SPECIFIC EMPLOYEES *
* ENDSUB *
* *
* DISPLAY_LIST: *
* DISPLAY LIST *
* IF NOT EXIT-PRESSED *
* UPDATE PHONE NUMBER(S) *
* WRITE CONFIRMATION MESSAGE *
* *
* P3_DBERROR: *
* IF SQL ERROR OCCURS THEN *
* FORMAT ERROR MESSAGE *
* ROLLBACK *
* END *
* END. *
*********************************************************************/
/********************************************************************/
/* DECLARATION FOR BUILTIN FUNCTIONS */
/********************************************************************/
DCL ADDR BUILTIN;
DCL INDEX BUILTIN;
DCL PLIRETC BUILTIN;
DCL PLIRETV BUILTIN;
DCL STG BUILTIN;
DCL SUBSTR BUILTIN;
DCL TRANSLATE BUILTIN;
/********************************************************************/
/* MESSAGE ROUTINE DECLARATIONS */
/********************************************************************/
DCL DSN8MPG EXTERNAL ENTRY;
DCL MODULE CHAR (7) INIT('DSN8SP3'); /* EXECUTING PROGRAM */
DCL OUTMSG CHAR (69); /* MESSAGE TEXT */
1/********************************************************************/
/* ISPF DIALOG VARIABLE NAMES */
/********************************************************************/
/* SELECTION AND LIST PANEL VARIABLES */
DCL MSGS_VAR CHAR(08) STATIC INIT('DSN8MSGS'); /*PANEL MSG FIELD*/
/* SELECTION PANEL VARIABLES */
DCL FI_VAR CHAR(08) STATIC INIT('FNAMEI '); /*FIRST NAME VAR */
DCL LI_VAR CHAR(08) STATIC INIT('LNAMEI '); /*LAST NAME VAR */
/* LIST PANEL VARIABLES */
DCL CH_VAR CHAR(08) STATIC INIT('ZTDSELS '); /*# ROWS CHANGED */
DCL FN_VAR CHAR(08) STATIC INIT('FNAMED '); /*FIRST NAME VAR */
DCL MI_VAR CHAR(08) STATIC INIT('MINITD '); /*MID INIT VAR */
DCL LN_VAR CHAR(08) STATIC INIT('LNAMED '); /*LAST NAME VAR */
DCL PN_VAR CHAR(08) STATIC INIT('PNOD '); /*PHONE NUM VAR */
DCL EN_VAR CHAR(08) STATIC INIT('ENOD '); /*EMPL NUM VAR */
DCL WD_VAR CHAR(08) STATIC INIT('WDEPTD '); /*WORK DEPT VAR */
DCL WN_VAR CHAR(08) STATIC INIT('WNAMED '); /*DEPT NAME VAR */
DCL TABLE_NAME CHAR(08) STATIC INIT('DSN8TABL'); /*TABLE NAME VAR */
DCL SEL_VARS CHAR(20) STATIC /*SELECTION VARS */
INIT('( FNAMEI LNAMEI ) ');
DCL DIS_VARS CHAR(56) STATIC /*DISPLAY VARS */
INIT('( ZTDSELS FNAMED MINITD LNAMED PNOD ENOD WDEPTD WNAMED )');
DCL EMP_VARS CHAR(48) STATIC /*DISPLAY VARS */
INIT('( FNAMED MINITD LNAMED PNOD ENOD WDEPTD WNAMED )');
/********************************************************************/
/* ISPF DIALOG SERVICES DECLARATIONS */
/********************************************************************/
/* PROGRAM NAME */
DCL ISPLINK EXTERNAL ENTRY OPTIONS(ASM INTER RETCODE);
/* ISPF DIALOG SERVICE TYPES */
DCL I_VDEFINE CHAR(8) STATIC INIT('VDEFINE ');
DCL I_VGET CHAR(8) STATIC INIT('VGET ');
DCL I_VPUT CHAR(8) STATIC INIT('VPUT ');
DCL I_DISPLAY CHAR(8) STATIC INIT('DISPLAY ');
DCL I_TBDISPL CHAR(8) STATIC INIT('TBDISPL ');
DCL I_TBTOP CHAR(8) STATIC INIT('TBTOP ');
DCL I_TBCREATE CHAR(8) STATIC INIT('TBCREATE');
DCL I_TBCLOSE CHAR(8) STATIC INIT('TBCLOSE ');
DCL I_TBADD CHAR(8) STATIC INIT('TBADD ');
DCL I_TBPUT CHAR(8) STATIC INIT('TBPUT ');
/* ISPF CALL MODIFIERS */
DCL I_NOWRITE CHAR(8) STATIC INIT('NOWRITE');
DCL I_REPLACE CHAR(8) STATIC INIT('REPLACE');
DCL I_CHAR CHAR(8) STATIC INIT('CHAR');
/* PANEL NAMES */
DCL SEL_PANEL CHAR(8) STATIC INIT('DSN8SSL'); /* SELECTION PANEL */
DCL DIS_PANEL CHAR(8) STATIC INIT('DSN8SSN'); /* LIST PANEL */
/* LOCAL VARIABLES FOR ISPF VARIABLES */
DCL LNAMEI CHAR(15) INIT(' '); /* LAST-NAME INPUT */
DCL FNAMEI CHAR(12) INIT(' '); /* FIRST-NAME INPUT */
DCL MSGS CHAR(79) INIT(' '); /* MESSAGE FOR ISPF PANEL */
DCL 1 EMP_RECORD, /* PANEL DISPLAY INFORMATION */
2 LASTNAME CHAR (15),
2 FIRSTNAME CHAR (12),
2 MIDDLEINITIAL CHAR (1),
2 PHONENUMBER CHAR (4),
2 EMPLOYEENUMBER CHAR (6),
2 DEPTNUMBER CHAR (3),
2 DEPTNAME CHAR (36);
1/********************************************************************/
/* DECLARATION FOR PROGRAM LOGIC */
/********************************************************************/
/* CONSTANTS */
DCL YES BIT(1) STATIC INIT('1'B);
DCL NO BIT(1) STATIC INIT('0'B);
DCL ZERO FIXED BIN(31,0) STATIC INIT(0);
/* FLAGS */
DCL SEL_EXIT BIT(1); /* EXIT PRESSED? FLAG */
DCL DIS_EXIT BIT(1); /* EXIT PRESSED? FLAG */
DCL DIS_TABLE BIT(1); /* DISPLAY-TABLE? FLAG */
DCL MORE_CHANGES BIT(1); /* MORE CHANGES TO PROCESS? */
/* DATA VARIABLES */
DCL ROWS_CHANGED PIC'9999';
DCL TYPE CHAR(8); /* TYPE OF LIST */
DCL LNAMES CHAR(15); /* LAST NAME SELECTION VALUE */
DCL FNAMES CHAR(12); /* FIRST NAME SELECTION VALUE */
1/********************************************************************/
/* SQL DECLARATIONS */
/********************************************************************/
/* SQL COMMUNICATION AREA */
0EXEC SQL INCLUDE SQLCA;
DCL SQL_PIC PIC'-999';
/* SQL DECLARATION FOR VIEW PHONE */
EXEC SQL DECLARE VPHONE TABLE
(LASTNAME VARCHAR(15),
FIRSTNAME VARCHAR(12),
MIDDLEINITIAL CHAR(1),
PHONENUMBER CHAR(4),
EMPLOYEENUMBER CHAR(6),
DEPTNUMBER CHAR(3) NOT NULL,
DEPTNAME VARCHAR(36) NOT NULL);
/* STUCTURE FOR PHONE RECORD */
DCL 1 PPHONE,
2 LASTNAME CHAR (15) VAR,
2 FIRSTNAME CHAR (12) VAR,
2 MIDDLEINITIAL CHAR (1),
2 PHONENUMBER CHAR (4),
2 EMPLOYEENUMBER CHAR (6),
2 DEPTNUMBER CHAR (3),
2 DEPTNAME CHAR (36) VAR;
/* SQL DECLARATION FOR VIEW VEMPLP*/
EXEC SQL DECLARE VEMPLP TABLE
(EMPLOYEENUMBER CHAR(6),
PHONENUMBER CHAR(4));
/********************************************************************/
/* CURSOR DECLARATIONS */
/********************************************************************/
EXEC SQL DECLARE TELE1 CURSOR FOR
SELECT *
FROM VPHONE;
EXEC SQL DECLARE TELE2 CURSOR FOR
SELECT *
FROM VPHONE
WHERE LASTNAME LIKE :LNAMES
AND FIRSTNAME LIKE :FNAMES;
EXEC SQL DECLARE TELE3 CURSOR FOR
SELECT *
FROM VPHONE
WHERE LASTNAME = :LNAMES
AND FIRSTNAME LIKE :FNAMES;
1/********************************************************************/
/* SQL RETURN CODE HANDLING */
/********************************************************************/
EXEC SQL WHENEVER SQLERROR GOTO P3_DBERROR;
EXEC SQL WHENEVER SQLWARNING GOTO P3_DBERROR;
EXEC SQL WHENEVER NOT FOUND CONTINUE;
/********************************************************************/
/* DEFINE PL/I - ISPF VARIABLES */
/********************************************************************/
CALL ISPLINK(I_VDEFINE, CH_VAR, ROWS_CHANGED,
I_CHAR, STG(ROWS_CHANGED));
CALL ISPLINK(I_VDEFINE, FN_VAR, EMP_RECORD.FIRSTNAME,
I_CHAR, STG(EMP_RECORD.FIRSTNAME));
CALL ISPLINK(I_VDEFINE, MI_VAR, EMP_RECORD.MIDDLEINITIAL,
I_CHAR, STG(EMP_RECORD.MIDDLEINITIAL));
CALL ISPLINK(I_VDEFINE, LN_VAR, EMP_RECORD.LASTNAME,
I_CHAR, STG(EMP_RECORD.LASTNAME));
CALL ISPLINK(I_VDEFINE, PN_VAR, EMP_RECORD.PHONENUMBER,
I_CHAR, STG(EMP_RECORD.PHONENUMBER));
CALL ISPLINK(I_VDEFINE, EN_VAR, EMP_RECORD.EMPLOYEENUMBER,
I_CHAR, STG(EMP_RECORD.EMPLOYEENUMBER));
CALL ISPLINK(I_VDEFINE, WD_VAR, EMP_RECORD.DEPTNUMBER,
I_CHAR, STG(EMP_RECORD.DEPTNUMBER));
CALL ISPLINK(I_VDEFINE, WN_VAR, EMP_RECORD.DEPTNAME,
I_CHAR, STG(EMP_RECORD.DEPTNAME));
CALL ISPLINK(I_VDEFINE, FI_VAR, FNAMEI,
I_CHAR, STG(FNAMEI));
CALL ISPLINK(I_VDEFINE, LI_VAR, LNAMEI,
I_CHAR, STG(LNAMEI));
CALL ISPLINK(I_VDEFINE, MSGS_VAR, MSGS,
I_CHAR, STG(MSGS));
1/********************************************************************/
/* MAIN PROGRAM */
/********************************************************************/
SEL_EXIT = '0'B; /* INITIALIZE EXIT BIT */
DO WHILE (^SEL_EXIT); /* DO WHILE NOT EXIT */
CALL ISPLINK(I_DISPLAY, SEL_PANEL);
MSGS = ' '; /* RESET THE MSG FIELD */
OUTMSG = ' '; /* RESET THE MSG FIELD */
SEL_EXIT = (PLIRETV = 8); /* SEL_EXIT = TRUE IF RC=8 */
/******************************************************************/
/* EXIT WAS NOT SPECIFIED SO PROCESS THE REQUEST */
/******************************************************************/
IF ^SEL_EXIT THEN /* IF USER PRESSED ENTER */
DO;
DIS_TABLE = NO; /* INIT FLAG TO NO */
CALL ISPLINK(I_VGET, SEL_VARS);
LNAMES = LNAMEI; /* COPY INPUT TO WORKING VAR */
FNAMES = FNAMEI; /* COPY INPUT TO WORKING VAR */
CALL GET_TYPE; /* DETERMINE LIST TYPE */
CALL GET_LIST; /* GET LIST OF EMPLOYEES */
IF DIS_TABLE THEN
CALL DISPLAY_LIST;
END; /* END IF USER PRESSED ENTER */
CALL ISPLINK(I_VPUT, MSGS_VAR); /* SET PANEL MESSAGE */
END; /* END DO WHILE NOT EXIT */
CALL PLIRETC(ZERO); /* SET EXIT RETURN CODE TO 0 */
RETURN;
1/********************************************************************/
/* GET TYPE OF LIST */
/********************************************************************/
GET_TYPE: PROCEDURE;
IF LNAMES = '*' THEN /* LIST DIRECTORY */
TYPE = 'ALL';
ELSE
IF INDEX(LNAMES, '%') > 0 THEN
DO; /* GENERIC LIST */
TYPE = 'GENERIC';
LNAMES = TRANSLATE(LNAMES, '%', ' '); /* CHG SPACES TO % */
FNAMES = TRANSLATE(FNAMES, '%', ' '); /* CHG SPACES TO % */
END; /* END IF GENERIC */
ELSE
DO; /* SPECIFIC NAME */
TYPE = 'SPECIFIC';
FNAMES = TRANSLATE(FNAMES, '%', ' '); /* CHG SPACES TO % */
END; /* END IF SPECIFIC */
END GET_TYPE;
1/********************************************************************/
/* GET LIST OF EMPLOYEES */
/********************************************************************/
GET_LIST: PROCEDURE;
SQLERRP = ' '; /* CONNECTION CHECK: INIT SQLERRP */
SELECT (TYPE); /* OPEN CURSOR & GET FIRST RECORD */
WHEN ('ALL') /* FOR ALL EMPLOYEES */
DO;
EXEC SQL OPEN TELE1;
EXEC SQL FETCH TELE1
INTO :PPHONE;
END;
WHEN ('GENERIC') /* FOR GENERIC EMPLOYEES */
DO;
EXEC SQL OPEN TELE2;
EXEC SQL FETCH TELE2
INTO :PPHONE;
END;
OTHERWISE /* FOR SPECIFIC EMPLOYEE(S) */
DO;
EXEC SQL OPEN TELE3;
EXEC SQL FETCH TELE3
INTO :PPHONE;
END;
END; /* SELECT */
/********************************************************************/
/* NO EMPLOYEE FULFILLED THE REQUEST */
/********************************************************************/
SELECT;
WHEN (SQLERRP = ' ') /* NO CONNECTION TO DB2 */
DO;
CALL DSN8MPG (MODULE, '079E', OUTMSG);
MSGS = OUTMSG; /* SET ISPF ERROR MESSAGE */
END; /* END NO EMPLOYEE FOUND */
WHEN (SQLCODE = 100)
DO;
CALL DSN8MPG (MODULE, '008I', OUTMSG);
MSGS = OUTMSG; /* SET ISPF ERROR MESSAGE */
END; /* END NO EMPLOYEE FOUND */
OTHERWISE
/********************************************************************/
/* EMPLOYEES EXIST THAT FULFILL THE REQUEST. DISPLAY THEM. */
/********************************************************************/
DO; /* BUILD RESULT TABLE */
DIS_TABLE = YES;
CALL ISPLINK(I_TBCREATE, TABLE_NAME, ' ', EMP_VARS, I_NOWRITE,
I_REPLACE);
DO WHILE (SQLCODE = 0); /* WHILE MORE ENTRIES */
EMP_RECORD = PPHONE, BY NAME;
CALL ISPLINK(I_TBADD, TABLE_NAME); /* ADD TO ISPF TABLE */
SELECT (TYPE); /* GET NEXT RECORD */
WHEN ('ALL')
EXEC SQL FETCH TELE1 INTO :PPHONE;
WHEN ('GENERIC')
EXEC SQL FETCH TELE2 INTO :PPHONE;
OTHERWISE
EXEC SQL FETCH TELE3 INTO :PPHONE;
END; /* END SELECT */
END; /* END WHILE MORE */
END; /* END EMPLOYEE FOUND */
END; /* END SELECT */
/********************************************************************/
/* CLOSE THE CURSORS */
/********************************************************************/
SELECT (TYPE);
WHEN ('ALL')
EXEC SQL CLOSE TELE1;
WHEN ('GENERIC')
EXEC SQL CLOSE TELE2;
OTHERWISE
EXEC SQL CLOSE TELE3;
END;
END GET_LIST;
1/********************************************************************/
/* DISPLAY/UPDATE EMPLOYEE PHONE NUMBERS */
/********************************************************************/
DISPLAY_LIST: PROCEDURE;
EXEC SQL WHENEVER SQLERROR CONTINUE; /* CHANGE ERROR HANDLING */
EXEC SQL WHENEVER SQLWARNING CONTINUE; /* FOR UPDATE */
CALL ISPLINK(I_TBTOP, TABLE_NAME);
CALL ISPLINK(I_TBDISPL, TABLE_NAME, DIS_PANEL);
DIS_EXIT = (PLIRETV = 8); /* WAS EXIT PRESSED? */
IF ^DIS_EXIT THEN /* IF EXIT NOT PRESSED */
DO;
CALL ISPLINK(I_VGET, DIS_VARS);
MORE_CHANGES = (ROWS_CHANGED > 0); /* ANY CHANGES? */
DO WHILE(MORE_CHANGES); /* FIND PHONE NUM UPDATES */
EXEC SQL UPDATE VEMPLP /* PERFORM UPDATE */
SET PHONENUMBER = :EMP_RECORD.PHONENUMBER
WHERE EMPLOYEENUMBER = :EMP_RECORD.EMPLOYEENUMBER;
IF SQLCODE ^= 0 THEN /* IF UPDATE FAILED */
DO;
CALL DSN8MPG(MODULE, '060E', OUTMSG);
SQL_PIC = SQLCODE;
MSGS = SUBSTR(OUTMSG,1,46) || SQL_PIC;
EXEC SQL ROLLBACK;
MORE_CHANGES = NO;
END; /* END UPDATE FAILED */
ELSE /* SUCCESSFUL UPDATE */
DO;
CALL DSN8MPG(MODULE, '004I', OUTMSG);
MSGS = OUTMSG;
CALL ISPLINK(I_TBPUT, TABLE_NAME);
IF ROWS_CHANGED > 1 THEN /* MORE CHANGES TO DO */
DO; /* DISPLAY CHANGES */
CALL ISPLINK(I_TBDISPL, TABLE_NAME);
CALL ISPLINK(I_VGET, DIS_VARS);
END;
ELSE /* NO MORE CHANGES */
MORE_CHANGES = NO;
END; /* END SUCCESSFUL UPDATE */
END; /* DO WHILE MORE CHANGES */
CALL ISPLINK(I_TBCLOSE, TABLE_NAME); /* CLOSE ISPF TABLE */
END; /* END IF ^DIS_EXIT */
END DISPLAY_LIST;
1/********************************************************************/
/* ERROR HANDLING */
/********************************************************************/
P3_DBERROR:
CALL DSN8MPG(MODULE, '060E', OUTMSG); /* GET FULL MSG TEXT */
SQL_PIC = SQLCODE;
MSGS = SUBSTR(OUTMSG,1,46) || SQL_PIC; /* APPEND SQL CODE */
CALL ISPLINK(I_VPUT, MSGS_VAR); /* PUT MSG OUT */
RETURN; /* EXIT PROGRAM */
END DSN8SP3;