DSN8EP1
PASS DB2 COMMANDS TO BE EXECUTED BY THE STORED PROCEDURE PROGRAM DSN8EP2.
DSN8EP1: PROCEDURE(PARMS) OPTIONS(MAIN); 00010000
/******************************************************************** 00020000
* MODULE NAME = DSN8EP1 (SAMPLE PROGRAM) * 00030000
* * 00040000
* DESCRIPTIVE NAME = STORED PROCEDURE REQUESTER PROGRAM * 00050000
* * 00060000
* LICENSED MATERIALS - PROPERTY OF IBM * 00070000
* 5675-DB2 * 00080000
* (C) COPYRIGHT 1982, 2000 IBM CORP. ALL RIGHTS RESERVED. * 00090000
* * 00100000
* STATUS = VERSION 7 * 00110000
* * 00120000
* FUNCTION = * 00130000
* * 00140000
* PASS DB2 COMMANDS TO BE EXECUTED BY THE STORED * 00150000
* PROCEDURE PROGRAM DSN8EP2. GET INPUT FROM 'SYSIN'. * 00160000
* PASS THE COMMAND AND RECEIVE THE COMMAND RESULTS * 00170000
* VIA THE PARAMETERS CONTAINED IN THE EXEC SQL CALL * 00180000
* STATEMENT. WRITE THE RESULTS TO 'SYSPRINT'. * 00190000
* * 00200000
* DEPENDENCIES = NONE * 00210000
* * 00220000
* RESTRICTIONS = * 00230000
* * 00240000
* 1. BEGIN DB2 COMMANDS WITH A HYPHEN AND END THEM * 00250000
* WITH A SEMICOLON. A '*' IN COLUMN ONE OR '--' * 00260000
* ANYWHERE ON A LINE (EXCEPT WITHIN A COMMAND) CAN * 00270000
* BE USED TO DENOTE COMMENTS. * 00280000
* * 00290000
* 2. THIS PROGRAM ACCEPTS COMMANDS OF AT MOST 4096 BYTES. * 00300000
* * 00310000
* PROGRAM SIZES = * 00320000
* * 00330000
* THE FOLLOWING VARIABLES CAN BE CHANGED TO FIT THE * 00340000
* SPECIFIC ENVIRONMENT OF THE USER. * 00350000
* * 00360000
* VARIABLE VALUE MEANING * 00370000
* NAME * 00380000
* -------- ----- -------------------------- * 00390000
* * 00400000
* PAGEWIDTH 133 MAXIMUM WIDTH OF A PAGE IN * 00410000
* CHARACTERS (INCLUDING THE CONTROL * 00420000
* CHARACTER IN COLUMN ONE) * 00430000
* * 00440000
* MAXPAGWD 125 PRINT LINE WIDTH CONTROLLER = * 00450000
* MAXIMUM WIDTH - 1 (FOR CONTROL * 00460000
* CHARACTER) - 6 (LENGTH OF THE * 00470000
* COLUMN DISPLAY) - 1 ( A '-' * 00480000
* BETWEEN THE COLUMN NUMBER DISPLAY * 00490000
* THE SQL OUTPUT DISPLAY). * 00500000
* * 00510000
* MAXPAGLN 60 MAXIMUM NUMBER OF LINES ON THE * 00520000
* PRINT OUTPUT PAGES 2 THRN N. PAGE * 00530000
* 1 WILL HAVE MAXPAGLN + 1 LINES. * 00540000
* * 00550000
* INPUTL 72 LENGTH OF THE INPUT RECORD * 00560000
* * 00570000
* INPUT = * 00580000
* * 00590000
* 1. INPUT STATEMENTS WILL BE TRANSFERRED * 00600000
* TO THE STATEMENT BUFFER WITH ONE BLANK BETWEEN * 00610000
* WORDS. * 00620000
* * 00630000
* 2. BLANKS IN DELIMITED STRINGS WILL BE * 00640000
* TRANSFERRED INTO THE STATEMENT BUFFER * 00650000
* EXACTLY AS THEY APPEAR IN THE INPUT * 00660000
* STATEMENT. * 00670000
* * 00680000
* 3. AN INPUT LINE CONSISTS OF CHARACTERS FROM * 00690000
* COLUMNS 1-INPUTL. IF AN INPUT STATEMENT SPANS * 00700000
* OVER MULITPLE LINES, THE LINES ARE CONCATENATED * 00710000
* AND BLANKS ARE REMOVED SUCH THAT ONLY ONE * 00720000
* BLANK OCCURS BETWEEN WORDS. * 00730000
* * 00740000
* MODULE TYPE = PROCEDURE * 00750000
* PROCESSOR = * 00760000
* ADMF PRECOMPILER * 00770000
* PL/I MVS/VM (FORMERLY PL/I SAA AD/CYCLE) * 00780000
* MODULE SIZE = 2K * 00790000
* ATTRIBUTES = RE-ENTERABLE * 00800000
* * 00810000
* ENTRY POINT = DSN8EP1 * 00820000
* PURPOSE = SEE FUNCTION * 00830000
* LINKAGE = STANDARD MVS PROGRAM INVOCATION, ONE PARAMETER. * 00840000
* INPUT = PARAMETERS EXPLICITLY PASSED TO THIS FUNCTION: * 00850000
* SYMBOLIC LABEL/NAME = SYSIN * 00860000
* DESCRIPTION = DDNAME OF SEQUENTIAL DATA SET CONTAINING * 00870000
* DB2 COMMANDS TO BE EXECUTED. * 00880000
* OUTPUT = PARAMETERS EXPLICITLY RETURNED: * 00890000
* SYMBOLIC LABEL/NAME = SYSPRINT * 00900000
* DESCRIPTION = DDNAME OF SEQUENTIAL OUTPUT DATA SET TO * 00910000
* CONTAIN RESULTS OF THE COMMANDS EXECUTED. * 00920000
* * 00930000
* EXIT NORMAL = * 00940000
* * 00950000
* NO ERRORS WERE FOUND IN THE SOURCE AND NO * 00960000
* ERRORS OCCURRED DURING PROCESSING. * 00970000
* * 00980000
* * 00990000
* NORMAL MESSAGES = * 01000000
* * 01010000
* 1. THE FOLLOWING MESSAGE WILL BE GENERATED FOR ALL INPUT * 01020000
* STATEMENTS: * 01030000
* * 01040000
* ***INPUT STATEMENT: DB2 COMMAND INPUT STATEMENT * 01050000
* * 01060000
* * 01070000
* EXIT-ERROR = * 01080000
* * 01090000
* ERRORS WERE FOUND IN THE SOURCE, OR OCCURRED DURING * 01100000
* PROCESSING. * 01110000
* * 01120000
* RETURN CODE = 4 - WARNING-LEVEL ERRORS DETECTED. * 01130000
* SQLWARNING OR IFI WARNING FOUND DURING EXECUTION. * 01140000
* REASON CODE = 0 OR IFI REASON CODE * 01150000
* * 01160000
* RETURN CODE = 8 - ERRORS DETECTED. * 01170000
* SQLERROR OR IFI ERROR FOUND DURING EXECUTION. * 01180000
* REASON CODE = 0 OR IFI REASON CODE * 01190000
* * 01200000
* RETURN CODE = 12 - SEVERE ERRORS DETECTED. * 01210000
* ONE OF THE FOLLOWING ERRORS OCCURRED: * 01220000
* UNABLE TO OPEN FILES. * 01230000
* INTERNAL ERROR, ERROR MESSAGE ROUTINE RETURN CODE. * 01240000
* STATEMENT IS TOO LONG. * 01250000
* SQL OR IFI BUFFER OVERFLOW. * 01260000
* REASON CODE = 0 OR IFI REASON CODE * 01270000
* * 01280000
* ABEND CODES = NONE * 01290000
* * 01300000
* ERROR MESSAGES = * 01310000
* * 01320000
* 1. THE FOLLOWING MESSAGE WILL BE GENERATED WHEN A DB2 * 01330000
* COMMAND DOES NOT BEGIN WITH A HYPHEN "-". * 01340000
* * 01350000
* *** SYNTAX FOR DB2 COMMAND IS NOT VALID. * 01360000
* A VALID COMMAND MUST BEGIN WITH A HYPHEN "-". * 01370000
* * 01380000
* 2. THE FOLLOWING MESSAGE WILL BE GENERATED WHEN AN INPUT * 01390000
* STATEMENT IS GREATER THAN STMTMAX SIZE: * 01400000
* * 01410000
* **ERROR: DB2 COMMAND GREATER THAN NNN CHARACTERS. * 01420000
* STMT: * 01430000
* DB2 COMMAND. * 01440000
* * 01450000
* NNN IS MAXIMUM COMMAND SIZE * 01460000
* DB2 COMMAND IS THE CURRENT DB2 COMMAND BEING * 01470000
* PROCESSED. * 01480000
* * 01490000
* EXTERNAL REFERENCES = * 01500000
* ROUTINES/SERVICES = NONE * 01510000
* DSNTIAR - SQL COMMUNICATION AREA FORMATTING * 01520000
* DATA-AREAS = NONE * 01530000
* CONTROL-BLOCKS = * 01540000
* SQLCA - SQL COMMUNICATION AREA * 01550000
* * 01560000
* PSEUDOCODE = * 01570000
* * 01580000
* DSN8EP1: PROCEDURE. * 01590000
* DECLARATIONS. * 01600000
* INITIALIZE VARIABLES. * 01610000
* CALL READRTN TO READ IN A DB2 COMMAND STATEMENT. * 01620000
* DO UNTIL END-OF-FILE. * 01630000
* CALL READRTN TO READ A NEW DB2 COMMAND STATEMENT. * 01640000
* END. * 01650000
* * 01660000
* HEX2CHAR: PROCEDURE. * 01670000
* CONVERT THE RETURN CODE AND REASON CODE THAT ARE RETURNED * 01680000
* FROM THE IFI CALL FROM BINARY TO HEXADECIMAL. * 01690000
* END HEX2CHAR. * 01700000
* * 01710000
* PRINTCA: PROCEDURE. * 01720000
* CALL DSNTIAR TO FORMAT ANY MESSAGES. * 01730000
* IF A RETURN CODE WAS PASSED FROM DSNTIAR, INDICATE IT. * 01740000
* PRINT THE DATA FORMATTED FORMATTED BY DSNTIAR. * 01750000
* SET THE RETURN CODE TO 8. * 01760000
* END PRINTCA. * 01770000
* * 01780000
* READRTN: PROCEDURE. * 01790000
* SET ENDSTR = "NO". * 01800000
* SET REREAD = "NO". * 01810000
* DO WHILE (ENDSTR = NO). * 01820000
* FILL THE STATEMENT BUFFER FROM THE CURRENT INPUT LINE. * 01830000
* AVOID INITIAL BLANKS. * 01840000
* TERMINATE A STATEMENT WHEN A SEMICOLON IS FOUND. * 01850000
* VERIFY THAT COMMAND IS VALID. * 01860000
* DO SQL TO CALL DSN8EP2. * 01870000
* PROCESS THE COMMAND RESULTS. * 01880000
* SET REREAD FLAG. * 01890000
* RETURN TO CALLER. * 01900000
* END COMMAND. * 01910000
* END READRTN. * 01920000
* * 01930000
* RESULTS: PROCEDURE. * 01940000
* PROCESS THE RETURN CODE, REASON CODE, THE NUMBER OF * 01950000
* BYTES IN THE RETURN BUFFER, AND THE RETURN BUFFER * 01960000
* THAT ARE RETURNED FROM THE IFI CALL. * 01970000
* END RESULTS. * 01980000
* * 01990000
* CHANGE ACTIVITY = * 02000000
* 6/29/95 UPDATED THE REMOTE LOCATION NAME VARIABLES (DB2LOC @03* 02010000
* & PARMS) TO ACCEPT A SIXTEEN CHARACTER NAME @03* 02020000
* (PN69303) @03 KFF0296* 02030000
* 7/05/95 CHANGED THE OUTPUT STRING LENGTH FROM VARYING @35* 02040000
* TO FIXED 80 BYTE STRINGS (PN72035) @35 KFF0347* 02050000
* 8/28/95 ADDED ROLLBACK WORK STATEMENT TO ENSURE THAT DB2 @42* 02060000
* WORK IS ROLLED BACK IN ERROR SITUATIONS @42* 02070000
* (PN74842) @42 KFF0580* 02080000
* 04/17/00 INITIALIZE STORAGE TO PREVENT RETURN CODE=04, * 02090000
* REASON CODE=00E60804 FROM IFI PQ36800* 02100000
* 05/22/03 FIX CODE HOLE CLOSED BY VA AND ENTERPRISE PL/I PQ44916* 02110000
*******************************************************************/ 02120000
%PAGE; 02130000
/*******************************************************************/ 02140000
/* VARIABLE DECLARATIONS */ 02150000
/*******************************************************************/ 02160000
02170000
/*******************************************************************/ 02180000
/* DECLARE IFI-RELATED VARIABLES */ 02190000
/*******************************************************************/ 02200000
DCL 02210000
IFCA_RET_CODE CHAR(8) INIT(' '), /* RETURN CODE IN HEX */ 02220000
IFCA_RES_CODE CHAR(8) INIT(' '), /* REASON CODE IN HEX */ 02230000
INPUTCMD VAR CHAR(4096) INIT(' '),/* DB2 COMMAND */ 02240000
IFCA_RET_HEX FIXED BIN(31) INIT(0), /* RETURN CODE PARAMETER */ 02250000
IFCA_RES_HEX FIXED BIN(31) INIT(0), /* REASON CODE PARAMETER */ 02260000
BUFF_OVERFLOW FIXED BIN(31) INIT(0), /* BUFFER OVERFLOW IND@35*/ 02270000
REMBYTES FIXED BIN(15) INIT(0), /* BYTES REMAINING @35*/ 02280000
RETURN_BUFF VAR CHAR(8320) INIT(' '),/* COMMAND RESULT @35*/ 02290000
RETURN_IND FIXED BIN(15) INIT(0); /* INDICATOR VARIABLE @35*/ 02300000
/* FOR RETURN_BUFFER */ 02310000
02320000
02330000
/*******************************************************************/ 02340000
/* CHARACTER CONSTANTS */ 02350000
/*******************************************************************/ 02360000
02370000
DCL 02380000
ASTERISK CHAR(1) INIT('*') STATIC, /* COMMENT INDICATOR */ 02390000
BLANK CHAR(1) INIT(' ') STATIC, /* INITIALIZATION BLANKS */ 02400000
HYPHEN CHAR(1) INIT('-') STATIC, /* HYPHEN */ 02410000
NULLCHAR CHAR(1) VAR INIT('') STATIC, /* NULL CHARACTER */ 02420000
QUOTE CHAR(1) INIT('''') STATIC, /* QUOTATION MARK */ 02430000
DQUOTE CHAR(1) INIT('"') STATIC, /* DOUBLE QUOTATION MARK */ 02440000
SEMICOLON CHAR(1) INIT(';') STATIC; /* SQL STMT TERMINATOR */ 02450000
02460000
/*******************************************************************/ 02470000
/* PROGRAM INPUT/OUTPUT CONSTANTS */ 02480000
/*******************************************************************/ 02490000
02500000
DCL 02510000
INPUTL FIXED BIN(15) INIT(72) STATIC, /* SYSIN LRECL */ 02520000
MAXPAGWD FIXED BIN(31) INIT(125) STATIC, /* OUTPUT WIDTH */ 02530000
MAXPAGLN FIXED BIN(15) INIT(60) STATIC, /* # LINES / PAGE */ 02540000
OUTLEN FIXED BIN(15) INIT(80) STATIC, /* LENGTH OF AN @35*/ 02550000
/* OUTPUT LINE */ 02560000
PAGEWIDTH FIXED BIN(31) INIT(133) STATIC; /* SYSOUT LRECL */ 02570000
/* AREA LENGTH */ 02580000
02590000
/*******************************************************************/ 02600000
/* ERROR CODE CONSTANTS */ 02610000
/*******************************************************************/ 02620000
02630000
DCL 02640000
RETWRN FIXED BIN(15) INIT(4) STATIC, /* WARN RET COD @35*/ 02650000
RETERR FIXED BIN(15) INIT(8) STATIC, /* ERROR RET CODE */ 02660000
SEVERE FIXED BIN(15) INIT(12) STATIC; /* SEVERE ERROR */ 02670000
/* RETURN CODE */ 02680000
02690000
/*******************************************************************/ 02700000
/* NUMBER CONSTANTS */ 02710000
/*******************************************************************/ 02720000
02730000
DCL 02740000
ZERO FIXED BIN(15) INIT(0) STATIC, 02750000
ONE FIXED BIN(15) INIT(1) STATIC, 02760000
TWO FIXED BIN(15) INIT(2) STATIC, 02770000
FOUR FIXED BIN(15) INIT(4) STATIC, 02780000
FIVE FIXED BIN(15) INIT(5) STATIC, 02790000
EIGHT FIXED BIN(15) INIT(8) STATIC, 02800000
TEN FIXED BIN(15) INIT(10) STATIC; 02810000
02820000
/*******************************************************************/ 02830000
/* FLAG CONSTANTS */ 02840000
/*******************************************************************/ 02850000
02860000
DCL 02870000
YES BIT(1) INIT('1'B) STATIC, /* BIT FLAG ON */ 02880000
NO BIT(1) INIT('0'B) STATIC; /* BIT FLAG OFF */ 02890000
02900000
/*******************************************************************/ 02910000
/* INPUT / OUTPUT BUFFER VARIABLES DECLARATION */ 02920000
/*******************************************************************/ 02930000
02940000
DCL 02950000
COMMENT BIT(1) INIT('0'B), /* COMMENT ENCOUNTERED? */ 02960000
CURPTR FIXED BIN(15) INIT(0), /* CURR LOCN IN OUTPUT @35*/ 02970000
DB2LOC2 VAR CHAR(16) INIT(' '), /* REMOTE DB2 LOC NAME @03*/ 02980000
ENDSTR BIT(1) INIT('0'B), /* END OF STATEMENT FLAG */ 02990000
EODIN BIT(1) INIT('0'B), /* END OF INPUT DATA FLAG */ 03000000
ERR FIXED BIN(15) INIT(0), /* THE CURRENT RETURN CODE*/ 03010000
EXIT BIT(1) INIT('0'B), /* PROGRAM EXIT INDICATOR */ 03020000
I FIXED BIN(15) INIT(0), /* LOOP COUNTER VARIABLE */ 03030000
INCOL FIXED BIN(15) INIT(0), /* CURRENT INPUT COLUMN */ 03040000
INPUT(INPUTL) CHAR(1), /* CURRENT INPUT DATA */ 03050000
J FIXED BIN(15) INIT(0), /* LOOP COUNTER VARIABLE */ 03060000
K FIXED BIN(15) INIT(0), /* LOOP COUNTER VARIABLE */ 03070000
KK FIXED BIN(15) INIT(0), /* LOOP COUNTER VARIABLE */ 03080000
OSTMTLN FIXED BIN(15) INIT(0), /* # OF OUTPUT LINES NEED-*/ 03090000
/* ED FOR INPUT STATEMENT */ 03100000
PAGEBUF VAR CHAR(15) INIT(' '), /* OUTPUT PAGE INFORMATION*/ 03110000
PARMS VAR CHAR(16), /* PROGRAM INPUT PARM @03*/ 03120000
PRTBUF VAR CHAR(80) INIT(' '), /* PRINT BUFFER @35*/ 03130000
WRNING BIT(1) INIT('0'B), /* PRINT SQLCA ON WARNING */ 03140000
RETCODE FIXED BIN(31) INIT(0); /* RETURN CODE FOR DSN8EP1*/ 03150000
03160000
/*******************************************************************/ 03170000
/* BUILT IN FUNCTIONS DECLARATIONS */ 03180000
/*******************************************************************/ 03190000
03200000
DCL 03210000
ADDR BUILTIN, /* FUNCTION TO RETURN THE ADDRESS */ 03220000
CHAR BUILTIN, /* RETURNS CHAR REPRESENTATION */ 03230000
LENGTH BUILTIN, /* RETURNS LENGTH OF A STRING */ 03240000
MIN BUILTIN, /* FUNCTION TO RETURN MINIMUM */ 03250000
NULL BUILTIN, /* NULL VALUE */ 03260000
SUBSTR BUILTIN, /* FUNCTION TO RETURN SUBSTRING */ 03270000
PLIRETC BUILTIN, /* FUNCTION TO SET RETURN CODE */ 03280000
PLIRETV BUILTIN, /* PL/I RETURN CODE VALUE */ 03290000
UNSPEC BUILTIN; /* IGNORES VARIABLE TYPING */ 03300000
03310000
/*******************************************************************/ 03320000
/* DECLARE BUFFER AREAS FOR THE SQLCA AND THE SQLDA */ 03330000
/*******************************************************************/ 03340000
03350000
EXEC SQL INCLUDE SQLCA; /* DEFINE THE SQLCA */ 03360000
03370000
/*******************************************************************/ 03380000
/* MESSAGE FORMATTING ROUTINE AND VARIABLES DECLARAIONS */ 03390000
/*******************************************************************/ 03400000
DCL 03410000
DSNTIAR ENTRY EXTERNAL OPTIONS(ASM INTER RETCODE); 03420000
DCL 03430000
MSGBLEN FIXED BIN(15) INIT(10); /* MAX # SQL MESSAGES */ 03440000
DCL 03450000
01 MESSAGE, /* RETURNED MESSAGES AREA */ 03460000
02 MESSAGEL FIXED BIN(15) /* MESSAGE BUFFER LENGTH */ 03470000
INIT(0), 03480000
02 MESSAGET(MSGBLEN) CHAR(MAXPAGWD) /* SQLCA MSGS SPACE */ 03490000
INIT(' '); 03500000
/*******************************************************************/ 03510000
/* BUFFER DECLARATION FOR THE INPUT STATEMENT */ 03520000
/* *** NOTE *** : THE CHARACTER SIZE MUST BE EXPLICIT FOR THE */ 03530000
/* PRECOMPILER */ 03540000
/*******************************************************************/ 03550000
03560000
DCL 03570000
INPLLEN FIXED BIN(15) INIT(100), /* LENGTH OF PRINT STMT */ 03580000
STMTBUF VAR CHAR(4096) INIT(' '), /* STATEMENT STRING */ 03590000
STMTLEN FIXED BIN(15) INIT(0), /* STMT STRING LENGTH */ 03600000
STMTMAX FIXED BIN INIT(4096);/* STATEMENT BUFFER */ 03610000
/* MAXIMUM LENGTH */ 03620000
03630000
/*******************************************************************/ 03640000
/* FILE DECLARATIONS */ 03650000
/*******************************************************************/ 03660000
03670000
DCL 03680000
SYSIN FILE STREAM INPUT, /* INPUT FILE */ 03690000
SYSPRINT FILE STREAM OUTPUT /* OUTPUT FILE */ 03700000
ENV(FB,RECSIZE(PAGEWIDTH),BLKSIZE(PAGEWIDTH)); 03710000
%PAGE; 03720000
/*******************************************************************/ 03730000
/* MAIN PROGRAM */ 03740000
/*******************************************************************/ 03750000
/* GENERAL INITIALIZATION */ 03760000
/*******************************************************************/ 03770000
03780000
RETCODE = ZERO; /* INITIALIZE THE RETURN CODE */ 03790000
WRNING = NO; /* INITIALIZE PRINTING SQLCA ON */ 03800000
/* WARNING FLAG */ 03810000
MESSAGEL = MSGBLEN * MAXPAGWD; /* SET MESSAGE BUFFER LENGTH */ 03820000
DB2LOC2 = PARMS; /* INPUT PARAMETER IS THE REMOTE */ 03830000
/* DB2 LOCATION NAME */ 03840000
03850000
/*******************************************************************/ 03860000
/* INPUT PROCESSING INITIALIZATION */ 03870000
/*******************************************************************/ 03880000
03890000
EXIT = NO; /* DON'T EXIT-CONTINUE PROCESSING */ 03900000
EODIN = NO; /* NOT AT THE END OF INPUT DATA */ 03910000
INPUT = NULLCHAR; /* NULL THE INPUT DATA ARRAY */ 03920000
INCOL = INPUTL+ONE; /* SET COLUMN TO 73 TO INDICATE A */ 03930000
/* NEW LINE IS TO BE READ IN */ 03940000
/* READRTN */ 03950000
03960000
%PAGE; 03970000
/*******************************************************************/ 03980000
/* READ THE FIRST COMMAND STATEMENT TO BE PROCESSED */ 03990000
/*******************************************************************/ 04000000
04010000
CALL READRTN; 04020000
/*******************************************************************/ 04030000
/* MAIN LOOP. CONTINUE PROCESSING DB2 COMMANDS UNTIL THE END OF */ 04040000
/* DATA IS REACHED OR A SEVERE ERROR HAS BEEN ENCOUNTERED */ 04050000
/*******************************************************************/ 04060000
04070000
PRC: 04080000
DO WHILE (EXIT = NO & RETCODE < SEVERE); 04090000
ERR = ZERO; /* CLEAR THE CURRENT RETURN CODE */ 04100000
/* INCLUDE OUTPUT HEADINGS */ 04110000
CALL READRTN; /* READ NEXT STATEMENT */ 04120000
END; /* END PRC */ 04130000
GOTO STOPRUN; /* EXIT */ 04140000
04150000
%PAGE; 04160000
04170000
HEX2CHAR: 04180000
/***************************************************/ 04190000
/* PROCEDURE TO PRINT THE IFI RETURN CODE IN HEX */ 04200000
/***************************************************/ 04210000
PROCEDURE(INPUT) RETURNS(CHAR(8)); /* RESULTS RETURNED IN */ 04220000
/* CHARACTER FORMAT */ 04230000
DECLARE INPUT BIT(31), /* RETURN CODE IN BINARY */ 04240000
I1 BIT(4) DEF INPUT, 04250000
I2 BIT(4) DEF INPUT POSITION(4), 04260000
I3 BIT(4) DEF INPUT POSITION(8), 04270000
I4 BIT(4) DEF INPUT POSITION(12), 04280000
I5 BIT(4) DEF INPUT POSITION(16), 04290000
I6 BIT(4) DEF INPUT POSITION(20), 04300000
I7 BIT(4) DEF INPUT POSITION(24), 04310000
I8 BIT(4) DEF INPUT POSITION(28), 04320000
HEXES CHAR(16) INIT('0123456789ABCDEF'), 04330000
OUTPUT CHAR(8), 04340000
OUTPUT1(8) CHAR(1) DEFINED(OUTPUT); 04350000
OUTPUT1(1)=SUBSTR(HEXES,I1+1,1); /*1ST BYTE OF RET CODE IN HEX */ 04360000
OUTPUT1(2)=SUBSTR(HEXES,I2+1,1); /*2ND BYTE OF RET CODE IN HEX */ 04370000
OUTPUT1(3)=SUBSTR(HEXES,I3+1,1); /*3RD BYTE OF RET CODE IN HEX */ 04380000
OUTPUT1(4)=SUBSTR(HEXES,I4+1,1); /*4TH BYTE OF RET CODE IN HEX */ 04390000
OUTPUT1(5)=SUBSTR(HEXES,I5+1,1); /*5TH BYTE OF RET CODE IN HEX */ 04400000
OUTPUT1(6)=SUBSTR(HEXES,I6+1,1); /*6TH BYTE OF RET CODE IN HEX */ 04410000
OUTPUT1(7)=SUBSTR(HEXES,I7+1,1); /*7TH BYTE OF RET CODE IN HEX */ 04420000
OUTPUT1(8)=SUBSTR(HEXES,I8+1,1); /*8TH BYTE OF RET CODE IN HEX */ 04430000
RETURN (OUTPUT); /* RETURN THE OUTPUT RESULT*/ 04440000
END HEX2CHAR; 04450000
04460000
%PAGE; 04470000
/*******************************************************************/ 04480000
/* PROCEDURE TO PRINT THE SQLCA ERROR INDICATION AND CLEAR OUT THE */ 04490000
/* SQLCA. OUTPUT MOST OF THE DATA ON AN EXCEPTION BASIS */ 04500000
/*******************************************************************/ 04510000
04520000
PRINTCA: PROCEDURE; 04530000
04540000
/*******************************************************************/ 04550000
/* PROCESS SQL OUTPUT MESSAGE */ 04560000
/*******************************************************************/ 04570000
04580000
CALL DSNTIAR ( SQLCA, MESSAGE, MAXPAGWD); /* FORMAT ANY MESSAGES */ 04590000
IF PLIRETV ^= ZERO THEN /* IF THE RETURN CODE ISN'T ZERO */ 04600000
DO; /* ISSUE AN ERROR MESSAGE */ 04610000
PUT EDIT (' *** RETURN CODE ', PLIRETV, /*@35*/ 04620000
' FROM MESSAGE ROUTINE DSNTIAR.') 04630000
(COL(1), A(17), F(8), A(30)); /* ISSUE THE MESSAGE */ 04640000
RETCODE = SEVERE; /* SET THE RETURN CODE */ 04650000
END; /* END ISSUE AN ERROR MESSAGE */ 04660000
04670000
DO I = ONE TO MSGBLEN /* PRINT OUT THE DSNTIAR BUFFER */ 04680000
WHILE (MESSAGET(I) ^= BLANK); /* PRINT NON BLANK LINES */ 04690000
PUT EDIT ( MESSAGET(I) ) (COL(2), A(MAXPAGWD)); 04700000
END; 04710000
04720000
RETCODE = SEVERE; /* SET THE RETURN CODE */ 04730000
04740000
END PRINTCA; 04750000
04760000
04770000
%PAGE; 04780000
04790000
/*******************************************************************/ 04800000
/* THIS PROCEDURE READS THE DATA FROM THE USER AND OBTAINS A DB2 */ 04810000
/* COMMAND TO PASS TO DSN8EP2 FOR EXECUTION VIA THE IFI CALL */ 04820000
/*******************************************************************/ 04830000
04840000
READRTN: PROCEDURE; 04850000
04860000
DCL 04870000
CONTLINE FIXED BIN(15) /* CONTINUATION LINE - INPUT STMT */ 04880000
INIT(0), /* IS MORE THAN 72 CHARACTERS */ 04890000
DQUOTFLAG BIT(1) /* DOUBLE QUOTE (") ENCOUNTERED? */ 04900000
INIT('0'B), 04910000
FIRSTCHAR BIT(1) /* FIRST NON BLANK CHAR? */ 04920000
INIT('0'B), 04930000
LASTCHAR CHAR(1) /* LAST CHARACTER IN THE BUFFER */ 04940000
INIT(' '), 04950000
MOVECHAR BIT(1) /* MOVE CHAR INTO STMT BUFFER? */ 04960000
INIT('0'B), 04970000
NBLK FIXED BIN(15) /* NUMBER OF BLANKS FOUND */ 04980000
INIT( 0 ), 04990000
NEWOFSET FIXED BIN(15) /* FIRST POSITION OF THE COMMAND */ 05000000
INIT( 0 ), /* IN THE STATEMENT BUFFER */ 05010000
NEWSTMT BIT(1) /* NEW STMT TO BE PROCESSED? */ 05020001
INIT('0'B), 05030000
QUOTEFLAG BIT(1) /* QUOTE (') ENCOUNTERED? */ 05040000
INIT('0'B); 05050000
05060000
/*******************************************************************/ 05070000
/* ENDFILE CONDITIONS */ 05080000
/*******************************************************************/ 05090000
05100000
ON ENDFILE(SYSIN) /* PROCESS EOF ON INPUT FILE */ 05110000
BEGIN; /* END OF FILE */ 05120000
IF LENGTH(STMTBUF) = 0 THEN 05130000
DO; /* LENGTH(STMTBUF) = 0 */ 05140000
EXIT = YES; /* NO STMT TO PROCESS, */ 05150000
GOTO ENDRD; /* SO END THE PROGRAM */ 05160000
END; /* END LENGTH(STMTBUF) = 0 */ 05170000
ELSE /* PROCESS THE CURRENT STATEMENT */ 05180000
DO; /* LENGTH(STMTBUF) ^= 0 */ 05190000
EODIN = YES; /* SIGNAL END_OF_DATA */ 05200000
ENDSTR = YES; /* SIGNAL END_OF_STRING */ 05210000
GOTO CHKCOMM; /* PROCESS CURRENT COMMAND */ 05220000
END; /* END LENGTH(STMTBUF) ^= 0 */ 05230000
END; /* END END OF FILE */ 05240000
05250000
/*******************************************************************/ 05260000
/* BEGIN READRTN PROCESSING */ 05270000
/*******************************************************************/ 05280000
05290000
NEWSTMT= YES; /* NEW STMT IS BEING PROCESSED */ 05300000
05310000
%PAGE; 05320000
05330000
/*******************************************************************/ 05340000
/* READ IN THE INPUT STATEMENT */ 05350000
/*******************************************************************/ 05360000
05370000
RD: 05380000
05390000
DO WHILE (NEWSTMT = YES); 05400000
05410000
/*****************************************************************/ 05420000
/* NO MORE INPUT DATA (EOF) SO RETURN TO CALLER */ 05430000
/*****************************************************************/ 05440000
05450000
IF EODIN = YES THEN 05460000
DO; /* END OF DATA */ 05470000
EXIT = YES; /* EXIT PROGRAM */ 05480000
LEAVE RD; /* LEAVE THE LOOP */ 05490000
END; /* END END OF DATA */ 05500000
05510000
/*****************************************************************/ 05520000
/* PROCESS THE STATEMENT */ 05530000
/*****************************************************************/ 05540000
05550000
ELSE /* MORE INPUT TO PROCESS */ 05560000
DO; 05570000
NEWSTMT = NO; /* TURN NEW STATEMENT FLAG OFF */ 05580000
CONTLINE = ZERO; /* CLEAR MULTILINE STMT COUNTER */ 05590000
ENDSTR = NO; /* NOT AT THE END OF THE STRING */ 05600000
QUOTEFLAG = NO; /* INITIALIZE QUOTE FLAG */ 05610000
DQUOTFLAG = NO; /* INITIALIZE DOUBLE QUOTE FLAG */ 05620000
STMTLEN = ZERO; /* INITIALIZE THE STMT LENGTH */ 05630000
STMTBUF = NULLCHAR; /* INIT STMT BUFFER TO NULLS */ 05640000
LASTCHAR = NULLCHAR; /* INIT. LAST CHARACTER TO NULL */ 05650000
COMMENT = NO; /* INITIALIZE THE COMMENT FLAG */ 05660000
FIRSTCHAR = NO; /* INIT. FIRST CHAR TO NO */ 05670000
NBLK = ZERO; /* INIT. BLANK COUNT TO 0 */ 05680000
05690000
/*************************************************************/ 05700000
/* READ AND PROCESS A NEW STATEMENT */ 05710000
/*************************************************************/ 05720000
05730000
DO WHILE (ENDSTR = NO); /* PUT INPUT STMT IN STMT BUFFER */ 05740000
05750000
/***********************************************************/ 05760000
/* IF THE COLUMN BEING PROCESSED IS GREATER THAN THE */ 05770000
/* LENGTH OF THE INPUT LINE THEN READ THE NEXT LINE */ 05780000
/***********************************************************/ 05790000
05800000
IF INCOL > INPUTL THEN 05810000
DO; /* GET SYSIN DATA */ 05820000
GET EDIT (INPUT) (COL(1), (INPUTL) A(1)); /* */ 05830000
INCOL = ONE; /* POINT TO FIRST CHARACTER */ 05840000
IF FIRSTCHAR = YES THEN /* FIRST CHAR SET? */ 05850000
CONTLINE = CONTLINE + 1; /* INCREMENT INPUT LINE CTR */ 05860000
END; 05870000
05880000
/***********************************************************/ 05890000
/* THE CHARACTER IN COLUMN ONE IS AN ASTERISK OR THE */ 05900000
/* CHARACTERS IN COLUMNS 1 AND 2 ARE '--'. CONSIDER THIS */ 05910000
/* LINE TO BE A COMMENT. PRINT THE LINE AND RETRIEVE THE */ 05920000
/* NEXT INPUT LINE. */ 05930000
/***********************************************************/ 05940000
05950000
IF INCOL = 1 & (INPUT(1) = ASTERISK 05960000
| (INPUT(1) = HYPHEN & INPUT(2) = HYPHEN)) 05970000
& STMTLEN = 0 THEN 05980000
DO; /* STATEMENT IS A COMMENT */ 05990000
DO J = 1 TO INPUTL; /* PUT ENTIRE LINE INTO STMTBUF */ 06000000
STMTBUF = STMTBUF || INPUT(J); 06010000
END; 06020000
STMTLEN = LENGTH(STMTBUF); 06030000
ENDSTR = YES; /* INDICATE END OF A STRING */ 06040000
NEWSTMT = YES; /* NEW STMT SHOULD BE READ */ 06050000
INCOL = INPUTL + ONE; /* SET INDEX TO 73 TO FORCE */ 06060000
/* THE NEXT STMT TO BE READ */ 06070000
COMMENT= ^COMMENT; /* SET COMMENT INDICATOR ON */ 06080000
END; /* END STATEMENT IS A COMMENT */ 06090000
06100000
/***********************************************************/ 06110000
/* PROCESS THE INPUT STATEMENT */ 06120000
/***********************************************************/ 06130000
06140000
ELSE 06150000
DO; 06160000
06170000
/*******************************************************/ 06180000
/* MOVE THE CHARACTER FROM THE INPUT DATA INTO THE */ 06190000
/* STATEMENT BUFFER UNTIL AN END OF LINE CHARACTER */ 06200000
/* OR SEMICOLON IS ENCOUNTERED */ 06210000
/*******************************************************/ 06220000
06230000
DO J = INCOL TO INPUTL WHILE (^ENDSTR); 06240000
06250000
/*****************************************************/ 06260000
/* PREPROCESS ANY DOUBLE QUOTATION MARKS ("). IF THE */ 06270000
/* DOUBLE QUOTATION MARK IS CONTAINED BETWEEN */ 06280000
/* QUOTATION MARKS ('), THE QUOTATION MARK IS */ 06290000
/* CONSIDERED TO BE THE STRING DELIMITER. THE */ 06300000
/* DQUOTFLAG WILL NOT BE SET. IN THIS CASE THE */ 06310000
/* DOUBLE QUOTATION MARK IS CONSIDERED TO BE PART OF */ 06320000
/* THE STRING */ 06330000
/*****************************************************/ 06340000
06350000
IF INPUT(J) = DQUOTE THEN 06360000
DO; /* INPUT(J)=DQUOTE */ 06370000
IF ^QUOTEFLAG THEN /* NOT DELIMITED BY QUOTES */ 06380000
/* THEN DOUBLE */ 06390000
/* QUOTES ARE */ 06400000
DQUOTFLAG = ^DQUOTFLAG; /* THE DELIMITER */ 06410000
END; /* END INPUT(J) = DQUOTE */ 06420000
06430000
/*****************************************************/ 06440000
/* PREPROCESS ANY QUOTATION MARKS ('). IF THE */ 06450000
/* QUOTATION MARK IS CONTAINED BETWEEN DOUBLE */ 06460000
/* QUOTATION MARKS ("), THE DOUBLE QUOTATION MARK IS */ 06470000
/* CONSIDERED TO BE THE STRING DELIMITER. THE */ 06480000
/* QUOTEFLAG WILL NOT BE SET. IN THIS CASE THE */ 06490000
/* QUOTATION MARK IS CONSIDERED TO BE PART OF THE */ 06500000
/* STRING. */ 06510000
/*****************************************************/ 06520000
06530000
IF INPUT(J) = QUOTE THEN 06540000
DO; /* INPUT(J) = QUOTE */ 06550000
IF ^DQUOTFLAG THEN /* NOT DELIMITED BY */ 06560000
/* DOUBLE QUOTES THEN */ 06570000
/* SINGLE QUOTES ARE THE */ 06580000
QUOTEFLAG = ^QUOTEFLAG; /* DELIMITER */ 06590000
END; /* END INPUT(J) = QUOTE */ 06600000
06610000
/*****************************************************/ 06620000
/* PROCESS A HYPHEN IF FOUND. THE HYPHEN IS */ 06630000
/* CONSIDERED PART OF A STRING IF A DELIMITER FLAG */ 06640000
/* IS SET. IF THE FOLLOWING CHARACTER IS A HYPHEN, */ 06650000
/* MOVE THE REMAINING CHARACTERS TO THE STATEMENT */ 06660000
/* BUFFER. */ 06670000
/*****************************************************/ 06680000
06690000
IF (INPUT(J) = HYPHEN) & /*INPUT CHAR IS '-' */ 06700000
(J < INPUTL) & /* STILL MORE & */ 06710000
^QUOTEFLAG & /* NOT CURRENTLY IN */ 06720000
^DQUOTFLAG THEN /* DELIMITED STRING THEN */ 06730000
DO; /* LOOK FOR '--' */ 06740000
IF INPUT(J+1) = HYPHEN THEN /* FOUND '--' */ 06750000
DO; /* DO NOT MOVE CHARACTERS */ 06760000
MOVECHAR = NO; /* INTO THE STATEMENT BUFFER*/ 06770000
END; 06780000
IF (INPUT(J+1) = HYPHEN) & 06790000
(MOVECHAR = NO) THEN /* COMMENT FOUND */ 06800000
DO; /* STATEMENT IS A COMMENT*/ 06810000
DO J = 1 TO INPUTL; 06820000
STMTBUF = STMTBUF || INPUT(J); 06830000
END; /* PUT ENTIRE LINE INTO STMTBUF */ 06840000
STMTLEN = LENGTH(STMTBUF); 06850000
ENDSTR = YES; /* INDICATE END OF A STRING */ 06860000
NEWSTMT = YES; /* NEW STMT SHOULD BE READ */ 06870000
INCOL = INPUTL + ONE; /* SET INDEX TO 73 */ 06880000
/* TO FORCE THE NEXT STATEMENT */ 06890000
/* TO BE READ */ 06900000
COMMENT= ^COMMENT; /* SET THE COMMENT */ 06910000
/* INDICATOR ON */ 06920000
END; /* END STATEMENT IS A COMMENT */ 06930000
END; /* END LOOK FOR '--' */ 06940000
/*****************************************************/ 06950000
/* PROCESS THE END-OF-STRING IF A SEMICOLON IS */ 06960000
/* FOUND. THE SEMICOLON CANNOT BE CONTAINED WITHIN */ 06970000
/* A DELIMITED STRING. THE ACCEPTABLE DELIMITERS */ 06980000
/* ARE QUOTE OR DOUBLE QUOTE MARKS. */ 06990000
/*****************************************************/ 07000000
07010000
IF (INPUT(J) = SEMICOLON) & ^DQUOTFLAG & 07020000
^QUOTEFLAG THEN /* SEMICOLON & NOT */ 07030000
ENDSTR = ^ENDSTR; /* DELIMITED THEN SET END */ 07040000
/* OF STRING */ 07050000
/*****************************************************/ 07060000
/* NOT THE END OF THE STRING, PROCESS THE STATEMENT */ 07070000
/*****************************************************/ 07080000
07090000
ELSE 07100000
DO; 07110000
07120000
/***************************************************/ 07130000
/* MOVE ALL NON BLANK CHARACTERS INTO THE DB2 */ 07140000
/* COMMAND STATEMENT BUFFER */ 07150000
/***************************************************/ 07160000
07170000
IF INPUT(J)^= BLANK THEN 07180000
DO; 07190000
MOVECHAR = YES; 07200000
FIRSTCHAR = YES; 07210000
NBLK = ZERO; 07220000
END; 07230000
07240000
/***************************************************/ 07250000
/* A BLANK SHOULD BE MOVED IN THE FOLLOWING CASES: */ 07260000
/* */ 07270000
/* 1. IF THE BLANK IS IN A DELIMITED STRING */ 07280000
/* */ 07290000
/* 2. IF AN INPUT STATEMENT SPANS MORE THAN */ 07300000
/* ONE LINE AND THE PREVIOUS LINE HAD A */ 07310000
/* CHARACTER IN COLUMN 72 AND THE CURRENT */ 07320000
/* LINE HAS BLANKS BEFORE THE FIRST WORD */ 07330000
/***************************************************/ 07340000
07350000
ELSE /* BLANK CHARACTER FOUND */ 07360000
DO; 07370000
IF QUOTEFLAG | DQUOTFLAG | 07380000
(CONTLINE >= 1 & J = 1 & NBLK = 0) THEN 07390000
DO; /* BLANK IS DELIMITED, MOVE */ 07400000
MOVECHAR = YES; /* IT INTO STMT BUFFER*/ 07410000
NBLK = NBLK + ONE; /* & INC BLANK COUNT */ 07420000
END; 07430000
ELSE /* BLANK NOT DELIMITED */ 07440000
DO; 07450000
NBLK = NBLK + ONE; /* INCREASE BLANK CTR */ 07460000
IF (NBLK = ONE) & (FIRSTCHAR = YES) THEN 07470000
MOVECHAR = YES; 07480000
ELSE 07490000
DO; 07500000
MOVECHAR = NO; 07510000
END; 07520000
END; /* END BLANK NOT DELIMITED */ 07530000
END; /* END BLANK CHARACTER FOUND */ 07540000
07550000
/*************************************************/ 07560000
/* IF MOVECHAR IS SET THEN MOVE THE INPUT */ 07570000
/* CHARACTER INTO STATEMENT BUFFER AREA */ 07580000
/*************************************************/ 07590000
07600000
IF MOVECHAR = YES THEN 07610000
DO; 07620000
07630000
/*********************************************/ 07640000
/* WHEN THE STATEMENT LENGTH IS TOO LONG,THE */ 07650000
/* STATEMENT CANNOT BE PROCESSED. A RETURN */ 07660000
/* CODE IS SET TO INDICATE NO FURTHER */ 07670000
/* PROCESSING SHOULD BE DONE. AN ERROR */ 07680000
/* MESSAGE WILL BE PUT OUT. */ 07690000
/*********************************************/ 07700000
07710000
STMTLEN = LENGTH(STMTBUF); 07720000
IF STMTLEN = STMTMAX THEN /* STMT TOO LONG */ 07730000
DO; 07740000
RETCODE = SEVERE; /* SET RETURN CODE */ 07750000
PUT EDIT(' *** ERROR: STATEMENT GREATER ', 07760000
'THAN ',STMTMAX,' CHARACTERS. ', 07770000
'STMT: ') /* @35*/ 07780000
(COL(1),A(31),A(5),F(4),A(13), 07790000
A(7)); /* @35*/ 07800000
PUT EDIT((SUBSTR(STMTBUF,KK, 07810000
MIN(100,STMTLEN-KK+1)) 07820000
DO KK = 1 TO STMTLEN BY 100)) 07830000
(COL(2),A(100)); /* @35*/ 07840000
LEAVE RD; 07850000
END; /* END STMT TOO LONG */ 07860000
STMTBUF = STMTBUF || INPUT(J); 07870000
END; /* MOVE CHARACTER INTO BUFFER */ 07880000
LASTCHAR = INPUT(J); /* SAVE THIS CHARACTER */ 07890000
END; /* END CHARACTER NOT A SEMICOLON */ 07900000
END; /* END DO J = INCOL TO INPUTL */ 07910000
END; /* END PROCESS THE INPUT STMT */ 07920000
INCOL = J; /* UPDATE THE INPUT COLUMN */ 07930000
END; /* END DO WHILE (ENDSTR = NO) */ 07940000
07950000
/*************************************************************/ 07960000
/* CHECK WHETHER THE COMMAND ENTERED IS A COMMENT. IF NOT, */ 07970000
/* PRINT THE DB2 COMMAND INPUT STATEMENT. */ 07980000
/*************************************************************/ 07990000
CHKCOMM: 08000000
IF ^COMMENT THEN 08010000
DO; 08020000
STMTLEN = LENGTH(STMTBUF); 08030000
NEWOFSET = ONE; 08040000
END; 08050000
/***************************************************/ 08060000
/* PRINT OUT THE DB2 COMMAND INPUT STATEMENT */ 08070000
/***************************************************/ 08080000
PUT SKIP; 08090000
IF ^COMMENT THEN 08100000
DO; 08110000
PUT SKIP; /*@35*/ 08120000
PUT EDIT (' *** INPUT STATEMENT: ') (COL(1), A); /*@35*/ 08130000
J = STMTLEN; /*@35*/ 08140000
PUT EDIT ((SUBSTR(STMTBUF,KK,MIN(INPLLEN,J-KK+1)) 08150000
DO KK = 1 TO STMTLEN BY INPLLEN)) 08160000
(A(INPLLEN),COL(1)); 08170000
END; 08180000
ELSE /*@35*/ 08190000
DO; /*@35*/ 08200000
J = STMTLEN; /*@35*/ 08210000
PUT EDIT ((SUBSTR(STMTBUF,KK,MIN(INPLLEN,J-KK+1)) /*@35*/ 08220000
DO KK = 1 TO STMTLEN BY INPLLEN)) /*@35*/ 08230000
(COL(2),A(INPLLEN),COL(1)); /*@35*/ 08240000
END; /*@35*/ 08250000
IF ^COMMENT THEN 08260000
STMTBUF = SUBSTR(STMTBUF,ONE,STMTLEN); 08270000
/*************************************************/ 08280000
/* UPDATE THE OUTPUT LINE COUNTER */ 08290000
/*************************************************/ 08300000
08310000
OSTMTLN = STMTLEN/INPLLEN; /* # LINES NEEDED FOR */ 08320000
/* INPUT STMT */ 08330000
IF OSTMTLN * INPLLEN ^= STMTLEN THEN 08340000
OSTMTLN = OSTMTLN + ONE; 08350000
08360000
/*****************************************************/ 08370000
/* CHECK THAT THE DB2 COMMAND BEGINS WITH A HYPHEN. */ 08380000
/* IF NOT, CALL BADCMD AND ISSUE AN ISSUE AN ERROR */ 08390000
/* MESSAGE. */ 08400000
/*****************************************************/ 08410000
08420000
IF ^COMMENT THEN 08430000
DO; /* STATEMENT NOT A COMMENT */ 08440000
/*******************************************************************/ 08450000
/* HANDLE BAD IFI CALL SYNTAX */ 08460000
/*******************************************************************/ 08470000
IF SUBSTR(STMTBUF,ONE,ONE) ^= '-' THEN /* NO HYPHEN */ 08480000
DO; 08490000
PUT SKIP; 08500000
PUT SKIP EDIT(' *** SYNTAX FOR DB2 COMMAND ',/*@35*/ 08510000
'IS NOT VALID.') /*@35*/ 08520000
(COL(1),A(28),A(13)); /*@35*/ 08530000
PUT SKIP EDIT(' *** A VALID COMMAND MUST ', /*@35*/ 08540000
'BEGIN WITH A HYPHEN.') 08550000
(COL(1),A(26),A(20)); /*@35*/ 08560000
RETCODE = RETERR; /* SET RET CODE TO 8 */ 08570000
END; /* END NO HYPHEN */ 08580000
/*******************************************************************/ 08590000
/* COMMAND SYNTAX IS CORRECT */ 08600000
/*******************************************************************/ 08610000
ELSE 08620000
DO; /* A VALID */ 08630000
INPUTCMD = SUBSTR(STMTBUF,ONE,STMTLEN); /* COMMAND*/ 08640000
/*SO MAKE CALL*/ 08650000
/****************************************************/ 08660000
/* CONNECT TO THE DB2 REMOTE LOCATION */ 08670000
/****************************************************/ 08680000
EXEC SQL CONNECT TO :DB2LOC2; /* CONNECT TO */ 08690000
/* REMOTE LOCATION */ 08700000
IF SQLCODE < 0 THEN /* SQL ERROR? @42*/ 08710000
DO; /* YES, ERROR FOUND*/ 08720000
PUT EDIT (' *** CONNECTION TO ',DB2LOC2, /*@35*/ 08730000
' NOT SUCCESSFUL:') 08740000
(COL(1), A(19), A(16), A(16)); /*@35*/ 08750000
CALL PRINTCA; /* PRINT ERROR MSG */ 08760000
GOTO STOPRUN; /* END PROGRAM */ 08770000
END; /* END ERROR FOUND */ 08780000
/****************************************************/ 08790000
/* CALL THE STORED PROCEDURE PROGRAM DSN8EP2 */ 08800000
/****************************************************/ 08810000
RETURN_IND = -1; /*@35*/ 08820000
EXEC SQL CALL DSN8.DSN8EP2(:INPUTCMD, 08830000
:IFCA_RET_HEX, 08840000
:IFCA_RES_HEX, 08850000
:BUFF_OVERFLOW, /*@35*/ 08860000
:RETURN_BUFF:RETURN_IND); /*@35*/ 08870000
IF SQLCODE < 0 THEN /* SQL ERROR? @42*/ 08880000
DO; /* YES ERROR FOUND */ 08890000
PUT EDIT (' *** CALL TO DSN8EP2 NOT SUCCESSFUL:') 08900000
(COL(1),A(36)); /*@35*/ 08910000
IF SQLCODE = -911 | SQLCODE = -918 /*@42*/ 08920000
| SQLCODE = -919 | SQLCODE = -965 /*@42*/ 08930000
THEN /* CHECK FOR SPECIFIC ERRORS @42*/ 08940000
/* THAT REQUIRE A ROLL BACK @42*/ 08950000
DO; /* YES, ROLL BACK REQUIRED @42*/ 08960000
CALL PRINTCA; /* PRINT ERROR MSG @42*/ 08970000
PUT EDIT (' *** ISSUE ROLLBACK WORK ', 08980000
'BECAUSE STORED PROCEDURE ', 08990000
'CALL NOT SUCCESSFUL') 09000000
(COL(1), A(25), A(25), A(19)); 09010000
/* PRINT ROLLBACK WORK MESSAGE @42*/ 09020000
EXEC SQL ROLLBACK WORK; /* EXECUTE ROLLBACK*/ 09030000
/* WORK STMT @42*/ 09040000
END; /* END ROLL BACK REQUIRED @42*/ 09050000
CALL PRINTCA; /* PRINT ERROR MSG */ 09060000
GOTO STOPRUN; /* END PROGRAM */ 09070000
END; /* END ERROR FOUND */ 09080000
/*******************************************************************/ 09090000
/* CALL THE RESULTS PROC TO PROCESS THE RETURN CODE, THE REASON */ 09100000
/* CODE AND THE RESULTS MESSAGE OF THE COMMAND EXECUTED BY IFI. */ 09110000
/* NEXT, INITIALIZE THE VARIABLES TO PROCESS THE NEXT DB2 COMMAND. */ 09120000
/*******************************************************************/ 09130000
CALL RESULTS; /* PROCESS THE RESULTS */ 09140000
END; /* END VALID COMMAND */ 09150000
NEWOFSET = ZERO; /* RESET CHARACTER PTR */ 09160000
NEWSTMT = YES; /* RESET FOR NEW STMT */ 09170000
END; /* END STATEMENT NOT A COMMENT */ 09180000
END; /* END ELSE MORE INPUT */ 09190000
END; /* END DO WHILE NEW STMT */ 09200000
09210000
ENDRD:; /* END RD SUB-PROC */ 09220000
END READRTN; /* END READRTN PROC */ 09230000
09240000
%PAGE; 09250000
09260000
/*******************************************************************/ 09270000
/* PROCESS THE DB2 COMMAND RESULTS FROM THE IFCA RETURN BUFFER */ 09280000
/*******************************************************************/ 09290000
RESULTS: PROCEDURE; 09300000
DCL 09310000
M0LENGTH CHAR(2) INIT(' '), /* LENGTH OF CMD RESULT */ 09320000
M1LENGTH BIT(16) INIT('0'B), /* INTERNALLY STORED LNG */ 09330000
M2LENGTH FIXED BIN(15) INIT(0), /* LENGTH OF MESSAGE N */ 09340000
BEGINSTR FIXED BIN(15) INIT(1), /* CHAR 1 POINTER */ 09350000
TOTBYTES FIXED BIN(31) INIT(0); /* MSG BYTE COUNT */ 09360000
09370000
IFCA_RET_CODE = HEX2CHAR(IFCA_RET_HEX); /* RETURN CODE IN HEX */ 09380000
IFCA_RES_CODE = HEX2CHAR(IFCA_RES_HEX); /* REASON CODE IN HEX */ 09390000
TOTBYTES = 0; /* INITIALIZE COUNTER */ 09400000
BEGINSTR = 1; /* INITIALIZE POINTER */ 09410000
09420000
IF IFCA_RET_HEX ^= 0 THEN /* IF THE RETURN CODE ISN'T ZERO */ 09430000
/* ISSUE AN ERROR MESSAGE */ 09440000
DO; 09450000
PUT EDIT(' *** RETURN CODE=',SUBSTR(IFCA_RET_CODE,7,2), /*@35*/ 09460000
' REASON CODE=',IFCA_RES_CODE,' FROM IFI REQUEST') 09470000
(COL(1),A(17),A(2),A,A(8),A); /*@35*/ 09480000
END; /* END ISSUE AN ERROR MESSAGE */ 09490000
09500000
IF LENGTH(RETURN_BUFF) ^= 0 THEN /*@35*/ 09510000
/* DON'T PRINT UNLESS SOME DATA RET. */ 09520000
DO; 09530000
PUT SKIP; /*@35*/ 09540000
PUT SKIP EDIT(' *** IFI RETURN AREA:') /*@35*/ 09550000
(COL(1),A); /*@35*/ 09560000
/*************************************************************/ 09570000
/* PROCESS THE UNFORMATTED COMMAND RESULTS FROM THE IFI CALL.*/ 09580000
/* GET THE LENGTH OF EACH RESULT LINE FROM THE FIRST TWO */ 09590000
/* BYTES. PUT IT IN USABLE FORM. PRINT THE RESULTS FROM */ 09600000
/* THE FIRST LINE. UPDATE THE POINTER AND THE COUNTERS AND */ 09610000
/* REPEAT UNTIL ALL BYTES FROM IFCA_BYTES_MOVED HAVE BEEN */ 09620000
/* PROCESSED. */ 09630000
/*************************************************************/ 09640000
CURPTR = 0; /* START OF DATA IN RET AREA@35*/ 09650000
REMBYTES = LENGTH(RETURN_BUFF); /* NUMBER OF BYTES TO PROC@35*/ 09660000
DO WHILE (REMBYTES > 0); /* RETURN AREA PRINT LOOP @35*/ 09670000
PRTBUF = SUBSTR(RETURN_BUFF,CURPTR,OUTLEN); /*@35*/ 09680000
SUBSTR(PRTBUF,1,1) = BLANK; /* BLANK FIRST COLUMN TO @35*/ 09690000
/* AVOID CARRIAGE CTRL PROB */ 09700000
PUT SKIP EDIT (PRTBUF) (COL(1),A(OUTLEN)); /*@35*/ 09710000
CURPTR = CURPTR + OUTLEN; /*@35*/ 09720000
REMBYTES = REMBYTES - OUTLEN; /*@35*/ 09730000
END; /*@35*/ 09740000
END; /* END IFCA_BYTES_MOVED ^= 0 */ 09750000
09760000
IF BUFF_OVERFLOW = 1 THEN /* COULDN'T GET ALL DATA @35*/ 09770000
DO; /*@35*/ 09780000
PUT SKIP EDIT (' *** INSUFFICIENT SPACE TO RECEIVE ', /*@35*/ 09790000
'ALL OUTPUT FROM IFI RETURN AREA.') /*@35*/ 09800000
(A(35),A(32)); /*@35*/ 09810000
IF RETCODE < RETWRN THEN /*@35*/ 09820000
RETCODE = RETWRN; /*@35*/ 09830000
END; /*@35*/ 09840000
IF IFCA_RET_HEX > RETCODE THEN /* CHECK RETURN CODES */ 09850000
RETCODE = IFCA_RET_HEX; /* USE THE HIGHEST ONE */ 09860000
09870000
IF IFCA_RET_HEX = SEVERE THEN /* IF RETURN CODE = 12 */ 09880000
GOTO STOPRUN; /* STOP PROGRAM EXECUTION*/ 09890000
09900000
END RESULTS; /* END RESULTS PROC */ 09910000
/*******************************************************************/ 09920000
/* SET THE PL/I RETURN CODE AND TERMINATE PROCESSING */ 09930000
/*******************************************************************/ 09940000
09950000
STOPRUN: 09960000
IF RETCODE >= SEVERE THEN /*@35*/ 09970000
DO; /*@35*/ 09980000
PUT SKIP; /*@35*/ 09990000
PUT SKIP EDIT (' *** SEVERE ERROR OCCURRED. ', /*@35*/ 10000000
'PROGRAM IS TERMINATING.') /*@35*/ 10010000
(A(28),A(23)); /*@35*/ 10020000
END; /*@35*/ 10030000
CALL PLIRETC(RETCODE); /* SET PLI RETURN CODE */ 10040000
END DSN8EP1; /* END PROGRAM */ 10050000