DSN8MP5
THIS MODULE VALIDATES SPECIFIC INPUT AND MOVES IT TO THE OUTPUT MESSAGE TOGETHER WITH A TEXT FIELD.
DSN8MP5: PROC; 00010000
/********************************************************************* 00020000
* * 00030000
* MODULE NAME = DSN8MP5 * 00040000
* * 00050000
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION PROGRAM * 00060000
* VALIDATION MODULE FOR SEARCH CRITERIA * 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 = DSN8MP5 * 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
* EXIT-NORMAL = DROP THRU TO NEXT LINE OF CODE IN DSN8MP1 * 00390000
* * 00400000
* EXIT-ERROR = IF SQLERROR OR SQLWARNING, SQL WHENEVER CONDITION * 00410000
* SPECIFIED IN DSN8CP1/IP1 WILL BE RAISED AND PROGRAM * 00420000
* WILL GO TO THE LABEL DB_ERROR. * 00430000
* * 00440000
* * 00450000
* RETURN CODE = NONE * 00460000
* * 00470000
* ABEND CODES = NONE * 00480000
* * 00490000
* ERROR-MESSAGES = * 00500000
* DSN8070E - VITAL DATA MISSING IN TABLE 'TOPTVAL' * 00510000
* * 00520000
* EXTERNAL REFERENCES = MOST VARIABLES ARE GLOBAL AND DEFINED * 00530000
* IN DSN8CP1/IP1. * 00540000
* ROUTINES/SERVICES = * 00550000
* DSN8MPG - ERROR MESSAGE ROUTINE * 00560000
* * 00570000
* DATA-AREAS = NONE * 00580000
* * 00590000
* CONTROL-BLOCKS = * 00600000
* SQLCA - SQL COMMUNICATION AREA * 00610000
* * 00620000
* TABLES = NONE * 00630000
* * 00640000
* CHANGE-ACTIVITY = NONE * 00650000
* * 00660000
* * 00670000
* *PSEUDOCODE* * 00680000
* PROCEDURE * 00690000
* INITIALIZE RETURNCODE TO '0'. * 00700000
* * 00710000
* FILL IN THE DISPLAY AREA * 00720000
* FROM VOPTVAL (SEARCH,SELTXT) DEPENDING ON SEARCH REQUIRED * 00730000
* RETURN. * 00740000
* * 00750000
* IF SEARCH CRITERIA NOT FOUND * 00760000
* PUT A LIST OF SEARCH CRITERIA WHICH EXISTS, * 00770000
* HEADTXT, INFOTXT AND PFKTXT * 00780000
* FROM VOPTVAL * 00790000
* DEPENDING ON MAJSYS = MAJSYS , ACTION = ACTION , * 00800000
* OBJECT = OBJECT AND SEARCH = BLANK * 00810000
* FILL IN DISPLAY AREA * 00820000
* SET RETURNCODE TO '1'. * 00830000
* * 00840000
* END. * 00850000
*********************************************************************/ 00860000
00870000
DCL 1 OUTPUT_REDEF(15) BASED (ADDR(PCONVSTA.OUTPUT)), 00880000
4 FIELD_1 CHAR (3), 00890000
4 FIELD_2 CHAR (6), 00900000
4 FIELD_3 CHAR (70); 00910000
00920000
/********************************************************/ 00930000
/* ** INITIALIZE RETURN CODE */ 00940000
/********************************************************/ 00950000
00960000
0 RETCODE = '0'; 00970000
DSN8_MODULE_NAME.MAJOR = 'DSN8MP5'; 00980000
MODULE = 'DSN8MP5'; 00990000
01000000
/************************************************************/ 01010000
/* ** LET'S SEE IF THE OBJECT SPECIFIED ON INPUT */ 01020000
/* ** EXISTS BY TRYING TO RETRIEVE OBJECT AND TEXT */ 01030000
/************************************************************/ 01040000
01050000
/*RETRIEVAL*/ 01060000
EXEC SQL SELECT SELTXT 01070000
INTO :POPTVAL.SELTXT 01080000
FROM VOPTVAL 01090000
WHERE MAJSYS = :INAREA.MAJSYS 01100000
AND ACTION = :INAREA.ACTION 01110000
AND OBJFLD = :INAREA.OBJFLD 01120000
AND SRCHCRIT = :INAREA.SEARCH 01130000
AND SRCHCRIT <> ' ' 01140000
AND (SCRTYPE = ' ' OR SCRTYPE = 'S'); 01150000
01160000
IF SQLCODE = +0 THEN 01170000
DO; 01180000
/*OBJECT EXISTS */ 01190000
/*FILL IN DISPLAY AREA*/ 01200000
0 OUTAREA.DESC4 = POPTVAL.SELTXT; 01210000
0 OUTAREA.SEARCH = INAREA.SEARCH; 01220000
RETURN; /* RETURN */ 01230000
END; 01240000
01250000
/**************************************************************/ 01260000
/* ** OBJECT NOT FOUND */ 01270000
/* ** PROVIDE A LIST OF OBJECTS WHICH EXIST */ 01280000
/**************************************************************/ 01290000
01300000
OUTAREA.SEARCH = ' '; 01310000
OUTAREA.DESC4 = ' '; 01320000
01330000
0 EXEC SQL OPEN VO4; /* OPEN VO4 CURSOR */ 01340000
01350000
/* RETRIEVE LIST */ 01360000
/* OF OBJECTS */ 01370000
0 DO I = 1 TO 15; 01380000
EXEC SQL FETCH VO4 INTO :POPTVAL.SRCHCRIT , :POPTVAL.SELTXT; 01390000
IF SQLCODE = +100 THEN GO TO MP5_10; 01400000
FIELD_1(I) = ''; 01410000
FIELD_2(I) = POPTVAL.SRCHCRIT; 01420000
FIELD_3(I) = POPTVAL.SELTXT; 01430000
END; 01440000
MP5_10: 01450000
0 EXEC SQL CLOSE VO4; /* CLOSE VO4 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
/* GET ERROR TEXT */ 01610000
IF I = 1 THEN 01620000
DO; 01630000
RETCODE = '1'; 01640000
/*PRINT ERROR TEXT */ 01650000
CALL DSN8MPG (MODULE, '070E', OUTMSG); 01660000
MESSAGE.MSGTXT = OUTMSG; 01670000
RETURN; /* RETURN */ 01680000
END; 01690000
01700000
/*************************************************************/ 01710000
/* ** IF ONLY ONE SEARCH CRITERIA EXISTS THEN USE IT AS */ 01720000
/* A DEFAULT */ 01730000
/* ** SET UP SEARCH CRITERIA AND DESCRIPTION IN OUTPUT */ 01740000
/*************************************************************/ 01750000
01760000
IF I = 2 & INAREA.SEARCH = ' ' THEN 01770000
DO; 01780000
RETCODE = '0'; 01790000
INAREA.SEARCH = FIELD_2(1); 01800000
OUTAREA.SEARCH = FIELD_2(1); 01810000
OUTAREA.DESC4 = FIELD_3(1); 01820000
LINE (1) = ' '; 01830000
RETURN; /* RETURN */ 01840000
END; 01850000
01860000
/*************************************************************/ 01870000
/* ** SEARCH CRITERIA 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 = :INAREA.OBJFLD 01980000
AND SRCHCRIT = ' '; 01990000
/*FILL IN DISPLAY AREA */ 02000000
/*WITH HEADING, PFKEY */ 02010000
/*AND MESSAGE INFO. */ 02020000
OUTAREA.TITLE = POPTVAL.HEADTXT; 02030000
OUTAREA.MSG = POPTVAL.INFOTXT; 02040000
OUTAREA.PFKTEXT= POPTVAL.PFKTXT; 02050000
02060000
/* RETURN TO */ 02070000
/* DSN8MP1 MODULE */ 02080000
0 END DSN8MP5; 02090000