IDENTIFICATION DIVISION. PROGRAM-ID. EXPLODE. ENVIRONMENT DIVISION. DATA DIVISION. WORKING-STORAGE SECTION. 01 SQLMSGS. 02 SQLMMAX PIC S9(8) COMP VALUE +6. 02 SQLMSIZE PIC S9(8) COMP VALUE +80. 02 SQLMCNT PIC S9(8) COMP. 02 SQLMLINE OCCURS 6 TIMES PIC X(80). 01 REQ-WK. 02 REQUEST-CODE PIC S9(8) COMP. 02 REQUEST-RETURN PIC S9(8) COMP. 01 LIMITS-AND-CONSTANTS. 02 NUMBER-OF-CURSORS PIC S9 COMP VALUE 3. 02 MAX-LEVELS PIC S9(4) COMP VALUE 100. 02 NULL-KEY-VALUE PIC 9(7) VALUE 0. 01 CURSOR-FLAGS. 02 CURSOR-FLAG OCCURS 3 TIMES PIC X. 01 KEY-TABLE. 02 SAVE-KEY OCCURS 100 TIMES PIC 9(7). 01 WORK-FIELDS. 02 CURRENT-LEVEL PIC S9(4) COMP. 02 CURRENT-CURSOR PIC S9(4) COMP. 02 DISPLAY-LEVEL PIC ZZ9. 02 WARNING-MSG PIC X(40). 02 SQLVALUE PIC ----9. EXEC SQL BEGIN DECLARE SECTION END-EXEC 01 DBNAME PIC X(8). 01 PREVIOUS-COMPONENT PIC S9(7) COMP-3. 01 TOP-KEY PIC S9(7) COMP-3. 01 CURRENT-ROW. 02 CURRENT-KEY PIC S9(7) COMP-3. 02 COMPONENT-KEY PIC S9(7) COMP-3. 02 QTY PIC S9(5)V99 COMP-3. 02 COMPONENT-NAME PIC X(30). EXEC SQL END DECLARE SECTION END-EXEC.
********************************************************* ***** DECLARE CURSORS ***** EXEC SQL DECLARE CURSOR1 CURSOR FOR SELECT COMPONENT_PART, QUANTITY, PART_NAME FROM COMPONENT C, PART P WHERE C.PART = :CURRENT-KEY AND C.COMPONENT_PART > :PREVIOUS-COMPONENT AND P.NUMBER = C.PART ORDER BY COMPONENT_PART END-EXEC EXEC SQL DECLARE CURSOR2 CURSOR FOR SELECT COMPONENT_PART, QUANTITY, PART_NAME FROM COMPONENT C, PART P WHERE C.PART = :CURRENT-KEY AND C.COMPONENT_PART > :PREVIOUS-COMPONENT AND P.NUMBER = C.PART ORDER BY COMPONENT_PART END-EXEC EXEC SQL DECLARE CURSOR3 CURSOR FOR SELECT COMPONENT_PART, QUANTITY, PART_NAME FROM COMPONENT C, PART P WHERE C.PART = :CURRENT-KEY AND C.COMPONENT_PART > :PREVIOUS-COMPONENT AND P.NUMBER = C.PART ORDER BY COMPONENT_PART END-EXEC ********************************************************* PROCEDURE DIVISION. EXEC SQL WHENEVER SQLERROR GO TO SQL-ERROR END-EXEC.
MAINLINE SECTION. ACCEPT DBNAME. ACCEPT TOP-KEY. * INITIALIZE VARIABLES TO GET US STARTED MOVE 1 TO CURRENT-LEVEL. MOVE 1 TO CURRENT-CURSOR. MOVE SPACES TO CURSOR-FLAGS. MOVE NULL-KEY-VALUE TO PREVIOUS-COMPONENT. * PERFORM GET-FIRST-ROW. PERFORM FETCH-NEXT-ROW UNTIL CURRENT-LEVEL = 0. EXEC SQL COMMIT RELEASE END-EXEC. GOBACK. GET-FIRST-ROW SECTION. EXEC SQL CONNECT TO :DBNAME END-EXEC. EXEC SQL SELECT PART_NUMBER, PART_NAME INTO :CURRENT-KEY, :COMPONENT-NAME FROM PART WHERE PART_NUMBER = :TOP-KEY END-EXEC. IF SQLCODE = 100 MOVE 0 TO CURRENT-LEVEL DISPLAY '***** INVALID PART NUMBER: ' TOP-KEY ELSE DISPLAY '***** BILL OF MATERIALS FOR ' 'PART: ' CURRENT-KEY ' ' COMPONENT-NAME ' *****' DISPLAY '**********************************' '**********************************' '**********************************'.
FETCH-NEXT-ROW SECTION. PERFORM OPEN-CURRENT-CURSOR. IF CURRENT-CURSOR = 1 EXEC SQL FETCH CURSOR1 INTO :COMPONENT-KEY, :QTY, :COMPONENT-NAME END-EXEC ELSE IF CURRENT-CURSOR = 2 EXEC SQL FETCH CURSOR2 INTO :COMPONENT-KEY, :QTY, :COMPONENT-NAME END-EXEC ELSE IF CURRENT-CURSOR = 3 EXEC SQL FETCH CURSOR3 INTO :COMPONENT-KEY, :QTY, :COMPONENT-NAME END-EXEC. IF SQLCODE = 100 PERFORM BACKUP-ONE-LEVEL ELSE PERFORM PRINT-CURRENT-ROW PERFORM DOWN-ONE-LEVEL. OPEN-CURRENT-CURSOR SECTION. IF CURSOR-FLAG (CURRENT-CURSOR) NOT = 'O' MOVE 'O' TO CURSOR-FLAG (CURRENT-CURSOR) IF CURRENT-CURSOR = 1 EXEC SQL OPEN CURSOR1 END-EXEC ELSE IF CURRENT-CURSOR = 2 EXEC SQL OPEN CURSOR2 END-EXEC ELSE IF CURRENT-CURSOR = 3 EXEC SQL OPEN CURSOR3 END-EXEC.
CLOSE-CURRENT-CURSOR SECTION.
IF CURSOR-FLAG (CURRENT-CURSOR) = 'O' MOVE ' ' TO CURSOR-FLAG (CURRENT-CURSOR) IF CURRENT-CURSOR = 1 EXEC SQL CLOSE CURSOR1 END-EXEC ELSE IF CURRENT-CURSOR = 2 EXEC SQL CLOSE CURSOR2 END-EXEC ELSE IF CURRENT-CURSOR = 3 EXEC SQL CLOSE CURSOR3 END-EXEC. DOWN-ONE-LEVEL SECTION. IF CURRENT-LEVEL > MAX-LEVELS NEXT SENTENCE ELSE MOVE COMPONENT-KEY TO CURRENT-KEY MOVE COMPONENT-KEY TO SAVE-KEY (CURRENT-LEVEL) MOVE NULL-KEY-VALUE TO PREVIOUS-COMPONENT ADD 1 TO CURRENT-LEVEL IF CURRENT-CURSOR = MAX-CURSORS MOVE 1 TO CURRENT-CURSOR PERFORM CLOSE-CURRENT-CURSOR ELSE ADD 1 TO CURRENT-CURSOR PERFORM CLOSE-CURRENT-CURSOR. BACKUP-ONE-LEVEL SECTION. SUBTRACT 1 FROM CURRENT-LEVEL. IF CURRENT-LEVEL > 0 MOVE SAVE-KEY (CURRENT-LEVEL) TO PREVIOUS-COMPONENT. IF CURRENT-LEVEL > 1 MOVE SAVE-KEY (CURRENT-LEVEL - 1) TO CURRENT-KEY ELSE MOVE TOP-KEY TO CURRENT-KEY. PERFORM CLOSE-CURRENT-CURSOR. IF CURRENT-CURSOR = 1 MOVE MAX-CURSORS TO CURRENT-CURSOR ELSE SUBTRACT 1 FROM CURRENT-CURSOR.
PRINT-CURRENT-ROW SECTION.
MOVE CURRENT-LEVEL TO DISPLAY-LEVEL. IF CURRENT-LEVEL > MAX-LEVELS MOVE 'MAXIMUM LEVEL, COMPONENTS NOT LISTED' TO WARNING-MSG ELSE MOVE SPACES TO WARNING-MSG. DISPLAY ' ' DISPLAY-LEVEL ' PART: ' COMPONENT-KEY ' ' COMPONENT-NAME ' QTY: ' QTY ' ' WARNING-MSG. SQL-ERROR SECTION. DISPLAY '****************** ERROR IN SQL STATEMENT' ' ******************'. DISPLAY 'PROGRAM ' SQLPGM DISPLAY 'COMPILED ' SQLDATE MOVE SQLCLNO TO SQLVALUE. DISPLAY 'SQL LINE NUMBER ' SQLVALUE MOVE SQLCODE TO SQLVALUE. DISPLAY 'SQLCODE ' SQLVALUE MOVE SQLCERC TO SQLVALUE. DISPLAY 'REASON CODE ' SQLVALUE MOVE SQLCERC TO SQLVALUE. DISPLAY 'ERROR CODE ' SQLVALUE MOVE SQLCNRP TO SQLVALUE. DISPLAY 'ROWS PROCESSED ' SQLVALUE MOVE 4 TO REQUEST-CODE. CALL 'IDMSIN01' USING SQLRPB, REQ=WK, SQLCA, SQLMSGS. IF REQUEST-RETURN NOT = 4 MOVE 1 TO LINE-CNT PERFORM DISP=MSG UNTIL LINE-CNT > SQLMCNT. DISP-MSG SECTION. DISPLAY SQLMLINE (LINE-CNT). ADD 1 TO LINE-CNT.
|
Copyright © 2013 CA.
All rights reserved.
|
|