DSN8MC5
THIS MODULE VALIDATES SPECIFIC INPUT AND MOVES IT TO THE OUTPUT MESSAGE TOGETHER WITH A TEXT FIELD.
*****DSN8MC5 - VALIDATION MODULE FOR SEARCH CRITERIA - COBOL***** 00010000
* * 00020000
* MODULE NAME = DSN8MC5 * 00030000
* * 00040000
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION * 00050000
* VALIDATION MODULE FOR SEARCH CRITERIA * 00060000
* COBOL * 00070000
* * 00080000
* * 00090000
*LICENSED MATERIALS - PROPERTY OF IBM * 00100000
*5695-DB2 * 00106000
*(C) COPYRIGHT 1996, 1996 IBM CORP. ALL RIGHTS RESERVED. * 00127000
* * 00134000
*STATUS = VERSION 8 * 00139001
* * 00144000
* FUNCTION = THIS MODULE VALIDATES SPECIFIC INPUT * 00150000
* AND MOVES IT TO THE OUTPUT MESSAGE * 00160000
* TOGETHER WITH A TEXT FIELD. * 00170000
* * 00180000
* NOTES = NONE * 00190000
* * 00200000
* MODULE TYPE = * 00220000
* PROCESSOR = DB2 PRECOMPILER, COBOL COMPILER * 00230000
* MODULE SIZE = SEE LINKEDIT * 00240000
* ATTRIBUTES = NONE * 00250000
* * 00260000
* ENTRY POINT = DSN8MC5 * 00270000
* PURPOSE = SEE FUNCTION * 00280000
* LINKAGE = INCLUDED BY MODULE DSN8CC1 * 00290000
* * 00300000
* INPUT = PARAMETERS EXPLICITLY PASSED TO THIS * 00310000
* FUNCTION: * 00320000
* SYMBOLIC LABEL/NAME = NONE * 00330000
* DESCRIPTION = NONE * 00340000
* * 00350000
* OUTPUT = PARAMETERS EXPLICITLY RETURNED: * 00360000
* SYMBOLIC LABEL/NAME = NONE * 00370000
* DESCRIPTION = NONE * 00380000
* * 00390000
* EXIT-NORMAL = THIS CODE IS "PERFORMED", SO IT EXITS TO * 00400000
* THE CODE FOLLOWING THE "PERFORM" STATEMENT * 00410000
* * 00420000
* EXIT-ERROR = IF SQLERROR OR SQLWARNING, SQL WHENEVER * 00430000
* CONDITION SPECIFIED IN DSN8CC1/IC1 WILL BE * 00440000
* RAISED AND PROGRAM WILL GO TO THE LABEL * 00450000
* DB-ERROR. * 00460000
* * 00470000
* RETURN CODE = NONE * 00480000
* * 00490000
* ABEND CODES = NONE * 00500000
* * 00510000
* ERROR MESSAGES = * 00520000
* DSN8070E - VITAL DATA MISSING IN TABLE 'TOPTVAL' * 00530000
* * 00540000
* * 00550000
* EXTERNAL REFERENCES = MOST VARIABLES ARE GLOBAL AND * 00560000
* DEFINED IN DSN8CC1/IC1. * 00570000
* ROUTINES/SERVICES = * 00580000
* DSN8MCG - ERROR MESSAGE ROUTINE * 00590000
* * 00600000
* DATA-AREAS = NONE * 00610000
* * 00620000
* CONTROL-BLOCKS = * 00630000
* SQLCA - SQL COMMUNICATION AREA * 00640000
* * 00650000
* TABLES = NONE * 00660000
* * 00670000
* CHANGE-ACTIVITY = NONE * 00680000
* * 00690000
* * 00700000
* *PSEUDOCODE* * 00710000
* * 00720000
* PROCEDURE * 00730000
* INITIALIZE RETURNCODE TO '0'. * 00740000
* * 00750000
* FILL IN THE DISPLAY AREA * 00760000
* FROM VOPTVAL (SEARCH,SELTXT) * 00770000
* DEPENDING ON SEARCH REQUIRED * 00780000
* RETURN. * 00790000
* * 00800000
* IF SEARCH CRITERIA NOT FOUND * 00810000
* RETRIEVE A LIST OF SEARCH CRITERIA WHICH EXISTS, * 00820000
* HEADTXT, INFOTXT AND PFKTXT * 00830000
* FROM VOPTVAL * 00840000
* DEPENDING ON MAJSYS = MAJSYS , ACTION = ACTION , * 00850000
* OBJFLD = OBJFLD AND SEARCH = BLANK * 00860000
* FILL IN DISPLAY AREA * 00870000
* SET RETURNCODE TO '1'. * 00880000
* * 00890000
* END. * 00900000
* * 00910000
*---------------------------------------------------------------* 00920000
00930000
DSN8MC5. 00940000
00950000
***************************************************************** 00960000
* ** INITIALIZE RETURN CODE 00970000
***************************************************************** 00980000
MOVE '0' TO RETCODE. 00990000
MOVE 'DSN8MC5' TO MAJOR IN DSN8-MODULE-NAME. 01000000
01010000
***************************************************************** 01020000
* ** LET'S SEE IF THE SEARCH CRITERIA SPECIFIED ON T01030000
* ** INPUT EXISTS BY TRYING TO RETRIEVE SEARCH CRITERIAT01040000
* ** AND TEXT T01050000
***************************************************************** 01060000
01070000
* **RETRIEVAL 01080000
EXEC SQL SELECT SELTXT 01090000
INTO :POPTVAL.SELTXT 01100000
FROM VOPTVAL 01110000
WHERE MAJSYS = :INAREA.MAJSYS 01120000
AND ACTION = :INAREA.ACTION 01130000
AND OBJFLD = :INAREA.OBJFLD 01140000
AND SRCHCRIT = :INAREA.SRCH 01150000
AND SRCHCRIT <> ' ' 01160000
AND (SCRTYPE = ' ' OR SCRTYPE = 'S') 01170000
END-EXEC. 01180000
* **SEARCH CRITERIA EXIST 01190000
* **FILL IN DISPLAY AREA 01200000
01210000
MOVE SELTXT IN POPTVAL TO DESC4 IN OUTAREA. 01220000
MOVE SRCH IN INAREA TO SRCH IN OUTAREA. 01230000
01240000
* **RETURN 01250000
IF SQLCODE = +0 THEN 01260000
GO TO END-DSN8MC5. 01270000
01280000
***************************************************************** 01290000
* ** SEARCH CRITERIA NOT FOUND 01300000
* ** PROVIDE A LIST OF SEARCH CRITERIA WHICH EXIST 01310000
***************************************************************** 01320000
MOVE SPACE TO SRCH IN OUTAREA. 01330000
MOVE SPACE TO DESC4 IN OUTAREA. 01340000
* ** OPEN CURSOR 01350000
EXEC SQL OPEN VO4 END-EXEC. 01360000
* 01370000
MOVE +1 TO I. 01380000
01390000
* **RETRIEVE LIST OF 01400000
* **SEARCH CRITERIA 01410000
MC5-10. 01420000
IF I NOT > 15 THEN 01430000
EXEC SQL FETCH VO4 INTO :POPTVAL.SRCHCRIT , 01440000
:POPTVAL.SELTXT END-EXEC 01450000
IF SQLCODE IS NOT EQUAL TO +100 THEN 01460000
MOVE SPACES TO FIELD-1(I) 01470000
MOVE SRCHCRIT IN POPTVAL TO FIELD-2(I) 01480000
MOVE SELTXT IN POPTVAL TO FIELD-3(I) 01490000
ADD 1 TO I 01500000
GO TO MC5-10. 01510000
MC5-20. 01520000
* **CLOSE CURSOR 01530000
EXEC SQL CLOSE VO4 END-EXEC. 01540000
* 01550000
MOVE I TO J. 01560000
01570000
* **PUT BLANKS AT 01580000
* **END OF LINE 01590000
MC5-30. 01600000
IF J NOT > 15 THEN 01610000
MOVE SPACE TO LINE0(J) 01620000
ADD 1 TO J 01630000
GO TO MC5-30. 01640000
* 01650000
***************************************************************** 01660000
* ** CHECK FOR CONDITION WHERE THERE ARE NO VALID ENTRIES */01670000
***************************************************************** 01680000
01690000
* **IF NO VALID ENTRY IN 01700000
* **OPTION VALIDATION 01710000
* **BASE TABLE (TOPTVAL) 01720000
* **TRY TO GET ERROR TEXT 01730000
IF I = 1 THEN MOVE '1' TO RETCODE 01740000
01750000
MOVE '070E' TO MSGCODE 01760000
CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG 01770000
MOVE OUTMSG TO MSGTEXT IN MSG 01780000
01790000
* **RETURN 01800000
GO TO END-DSN8MC5. 01810000
* 01820000
***************************************************************** 01830000
* ** IF ONLY THE SEARCH CRITERIA EXISTS THEN USE THE 01840000
* ** DEFAULT TO SET UP SEARCH CRITERIA AND 01850000
* ** DESCRIPTION IN OUTPUT 01860000
***************************************************************** 01870000
01880000
IF I = 2 AND SRCH IN INAREA = ' ' THEN 01890000
MOVE '0' TO RETCODE 01900000
MOVE FIELD-2(1) TO SRCH IN INAREA 01910000
MOVE FIELD-2(1) TO SRCH IN OUTAREA 01920000
MOVE FIELD-3(1) TO DESC4 IN OUTAREA 01930000
MOVE SPACE TO LINE0 (1) 01940000
* **RETURN 01950000
GO TO END-DSN8MC5. 01960000
01970000
***************************************************************** 01980000
* ** SEARCH CRITERIA WAS NOT FOUND 01990000
***************************************************************** 02000000
02010000
MOVE '1' TO RETCODE. 02020000
02030000
EXEC SQL SELECT * 02040000
INTO :POPTVAL 02050000
FROM VOPTVAL 02060000
WHERE MAJSYS = :INAREA.MAJSYS 02070000
AND ACTION = :INAREA.ACTION 02080000
AND OBJFLD = :INAREA.OBJFLD 02090000
AND SRCHCRIT = ' ' 02100000
END-EXEC. 02110000
* **FILL IN DISPLAY AREA 02120000
* **WITH HEADING, PFKEY, 02130000
* **& MESSAGE INFO. 02140000
02150000
MOVE HEADTXT IN POPTVAL TO HTITLE IN OUTAREA. 02160000
MOVE INFOTXT IN POPTVAL TO MSG IN OUTAREA. 02170000
MOVE PFKTXT IN POPTVAL TO PFKTEXT IN OUTAREA. 02180000
* 02190000
02200000
* **RETURN TO 02210000
* **DSN8MC1 MODULE 02220000
END-DSN8MC5. 02230000