DSN8BP3
THIS MODULE LISTS EMPLOYEE PHONE NUMBERS AND UPDATES THEM IF DESIRED.
DSN8BP3: PROC REORDER OPTIONS(MAIN);
/*********************************************************************
* *
* MODULE NAME = DSN8BP3 *
* *
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION *
* PHONE APPLICATION *
* BATCH *
* PL/I *
* *
* LICENSED MATERIALS - PROPERTY OF IBM *
* 5695-DB2 *
* (C) COPYRIGHT 1982, 1995 IBM CORP. ALL RIGHTS RESERVED. *
* *
* STATUS = VERSION 4 *
* *
* FUNCTION = THIS MODULE LISTS EMPLOYEE PHONE NUMBERS AND *
* UPDATES THEM IF DESIRED. *
* *
* NOTES = NONE *
* *
* *
* MODULE TYPE = PL/I PROC OPTIONS(MAIN) *
* PROCESSOR = DB2 PRECOMPILER, PL/I OPTIMIZER *
* MODULE SIZE = SEE LINK EDIT *
* ATTRIBUTES = REENTRANT *
* *
* ENTRY POINT = DSN8BP3 *
* PURPOSE = SEE FUNCTION *
* LINKAGE = INVOKED FROM DSN RUN *
* INPUT = *
* *
* SYMBOLIC LABEL/NAME = CARDIN *
* DESCRIPTION = INPUT REQUEST FILE *
* *
* SYMBOLIC LABEL/NAME = VPHONE *
* DESCRIPTION = VIEW OF TELEPHONE INFORMATION *
* *
* OUTPUT = *
* *
* SYMBOLIC LABEL/NAME = REPORT *
* DESCRIPTION = REPORT OF EMPLOYEE PHONE NUMBERS *
* *
* SYMBOLIC LABEL/NAME = VEMPLP *
* DESCRIPTION = VIEW OF EMPLOYEE INFORMATION *
* *
* *
* EXIT-NORMAL = RETURN CODE 0 NORMAL COMPLETION *
* *
* EXIT-ERROR = *
* *
* RETURN CODE = NONE *
* *
* ABEND CODES = NONE *
* *
* ERROR-MESSAGES = *
* DSN8004I - EMPLOYEE SUCCESSFULLY UPDATED *
* DSN8007E - EMPLOYEE DOES NOT EXIST, UPDATE NOT DONE *
* DSN8008I - NO EMPLOYEE FOUND IN TABLE *
* DSN8053I - ROLLBACK SUCCESSFUL, ALL UPDATES REMOVED *
* DSN8060E - SQL ERROR, RETURN CODE IS: *
* DSN8061E - ROLLBACK FAILED, RETURN CODE IS: *
* DSN8068E - INVALID REQUEST, SHOULD BE 'L' OR 'U' *
* DSN8075E - MESSAGE FORMAT ROUTINE ERROR, *
* RETURN CODE IS : *
* *
* EXTERNAL REFERENCES = *
* ROUTINES/SERVICES = *
* DSN8MPG - ERROR MESSAGE ROUTINE *
* *
* DATA-AREAS = NONE *
* *
* CONTROL-BLOCKS = *
* SQLCA - SQL COMMUNICATION AREA *
* *
* TABLES = NONE *
* *
* CHANGE-ACTIVITY = NONE *
* *
* *
* *PSEUDOCODE* *
* *
* PROCEDURE *
* GET FIRST INPUT *
* DO WHILE MORE INPUT *
* CREATE REPORT HEADING *
* CASE (ACTION) *
* *
* SUBCASE ('L') *
* IF LASTNAME IS '*' THEN *
* LIST ALL EMPLOYEES *
* ELSE *
* IF LASTNAME CONTAINS '%' THEN *
* LIST EMPLOYEES GENERIC *
* ELSE *
* LIST EMPLOYEES SPECIFIC *
* ENDSUB *
* *
* SUBCASE ('U') *
* UPDATE PHONENUMBER FOR EMPLOYEE *
* WRITE CONFIRMATION MESSAGE *
* OTHERWISE *
* INVALID REQUEST *
* ENDSUB *
* *
* ENDCASE *
* GET NEXT INPUT *
* END *
* *
* IF SQL ERROR OCCURS THEN *
* ROLLBACK *
* END. *
* *
*-------------------------------------------------------------------*/
1/**********************/
/* INPUT/OUTPUT FILES */
/**********************/
DCL CARDIN FILE STREAM INPUT; /* INPUT CONTROL CARDS */
DCL REPORT FILE STREAM OUTPUT PRINT; /* OUTPUT PHONE REPORT */
/********************/
/* ENDFILE HANDLING */
/********************/
ON ENDFILE (CARDIN) EOF = '1'B;
/***********************/
/* STRUCTURE FOR INPUT */
/***********************/
DCL 1 IOAREA,
2 ACTION CHAR( 1), /* ACTION */
2 LNAME CHAR(15), /* LAST NAME */
2 FNAME CHAR(12), /* FIRST NAME */
2 ENO CHAR( 6), /* EMPLOYEE NUMBER */
2 NEWNO CHAR( 4); /* PHONE NUMBER */
/***********************/
/* WORK VARIABLES */
/***********************/
DCL LNAMEWK CHAR(15) VAR; /* WORK VERSION OF LAST NAME */
DCL FNAMEWK CHAR(12) VAR; /* WORK VERSION OF FIRST NAME */
/***************************/
/* REPORT HEADER STRUCTURE */
/***************************/
DCL 1 REPHDR1 STATIC,
2 HDR111 CHAR(29) INIT ((29)'-'),
2 HDR112 CHAR(21) INIT (' TELEPHONE DIRECTORY '),
2 HDR113 CHAR(28) INIT ((28)'-');
DCL 1 REPHDR2 STATIC,
2 HDR211 CHAR( 9) INIT ('LAST NAME'),
2 HDR212 CHAR(10) INIT ('FIRST NAME'),
2 HDR213 CHAR( 7) INIT ('INITIAL'),
2 HDR214 CHAR( 5) INIT ('PHONE'),
2 HDR215 CHAR( 8) INIT ('EMPLOYEE'),
2 HDR216 CHAR( 4) INIT ('WORK'),
2 HDR217 CHAR( 4) INIT ('WORK'),
2 HDR221 CHAR( 6) INIT ('NUMBER'),
2 HDR222 CHAR( 6) INIT ('NUMBER'),
2 HDR223 CHAR( 4) INIT ('DEPT'),
2 HDR224 CHAR( 4) INIT ('DEPT'),
2 HDR225 CHAR( 4) INIT ('NAME');
/******************/
/* REPORT FORMATS */
/******************/
L1: FORMAT (A(29),A(21),A(28));
L2: FORMAT (SKIP(2),A(9),X(7),A(10),X(3),A(7),X(1),A(5),X(2),A(8),
X(1),A(4),X(1),A(4),SKIP,X(37),A(6),X(1),A(6),X(3),
A(4),X(1),A(4),X(1),A(4));
L3: FORMAT (SKIP,A(15),X(1),A(12),X(4),A(1),X(4),A(4),X(3),A(6),X(3),
A(3),X(2),A(36));
L4: FORMAT (COL(1),A(1),A(15),A(12),A(6),A(4));
/*********************************/
/* FIELDS SENT TO MESSAGE ROUTINE*/
/*********************************/
DCL OUTMSG CHAR(69);
DCL MODULE CHAR(07) INIT('DSN8BP3');
DCL DSN8MPG EXTERNAL ENTRY;
/********************/
/* GENERAL DECLARES */
/********************/
DCL (ADDR,
DIM,
PLIRETV,
TRANSLATE,
INDEX) BUILTIN;
DCL EOF BIT(1) INIT ('0'B);
DCL I BIN FIXED(15);
DCL ZERO BIN FIXED(15) STATIC INIT(0);
DCL ONE BIN FIXED(15) STATIC INIT(1);
DCL NOTFOUND BIN FIXED(15) STATIC INIT(100);
1/***********************************/
/* SQL DECLARATION FOR VIEW VPHONE */
/***********************************/
EXEC SQL DECLARE VPHONE TABLE
(LASTNAME VARCHAR(15) NOT NULL,
FIRSTNAME VARCHAR(12) NOT NULL,
MIDDLEINITIAL CHAR( 1) NOT NULL,
PHONENUMBER CHAR( 4) ,
EMPLOYEENUMBER CHAR( 6) NOT NULL,
DEPTNUMBER CHAR( 3) NOT NULL,
DEPTNAME VARCHAR(36) NOT NULL);
/**************************/
/* SQL COMMUNICATION AREA */
/**************************/
EXEC SQL INCLUDE SQLCA;
/*******************************/
/* STRUCTURE FOR PPHONE 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) NOT NULL,
PHONENUMBER CHAR( 4) );
/*******************************/
/* STRUCTURE FOR PEMPLP RECORD */
/*******************************/
DCL 1 PEMPLP,
2 EMPLOYEENUMBER CHAR(6),
2 PHONENUMBER CHAR(4);
/***************/
/* SQL CURSORS */
/***************/
/* CURSOR LISTS ALL EMPLOYEE NAMES */
EXEC SQL DECLARE TELE1 CURSOR FOR
SELECT *
FROM VPHONE;
/* CURSOR LISTS ALL EMPLOYEE NAMES WITH A PATTERN (% OR _) */
/* IN LAST NAME OR A BLANK LAST NAME. */
EXEC SQL DECLARE TELE2 CURSOR FOR
SELECT *
FROM VPHONE
WHERE LASTNAME LIKE :LNAMEWK
AND FIRSTNAME LIKE :FNAMEWK;
/* CURSOR LISTS ALL EMPLOYEES WITH A SPECIFIC LAST NAME */
EXEC SQL DECLARE TELE3 CURSOR FOR
SELECT *
FROM VPHONE
WHERE LASTNAME = :LNAMEWK
AND FIRSTNAME LIKE :FNAMEWK;
/****************************/
/* SQL RETURN CODE HANDLING */
/****************************/
EXEC SQL WHENEVER SQLERROR GOTO DBERROR;
EXEC SQL WHENEVER SQLWARNING GOTO DBERROR;
EXEC SQL WHENEVER NOT FOUND CONTINUE;
1/****************************/
/* MAIN PROGRAM ROUTINE */
/****************************/
GET FILE (CARDIN) EDIT (IOAREA) (R(L4)); /* READ FIRST REQUEST */
/* PROCESS INPUT REQUESTS */
DO WHILE (^EOF); /* CONTINUE WHILE MORE TO DO */
/* PUT REPORT HEADINGS */
/****************************/
/* CREATE REPORT HEADING */
/* SELECT ACTION */
/****************************/
PUT FILE (REPORT) PAGE EDIT (REPHDR1) (R(L1));
PUT FILE (REPORT) EDIT (REPHDR2) (R(L2));
IF INDEX(LNAME,' ') > 0 THEN
LNAMEWK = SUBSTR(LNAME,1,INDEX(LNAME,' ')-1);
ELSE
LNAMEWK = LNAME;
IF INDEX(FNAME,' ') > 0 THEN
FNAMEWK = SUBSTR(FNAME,1,INDEX(FNAME,' ')-1);
ELSE
FNAMEWK = FNAME;
/* GET WORKING VERSIONS OF */
/* LAST AND FIRST NAMES WITH */
/* NO TRAILING BLANKS */
IF LNAME = ' ' THEN LNAMEWK='%'; /* BLANK NAMES IN INPUT MEAN */
IF FNAME = ' ' THEN FNAMEWK='%'; /* SEARCH FOR ALL NAMES */
SELECT (ACTION); /* DETERMINE INPUT REQUEST */
/**************************************/
/* LIST ALL EMPLOYEES */
/**************************************/
WHEN ('L') DO; /* LIST EMPLOYEES */
IF LNAME = '*' THEN /* LIST ALL EMPLOYEES */
DO;
EXEC SQL OPEN TELE1; /* OPEN CURSOR FOR SEARCH */
EXEC SQL FETCH TELE1 INTO :PPHONE;/* GET FIRST RECORD */
IF SQLCODE = NOTFOUND THEN /* NO RECORDS FOUND */
DO; /* GET ERROR MESSAGE */
CALL DSN8MPG (MODULE, '008I', OUTMSG);
PUT FILE (REPORT) EDIT (OUTMSG) (SKIP(2),A);
END;
/* GET AND PRINT ALL RECORDS */
DO WHILE (SQLCODE = ZERO);
PUT FILE (REPORT) EDIT (PPHONE) (R(L3));
EXEC SQL FETCH TELE1 INTO :PPHONE;/* GET NEXT RECORD */
END; /* END DO WHILE */
EXEC SQL CLOSE TELE1; /* CLOSE CURSOR FOR SEARCH */
END; /* END DO IF */
/**************************************/
/* LIST GENERIC EMPLOYEES */
/**************************************/
ELSE /* SELECT EMPLOYEES BY NAME */
DO; /* SEARCH ON PART OF NAME? */
IF INDEX(LNAMEWK,'%') > ZERO THEN
DO; /* YES: SEARCH ON PART OF */
/* LAST NAME */
EXEC SQL OPEN TELE2; /* OPEN CURSOR FOR SEARCH */
EXEC SQL FETCH TELE2 INTO :PPHONE;/* GET 1ST RECORD */
IF SQLCODE = NOTFOUND THEN /* NO RECORDS FOUND */
DO; /* GET ERROR MESSAGE*/
CALL DSN8MPG (MODULE, '008I', OUTMSG);
PUT FILE (REPORT) EDIT (OUTMSG) (SKIP(2),A);
END;
/* GET AND PRINT ALL RECORDS */
DO WHILE (SQLCODE = ZERO);
PUT FILE (REPORT) EDIT (PPHONE) (R(L3));
EXEC SQL FETCH TELE2 INTO :PPHONE;/*GET NEXT RECORD*/
END; /* END DO WHILE */
EXEC SQL CLOSE TELE2; /* CLOSE CURSOR FOR SEARCH */
END; /* END DO IF */
/**************************************/
/* LIST SPECIFIC EMPLOYEES */
/**************************************/
ELSE /* NO - SEARCH ON LAST NAME */
DO; /* & OPTIONALLY FIRST NAME */
/* SEE IF FIRST NAME ENTERED */
/* IF NOT SET UP FOR ALL NAMES*/
EXEC SQL OPEN TELE3; /* OPEN CURSOR FOR SEARCH */
EXEC SQL FETCH TELE3 INTO :PPHONE;/* GET 1ST RECORD */
IF SQLCODE = NOTFOUND THEN /* NO RECORDS FOUND*/
DO; /* GET ERROR MESSAGE*/
CALL DSN8MPG (MODULE, '008I', OUTMSG);
PUT FILE (REPORT) EDIT (OUTMSG) (SKIP(2),A);
END;
/* GET AND PRINT ALL RECORDS */
DO WHILE (SQLCODE = ZERO);
PUT FILE (REPORT) EDIT (PPHONE) (R(L3));
EXEC SQL FETCH TELE3 INTO :PPHONE;/*GET NEXT RECORD*/
END; /* END DO WHILE */
EXEC SQL CLOSE TELE3; /* CLOSE CURSOR FOR SEARCH*/
END; /* END DO ELSE */
END; /* END DO IF */
END; /*END WHEN */
/***************************************/
/* UPDATES PHONE NUMBERS FOR EMPLOYEES */
/***************************************/
WHEN ('U') DO; /* TELEPHONE UPDATE */
EXEC SQL UPDATE VEMPLP
SET PHONENUMBER = :NEWNO /* CHANGE PHONE NO.*/
WHERE EMPLOYEENUMBER = :ENO;
IF SQLCODE = ZERO THEN /* WAS UPDATE OK? */
DO;
CALL DSN8MPG (MODULE, '004I', OUTMSG); /* YES */
PUT FILE (REPORT) EDIT (OUTMSG) (SKIP(2),A);/* YES */
END; /*EMPLOYEE FOUND*/
/*UPDATE SUCCESSFUL*/
ELSE
DO;
CALL DSN8MPG (MODULE, '007E', OUTMSG); /*UPDATE FAILED*/
PUT FILE (REPORT) EDIT (OUTMSG) (SKIP(2),A);
END; /* END DO ELSE*/
END; /* END WHEN */
OTHERWISE /* INVALID REQUEST */
DO;
CALL DSN8MPG (MODULE, '068E', OUTMSG);
PUT FILE (REPORT) EDIT (OUTMSG) (SKIP(2),A);
END; /* END OTHERWISE */
END; /* END SELECT*/
GET FILE (CARDIN) EDIT (IOAREA) (R(L4)); /* READ NEXT REQUEST */
END; /* END EOF */
GOTO PGMEND; /* BYPASS SQL ERRORHANDLING */
/***************************/
/* SQL ERROR CODE HANDLING */
/***************************/
DCL
DSNTIAR ENTRY OPTIONS(ASM,INTER,RETCODE);
DCL
DATA_LEN FIXED BIN(31) INIT(120);
DCL
DATA_DIM FIXED BIN(31) INIT(10);
DCL
1 ERROR_MESSAGE AUTOMATIC,
3 ERROR_LEN FIXED BIN(15) UNAL INIT((DATA_LEN*DATA_DIM)),
3 ERROR_TEXT(DATA_DIM) CHAR(DATA_LEN);
/*****************************************/
/* SQL ERROR OCCURRED - GET ERROR MESSAGE*/
/*****************************************/
DBERROR:
/* SQL ERROR */
/* PRINT ERROR MESSAGE*/
CALL DSN8MPG (MODULE, '060E', OUTMSG);
PUT FILE (REPORT) EDIT (OUTMSG,SQLCODE) (SKIP(2),A,F(10));
CALL DSNTIAR( SQLCA , ERROR_MESSAGE , DATA_LEN );
IF PLIRETV = ZERO THEN /*ZERO RETURN CODE FROM DSNTIAR*/
DO I=ONE TO DIM(ERROR_TEXT,ONE);
PUT FILE (REPORT) EDIT ( ERROR_TEXT(I)) (SKIP,A) ;
END;
ELSE
DO;
CALL DSN8MPG (MODULE, '075E', OUTMSG);
PUT FILE (REPORT) EDIT /*NON-ZERO RETURN CODE FROM DSNTIAR*/
/*PRINT ERROR MESSAGE */
( OUTMSG, PLIRETV ) ( SKIP(2), A, F(10)) ;
END;
/**********************************************************/
/* SQL RETURN CODE HANDLING WHEN PROCESSING CANNOT PROCEED*/
/**********************************************************/
EXEC SQL WHENEVER SQLERROR CONTINUE;
EXEC SQL WHENEVER SQLWARNING CONTINUE;
EXEC SQL WHENEVER NOT FOUND CONTINUE;
EXEC SQL ROLLBACK; /* PERFORM ROLLBACK */
IF SQLCODE = ZERO THEN
DO; /* ROLLBACK SUCCESSFUL,*/
/* ALL UPDATES REMOVED */
CALL DSN8MPG (MODULE, '053I', OUTMSG);
PUT FILE (REPORT) EDIT (OUTMSG) (SKIP(2),A);
END;
ELSE
DO; /* ROLLBACK FAILED,*/
/* RETURN CODE IS: */
CALL DSN8MPG (MODULE, '061E', OUTMSG);
PUT FILE (REPORT) EDIT (OUTMSG,SQLCODE) (SKIP(2),A,F(10));
END;
PGMEND: /* PROGRAM END */
END;