-ADD SYSTABLE,PSWD=40EF,ARC,SEQ=/1,6,100,100/
-DESC COBOL-LE SYSTABLE TABLE LOOKUP
-PGMR RYDER  JSR SYSTEMS
-LANG COB
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.     SYSTABLE.
000300*AUTHOR.         STEVE RYDER JSR SYSTEMS.
000400 DATE-WRITTEN.   JUNE 23, 1997.
000500 DATE-COMPILED.
000600*REMARKS.
000700*    TABLE LOOKUP.
000800*
000900 ENVIRONMENT DIVISION.
001000 INPUT-OUTPUT SECTION.
001100 FILE-CONTROL.
001200     SELECT  TABLE-FILE
001300         FILE STATUS IS TABLE-FILE-STATUS
001400         ORGANIZATION IS INDEXED
001500         ACCESS IS DYNAMIC
001600         RECORD KEY IS TABLE-KEY
001700         ASSIGN TO  SYS016-TABL.
001800 DATA DIVISION.
001900 FILE    SECTION.
002000 FD  TABLE-FILE
002100     DATA RECORD IS  TABLE-REC.
002200 01  TABLE-REC.
002300     05  TABLE-DATU              PIC 9(4)V999.
002400     05  TABLE-BLNK              PIC X(01).
002500     05  TABLE-KEY.
002600         10  TABLE-NAME          PIC X(15).
002700         10  TABLE-RECORD-CODE   PIC X(01).
002800         10  TABLE-LEFT          PIC X(20).
002900     05  TABLE-DATE              PIC X(03).
003000     05  TABLE-RIGHT.
003100         10  TABLA011-MAX-ENTRIES       PIC 9(4).
003200         10  TABLA012-LEFT-SIDE-LENGTH  PIC 9(4).
003300         10  TABLA013-RIGHT-SIDE-LENGTH PIC 9(4).
003400         10  FILLER                     PIC X(238).
003500*              RIGHT SIDE LENGTH MUST TOTAL   250.
003600 WORKING-STORAGE SECTION.
003700 01  MY-PROGRAM-ID               PIC X(08) VALUE 'SYSTABLE'.
003800 01  SYSLOG-ID                   PIC X(08) VALUE 'SYSLOG  '.
003900*--- SYSLOAD-ID                  PIC X(08) VALUE 'SYSLOAD '.
004000*+++ SYSSNAP-ID                  PIC X(08) VALUE 'SYSSNAP '.
004100*+++ SYSSNAP-LEN                 PIC S9(4) BINARY VALUE +20.
004200 01  DISPLAY-TBL-X               PIC 9(04) VALUE ZERO.
004300 01  WS-DATA-VALUES.
004400     05  ENTRY-COUNT             PIC S9(9) BINARY VALUE ZERO.
004500     05  TABLE-FILE-STATE        PIC X(01) VALUE 'C'.
004600     05  TABLE-FILE-STATUS       PIC X(02) VALUE '00'.
004700         88  TABLE-FILE-OK                 VALUE '00' '04'.
004800*        04  MEANS READ SHORT RECORD, 00 IS NORMAL, ALL OK.
004900     COPY SYSLLOG.
005000     05  LOG-MESSAGE-X REDEFINES LOG-MESSAGE.
005100         10  LOG-MESSAGE-CALLING-ID  PIC X(08).
005200         10  LOG-MESSAGE-ENTRY-COUNT PIC ZZZ,ZZZ,ZZZ-.
005300         10  LOG-MESSAGE-TABLE-ID    PIC X(15).
005400         10  LOG-MESSAGE-TEXT.
005500             15  LOG-MESSAGE-LEFT    PIC X(20).
005600             15  LOG-MESSAGE-TEXT-XX PIC X(45).
005700*
005800     COPY SYSLLOAD.
005900*
006000 01  SAVE-TABLE-ID               PIC X(15) VALUE SPACES.
006100 01  SAVE-REFER.
006200     05  SAVE-REF-POUND1         PIC X(01).
006300     05  SAVE-REF-INDEX          PIC X(01).
006400     05  SAVE-REF-LL             PIC X(01).
006500     05  SAVE-REF-RRR            PIC X(01).
006600     05  SAVE-REF-POUND2         PIC X(01).
006700 01  TBL-REF-INDEX               PIC S9(4) BINARY VALUE ZERO.
006800 01  TBL-REF-INDEX-R REDEFINES TBL-REF-INDEX.
006900     05  FILLER                  PIC X(01).
007000     05  TBL-REF-INDEX-1         PIC X(01).
007100 01  TBL-REF-LL                  PIC S9(4) BINARY VALUE ZERO.
007200 01  TBL-REF-LL-R REDEFINES TBL-REF-LL.
007300     05  FILLER                  PIC X(01).
007400     05  TBL-REF-LL-1            PIC X(01).
007500 01  TBL-REF-RRR                 PIC S9(4) BINARY VALUE ZERO.
007600 01  TBL-REF-RRR-R REDEFINES TBL-REF-RRR.
007700     05  FILLER                  PIC X(01).
007800     05  TBL-REF-RRR-1           PIC X(01).
007900 01  TABLE-OF-TABLES.
008000     05  TABLE-ENTRY             OCCURS 50 TIMES
008100                                 INDEXED BY TBL-X TBL-TOP TBL-MAX.
008200         10  TABLE-TABLE-ID      PIC X(15).
008300         10  TABLE-REFER         PIC X(05).
008400         10  TABLE-SEARCHES      PIC 9(9).
008500         10  TABLE-POINTER       USAGE IS POINTER.
008600 01  SYS9TMEM-ID                 PIC X(08) VALUE 'SYS9TMEM'.
008700 01  SYS9TMEM-COMMANDS.
008800     05  SYS9TMEM-FUNCTION       PIC X(08) VALUE 'READ    '.
008900         88  SYS9TMEM-READ                 VALUE 'READ    '.
009000         88  SYS9TMEM-READX                VALUE 'READX   '.
009100     05  SYS9TMEM-STATUS         PIC X(04) VALUE '****'.
009200         88  SYS9TMEM-STATUS-OK       VALUE '****'.
009300     05  SYS9TMEM-TABLE-ID       PIC X(15) VALUE SPACES.
009400 01  SYS9TMEM-POINTER            USAGE IS POINTER.
009500 01  WS-MID-POINT                PIC S9(4) BINARY.
009600 01  WS-HI                       PIC S9(4) BINARY.
009700 01  WS-LO                       PIC S9(4) BINARY.
009800 LINKAGE SECTION.
009900 01  SYS9TMEM-TABLE.
010000     05  SYS9TMEM-MAX-ENTRIES    PIC S9(4) BINARY.
010100     05  SYS9TMEM-LENGTH-LEFT    PIC S9(4) BINARY.
010200     05  SYS9TMEM-LENGTH-RIGHT   PIC S9(4) BINARY.
010300     05  SYS9TMEM-ENTRY          OCCURS 1 TO 32000 TIMES
010400                                 DEPENDING ON SYS9TMEM-MAX-ENTRIES
010500                                 INDEXED BY SYS9TMEM-X.
010600         10  SYS9TMEM-LEFT.
010700             15  SYS9TMEM-LT-CHAR  PIC X(01) OCCURS 1 TO 20
010800                 DEPENDING ON SYS9TMEM-LENGTH-LEFT.
010900         10  SYS9TMEM-RIGHT.
011000             15  SYS9TMEM-RT-CHAR  PIC X(01) OCCURS 1 TO 250
011100                 DEPENDING ON SYS9TMEM-LENGTH-RIGHT.
011200*    COPY SYSLTBL, BUT W/O THE VALUE CLAUSES.
011300 01  SYSTABLE-LINKAGE-AREA.
011400     05  TBL-OPERATION           PIC X(08).
011500     05  TBL-PROGRAM-ID          PIC X(08).
011600     05  TBL-STATUS              PIC X(04).
011700     05  TBL-SYSTABLE            PIC X(08).
011800     05  TBL-TABLE-ID            PIC X(15).
011900     05  TBL-DIRECTION           PIC X(01).
012000     05  TBL-REFERENCE.
012100         10  TBL-REF-POUND1      PIC X(01).
012200         10  FILLER              PIC X(03).
012300         10  TBL-REF-POUND2      PIC X(01).
012400 01  TBL-LEFT.
012500     05  TBL-LEFT-CHAR           PIC X(01) OCCURS 1 TO 20
012600                                 DEPENDING ON TBL-REF-LL.
012700 01  TBL-RIGHT.
012800     05  TBL-RIGHT-CHAR          PIC X(01) OCCURS 1 TO 250
012900                                 DEPENDING ON TBL-REF-RRR.
013000 PROCEDURE DIVISION USING SYSTABLE-LINKAGE-AREA
013100                          TBL-LEFT     TBL-RIGHT.
013200 0000-SYSTABLE.
013300*+++ MOVE +49 TO SYSSNAP-LEN
013400*+++ CALL SYSSNAP-ID USING SYSSNAP-LEN SYSTABLE-LINKAGE-AREA
013500*+++ MOVE +20 TO SYSSNAP-LEN
013600*+++ CALL SYSSNAP-ID USING SYSSNAP-LEN SAVE-TABLE-ID
013700     ADD 1 TO ENTRY-COUNT
013800     IF  ENTRY-COUNT = 1
013900         MOVE MY-PROGRAM-ID TO SYSLOAD-PROGRAM-ID
014000         MOVE 'FILEOPEN'    TO SYSLOAD-FUNCTION
014100         CALL SYSLOAD-ID USING SYSLOAD-LINKAGE-AREA
014200         SET TBL-TOP TO 1
014300         SET TBL-MAX TO 50
014400         MOVE SPACES TO TABLE-OF-TABLES
014500     .
014600     MOVE '****' TO TBL-STATUS
014700     IF  TABLE-FILE-STATE = 'C'
014800         OPEN INPUT TABLE-FILE
014900         IF  TABLE-FILE-OK
015000             MOVE 'O' TO TABLE-FILE-STATE
015100         ELSE
015200             MOVE 'TFNO' TO TBL-STATUS
015300             DISPLAY 'SYSTABLE-FILE-STATUS=' TABLE-FILE-STATUS
015400             MOVE TABLE-FILE-STATUS  TO LOG-MESSAGE-LEFT
015500             MOVE '(TABL) FILE OPEN, BAD FILE STATUS.'
015600                                     TO LOG-MESSAGE-TEXT-XX
015700             PERFORM 9500-CALL-SYSLOG
015800             GOBACK
015900     .
016000     IF  TBL-OPERATION = 'CLOSE'
016100         IF  TABLE-FILE-STATE = 'C'
016200             CLOSE      TABLE-FILE
016300         END-IF
016400         MOVE 'FREE' TO SYS9TMEM-COMMANDS
016500         PERFORM 2000-DISPLAY-SEARCHES
016600            VARYING TBL-X FROM 1 BY 1
016700              UNTIL TBL-X > TBL-TOP
016800         IF  TBL-PROGRAM-ID NOT = 'SYSLOAD '
016900             MOVE 'FILECLOS'    TO SYSLOAD-FUNCTION
017000             CALL SYSLOAD-ID USING SYSLOAD-LINKAGE-AREA
017100         END-IF
017200     ELSE
017300     IF  TBL-OPERATION NOT = 'SEARCH'
017400         DISPLAY 'SYSTABLE--INVALID OPERATION=' TBL-OPERATION '*'
017500                 ' CALLING PROG=' TBL-PROGRAM-ID
017600                 ' TABLE='        TBL-TABLE-ID
017700         MOVE 'TOPN'             TO TBL-STATUS
017800         MOVE TBL-OPERATION      TO LOG-MESSAGE-LEFT
017900         MOVE ' TABLE OPERATION IS INVALID, MUST BE "SEARCH".  '
018000                                 TO LOG-MESSAGE-TEXT-XX
018100         PERFORM 9500-CALL-SYSLOG
018200     ELSE
018300     IF  TBL-DIRECTION     = 'R'
018400         DISPLAY 'SYSTABLE--INVALID DIRECTION=' TBL-DIRECTION '*'
018500                 ' CALLING PROG=' TBL-PROGRAM-ID
018600                 ' TABLE='        TBL-TABLE-ID
018700         MOVE 'TDIR'             TO TBL-STATUS
018800         MOVE TBL-DIRECTION      TO LOG-MESSAGE-LEFT
018900         MOVE ' TABLE DIRECTION IS INVALID, MUST BE "L" OR "R".'
019000                                 TO LOG-MESSAGE-TEXT-XX
019100         PERFORM 9500-CALL-SYSLOG
019200     ELSE
019300         PERFORM 1000-LOOKUP
019400     .
019500*+++ DISPLAY 'SYSTABLE-LINK=' SYSTABLE-LINKAGE-AREA
019600*+++             ' L=' TBL-REF-LL  '/' TBL-LEFT
019700*+++             ' R=' TBL-REF-RRR '/' TBL-RIGHT
019800*+++ MOVE +49 TO SYSSNAP-LEN
019900*+++ CALL SYSSNAP-ID USING SYSSNAP-LEN SYSTABLE-LINKAGE-AREA
020000*+++ MOVE +20 TO SYSSNAP-LEN
020100*+++ CALL SYSSNAP-ID USING SYSSNAP-LEN SAVE-TABLE-ID
020200     GOBACK
020300     .
020400 1000-LOOKUP.
020500     IF  TBL-TABLE-ID  = SAVE-TABLE-ID
020600     AND TBL-REFERENCE = SAVE-REFER
020700         PERFORM 1100-TABLE-LOOKUP
020800     ELSE
020900         MOVE TBL-REFERENCE TO SAVE-REFER
021000         PERFORM 1200-SET-TBL-REFER
021100         IF  TBL-STATUS   = '****'
021200         AND TBL-TABLE-ID = TABLE-TABLE-ID (TBL-X)
021300             MOVE TBL-TABLE-ID        TO SAVE-TABLE-ID
021400             MOVE TABLE-REFER (TBL-X) TO SAVE-REFER
021500                                         TBL-REFERENCE
021600             PERFORM 1200-SET-TBL-REFER
021700*+++         DISPLAY 'SYSTABLE-RESET, INDEX=' TBL-REF-INDEX
021800*+++             ' L=' TBL-REF-LL
021900*+++             ' R=' TBL-REF-RRR
022000*+++             ' T=' TABLE-TABLE-ID (TBL-X)
022100             PERFORM 1100-TABLE-LOOKUP
022200         ELSE
022300            MOVE 'LOOK' TO TBL-STATUS
022400            SET TBL-X TO 1
022500            PERFORM 1500-LOOK-FOR-TABLE
022600                  UNTIL TBL-STATUS NOT = 'LOOK'
022700                     OR TBL-X > TBL-MAX
022800*+++         DISPLAY 'SYSTABLE-RESET, NAMEX=' TBL-REF-INDEX
022900*+++             ' L=' TBL-REF-LL
023000*+++             ' R=' TBL-REF-RRR
023100*+++             ' T=' TABLE-TABLE-ID (TBL-X)
023200            PERFORM 1100-TABLE-LOOKUP
023300     .
023400 1100-TABLE-LOOKUP.
023500*+++ SET DISPLAY-TBL-X TO TBL-X
023600*+++ DISPLAY 'SEARCHING: ' TBL-TABLE-ID '/' TBL-LEFT
023700*+++         '=' DISPLAY-TBL-X
023800*+++ DISPLAY 'SYS9TMEM=' SYS9TMEM-MAX-ENTRIES  '/'
023900*+++                     SYS9TMEM-LENGTH-LEFT  '/'
024000*+++                     SYS9TMEM-LENGTH-RIGHT '/'
024100*+++                     SYS9TMEM-ENTRY (1)    '*'
024200     IF  TBL-STATUS = '****'
024300         IF  TABLE-POINTER (TBL-X) NOT = NULL
024400             PERFORM 1120-SEARCH
024500         ELSE
024600         MOVE TBL-TABLE-ID TO TABLE-NAME
024700         MOVE 'E'          TO TABLE-RECORD-CODE
024800         MOVE TBL-LEFT     TO TABLE-LEFT
024900         MOVE SPACES       TO TABLE-RIGHT
025000         PERFORM 9100-READ-TABLE-RANDOM
025100         IF  TABLE-FILE-OK
025200             ADD 1 TO TABLE-SEARCHES (TBL-X)
025300             MOVE TABLE-RIGHT  TO TBL-RIGHT
025400         ELSE
025500             PERFORM 1130-TRNF
025600     .
025700 1120-SEARCH.
025800     COMPUTE WS-HI = SYS9TMEM-MAX-ENTRIES
025900     COMPUTE WS-LO = 1
026000     PERFORM UNTIL WS-HI < WS-LO
026100         COMPUTE WS-MID-POINT = (WS-LO + WS-HI) / 2
026200         SET SYS9TMEM-X TO WS-MID-POINT
026300*+++     DISPLAY 'SEARCH: ' WS-MID-POINT '/' WS-LO '/' WS-HI
026400*+++     '/' TBL-LEFT '/' SYS9TMEM-LEFT (SYS9TMEM-X)
026500         IF  TBL-LEFT < SYS9TMEM-LEFT (SYS9TMEM-X)
026600             COMPUTE WS-HI = WS-MID-POINT - 1
026700         ELSE
026800         IF  TBL-LEFT > SYS9TMEM-LEFT (SYS9TMEM-X)
026900             COMPUTE WS-LO = WS-MID-POINT + 1
027000         ELSE
027100             COMPUTE WS-LO = WS-HI + 1
027200         END-IF END-IF
027300     END-PERFORM
027400     IF  TBL-LEFT = SYS9TMEM-LEFT (SYS9TMEM-X)
027500         MOVE SYS9TMEM-RIGHT (SYS9TMEM-X) TO TBL-RIGHT
027600         ADD 1 TO TABLE-SEARCHES (TBL-X)
027700     ELSE
027800         PERFORM 1130-TRNF
027900     .
028000 1130-TRNF.
028100     MOVE 'TRNF' TO TBL-STATUS
028200     MOVE TBL-LEFT           TO LOG-MESSAGE-LEFT
028300     MOVE ' TABLE RECORD NOT FOUND' TO LOG-MESSAGE-TEXT-XX
028400     PERFORM 9500-CALL-SYSLOG
028500     .
028600 1200-SET-TBL-REFER.
028700     IF  SAVE-REF-POUND1 = '#'
028800     AND SAVE-REF-POUND2 = '#'
028900         MOVE SAVE-REF-INDEX TO TBL-REF-INDEX-1
029000         MOVE SAVE-REF-LL    TO TBL-REF-LL-1
029100         MOVE SAVE-REF-RRR   TO TBL-REF-RRR-1
029200     ELSE
029300         MOVE '*REF'         TO TBL-STATUS
029400         SET TBL-REF-INDEX   TO TBL-MAX
029500         MOVE 1              TO TBL-REF-LL
029600         MOVE 1              TO TBL-REF-RRR
029700     .
029800     SET TBL-X TO TBL-REF-INDEX
029900     IF  TABLE-POINTER (TBL-X) NOT = NULL
030000         SET ADDRESS OF SYS9TMEM-TABLE TO TABLE-POINTER (TBL-X)
030100     .
030200 1500-LOOK-FOR-TABLE.
030300     IF  SPACES       = TABLE-TABLE-ID (TBL-X)
030400         PERFORM 1600-READ-TABLE-HEADER
030500     ELSE
030600     IF  TBL-TABLE-ID = TABLE-TABLE-ID (TBL-X)
030700         MOVE '****'                 TO TBL-STATUS
030800         MOVE TABLE-TABLE-ID (TBL-X) TO SAVE-TABLE-ID
030900         MOVE TABLE-REFER    (TBL-X) TO SAVE-REFER
031000                                        TBL-REFERENCE
031100         PERFORM 1200-SET-TBL-REFER
031200     ELSE
031300         SET TBL-X UP BY 1
031400     .
031500 1600-READ-TABLE-HEADER.
031600     MOVE 'READ    '   TO SYS9TMEM-FUNCTION
031700     MOVE TBL-TABLE-ID TO SYS9TMEM-TABLE-ID
031800     CALL SYS9TMEM-ID USING SYS9TMEM-COMMANDS SYS9TMEM-POINTER
031900     IF  SYS9TMEM-STATUS = 'TFNF'
032000         PERFORM 1610-READ-VSAM-HEADER
032100     ELSE
032200     IF  SYS9TMEM-STATUS NOT = '****'
032300         MOVE SYS9TMEM-STATUS TO TBL-STATUS
032400         MOVE 1      TO TBL-REF-LL
032500         MOVE 1      TO TBL-REF-RRR
032600         MOVE 'X'    TO SAVE-TABLE-ID
032700         MOVE SPACES TO TBL-REFERENCE
032800     ELSE
032900         MOVE SYS9TMEM-STATUS TO TBL-STATUS
033000         SET ADDRESS OF SYS9TMEM-TABLE TO SYS9TMEM-POINTER
033100         MOVE TBL-TABLE-ID         TO TABLE-TABLE-ID (TBL-X)
033200         SET  TBL-TOP TO TBL-X
033300         MOVE ZEROES               TO TABLE-SEARCHES (TBL-X)
033400         SET  TBL-REF-INDEX        TO TBL-X
033500         MOVE SYS9TMEM-LENGTH-LEFT       TO TBL-REF-LL
033600         MOVE SYS9TMEM-LENGTH-RIGHT      TO TBL-REF-RRR
033700         MOVE TBL-TABLE-ID    TO SAVE-TABLE-ID
033800         MOVE '#'             TO SAVE-REF-POUND1 SAVE-REF-POUND2
033900         MOVE TBL-REF-INDEX-1 TO SAVE-REF-INDEX
034000         MOVE TBL-REF-LL-1    TO SAVE-REF-LL
034100         MOVE TBL-REF-RRR-1   TO SAVE-REF-RRR
034200         MOVE SAVE-REFER      TO TABLE-REFER (TBL-X)
034300                                 TBL-REFERENCE
034400         SET  TABLE-POINTER (TBL-X) TO SYS9TMEM-POINTER
034500*+++     DISPLAY 'LOADED: ' SAVE-TABLE-ID
034600     .
034700 1610-READ-VSAM-HEADER.
034800     MOVE '****'       TO TBL-STATUS
034900     MOVE TBL-TABLE-ID TO TABLE-NAME
035000     MOVE 'A'          TO TABLE-RECORD-CODE
035100     MOVE SPACES       TO TABLE-LEFT
035200     PERFORM 9100-READ-TABLE-RANDOM
035300     IF  TABLE-FILE-OK
035400         MOVE TBL-TABLE-ID         TO TABLE-TABLE-ID (TBL-X)
035500         SET  TBL-TOP TO TBL-X
035600         MOVE ZEROES               TO TABLE-SEARCHES (TBL-X)
035700         SET  TBL-REF-INDEX        TO TBL-X
035800         MOVE TABLA012-LEFT-SIDE-LENGTH  TO TBL-REF-LL
035900         MOVE TABLA013-RIGHT-SIDE-LENGTH TO TBL-REF-RRR
036000*+++         DISPLAY 'SYSTABLE-LEFT='
036100*+++              TABLA012-LEFT-SIDE-LENGTH
036200*+++                        ' RIGHT='
036300*+++              TABLA013-RIGHT-SIDE-LENGTH
036400         MOVE TBL-TABLE-ID    TO SAVE-TABLE-ID
036500         MOVE '#'             TO SAVE-REF-POUND1 SAVE-REF-POUND2
036600         MOVE TBL-REF-INDEX-1 TO SAVE-REF-INDEX
036700         MOVE TBL-REF-LL-1    TO SAVE-REF-LL
036800         MOVE TBL-REF-RRR-1   TO SAVE-REF-RRR
036900         MOVE SAVE-REFER      TO TABLE-REFER (TBL-X)
037000                                 TBL-REFERENCE
037100         SET  TABLE-POINTER (TBL-X) TO NULL
037200     ELSE
037300         MOVE 1              TO TBL-REF-LL
037400         MOVE 1              TO TBL-REF-RRR
037500         MOVE 'TFNF' TO TBL-STATUS
037600         MOVE ' TABLE FILE-- NOT FOUND'
037700                                     TO LOG-MESSAGE-TEXT
037800         PERFORM 9500-CALL-SYSLOG
037900         MOVE 'X' TO SAVE-TABLE-ID
038000         MOVE SPACES TO TBL-REFERENCE
038100     .
038200 2000-DISPLAY-SEARCHES.
038300     MOVE ALL '*SEARCH='         TO LOG-MESSAGE-CALLING-ID
038400     MOVE TABLE-SEARCHES (TBL-X) TO LOG-MESSAGE-ENTRY-COUNT
038500     MOVE TABLE-TABLE-ID (TBL-X) TO LOG-MESSAGE-TABLE-ID
038600     MOVE ' TABLE SEARCHES PERFORMED FOR TABLE.'
038700                                 TO LOG-MESSAGE-TEXT
038800     MOVE MY-PROGRAM-ID          TO LOG-PROGRAM-ID
038900     MOVE TBL-STATUS             TO LOG-STATUS
039000     CALL SYSLOG-ID USING           LOG-LINKAGE-AREA
039100     IF  TABLE-POINTER (TBL-X) NOT = NULL
039200         CALL SYS9TMEM-ID USING SYS9TMEM-COMMANDS
039300                                TABLE-POINTER (TBL-X)
039400     .
039500     MOVE SPACES TO TABLE-ENTRY (TBL-X)
039600     .
039700 9100-READ-TABLE-RANDOM.
039800     READ TABLE-FILE  RECORD
039900     IF  NOT TABLE-FILE-OK
040000         IF  TABLE-FILE-STATUS NOT = '23'
040100             DISPLAY 'SYSTABLE-FILE-STATUS=' TABLE-FILE-STATUS
040200                     ' KEY=' TABLE-KEY
040300     .
040400 9500-CALL-SYSLOG.
040500     MOVE MY-PROGRAM-ID         TO LOG-PROGRAM-ID
040600     MOVE TBL-PROGRAM-ID        TO LOG-MESSAGE-CALLING-ID
040700     MOVE ENTRY-COUNT           TO LOG-MESSAGE-ENTRY-COUNT
040800     MOVE TBL-STATUS            TO LOG-STATUS
040900     MOVE TBL-TABLE-ID          TO LOG-MESSAGE-TABLE-ID
041000     CALL SYSLOG-ID USING          LOG-LINKAGE-AREA
041100     .
041200 END PROGRAM SYSTABLE.
-END
