This is a non-working example of a multi-row fetch program to compare to a single row fetch program. This example shows the components required for the process to work: 000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. MULTI6. 000300 000400***************************************************************** 000500* 000600* DESCRIPTION: THIS PROCESS WILL READ PARTITION 1 OF 000700* ACCOUNT IN SEQUENCE USING MULTI-ROW FETCH 000800* TO COMPARE TO DIFFERENT LEVELS OF MULTI-ROW. 000900* 001000* 001100* RETURN CODES: 001200* 0 - EVERYTHING WORKED 001300* 8 - DB2 ERROR 001400* 001500***************************************************************** 001600* PROGRAM: MULTI6 001700* AUTHOR : Dan Luksetich c 2007 YL&A 001800* 001900* 004100 004200 ENVIRONMENT DIVISION. 005800 005900********************************************************* 006000* W O R K I N G - S T O R A G E S E C T I O N * 006100********************************************************* 006200 WORKING-STORAGE SECTION. 006300 006400********************************************************* 006500* W O R K I N G - S T O R A G E C O N S T A N T S * 006600********************************************************* 006700 01 KN-CONSTANT-VALUES. 006800 05 KN-NEW-SUBSCRIBER-BASE PIC X(04) VALUE SPACES. 006900 05 KN-NEW-ACCOUNT-NUMBER PIC X(30) VALUE SPACES. 007000 007100 007200********************************************************* 007300* W O R K I N G - S T O R A G E S W I T C H E S * 007400********************************************************/ 007500 01 WSS-WORK-SWITCHES. 007600 05 WS-EOF-SW PIC X(01) VALUE '0'. 007700 88 NOT-EOF VALUE '0'. 007800 88 UNLOAD-EOF VALUE '1'. 007900 05 WS-DB2-SWITCH PIC X(01) VALUE '0'. 008000 88 NO-DB2-ERROR VALUE '0'. 008100 88 DB2-ERROR VALUE '1'. 008200 05 WS-DUMMY-IMPERATIVE PIC X(01). 008300 008400********************************************************* 008500* W O R K I N G - S T O R A G E V A R I A B L E S * 008600********************************************************/ 008700 01 WS-VARIABLES. 008707 05 WS-ACCT-CNT PIC S9(9) COMP. 008708 05 WS-SQLCODE PIC S9(9) COMP. 008710 05 DIS-SQLCODE PIC S9(10). 008800 05 WS-ACCT-ID PIC S9(11) COMP-3 008801 OCCURS 100 TIMES. 008810 05 WS-ACCT-NUM PIC X(30) 008811 OCCURS 100 TIMES. 008820 05 WS-USER-SRC-ID PIC X(10) 008821 OCCURS 100 TIMES. 008830 05 WS-RSUB-BASE-CDE PIC X(04) 008831 OCCURS 100 TIMES. 008840 05 WS-RSUB-SFX-CDE PIC X(03) 008850 OCCURS 100 TIMES. 008900 05 WS-PARTY-ID PIC S9(11) COMP-3. 018600 018700***************************************************************** 018800* MULTI6 CURSOR DEFINITION 018900***************************************************************** 019000 019100 EXEC SQL 019200 DECLARE MULTI6-CURSOR CURSOR 019210 WITH ROWSET POSITIONING FOR 019300 SELECT ACCT_ID 019400 ,ACCT_NUM, USER_SRC_ID, RSUB_BASE_CDE 019500 ,RSUB_SFX_CDE 019800 FROM CDIA1030.ACCOUNT 021500 WITH UR 021600 FOR FETCH ONLY 021800 END-EXEC. 021900 022000 EXEC SQL 022100 INCLUDE SQLCA 022200 END-EXEC. 022300 022400********************************************************* 022500* E N D O F W O R K I N G - S T O R A G E * 022600********************************************************/ 023500 PROCEDURE DIVISION. 023600 024800 024900 0000-MAINLINE. 025000 025600 PERFORM 1000-OPEN-CURSOR THRU 1000-EXIT 025700 UNTIL UNLOAD-EOF OR DB2-ERROR. 025800 025900 0000-MAINLINE-EXIT. 026000 026300 026400 GOBACK. 026500 026600 030200***************************************************************** 030300* OPEN CURSOR, FETCH LOOP. READ NEXT RECORD 030400***************************************************************** 030500 1000-OPEN-CURSOR. 030600 030620 MOVE ZERO TO WS-ACCT-CNT. 030700 EXEC SQL OPEN MULTI6-CURSOR END-EXEC. 030800 030900 EVALUATE SQLCODE 031000 WHEN +0 031100 MOVE 'X' TO WS-DUMMY-IMPERATIVE 031200 WHEN +100 031400 GO TO 1000-EXIT 031500 WHEN OTHER 031600 MOVE '1' TO WS-DB2-SWITCH 031700 DISPLAY '***** DB2 OPEN ERROR IN 1000- ' 031800 SQLCODE UPON CONSOLE 031900 PERFORM 9000-DB2-ERROR THRU 9000-EXIT 032000 END-EVALUATE 032100 . 032200 032300 PERFORM 1100-FETCH-LOOP THRU 1100-EXIT 032400 UNTIL SQLCODE = +100 OR DB2-ERROR. 032500 032600 IF SQLCODE = +100 032700 THEN 032701 MOVE '1' TO WS-EOF-SW 032710 MOVE WS-ACCT-CNT TO WS-DISPLAY-CNT 032720 DISPLAY WS-CNT-MESSAGE 032800 EXEC SQL CLOSE MULTI6-CURSOR END-EXEC 032900 EVALUATE SQLCODE 033000 WHEN +0 033100 MOVE 'X' TO WS-DUMMY-IMPERATIVE 033200 WHEN OTHER 033300 MOVE '1' TO WS-DB2-SWITCH 033400 DISPLAY '***** DB2 CLOSE CURSOR ERROR IN 1100- ' 033500 SQLCODE UPON CONSOLE 033600 PERFORM 9000-DB2-ERROR THRU 9000-EXIT 033700 END-EVALUATE 033800 . 033900 1000-EXIT. 034000 EXIT. 034100 034200 034300***************************************************************** 034400* FETCH UNTIL END-OF-CURSOR 034500***************************************************************** 034600 1100-FETCH-LOOP. 034700 034800 EXEC SQL 034900 FETCH NEXT ROWSET FROM MULTI6-CURSOR 034910 FOR 050 ROWS 035000 INTO :WS-ACCT-ID 035100 ,:WS-ACCT-NUM 035200 ,:WS-USER-SRC-ID 035300 ,:WS-RSUB-BASE-CDE 035400 ,:WS-RSUB-SFX-CDE 035600 END-EXEC 035700 035710* EXEC SQL 035720* GET DIAGNOSTICS 035730* :WS-ROW-CNT = ROW_COUNT 035740* ,:WS-NUM-COND = NUMBER 035750* ,:WS-LAST-ROW = DB2_LAST_ROW 035760* END-EXEC 035770* 035780* EXEC SQL 035790* GET DIAGNOSTICS CONDITION 1 035791* :WS-SQLCODE = DB2_RETURNED_SQLCODE 035794* END-EXEC 035795* 035796* MOVE WS-SQLCODE TO SQLCODE. 035797 035800 EVALUATE SQLCODE 035900 WHEN +0 036000 MOVE 'X' TO WS-DUMMY-IMPERATIVE 036010 ADD SQLERRD(3) TO WS-ACCT-CNT 036011* FETCH WITHIN FETCH LOOP SHOULD GO HERE 036100 WHEN +100 036110 ADD SQLERRD(3) TO WS-ACCT-CNT 036111* FETCH WITHIN FETCH LOOP SHOULD GO HERE IF SQLERRD3>0 036200 MOVE 'Y' TO WS-DUMMY-IMPERATIVE 036400 WHEN OTHER 036500 MOVE '1' TO WS-DB2-SWITCH 036510 MOVE SQLCODE TO DIS-SQLCODE 036600 DISPLAY '***** DB2 ERROR IN 1100- ' 036700 DIS-SQLCODE UPON CONSOLE 036800 PERFORM 9000-DB2-ERROR THRU 9000-EXIT 036900 END-EVALUATE 037000 . 037100 037200 037300 037400 1100-EXIT. 037500 EXIT.