DSN8MP4
THIS MODULE VALIDATES SPECIFIC INPUT AND MOVES IT TO THE OUTPUT MESSAGE TOGETHER WITH A TEXT FIELD.
DSN8MP4: PROC; 00010000
/********************************************************************* 00020000
* * 00030000
* MODULE NAME = DSN8MP4 * 00040000
* * 00050000
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION PROGRAM * 00060000
* VALIDATION MODULE FOR OBJECTS * 00070000
* PL/I * 00080000
* * 00090000
* * 00100000
* COPYRIGHT = 5740-XYR (C) COPYRIGHT IBM CORP 1982, 1985 * 00110000
* REFER TO COPYRIGHT INSTRUCTIONS FORM NUMBER G120-2083 * 00120000
* * 00130000
* STATUS = RELEASE 8 * 00140001
* * 00150000
* FUNCTION = THIS MODULE VALIDATES SPECIFIC INPUT * 00160000
* AND MOVES IT TO THE OUTPUT MESSAGE * 00170000
* TOGETHER WITH A TEXT FIELD. * 00180000
* * 00190000
* NOTES = NONE * 00200000
* * 00210000
* * 00220000
* MODULE TYPE = BLOCK OF PL/I CODE * 00230000
* PROCESSOR = DB2 PRECOMPILER, PL/I OPTIMIZER * 00240000
* MODULE SIZE = SEE LINKEDIT * 00250000
* ATTRIBUTES = PROBLEM STATE, REUSABLE * 00260000
* * 00270000
* ENTRY POINT = DSN8MP4 * 00280000
* PURPOSE = SEE FUNCTION * 00290000
* LINKAGE = INCLUDED BY MODULE DSN8MP1 * 00300000
* INPUT = PARAMETERS EXPLICITLY PASSED TO THIS FUNCTION: * 00310000
* SYMBOLIC LABEL/NAME = NONE * 00320000
* DESCRIPTION = NONE * 00330000
* * 00340000
* OUTPUT = PARAMETERS EXPLICITLY RETURNED: * 00350000
* SYMBOLIC LABEL/NAME = NONE * 00360000
* DESCRIPTION = NONE * 00370000
* * 00380000
* * 00390000
* EXIT-NORMAL = DROP THRU TO NEXT LINE OF CODE IN DSN8MP1 * 00400000
* * 00410000
* EXIT-ERROR = IF SQLERROR OR SQLWARNING, SQL WHENEVER CONDITION * 00420000
* SPECIFIED IN DSN8CP1/IP1 WILL BE RAISED AND PROGRAM * 00430000
* WILL GO TO THE LABEL DB_ERROR. * 00440000
* * 00450000
* * 00460000
* RETURN CODE = NONE * 00470000
* * 00480000
* ABEND CODES = NONE * 00490000
* * 00500000
* ERROR-MESSAGES = * 00510000
* DSN070E - VITAL DATA MISSING IN TABLE 'TOPTVAL' * 00520000
* * 00530000
* EXTERNAL REFERENCES = MOST VARIABLES ARE GLOBAL AND DEFINED * 00540000
* IN DSN8CP1/IP1. * 00550000
* ROUTINES/SERVICES = * 00560000
* DSN8MPG - ERROR MESSAGE ROUTINE * 00570000
* * 00580000
* DATA-AREAS = NONE * 00590000
* * 00600000
* CONTROL-BLOCKS = * 00610000
* SQLCA - SQL COMMUNICATION AREA * 00620000
* * 00630000
* TABLES = NONE * 00640000
* * 00650000
* CHANGE-ACTIVITY = NONE * 00660000
* * 00670000
* * 00680000
* *PSEUDOCODE* * 00690000
* PROCEDURE * 00700000
* INITIALIZE RETURNCODE TO '0'. * 00710000
* * 00720000
* FILL IN THE DISPLAY AREA * 00730000
* FROM VOPTVAL (OBJFLD,SELTXT) DEPENDING ON OBJECT REQUIRED * 00740000
* RETURN. * 00750000
* * 00760000
* IF OBJECT NOT FOUND * 00770000
* RETRIEVE A LIST OF OBJECTS WHICH EXIST, * 00780000
* HEADTXT, INFOTXT AND PFKTXT * 00790000
* FROM VOPTVAL * 00800000
* DEPENDING ON MAJSYS = MAJSYS , ACTION = ACTION AND * 00810000
* OBJECT = BLANK * 00820000
* FILL IN DISPLAY AREA * 00830000
* SET RETURNCODE TO '1'. * 00840000
* * 00850000
* END. * 00860000
*-------------------------------------------------------------------*/ 00870000
00880000
DCL 1 OUTPUT_REDEF(15) BASED (ADDR(PCONVSTA.OUTPUT)), 00890000
4 FIELD_1 CHAR (3), 00900000
4 FIELD_2 CHAR (6), 00910000
4 FIELD_3 CHAR (70); 00920000
00930000
/********************************************************/ 00940000
/* ** INITIALIZE RETURN CODE */ 00950000
/********************************************************/ 00960000
00970000
0 RETCODE = '0'; 00980000
DSN8_MODULE_NAME.MAJOR = 'DSN8MP4'; 00990000
MODULE = 'DSN8MP4'; 01000000
01010000
/************************************************************/ 01020000
/* ** LET'S SEE IF THE OBJECT SPECIFIED ON INPUT */ 01030000
/* ** EXISTS BY TRYING TO RETRIEVE OBJECT AND TEXT */ 01040000
/************************************************************/ 01050000
01060000
/*RETRIEVAL*/ 01070000
EXEC SQL SELECT SELTXT 01080000
INTO :POPTVAL.SELTXT 01090000
FROM VOPTVAL 01100000
WHERE MAJSYS = :INAREA.MAJSYS 01110000
AND ACTION = :INAREA.ACTION 01120000
AND OBJFLD = :INAREA.OBJFLD 01130000
AND OBJFLD <> ' ' 01140000
AND SRCHCRIT = ' '; 01150000
01160000
IF SQLCODE = +0 THEN 01170000
DO; /*OBJECT EXISTS */ 01180000
/*FILL IN DISPLAY AREA*/ 01190000
0 OUTAREA.DESC3 = POPTVAL.SELTXT; 01200000
0 OUTAREA.OBJFLD = INAREA.OBJFLD; 01210000
RETURN; /* RETURN */ 01220000
END; 01230000
01240000
/**************************************************************/ 01250000
/* ** OBJECT NOT FOUND */ 01260000
/* ** PROVIDE A LIST OF OBJECTS WHICH EXIST */ 01270000
/**************************************************************/ 01280000
01290000
OUTAREA.OBJFLD = ' '; 01300000
OUTAREA.DESC3 = ' '; 01310000
01320000
0 EXEC SQL OPEN VO3; /* OPEN VO3 CURSOR */ 01330000
01340000
/* RETRIEVE LIST */ 01350000
/* OF OBJECTS */ 01360000
0 DO I = 1 TO 15; 01370000
EXEC SQL FETCH VO3 INTO :POPTVAL.OBJFLD , :POPTVAL.SELTXT; 01380000
IF SQLCODE = +100 THEN GO TO MP4_10; 01390000
FIELD_1(I) = ''; 01400000
FIELD_2(I) = POPTVAL.OBJFLD; 01410000
FIELD_3(I) = POPTVAL.SELTXT; 01420000
END; 01430000
01440000
MP4_10: 01450000
0 EXEC SQL CLOSE VO3; /* CLOSE VO3 CURSOR */ 01460000
01470000
/* PUT BLANKS AT */ 01480000
/* END OF LINE */ 01490000
0 DO J = I TO 15; 01500000
LINE(J) = ' '; 01510000
END; 01520000
01530000
/**************************************************************/ 01540000
/* ** CHECK FOR CONDITION WHERE THERE ARE NO VALID ENTRIES */ 01550000
/**************************************************************/ 01560000
01570000
/*IF NO VALID ENTRY IN */ 01580000
/*OPTION VALIDATION */ 01590000
/*BASE TABLE (TOPTVAL) */ 01600000
/*TRY TO GET ERROR TEXT */ 01610000
IF I = 1 THEN 01620000
DO; 01630000
RETCODE = '1'; 01640000
/*ERROR TEXT FOUND */ 01650000
/*PRINT ERROR TEXT */ 01660000
CALL DSN8MPG (MODULE, '070E', OUTMSG); 01670000
MESSAGE.MSGTXT = OUTMSG; 01680000
RETURN; /* RETURN */ 01690000
END; 01700000
01710000
/*************************************************************/ 01720000
/* ** IF ONLY ONE OBJECT EXISTS THEN USE IT AS DEFAULT */ 01730000
/* ** SET UP OBJECT AND DESCRIPTION IN OUTPUT */ 01740000
/*************************************************************/ 01750000
01760000
IF I = 2 & INAREA.OBJFLD = ' ' THEN 01770000
DO; 01780000
RETCODE = '0'; 01790000
INAREA.OBJFLD = FIELD_2(1); 01800000
OUTAREA.OBJFLD = FIELD_2(1); 01810000
OUTAREA.DESC3 = FIELD_3(1); 01820000
LINE (1) = ' '; 01830000
RETURN; /* RETURN */ 01840000
END; 01850000
01860000
/*************************************************************/ 01870000
/* ** OBJECT WAS NOT FOUND */ 01880000
/*************************************************************/ 01890000
01900000
RETCODE = '1'; 01910000
01920000
0 EXEC SQL SELECT * 01930000
INTO :POPTVAL 01940000
FROM VOPTVAL 01950000
WHERE MAJSYS = :INAREA.MAJSYS 01960000
AND ACTION = :INAREA.ACTION 01970000
AND OBJFLD = ' '; 01980000
01990000
/*FILL IN DISPLAY AREA */ 02000000
/*WITH HEADING, PFKEY */ 02010000
/*AND MESSAGE INFO. */ 02020000
0 OUTAREA.TITLE = POPTVAL.HEADTXT; 02030000
OUTAREA.MSG = POPTVAL.INFOTXT; 02040000
OUTAREA.PFKTEXT= POPTVAL.PFKTXT; 02050000
02060000
/* RETURN TO */ 02070000
END DSN8MP4; /* DSN8MP1 MODULE */ 02080000