DSN8CLPV
Prompts the user to choose an employee then retrieves the PSEG photo image for that employee from the PSEG - PHOTO column of the EMP_PHOTO_RESUME table and passes it to GDDM for formatting and display.
***************************************************************** 00010000
* MODULE NAME = DSN8CLPV (DB2 SAMPLE PROGRAM) * 00020000
* * 00030000
* DESCRIPTIVE NAME = Display PSEG photo image of a specified * 00040000
* employee * 00050000
* * 00060000
* LICENSED MATERIALS - PROPERTY OF IBM * 00070000
* 5615-DB2 * 00080000
* (C) COPYRIGHT 1982 2013 IBM CORP. ALL RIGHTS RESERVED. * 00090000
* * 00100000
* STATUS = VERSION 11 * 00110000
* * 00120000
* Function:Prompts the user to choose an employee then retrieves* 00130000
* the PSEG photo image for that employee from the PSEG - * 00140000
* PHOTO column of the EMP_PHOTO_RESUME table and passes it* 00150000
* to GDDM for formatting and display. * 00160000
* * 00170000
* Notes: * 00180000
* Dependencies: * 00190000
* Requires IBM Graphical Data Display Manager (GDDM)* 00200000
* V3R1 or higher * 00210000
* * 00220000
* Restrictions: * 00230000
* Module type: COBOL program * 00240000
* Module size: See linkedit output * 00250000
* Attributes: Re-entrant and re-usable * 00260000
* * 00270000
* Entry Point: CEESTART (Language Environment entry point) * 00280000
* Purpose: See Function * 00290000
* Linkage: Standard MVS program invocation no parameters * 00300000
* * 00310000
* Normal Exit: Return Code = 0000 * 00320000
* - Message: none * 00330000
* * 00340000
* Error Exit: Return Code = 0008 * 00350000
* - Message: *** ERROR: DSN8CLPV DB2 Sample Program* 00360000
* Unexpected SQLCODE encountered* 00370000
* at location xxx * 00380000
* Error detailed below * 00390000
* Processing terminated * 00400000
* (DSNTIAR-formatted message here)* 00410000
* * 00420000
* - Message: *** ERROR: DSN8CLPV DB2 Sample Program* 00430000
* No entry in the Employee Photo/* 00440000
* Resume table for employee with * 00450000
* empno = xxxxxx * 00460000
* Processing terminated * 00470000
* * 00480000
* - Message: *** ERROR: DSN8CLPV DB2 Sample Program* 00490000
* No PSEG data exists in * 00500000
* the Employee Photo/Resume table* 00510000
* for the employee with empno = * 00520000
* xxxxxx. * 00530000
* Processing terminated * 00540000
* * 00550000
* * 00560000
* External References: * 00570000
* - Routines/Services: DSNTIAR, GDDM, ISPF * 00580000
* - Data areas : DSNTIAR error_message * 00590000
* - CONTROL blocks : None * 00600000
* * 00610000
* * 00620000
* Pseudocode: * 00630000
* DSN8CLPV: * 00640000
* - Do until the user indicates termination * 00650000
* - Call GETEMPLNUM to request an employee id * 00660000
* - Call GETEMPLPHOTO to retrieve the PSEG photo image * 00670000
* - Call SHOWEMPLPHOTO to display the photo * 00680000
* End DSN8CLPV * 00690000
* * 00700000
* * 00710000
* GETEMPLNUM: * 00720000
* -prompt user to select an employee whose photo image is to * 00730000
* be viewed * 00740000
* End GETEMPLNUM * 00750000
* * 00760000
* GETEMPLPHOTO: * 00770000
* - Fetch the specified employee's PSEG photo image from DB2 * 00780000
* - call D31100-CHECK-SQLCODE for unexpected SQLCODEs * 00790000
* End GETEMPLPHOTO * 00800000
* * 00810000
* SHOWEMPLPHOTO: * 00820000
* - Use GDDM calls to format and display the PSEG photo image * 00830000
* End SHOWEMPLPHOTO * 00840000
* * 00850000
* D31100-CHECK-SQLCODE * 00860000
* - call DSNTIAR to format an unexpected SQLCODE. * 00870000
* End D31100-CHECK-SQLCODE * 00880000
* * 00890000
***************************************************************** 00900000
00910000
IDENTIFICATION DIVISION. 00920000
PROGRAM-ID. DSN8CLPV. 00930000
00940000
ENVIRONMENT DIVISION. 00950000
CONFIGURATION SECTION. 00960000
SOURCE-COMPUTER. IBM-370. 00970000
OBJECT-COMPUTER. IBM-370. 00980000
00990000
01000000
DATA DIVISION. 01010000
01020000
01030000
WORKING-STORAGE SECTION. 01040000
01050000
*************************** ISPF Syntax **************************01060000
01 CHAR PIC X(8) VALUE 'CHAR '. 01070000
01 VCONTROL PIC X(8) VALUE 'CONTROL '. 01080000
01 VDISPLAY PIC X(8) VALUE 'DISPLAY '. 01090000
01 VLINE PIC X(8) VALUE 'LINE '. 01100000
01 VDEFINE PIC X(8) VALUE 'VDEFINE '. 01110000
01 VGET PIC X(8) VALUE 'VGET '. 01120000
01 VRESET PIC X(8) VALUE 'VRESET '. 01130000
01 DSN8SSE PIC X(8) VALUE 'DSN8SSE '. 01140000
01 EMPLNUM PIC X(8) VALUE 'D8EMNUMB'. 01150000
01 VZERO PIC 9(06) COMP VALUE 0. 01160000
01 ONE PIC 9(06) COMP VALUE 1. 01170000
01 TWO PIC 9(06) COMP VALUE 2. 01180000
01 THREE PIC 9(06) COMP VALUE 3. 01190000
01 SIX PIC 9(06) COMP VALUE 06. 01200000
01 DB2IO-COMMAND PIC X(35). 01210000
01 KEEPVIEWING PIC XXX. 01220000
01 D8EMNUMB PIC X(6). 01230000
01 IH-PIXELS PIC S9(8) COMP VALUE 800. 01240000
01 IV-PIXELS PIC S9(8) COMP VALUE 750. 01250000
01 IIM-TYPE PIC S9(8) COMP VALUE 1. 01260000
01 IRES-TYPE PIC S9(8) COMP VALUE 1. 01270000
01 IRES-UNIT PIC S9(8) COMP VALUE 0. 01280000
01 IH-RES COMP-1 VALUE 10.000E1. 01290000
01 IV-RES COMP-1 VALUE 10.000E1. 01300000
01 PSEGFORMAT PIC S9(8) COMP VALUE -3. 01310000
01 PSEGCOMPRESSION PIC S9(8) COMP VALUE 4. 01320000
01 ATTYPE PIC S9(8) COMP VALUE +0. 01330000
01 ATTVAL PIC S9(8) COMP VALUE +0. 01340000
01 VCOUNT PIC S9(8) COMP VALUE +0. 01350000
01 APPL-ID PIC S9(9) COMP. 01360000
01370000
01 AABSTR. 01380000
02 SEVERITY-CODE PIC S9 COMP VALUE +0. 01390000
02 ERROR-CODE PIC S9 COMP VALUE +0. 01400000
02 GDDM-ANCHOR PIC S9(9) COMP VALUE 0. 01410000
***************************************************************** 01420000
* Job status indicator 01430000
***************************************************************** 01440000
01 STATUS1 PIC X(4). 01450000
88 NOT-OK VALUE 'BAD '. 01460000
88 OK VALUE 'GOOD'. 01470000
01480000
***************************************************************** 01490000
* Buffer for receiving SQL error messages 01500000
***************************************************************** 01510000
01 ERROR-MESSAGE. 01520000
02 ERROR-LEN PIC S9(4) COMP VALUE +960. 01530000
02 ERROR-TEXT PIC X(120) OCCURS 10 TIMES 01540000
INDEXED BY ERROR-INDEX. 01550000
77 ERROR-TEXT-LEN PIC S9(9) COMP VALUE +120. 01560000
01570000
01580000
**************************** DB2 TABLES **************************01590000
EXEC SQL DECLARE EMP_PHOTO_RESUME TABLE 01600000
( EMPNO CHAR(06) NOT NULL, 01610000
EMP_ROWID ROWID, 01620000
PSEG_PHOTO BLOB( 500K ), 01630000
BMP_PHOTO BLOB( 100K ), 01640000
RESUME CLOB( 5K ) ) 01650000
END-EXEC. 01660000
01670000
01680000
********** DB2 HOST AND NULL INDICATOR VARIABLES *************** 01690000
EXEC SQL BEGIN DECLARE SECTION END-EXEC. 01700000
77 SQLCODE PIC S9(9) COMP-4. 01710000
77 SQLSTATE PIC X(5). 01720000
01 HVEMPNO PIC X(6). 01730000
01 HVPSEG-PHOTO USAGE IS SQL TYPE IS BLOB(500K). 01740000
01 NIPSEG-PHOTO PIC S9(4) COMP-4 VALUE 0. 01750000
EXEC SQL END DECLARE SECTION END-EXEC. 01760000
01770000
PROCEDURE DIVISION. 01780000
A10000-LOBEXAMPLE. 01790000
01800000
MOVE 'GOOD' TO STATUS1. 01810000
MOVE "YES" TO KEEPVIEWING. 01820000
01830000
PERFORM UNTIL KEEPVIEWING = "NO" 01840000
01850000
*********************************************************** 01860000
* extract the employee's PSEG photo image from BLOB storage* 01870000
*********************************************************** 01880000
PERFORM C10000-GETEMPLNUM 01890000
01900000
*********************************************************** 01910000
* if okay, convert PSEG image to GDDM format and display it* 01920000
*********************************************************** 01930000
IF OK AND KEEPVIEWING = "YES" 01940000
PERFORM C10010-GETEMPLPHOTO 01950000
01960000
IF OK 01970000
PERFORM C10010-SHOWEMPLPHOTO 01980000
ELSE 01990000
MOVE "NO" TO KEEPVIEWING 02000000
END-IF 02010000
END-IF 02020000
02030000
END-PERFORM 02040000
02050000
STOP RUN. 02060000
02070000
02080000
C10000-GETEMPLNUM. 02090000
********************************************************** 02100000
* Called by the main routine. Displays an ISPF panels to* 02110000
* prompt the user to select an employee whose resume is * 02120000
* to be displayed. * 02130000
********************************************************** 02140000
02150000
********************************************************* 02160000
* Share the ISPF var having the employee number * 02170000
********************************************************* 02180000
02190000
CALL 'ISPLINK' USING VDEFINE EMPLNUM D8EMNUMB CHAR 02200000
SIX. 02210000
MOVE SPACES TO D8EMNUMB. 02220000
02230000
***** DISPLAY THE PROMPT PANEL ************************** 02240000
CALL 'ISPLINK' USING VDISPLAY DSN8SSE. 02250000
IF RETURN-CODE NOT = 0 02260000
MOVE 'NO' TO KEEPVIEWING. 02270000
02280000
*** SAVE OFF THE VALUE OF THE ISPF SHARED VARIABLE ****** 02290000
MOVE D8EMNUMB TO HVEMPNO. 02300000
02310000
*** AND RELEASE IT ************************************** 02320000
CALL 'ISPLINK' USING VRESET. 02330000
02340000
02350000
C10010-GETEMPLPHOTO. 02360000
********************************************************** 02370000
* CALLED BY THE MAIN ROUTINE. EXTRACTS A SPECIFIED * 02380000
* EMPLOYEE'S PHOTO DATA FROM A BLOB COLUMN IN THE SAMPLE * 02390000
* EMP_PHOTO_RESUME. THIS IMAGE WILL BE CONVERTED TO * 02400000
* GDDM FORMAT AND DISPLAYED BY THE ROUTINE SHOWEMPLPHOTO * 02410000
********************************************************** 02420000
02430000
EXEC SQL SELECT PSEG_PHOTO 02440000
INTO :HVPSEG-PHOTO 02450000
FROM EMP_PHOTO_RESUME 02460000
WHERE EMPNO = :HVEMPNO 02470000
END-EXEC. 02480000
02490000
IF SQLCODE = 100 02500000
MOVE 'BAD' TO STATUS1 02510000
DISPLAY '**************************************' 02520000
DISPLAY '*** ERROR: DSN8CLPV DB2 SAMPLE PROGRAM' 02530000
DISPLAY '*** NO ENTRY IN THE EMPLOYEE PHOTO/RESUME' 02540000
DISPLAY '*** TABLE FOR EMPLOYEE WITH EMPNO ' HVEMPNO 02550000
DISPLAY '*** PROCESSING TERMINATED' 02560000
DISPLAY '***************************************' 02570000
ELSE 02580000
IF SQLCODE = 305 02590000
MOVE 'BAD' TO STATUS1 02600000
DISPLAY '************************************' 02610000
DISPLAY '*** ERROR: DSN8CLPV DB2 SAMPLE PROGRAM' 02620000
DISPLAY '*** NO PHOTO IMAGE EXISTS IN THE' 02630000
DISPLAY '*** EMPLOYEE PHOTO/RESUME TABLE FOR ' 02640000
DISPLAY '*** EMPLOYEE WITH EMPNO = ' HVEMPNO 02650000
DISPLAY '*** PROCESSING TERMINATED' 02660000
DISPLAY '************************************' 02670000
ELSE 02680000
IF SQLCODE NOT = 0 02690000
MOVE 'BAD' TO STATUS1 02700000
MOVE 'GETEMPLPHOTO @ SELECT' TO DB2IO-COMMAND 02710000
PERFORM D31100-CHECK-SQLCODE 02720000
END-IF 02730000
END-IF 02740000
END-IF. 02750000
02760000
C10010-SHOWEMPLPHOTO. 02770000
**************************************************************** 02780000
* Called by the main routine.Converts the employee's photo * 02790000
* from PSEG format to a GDDM image and then displays IT until * 02800000
* the user depresses any PF key or the <enter> key. * 02810000
**************************************************************** 02820000
02830000
***************************************************************** 02840000
*Signal ISPF to full-screen refresh when GDDM session terminates* 02850000
***************************************************************** 02860000
CALL 'ISPLINK' USING VCONTROL VDISPLAY VLINE. 02870000
02880000
********** Initialize GDDM ************************************** 02890000
CALL 'FSINIT' USING AABSTR. 02900000
02910000
***** Obtain a GDDM application image id *********************** 02920000
CALL 'IMAGID' USING AABSTR, BY REFERENCE APPL-ID. 02930000
02940000
******************************************************************02950000
* Create a GDDM application image to receive the employee photo *02960000
******************************************************************02970000
CALL 'IMACRT' USING AABSTR, APPL-ID, IH-PIXELS, IV-PIXELS, 02980000
IIM-TYPE, IRES-TYPE, IRES-UNIT, IH-RES, IV-RES. 02990000
03000000
**** Set up conversion of photo from PSEG format to GDDM format **03010000
CALL 'IMAPTS' USING AABSTR, APPL-ID, VZERO, PSEGFORMAT, 03020000
PSEGCOMPRESSION. 03030000
03040000
******** Perform Conversion **************************************03050000
CALL 'IMAPT' USING AABSTR, APPL-ID, HVPSEG-PHOTO-LENGTH, 03060000
HVPSEG-PHOTO-DATA. 03070000
03080000
******** Terminate Conversion ************************************03090000
CALL 'IMAPTE' USING AABSTR, APPL-ID. 03100000
03110000
**** Transfer the GDDM application image to the display **********03120000
CALL 'IMXFER' USING AABSTR, APPL-ID, VZERO, VZERO. 03130000
03140000
**** Disable user updates to the image on the display ************03150000
CALL 'FSENAB' USING AABSTR, ONE, VZERO. 03160000
CALL 'FSENAB' USING AABSTR, TWO, VZERO. 03170000
CALL 'FSENAB' USING AABSTR, THREE, VZERO. 03180000
03190000
***** Display the image until attn or interrupt key depressed ****03200000
CALL 'ASREAD' USING AABSTR, ATTYPE, ATTVAL, VCOUNT. 03210000
03220000
***** Delete GDDM application image ******************************03230000
CALL 'IMADEL' USING AABSTR, APPL-ID. 03240000
03250000
***** Terminate GDDM *********************************************03260000
CALL 'FSTERM' USING AABSTR. 03270000
03280000
03290000
03300000
D31100-CHECK-SQLCODE. 03310000
**************************************************************** 03320000
* Verify that the prior SQL call completed successfully 03330000
**************************************************************** 03340000
IF SQLCODE NOT = 0 THEN 03350000
MOVE 'BAD' TO STATUS1. 03360000
DISPLAY '* UNEXPECTED SQLCODE FROM DSN8CLRV ' 03370000
'DURING ' DB2IO-COMMAND ' REQUEST.' 03380000
DISPLAY '*' 03390000
PERFORM E31110-DETAIL-SQL-ERROR. 03400000
03410000
03420000
E31110-DETAIL-SQL-ERROR. 03430000
**************************************************************** 03440000
* CALL DSNTIAR TO RETURN A TEXT MESSAGE FOR AN UNEXPECTED 03450000
* SQLCODE. 03460000
**************************************************************** 03470000
CALL 'DSNTIAR' USING SQLCA ERROR-MESSAGE ERROR-TEXT-LEN. 03480000
IF RETURN-CODE = ZERO 03490000
PERFORM F31111-PRINT-SQL-ERROR-MSG VARYING ERROR-INDEX 03500000
FROM 1 BY 1 UNTIL ERROR-INDEX GREATER THAN 10. 03510000
03520000
* **MESSAGE FORMAT 03530000
* **ROUTINE ERROR 03540000
* **PRINT ERROR MESSAG 03550000
03560000
03570000
F31111-PRINT-SQL-ERROR-MSG. 03580000
**************************************************************** 03590000
* PRINT MESSAGE TEXT 03600000
**************************************************************** 03610000
DISPLAY ERROR-TEXT (ERROR-INDEX). 03620000