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