DSN8CP3
THIS MODULE LISTS EMPLOYEE PHONE NUMBERS AND UPDATES THEM IF DESIRED.
DSN8CP3: PROC OPTIONS (MAIN);
/*********************************************************************
* *
* MODULE NAME = DSN8CP3 *
* *
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION *
* PHONE APPLICATION *
* CICS *
* PL/I *
* *
* Licensed Materials - Property of IBM *
* 5635-DB2 *
* (C) COPYRIGHT 1982, 2006 IBM Corp. All Rights Reserved. *
* *
* STATUS = Version 9 *
* *
* FUNCTION = THIS MODULE LISTS EMPLOYEE PHONE NUMBERS AND *
* UPDATES THEM IF DESIRED. *
* *
* NOTES = *
* DEPENDENCIES = THREE CICS MAPS(DSECTS) ARE REQUIRED: *
* DSN8MPMN, DSN8MPML, AND DSN8MPMU *
* RESTRICTIONS = NONE *
* *
* MODULE TYPE = PL/I PROC OPTIONS(MAIN) *
* PROCESSOR = DB2 PRECOMPILER, CICS TRANSLATOR, PL/I OPTIMIZER*
* MODULE SIZE = SEE LINKEDIT *
* ATTRIBUTES = REENTRANT *
* *
* ENTRY POINT = DSN8CP3 *
* PURPOSE = SEE FUNCTION *
* LINKAGE = INVOKED FROM CICS *
* *
* INPUT = PARAMETERS EXPLICITLY PASSED TO THIS FUNCTION: *
* INPUT-MESSAGE: *
* *
* SYMBOLIC LABEL/NAME = DSN8CPNI *
* DESCRIPTION = PHONE MENU 1 (SELECT) *
* *
* SYMBOLIC LABEL/NAME = DSN8CPLI *
* DESCRIPTION = PHONE MENU 2 (LIST) *
* *
* SYMBOLIC LABEL/NAME = DSN8CPUI *
* DESCRIPTION = PHONE MENU 3 (UPDATE) *
* *
* 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 = DSN8CPNO *
* DESCRIPTION = PHONE MENU 1 (SELECT) *
* *
* SYMBOLIC LABEL/NAME = DSN8CPLO *
* DESCRIPTION = PHONE MENU 2 (LIST) *
* *
* SYMBOLIC LABEL/NAME = DSN8CPUO *
* DESCRIPTION = PHONE MENU 3 (UPDATE) *
* *
* 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 *
* DSN8057I - FURTHER ENTRIES IN TABLE - UPDATE POSSIBLE *
* DSN8060E - SQL ERROR, RETURN CODE IS: *
* *
* EXTERNAL REFERENCES = *
* ROUTINES/SERVICES = *
* DSN8MPG - ERROR MESSAGE ROUTINE *
* *
* DATA-AREAS = *
* IN_MESSAGE - VIA BMS, SEE INPUT PARAMETERS *
* OUT_MESSAGE - VIA BMS, SEE OUTPUT PARAMTERS *
* DSN8MPML - DECLARE FOR DSN8CPL CICS MAP *
* DSN8MPMN - DECLARE FOR DSN8CPN CICS MAP *
* DSN8MPMU - DECLARE FOR DSN8CPU CICS MAP *
* *
* CONTROL-BLOCKS = *
* SQLCA - SQL COMMUNICATION AREA *
* *
* TABLES = NONE *
* *
* *
* CHANGE-ACTIVITY = *
* PQ92146 09/07/04 CHANGE DECLARED LENGTH OF BMS_IO FROM 32767 @01*
* TO 1408 TO STOP IBM2402I COMPILE-TIME ERROR @01*
* *
* *
* *PSEUDOCODE* *
* *
* PROCEDURE *
* GET FIRST INPUT *
* DO WHILE MORE INPUT *
* GET REPORT HEADING *
* *
* CASE (ACTION) *
* *
* SUBCASE ('L') *
* IF LASTNAME IS '*' *
* LIST ALL EMPLOYEES *
* ELSE *
* IF LASTNAME CONTAINS '%' *
* LIST EMPLOYEES GENERIC *
* ELSE *
* LIST EMPLOYEES SPECIFIC *
* ENDSUB *
* *
* SUBCASE ('U') *
* UPDATE PHONENUMBER FOR EMPLOYEE *
* WRITE CONFIRMATION MESSAGE *
* OTHERWISE *
* INVALID REQUEST *
* ENDSUB *
* *
* GET NEXT INPUT *
* ENDCASE *
* *
* IF SQL ERROR OCCURS THEN *
* FORMAT ERROR MESSAGE *
* ROLLBACK *
* END *
* END. *
*-------------------------------------------------------------------*/
/*-------------------------------------------------------------------*
* *
* MODULE NAME = DSN8CP3 *
* KDB0010 *
* *
* *
*-------------------------------------------------------------------*/
1/********************************************************************/
/* DECLARATION FOR INPUT / OUTPUT */
/********************************************************************/
EXEC SQL INCLUDE DSN8MPMN ;
EXEC SQL INCLUDE DSN8MPML ;
EXEC SQL INCLUDE DSN8MPMU ;
0DCL 1 SUBMAPI(15) UNALIGNED BASED(ADDR(DSN8CU2I.NEWNO1L)),
2 NEWNOL FIXED BIN(15,0),
2 NEWNOA CHAR(1),
2 NEWNOD CHAR(4),
2 ENOL FIXED BIN(15,0),
2 ENOA CHAR(1),
2 ENOD CHAR(6);
0DCL 1 SUBMAPO(15) UNALIGNED BASED(ADDR(DSN8CL2I.FNAME1L)),
2 FNAMEL FIXED BIN(15,0),
2 FNAMEA CHAR(1),
2 FNAMED CHAR(12),
2 MINITL FIXED BIN(15,0),
2 MINITA CHAR(1),
2 MINITD CHAR(1),
2 LNAMEL FIXED BIN(15,0),
2 LNAMEA CHAR(1),
2 LNAMED CHAR(15),
2 PNOL FIXED BIN(15,0),
2 PNOA CHAR(1),
2 PNOD CHAR(4),
2 ENOL FIXED BIN(15,0),
2 ENOA CHAR(1),
2 ENOD CHAR(6),
2 WDEPTL FIXED BIN(15,0),
2 WDEPTA CHAR(1),
2 WDEPTD CHAR(3),
2 WNAMEL FIXED BIN(15,0),
2 WNAMEA CHAR(1),
2 WNAMED CHAR(31);
/***** HOLDS BYTE-COUNT OF STORAGE ALLOCATED TO BMS OUTPUT AREA *****/
DCL BMS_LL BIN FIXED( 31 ) INIT( STG(DSN8CL2I) );/*@EDVG*/
/******* MASK/OVERLAY OF STORAGE ALLOCATED TO BMS OUTPUT AREA *******/
DCL BMS_IO CHAR( 1408 ) BASED( ADDR(DSN8CL2I) ); /*@01*/
1/********************************************************************/
/* DECLARATION FOR PGM-LOGIC */
/********************************************************************/
DCL FIRST BIT(1);
DCL PAGING BIT(1);
DCL OFLOW BIT(1);
DCL EMPLOYEE_NO CHAR (6);
DCL PHONE_NO CHAR (4);
DCL CHAR_SQLCODE CHAR (14);
DCL 1 CHAR_SQLSTR BASED(ADDR(CHAR_SQLCODE)),
2 CHAR_BLNK CHAR(4),
2 CHAR_SQLCOD CHAR(10);
1/***************************************************/
/* FIELDS SENT TO MESSAGE ROUTINE */
/***************************************************/
DCL MODULE CHAR (7) INIT('DSN8CP3');
DCL OUTMSG CHAR (69);
DCL DSN8MPG EXTERNAL ENTRY;
1/********************************************************************/
/* DECLARATION FOR SQL */
/********************************************************************/
0EXEC SQL INCLUDE SQLCA; /* SQL COMMUNICATION AREA */
/* 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));
/* STRUCTURE FOR PEMPLP RECORD */
DCL 1 PEMP,
2 EMPLOYEENUMBER CHAR (6),
2 PHONENUMBER CHAR (4);
1/********************************************************************/
/* SQL CURSORS */
/********************************************************************/
EXEC SQL DECLARE TELE1 CURSOR FOR
SELECT *
FROM VPHONE;
EXEC SQL DECLARE TELE2 CURSOR FOR
SELECT *
FROM VPHONE
WHERE LASTNAME LIKE :DSN8CN2I.LNAMEI
AND FIRSTNAME LIKE :DSN8CN2I.FNAMEI;
EXEC SQL DECLARE TELE3 CURSOR FOR
SELECT *
FROM VPHONE
WHERE LASTNAME = :DSN8CN2I.LNAMEI
AND FIRSTNAME LIKE :DSN8CN2I.FNAMEI;
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;
1/********************************************************************/
/* MAIN PROGRAM ROUTINE */
/********************************************************************/
/* SET HANDLE CONDITIONS */
EXEC CICS HANDLE CONDITION MAPFAIL (P3_MAPFAIL);
EXEC CICS HANDLE AID CLEAR (P3_CLEAR);
/******************** CLEAR THE BMS OUTPUT AREA ********************/
SUBSTR(BMS_IO,1,BMS_LL) = LOW(BMS_LL) ; /*@EDVG*/
P3_START:
FIRST = '1'B; /*INITIALIZE FIRST BIT */
OFLOW = '0'B; /*INITIALIZE OVERFLOW BIT*/
SELECT (EIBTRNID); /* SELECT ACTION */
WHEN ('D8PT') DO; /* LIST EMPLOYEES */
/* GET INPUT FROM SCREEN */
EXEC CICS RECEIVE MAP('DSN8CN2') MAPSET('DSN8CPN');
1/********************************************************************/
/* LIST ALL EMPLOYEES */
/********************************************************************/
IF DSN8CN2I.LNAMEI = '*' THEN /*LIST ALL EMPLOYEES */
DO;
EXEC SQL OPEN TELE1; /* OPEN CURSOR */
EXEC SQL FETCH TELE1 /* GET FIRST RECORD */
INTO :PPHONE;
I = 0; /* INITIALIZE COUNTER */
IF SQLCODE = 100 THEN /* NO EMPLOYEE FOUND */
DO; /* PRINT ERROR MESSAGE */
CALL DSN8MPG (MODULE, '008I', OUTMSG);
DSN8CN3I.EMSGI = OUTMSG;
EXEC CICS SEND MAP('DSN8CN3') MAPSET('DSN8CPN') ERASE;
EXEC CICS SEND MAP('DSN8CN2') MAPSET('DSN8CPN');
END;
DO WHILE (SQLCODE = 0); /*LIST EMPLOYEES*/
I = I + 1; /* INCREMENT COUNTER*/
PAGING = '1'B;
SUBMAPO.FNAMED(I) = PPHONE.FIRSTNAME;
SUBMAPO.MINITD(I) = PPHONE.MIDDLEINITIAL;
SUBMAPO.LNAMED(I) = PPHONE.LASTNAME;
SUBMAPO.PNOD(I) = PPHONE.PHONENUMBER;
SUBMAPO.ENOD(I) = PPHONE.EMPLOYEENUMBER;
SUBMAPO.WDEPTD(I) = PPHONE.DEPTNUMBER;
SUBMAPO.WNAMED(I) = PPHONE.DEPTNAME;
IF I = 15 THEN /*POSSIBLE OVERFLOW */
DO; /* PRINT ERROR MESSAGE*/
OFLOW = '1'B;
CALL DSN8MPG (MODULE, '057I', OUTMSG);
DSN8CL3O.EMSGO = OUTMSG;
END;
IF I = 15 THEN LEAVE; /* SCREEN IS FILLED */
EXEC SQL FETCH TELE1 /* GET NEXT RECORD */
INTO :PPHONE;
END; /* END OF WHILE */
EXEC SQL CLOSE TELE1; /* CLOSE CURSOR */
END; /* END OF IF */
1/********************************************************************/
/* LIST GENERIC EMPLOYEES */
/********************************************************************/
ELSE /* SELECT EMPLOYEES BY NAME*/
DO; /* SEARCH ON PART OF NAME? */
IF DSN8CN2I.LNAMEL = 0 THEN /* IS LAST NAME BLANK? */
DSN8CN2I.LNAMEI = '%%%%%%%%%%%%%%%'; /* YES, ANYTHING */
IF INDEX(DSN8CN2I.LNAMEI,'%') > 0 THEN /* IS IT A PATTERN*/
DO; /* YES, SEARCH ON */
/* PART OF LAST NAME */
DSN8CN2I.LNAMEI = TRANSLATE(DSN8CN2I.LNAMEI,'%',' ');
/*AND OPTIONALLY FIRST NAME*/
IF DSN8CN2I.FNAMEL = 0 THEN
DSN8CN2I.FNAMEI = '%%%%%%%%%%%%';
ELSE
DSN8CN2I.FNAMEI = TRANSLATE(DSN8CN2I.FNAMEI,'%',' ');
EXEC SQL OPEN TELE2; /* OPEN CURSOR */
EXEC SQL FETCH TELE2 /* GET FIRST RECORD */
INTO :PPHONE;
I = 0; /* INITIALIZE COUNTER */
IF SQLCODE = 100 THEN /* EMPLOYEE NOT FOUND */
DO; /* PRINT ERROR MESSAGE */
CALL DSN8MPG (MODULE, '008I', OUTMSG);
DSN8CN3I.EMSGI = OUTMSG;
EXEC CICS SEND MAP('DSN8CN3') MAPSET('DSN8CPN') ERASE;
EXEC CICS SEND MAP('DSN8CN2') MAPSET('DSN8CPN');
END;
DO WHILE (SQLCODE = 0); /* LIST EMPLOYEES */
I = I + 1; /* INCREMENT COUNTER */
PAGING = '1'B;
SUBMAPO.FNAMED(I) = PPHONE.FIRSTNAME;
SUBMAPO.MINITD(I) = PPHONE.MIDDLEINITIAL;
SUBMAPO.LNAMED(I) = PPHONE.LASTNAME;
SUBMAPO.PNOD(I) = PPHONE.PHONENUMBER;
SUBMAPO.ENOD(I) = PPHONE.EMPLOYEENUMBER;
SUBMAPO.WDEPTD(I) = PPHONE.DEPTNUMBER;
SUBMAPO.WNAMED(I) = PPHONE.DEPTNAME;
IF I = 15 THEN /*POSSIBLE OVERFLOW */
DO; /* PRINT ERROR MESSAGE*/
OFLOW = '1'B;
CALL DSN8MPG (MODULE, '057I', OUTMSG);
DSN8CL3O.EMSGO = OUTMSG;
END;
IF I = 15 THEN LEAVE; /* SCREEN IS FILLED */
EXEC SQL FETCH TELE2 /* GET NEXT RECORD */
INTO :PPHONE;
END; /* END OF DO WHILE */
EXEC SQL CLOSE TELE2; /* CLOSE CURSOR */
END; /* END OF IF */
1/********************************************************************/
/* LIST SPECIFIC EMPLOYEE(S) */
/********************************************************************/
ELSE /* SEARCH ON LAST NAME */
DO; /*AND OPTIONALLY FIRST NAME*/
IF DSN8CN2I.FNAMEL = 0 THEN
DSN8CN2I.FNAMEI = '%%%%%%%%%%%%';
ELSE
DSN8CN2I.FNAMEI = TRANSLATE(DSN8CN2I.FNAMEI,'%',' ');
EXEC SQL OPEN TELE3; /* OPEN CURSOR */
EXEC SQL FETCH TELE3 /* GET FIRST RECORD */
INTO :PPHONE;
I = 0; /* INITIALIZE COUNTER */
IF SQLCODE = 100 THEN /* EMPLOYEE NOT FOUND */
DO; /* PRINT ERROR MESSAGE */
CALL DSN8MPG (MODULE, '008I', OUTMSG);
DSN8CN3I.EMSGI = OUTMSG;
EXEC CICS SEND MAP('DSN8CN3') MAPSET('DSN8CPN') ERASE;
EXEC CICS SEND MAP('DSN8CN2') MAPSET('DSN8CPN');
END;
DO WHILE (SQLCODE = 0); /* LIST EMPLOYEE(S) */
I = I + 1; /* INCREMENT COUNTER */
PAGING = '1'B;
SUBMAPO.FNAMED(I) = PPHONE.FIRSTNAME;
SUBMAPO.MINITD(I) = PPHONE.MIDDLEINITIAL;
SUBMAPO.LNAMED(I) = PPHONE.LASTNAME;
SUBMAPO.PNOD(I) = PPHONE.PHONENUMBER;
SUBMAPO.ENOD(I) = PPHONE.EMPLOYEENUMBER;
SUBMAPO.WDEPTD(I) = PPHONE.DEPTNUMBER;
SUBMAPO.WNAMED(I) = PPHONE.DEPTNAME;
IF I = 15 THEN /*POSSIBLE OVERFLOW */
DO; /* PRINT ERROR MESSAGE*/
OFLOW = '1'B;
CALL DSN8MPG (MODULE, '057I', OUTMSG);
DSN8CL3O.EMSGO = OUTMSG;
END;
IF I = 15 THEN LEAVE; /* SCREEN IS FILLED */
EXEC SQL FETCH TELE3 /* GET NEXT RECORD */
INTO :PPHONE;
END; /* END OF DO WHILE */
EXEC SQL CLOSE TELE3; /* CLOSE CURSOR */
END; /* END OF ELSE */
END; /* END OF IF */
IF PAGING THEN
DO;
PAGING = '0'B;
EXEC CICS SEND MAP ('DSN8CL1') MAPSET('DSN8CPL') ERASE
ACCUM PAGING;
EXEC CICS SEND MAP ('DSN8CL2') MAPSET('DSN8CPL')
ACCUM PAGING;
IF OFLOW THEN
DO;
OFLOW = '0'B;
EXEC CICS SEND MAP ('DSN8CL3') MAPSET('DSN8CPL')
ACCUM PAGING;
END;
EXEC CICS SEND PAGE;
EXEC CICS RETURN TRANSID('D8PU');
END; /* END OF IF */
ELSE EXEC CICS RETURN TRANSID ('D8PT');
END; /* END OF WHEN */
/* CHANGE ERROR HANDLING */
/* FOR UPDATE */
EXEC SQL WHENEVER SQLERROR CONTINUE;
EXEC SQL WHENEVER SQLWARNING CONTINUE;
1/********************************************************************/
/* UPDATES PHONE NUMBERS FOR EMPLOYEES */
/********************************************************************/
WHEN ('D8PU') DO; /* TELEPHONE UPDATE */
/* GET UPDATED DATA */
EXEC CICS RECEIVE MAP('DSN8CU2') MAPSET('DSN8CPU');
/* FIND WHICH NUMBERS HAVE */
/* BEEN UPDATED */
DSN8CN3I.EMSGI = ''; /* SET IN CASE NO UPDATES */
DO I = 1 TO 15;
IF SUBMAPI.NEWNOL(I) = 0 THEN; /* NO UPDATE ON THIS LINE */
ELSE
DO;
EMPLOYEE_NO = SUBMAPI.ENOD(I);
PHONE_NO = SUBMAPI.NEWNOD(I);
EXEC SQL UPDATE VEMPLP /* PERFORM UPDATE */
SET PHONENUMBER = :PHONE_NO
WHERE EMPLOYEENUMBER = :EMPLOYEE_NO;
IF SQLCODE ^= 0 THEN
DO; /* UPDATE FAILED */
/* PRINT ERROR MESSAGE */
CALL DSN8MPG (MODULE, '007E', OUTMSG);
DSN8CU3I.EMSGI = OUTMSG;
EXEC CICS SEND MAP('DSN8CU3') MAPSET('DSN8CPU');
GOTO P3_DBERROR2;
END;
/* UPDATE SUCCESSFUL*/
/* PRINT CONFIRMATION */
ELSE /* MESSAGE */
DO;
CALL DSN8MPG (MODULE, '004I', OUTMSG);
DSN8CN3I.EMSGI = OUTMSG;
END;
END; /* END ELSE */
END; /* END FOR */
EXEC CICS SEND MAP('DSN8CN3') MAPSET('DSN8CPN') ERASE;
EXEC CICS SEND MAP('DSN8CN2') MAPSET('DSN8CPN') ;
EXEC CICS RETURN TRANSID('D8PT');
END; /* END WHEN */
OTHERWISE GOTO P3_CLEAR; /* WRONG TX CODE */
END; /* END SELECT */
GOTO P3_END;
P3_MAPFAIL: /* D8PT FROM UNFORMATTED */
/* SCREEN */
/* MAP ONLY */
EXEC CICS SEND MAP('DSN8CN2') MAPONLY MAPSET('DSN8CPN') ERASE;
EXEC CICS RETURN TRANSID('D8PT');
1/********************************************************************/
/* SQL ERROR HANDLING */
/********************************************************************/
P3_DBERROR: /* SQL ERROR HANDLING */
CALL DSN8MPG (MODULE, '060E', OUTMSG);
CHAR_SQLCODE = SQLCODE;
DSN8CN3I.EMSGI = OUTMSG||CHAR_SQLCOD;
EXEC CICS SEND MAP('DSN8CN3') MAPSET('DSN8CPN') ;
P3_DBERROR2:
EXEC CICS SEND PAGE ; /* PERFORM ROLLBACK */
EXEC CICS SYNCPOINT ROLLBACK;
EXEC CICS RETURN;
P3_CLEAR: /* CLEAR SCREEN */
EXEC CICS SEND CONTROL FREEKB ;
EXEC CICS RETURN;
/********************************************************************/
P3_END: /* PROGRAM END */
END DSN8CP3;