IDENTIFICATION DIVISION. PROGRAM-ID. COB_SQLM_ZILL_BROWSE_SUB. AUTHOR. Roland Hughes. DATE-WRITTEN. 2005-05-11. DATE-COMPILED. TODAY. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. DATA DIVISION. FILE SECTION. ********** * Data declarations ********** WORKING-STORAGE SECTION. 01 STATUS-VARIABLES. 05 DONE-FLAG PIC X. 88 WE-ARE-DONE VALUE 'Y'. 01 RECORD-DATE. 05 YYYY-STR PIC 9(4). 05 MM-STR PIC 9(2). 05 DD-STR PIC 9(2). 01 FORMATTED-DATE. 05 MM-STR PIC Z9. 05 SLASH-1 PIC X. 05 DD-STR PIC 9(2). 05 SLASH-2 PIC X. 05 YYYY-STR PIC 9(4). 01 FORMATTED-NUMBERS. 05 NO-1 PIC Z9. 05 FILLER PIC X VALUE SPACE. 05 NO-2 PIC Z9. 05 FILLER PIC X VALUE SPACE. 05 NO-3 PIC Z9. 05 FILLER PIC X VALUE SPACE. 05 NO-4 PIC Z9. 05 FILLER PIC X VALUE SPACE. 05 NO-5 PIC Z9. 01 SCREEN-REC. 05 SCREEN-RECORDS OCCURS 1 TO 5000 TIMES DEPENDING ON L-REC-COUNT. 10 F-MARK PIC X. 10 DRAW-DT PIC X(10). 10 NUMBERS PIC X(30). 10 MEGA-NO PIC Z9. 01 STUFF. 05 LOAD-DIRECTION PIC 9 COMP. 88 LOAD-FORWARD VALUE 0. 88 LOAD-REVERSE VALUE 1. 05 L-REC-COUNT PIC S9(9) COMP. 05 L-SUB PIC S9(9) COMP. 05 L-CURRENT-POS PIC S9(9) COMP. 05 L-SCREEN-SIZE PIC S9(9) COMP VALUE 10. 05 WORK-STR PIC X(80). 05 TERMINATOR PIC S9(9) COMP. 05 KEY_PAD_MODE PIC 9 COMP VALUE 0. 05 NEGATIVE-ONE PIC S9(9) COMP VALUE -1. 05 SQLCODE PIC S9(9) COMP. 01 SQL-RECORD. 05 DRAW-DT PIC S9(18) COMP. 05 NO-1 PIC 9(2) COMP. 05 NO-2 PIC 9(2) COMP. 05 NO-3 PIC 9(2) COMP. 05 NO-4 PIC 9(2) COMP. 05 NO-5 PIC 9(2) COMP. 05 MEGA-NO PIC 9(2) COMP. 01 DATE-STUFF. 05 LIB-RESULT PIC S9(8) COMP. 05 LIB-RESULT-DISPLAY PIC 9(8). 05 DATE-CONTEXT PIC S9(8) COMP. 05 DATE-COMPONENT PIC S9(8) COMP. 05 DATE-OUT-FMT-STR PIC X(14) VALUE '|!Y4/!MN0/!D0|'. 05 DATE-FLAGS PIC S9(8) COMP VALUE 127. 01 DISPLAY-STUFF. 05 DISPLAY-RECORDS OCCURS 10 TIMES. 10 F-MARK PIC X. 10 DRAW-DT PIC X(10). 10 NUMBERS PIC X(30). 10 MEGA-NO PIC Z9. * * FMS definitions * COPY 'COBFDVDEF' OF 'MEGA_TEXT_LIB'. COPY 'SYS$LIBRARY:SQL_LITERALS.LIB'. LINKAGE SECTION. 01 FMS-STUFF. 05 FMSSTATUS PIC S9(9) COMP. 05 RMSSTATUS PIC S9(9) COMP. 05 TCA PIC X(12). 05 WORKSPACE PIC X(12). PROCEDURE DIVISION USING FMS-STUFF. A000-MAIN. PERFORM B000-HSK. PERFORM B010-USER-INPUT UNTIL WE-ARE-DONE. CALL 'LIB$FREE_DATE_TIME_CONTEXT' USING BY REFERENCE DATE-CONTEXT GIVING LIB-RESULT. EXIT PROGRAM. ***** * Paragraph to initialize our data and files. ***** B000-HSK. MOVE SPACES TO STATUS-VARIABLES. CALL 'FDV$SPADA' USING BY REFERENCE KEY_PAD_MODE. CALL 'FDV$CDISP' USING BY DESCRIPTOR 'ZILL_BROWSE'. MOVE SPACES TO SCREEN-REC. * * Set up date context for display * MOVE ZERO TO DATE-CONTEXT. MOVE 1 TO DATE-COMPONENT. CALL 'LIB$INIT_DATE_TIME_CONTEXT' USING BY REFERENCE DATE-CONTEXT, DATE-COMPONENT, BY DESCRIPTOR DATE-OUT-FMT-STR GIVING LIB-RESULT. * * Count and load records * CALL 'COUNT_DRAW' USING BY REFERENCE SQLCODE, L-REC-COUNT. CALL 'OPEN_ALL_DRAW' USING BY REFERENCE SQLCODE. IF SQLCODE IS EQUAL TO SQLCODE_SUCCESS PERFORM C010-LOAD-ARRAY VARYING L-SUB FROM 1 BY 1 UNTIL L-SUB IS GREATER THAN OR EQUAL TO L-REC-COUNT. CALL 'CLOSE_ALL_DRAW' USING BY REFERENCE SQLCODE. CALL 'COMMIT_MEGA' USING BY REFERENCE SQLCODE. SET LOAD-FORWARD TO TRUE. MOVE -8 TO L-CURRENT-POS. ***** * Paragraph to handle use input ***** B010-USER-INPUT. PERFORM C000-FORWARD-LOAD CALL 'FDV$PUTAL' USING BY DESCRIPTOR DISPLAY-STUFF. MOVE SPACES TO WORK-STR. CALL 'FDV$GETAL' USING BY DESCRIPTOR WORK-STR BY REFERENCE TERMINATOR. EVALUATE TERMINATOR WHEN FDV$K_FK_E6 SET LOAD-FORWARD TO TRUE WHEN FDV$K_FK_E5 SET LOAD-REVERSE TO TRUE WHEN FDV$K_FK_F10 SET WE-ARE-DONE TO TRUE END-EVALUATE. ***** * Paragraph to load data going forward in the file. * If there is no more forward data, or the flag is * set to load in reverse we will call reverse load. ***** C000-FORWARD-LOAD. IF LOAD-REVERSE SUBTRACT 9 FROM L-CURRENT-POS IF L-CURRENT-POS IS LESS THAN 1 MOVE 1 TO L-CURRENT-POS CALL 'FDV$BELL' END-IF ELSE ADD 9 TO L-CURRENT-POS IF L-CURRENT-POS IS GREATER THAN OR EQUAL TO L-REC-COUNT SUBTRACT 10 FROM L-REC-COUNT GIVING L-CURRENT-POS CALL 'FDV$BELL' END-IF END-IF. IF L-CURRENT-POS IS LESS THAN 1 MOVE 1 TO L-CURRENT-POS. MOVE SCREEN-RECORDS( L-CURRENT-POS) TO DISPLAY-RECORDS(1). MOVE SCREEN-RECORDS( L-CURRENT-POS + 1) TO DISPLAY-RECORDS(2). MOVE SCREEN-RECORDS( L-CURRENT-POS + 2) TO DISPLAY-RECORDS(3). MOVE SCREEN-RECORDS( L-CURRENT-POS + 3) TO DISPLAY-RECORDS(4). MOVE SCREEN-RECORDS( L-CURRENT-POS + 4) TO DISPLAY-RECORDS(5). MOVE SCREEN-RECORDS( L-CURRENT-POS + 5) TO DISPLAY-RECORDS(6). MOVE SCREEN-RECORDS( L-CURRENT-POS + 6) TO DISPLAY-RECORDS(7). MOVE SCREEN-RECORDS( L-CURRENT-POS + 7) TO DISPLAY-RECORDS(8). MOVE SCREEN-RECORDS( L-CURRENT-POS + 8) TO DISPLAY-RECORDS(9). MOVE SCREEN-RECORDS( L-CURRENT-POS + 9) TO DISPLAY-RECORDS(10). ***** * Paragraph to load records into display array ***** C010-LOAD-ARRAY. CALL 'FETCH_ALL_DRAW' USING BY REFERENCE SQLCODE, DRAW-DT IN SQL-RECORD, NO-1 IN SQL-RECORD, NO-2 IN SQL-RECORD, NO-3 IN SQL-RECORD, NO-4 IN SQL-RECORD, NO-5 IN SQL-RECORD, MEGA-NO IN SQL-RECORD. CALL 'LIB$FORMAT_DATE_TIME' USING BY DESCRIPTOR DRAW-DT IN SCREEN-RECORDS( L-SUB), BY REFERENCE DRAW-DT IN SQL-RECORD, DATE-CONTEXT, OMITTED, OMITTED GIVING LIB-RESULT MOVE NO_1 IN SQL-RECORD TO NO-1 IN FORMATTED-NUMBERS. MOVE NO_2 IN SQL-RECORD TO NO-2 IN FORMATTED-NUMBERS. MOVE NO_3 IN SQL-RECORD TO NO-3 IN FORMATTED-NUMBERS. MOVE NO_4 IN SQL-RECORD TO NO-4 IN FORMATTED-NUMBERS. MOVE NO_5 IN SQL-RECORD TO NO-5 IN FORMATTED-NUMBERS. MOVE FORMATTED-NUMBERS TO NUMBERS IN SCREEN-RECORDS( L-SUB). MOVE MEGA_NO IN SQL-RECORD TO MEGA-NO IN SCREEN-RECORDS( L-SUB). END PROGRAM COB_SQLM_ZILL_BROWSE_SUB.