Tandem's Log
Created: 5/31/2007 5:53:03 PM
<< 01/2010 < 03/2010 Calendar 02/2011 > 01/2012 >>Sign InView Other Logs
Fri 
01/07/2011 10:29:44
 jim  Bat file for testing network connections

ECHO OFF
ECHO THIS IS TOOL TO TEST CONNECTIVITY, AND MAY TAKE SEVERAL MINUTES TO RUN
ipconfig/all > c:\networkinfo.txt
route print >> c:\networkinfo.txt
echo %username% >> c:\networkinfo.txt
echo %COMPUTERNAME% >> c:\networkinfo.txt
echo %OS% >> c:\networkinfo.txt
set /p dstip=ENTER THE IP OR DOMAIN YOU'RE ATTEMPTING TO ACCESS (I.E., WWW.ORIOLES.COM).
ping %dstip% >> c:\networkinfo.txt
tracert -h 20 %dstip% >> c:\networkinfo.txt
nslookup %dstip% >> c:\networkinfo.txt
netstat -n >> c:\networkinfo.txt
ECHO *************************************
ECHO *************************************
ECHO PLEASE ATTEMPT TO USE THE APPLICATION (I.E., CONNECT)
ECHO *************************************
ECHO *************************************
ECHO AFTER ATTEMPTING THE APPLICATION, CLOSE THIS DOS WINDOW.
ECHO *************************************
ECHO *************************************
ECHO THEN EMAIL THE C:\NETWORKINFO.TXT FILE TO THE APPROPRIATE SUPPORT PERSONNEL
netstat -n 3 >> c:\networkinfo.txt >> c:\networkinfo.txt

Wed 
12/08/2010 13:50:42
 jim  SQLCreat - Program to extract a SQL Create Table s
?SYMBOLS
?INSPECT
?SQL
?SAVE ALL
?ENV COMMON
?CONSULT $SYSTEM.SYSTEM.COBOLEX1
 IDENTIFICATION DIVISION.
 PROGRAM-ID. SQLBUILD.
 DATE-COMPILED.
 ENVIRONMENT DIVISION.
 CONFIGURATION SECTION.
 SOURCE-COMPUTER. TANDEM-16.
 OBJECT-COMPUTER. TANDEM-16.
 SPECIAL-NAMES.
     SWITCH-1 IS BATCH-SW
         ON STATUS IS RUNNING-BATCH
     FILE $SYSTEM.SYSTEM.COBOLLIB IS SYSTEM-COBOL-LIB
     FILE $0      IS SYSTEM-CONSOLE.
 INPUT-OUTPUT SECTION.
 FILE-CONTROL.
 DATA DIVISION.
 FILE SECTION.
 WORKING-STORAGE SECTION.  EXEC SQL INCLUDE SQLCA END-EXEC.
 EXEC SQL BEGIN DECLARE SECTION END-EXEC.
 01 COLUMNS.
    02 COLUMNS-TABLENAME                PIC X(34).
    02 COLUMNS-COLNUMBER                PIC 9(4) COMP.
    02 COLUMNS-COLNAME                  PIC X(30).
    02 COLUMNS-COLCLASS                 PIC X(1).
    02 COLUMNS-DATATYPE                 PIC X(18).
    02 COLUMNS-FSDATATYPE               PIC S9(4) COMP.
    02 COLUMNS-COLSIZE                  PIC S9(4) COMP.
    02 COLUMNS-SCALE                    PIC S9(4) COMP.
    02 COLUMNS-PRECISION                PIC S9(4) COMP.
    02 COLUMNS-OFFSET                   PIC S9(4) COMP.
    02 COLUMNS-UNIQUEENTRYCOUNT         PIC S9(18) COMP.
    02 COLUMNS-SECONDHIGHVALUE.
       03 LEN                           PIC S9(4) COMP.
       03 VAL                           PIC X(20).
    02 COLUMNS-SECONDLOWVALUE.
       03 LEN                           PIC S9(4) COMP.
       03 VAL                           PIC X(20).
    02 COLUMNS-NULLALLOWED              PIC X(1).
    02 COLUMNS-DEFAULTCLASS             PIC X(1).
    02 COLUMNS-DEFAULTVALUE.
       03 LEN                           PIC S9(4) COMP.
       03 VAL                           PIC X(36).
    02 COLUMNS-PICTURETEXT.
       03 LEN                           PIC S9(4) COMP.
       03 VAL                           PIC X(64).
    02 COLUMNS-DATETIMESTARTFIELD       PIC S9(4) COMP.
    02 COLUMNS-DATETIMEENDFIELD         PIC S9(4) COMP.
    02 COLUMNS-DATETIMEQUALIFIER.
       03 LEN                           PIC S9(4) COMP.
       03 VAL                           PIC X(28).
    02 COLUMNS-UPSHIFT-FLAG             PIC X(1).
    02 COLUMNS-HEADING-FLAG             PIC X(1).
    02 COLUMNS-HEADINGTEXT.
       03 LEN                           PIC S9(4) COMP.
       03 VAL                           PIC X(132).
 01 KEYS.
    02 KEYS-INDEXNAME                   PIC X(34).
    02 KEYS-KEYSEQNUMBER                PIC 9(4) COMP.
    02 KEYS-TABLECOLNUMBER              PIC 9(4) COMP.
    02 KEYS-ORDERING                    PIC X(1).
 01 INDEXES.
    02 INDEXES-TABLENAME                PIC X(34).
    02 INDEXES-INDEXNAME                PIC X(34).
    02 INDEXES-TABLECODE                PIC 9(4) COMP.
    02 INDEXES-INDEX-COLCOUNT           PIC S9(4) COMP.
    02 INDEXES-CREATETIME               PIC S9(18) COMP.
    02 INDEXES-KEYTAG                   PIC 9(4) COMP.
    02 INDEXES-UNIQUEVALUE              PIC X(1).
    02 INDEXES-VALIDDEF                 PIC X(1).
    02 INDEXES-VALIDDATA                PIC X(1).
    02 INDEXES-INDEXLEVELS              PIC S9(4) COMP.
    02 INDEXES-ROWSIZE                  PIC S9(4) COMP.
    02 INDEXES-FILENAME                 PIC X(34).
 01 FILES-REC.
    02 FILES-FILENAME                   PIC X(34).
    02 FILES-FILETYPE                   PIC X(1).
    02 FILES-BLOCKSIZE                  PIC S9(4) COMP.
    02 FILES-PRIMARYEXT                 PIC 9(4)  COMP.
    02 FILES-SECONDARYEXT               PIC 9(4)  COMP.
    02 FILES-MAXEXTS                    PIC S9(4) COMP.
    02 FILES-LOCKLENGTH                 PIC S9(4) COMP.
    02 FILES-PARTITIONED                PIC X(1).
    02 FILES-AUDIT                      PIC X(1).
    02 FILES-DCOMPRESS                  PIC X(1).
    02 FILES-ICOMPRESS                  PIC X(1).
    02 FILES-CLEARONPURGE               PIC X(1).
    02 FILES-SERIALWRITES               PIC X(1).
    02 FILES-VERIFIEDWRITES             PIC X(1).
    02 FILES-BUFFERED                   PIC X(1).
    02 FILES-NOPURGEUNTIL               PIC S9(18) COMP.
    02 FILES-EOF                        PIC S9(9)  COMP.
    02 FILES-NONEMPTYBLOCKCOUNT         PIC S9(18) COMP.
    02 FILES-RECORDSIZE                 PIC S9(4)  COMP.
    02 FILES-AUDITCOMPRESS              PIC X(1).
 01 TABLES-REC.                        
    02 TABLES-TABLENAME                 PIC X(34).
    02 TABLES-TABLETYPE                 PIC X(2).
    02 TABLES-TABLECODE                 PIC 9(4) COMP.
    02 TABLES-COLCOUNT                  PIC S9(4) COMP.
    02 TABLES-GROUPID                   PIC 9(4) COMP.
    02 TABLES-USERID                    PIC 9(4) COMP.
    02 TABLES-CREATETIME                PIC S9(18) COMP.
    02 TABLES-REDEFTIME                 PIC S9(18) COMP.
    02 TABLES-SECURITYVECTOR            PIC X(4).
 01 PARTNS-REC.                        
    02 PARTNS-FILENAME                  PIC X(34).
    02 PARTNS-PRIMARYPARTITION          PIC X(1).
    02 PARTNS-PARTITIONNAME             PIC X(34).
    02 PARTNS-CATALOGNAME               PIC X(25).
    02 PARTNS-FIRSTKEY.                
       03 PARTNS-LEN                    PIC S9(4) COMP.
       03 PARTNS-VAL                    PIC X(3000).
 01 WS-TABLENAME                        PIC X(36) VALUE SPACES.
 01 WS-CURSOR                           PIC X(1000).  EXEC SQL END DECLARE SECTION END-EXEC.  01 GET-COLUMNS.
    05 FILLER                PIC X(23) VALUE " SELECT                ".
    05 FILLER                PIC X(23) VALUE " C.TABLENAME          ,".
    05 FILLER                PIC X(23) VALUE " C.COLNUMBER          ,".
    05 FILLER                PIC X(23) VALUE " C.COLNAME            ,".
    05 FILLER                PIC X(23) VALUE " C.COLCLASS           ,".
    05 FILLER                PIC X(23) VALUE " C.DATATYPE           ,".
    05 FILLER                PIC X(23) VALUE " C.FSDATATYPE         ,".
    05 FILLER                PIC X(23) VALUE " C.COLSIZE            ,".
    05 FILLER                PIC X(23) VALUE " C.SCALE              ,".
    05 FILLER                PIC X(23) VALUE " C.PRECISION          ,".
    05 FILLER                PIC X(23) VALUE " C.OFFSET             ,".
    05 FILLER                PIC X(23) VALUE " C.UNIQUEENTRYCOUNT   ,".
    05 FILLER                PIC X(23) VALUE " C.SECONDHIGHVALUE    ,".
    05 FILLER                PIC X(23) VALUE " C.SECONDLOWVALUE     ,".
    05 FILLER                PIC X(23) VALUE " C.NULLALLOWED        ,".
    05 FILLER                PIC X(23) VALUE " C.DEFAULTCLASS       ,".
    05 FILLER                PIC X(23) VALUE " C.DEFAULTVALUE       ,".
    05 FILLER                PIC X(23) VALUE " C.PICTURETEXT        ,".
    05 FILLER                PIC X(23) VALUE " C.DATETIMESTARTFIELD ,".
    05 FILLER                PIC X(23) VALUE " C.DATETIMEENDFIELD   ,".
    05 FILLER                PIC X(23) VALUE " C.DATETIMEQUALIFIER  ,".
    05 FILLER                PIC X(23) VALUE " C.UPSHIFT            ,".
    05 FILLER                PIC X(23) VALUE " C.HEADING            ,".
    05 FILLER                PIC X(23) VALUE " C.HEADINGTEXT FROM    ".
    05 GET-COLUMNS-FILE      PIC X(36) VALUE "                       ".
    05 FILLER                PIC X(03) VALUE " C ".
    05 FILLER                PIC X(23) VALUE " WHERE C.TABLENAME =  '".
    05 GET-COLUMNS-TABLENAME PIC X(36) VALUE "                       ".
    05 FILLER                PIC X(23) VALUE "' ORDER BY C.TABLENAME,".
    05 FILLER                PIC X(23) VALUE "          C.COLNUMBER  ".
    05 FILLER                PIC X(23) VALUE " BROWSE ACCESS" .  01 WS-DISPLAY                          PIC X(79).
 01 SQL-DATA.                          
     03 FIRST-FLAG                      PIC S9(4) COMP VALUE ZEROS.
     03 ERROR-INFO                      PIC S9(4) COMP VALUE ZEROS.
     03 MYSQL-ERROR                     PIC S9(4) COMP VALUE ZEROS.
        88 SQL-NOT-FOUND                               VALUE 100.
        88 SQL-COMPILE                                 VALUE -8025.
        88 SQL-SECURITY                                VALUE -8200.
        88 SQL-DUPLICATE                               VALUE -8227.
        88 SQL-NULL                                    VALUE -8423.
     03 SQLMSG-FILENUM                  PIC S9(4) COMP VALUE ZEROS.
     03 FIRST-RECORD-NUMBER             PIC S9(4) COMP VALUE ZEROS.
     03 OUTPUT-RECORDS                  PIC S9(4) COMP VALUE ZEROS.
     03 SQLMSG-BUFFER                   PIC X(400)     VALUE SPACES.
     03 MORE                            PIC X          VALUE SPACES.
     03 STATISTICS                      PIC X          VALUE "N".
     03 PROG-TERMID                     PIC X(8)       VALUE SPACES.
 77 WS-PROGID                           PIC X(8) VALUE "SQLKEY".
 77 WS-PRIKEY-COLCOUNT                  PIC S9(4) COMP VALUE ZERO.
 77 WS-MAX-KEYSEQ                       PIC S9(4) COMP VALUE ZERO.
 01 WS-KEYTAGX.                        
    05 WS-KEYTAG9                       PIC S9(4) COMP.
 01 WS-EXPANDED-DESCS.                 
    05 WS-DESC                          PIC X(4).
    05 WS-PICTURE                       PIC X(30).
    05 WS-NBR                           PIC 9(4).
    05 WS-FILETYPE                      PIC S9(4) COMP.
 01 GET-START-UP-MESSAGE.              
    05 GET-START-UP-PORTION             PIC X(8)        VALUE "STRING  ".
    05 GET-START-UP-RESULT              PIC S9(4)       VALUE ZEROS.
    05 GET-START-UP-TEXT                PIC X(100)      VALUE SPACES.
 01 WS-COLUMNS.                        
    05 WS-COLUMN                        PIC X(30)       OCCURS 100 TIMES.
 77 WS-PARTIAL-FILE-LENGTH              PIC S9(4) COMP  VALUE ZERO.
 77 WS-PARTIAL-FILE-NAME                PIC X(36)       VALUE " ".
 77 WS-EXTERNAL-FILE-LENGTH             PIC S9(4) COMP  VALUE ZERO.
 77 WS-EXTERNAL-FILE-NAME               PIC X(256)      VALUE " ".
 77 WS-INTERNAL-FILE-NAME               PIC X(256)     VALUE SPACES.
 77 X                                   PIC S9(4) COMP VALUE ZERO.
 77 WS-DEFAULT                          PIC X(38)      VALUE SPACES.
 77 WS-ERROR                            PIC S9(4) COMP VALUE ZERO.
 77 WS-CATALOG-NAME                     PIC X(38)      VALUE SPACES.
 77 WS-CATALOG-SUBVOL                   PIC X(38)      VALUE SPACES.
 77 WS-FILENAME                         PIC X(38)      VALUE SPACES.
 77 WS-FINQ-CATALOG                     PIC S9(4) COMP VALUE 14.
 77 WS-FINQ-ITEMS                       PIC S9(4) COMP VALUE 1.
 77 WS-FINQ-LENGTH                      PIC S9(4) COMP VALUE 36.
 77 WS-COMMA                            PIC X          VALUE SPACES.
 77 WS-PRECISION                        PIC 9(4).
 77 WS-SCALE                            PIC 9(4).
 
********************
 PROCEDURE DIVISION.
********************
 0000-STARTUP SECTION.
     MOVE ZEROS              TO GET-START-UP-RESULT.
     ENTER "GETSTARTUPTEXT" OF SYSTEM-COBOL-LIB
           USING GET-START-UP-PORTION
                 GET-START-UP-TEXT
          GIVING GET-START-UP-RESULT.       IF GET-START-UP-RESULT = 0
         DISPLAY "--------------------------------------------------"
         DISPLAY "                SQLBUILD SYNTAX                   "
         DISPLAY "--------------------------------------------------"
         DISPLAY "   SYNTAX IS:                                     "
         DISPLAY "   SQLBUILD TableLocation                         "
         DISPLAY "                                                  "
         DISPLAY "Example: SQLBUILD/out $S.#SQLBUILD/CFFILEX.CFADDR "
         DISPLAY "                                                  "
         DISPLAY " This program displays the keys of a given table  "
         DISPLAY "                                                  "
         DISPLAY " The TableLocation does not accept define names   "
         DISPLAY " and should at the minimum, specify the subvolume "
         DISPLAY " of the table.                                    "
         DISPLAY "--------------------------------------------------"
         STOP RUN.       INSPECT GET-START-UP-TEXT REPLACING ALL "," BY SPACE
      UNSTRING GET-START-UP-TEXT DELIMITED BY SPACE
                                     INTO WS-TABLENAME.       MOVE WS-TABLENAME                TO WS-PARTIAL-FILE-NAME.
      MOVE  255                        TO WS-EXTERNAL-FILE-LENGTH.
      ENTER  "FILENAME_RESOLVE_" USING WS-PARTIAL-FILE-NAME
                                          WS-EXTERNAL-FILE-NAME
                                          WS-EXTERNAL-FILE-LENGTH
                                   GIVING WS-ERROR.
      IF WS-ERROR NOT = 0
         DISPLAY "AN INVALID FILE NAME WAS ENTERED"
         STOP RUN.
      MOVE WS-EXTERNAL-FILE-NAME       TO WS-TABLENAME. *---- GET THE CATALOG'S NAME
      ENTER TAL "FNAMEEXPAND"       USING WS-EXTERNAL-FILE-NAME
                                          WS-INTERNAL-FILE-NAME
                                          WS-DEFAULT
                                   GIVING WS-ERROR.
      ENTER TAL "FILEINQUIRE"       USING OMITTED
                                          WS-INTERNAL-FILE-NAME
                                          WS-FINQ-CATALOG
                                          WS-FINQ-ITEMS
                                          WS-CATALOG-NAME
                                          WS-FINQ-LENGTH
                                          OMITTED
                                          WS-ERROR.
     MOVE SPACES                       TO WS-CATALOG-SUBVOL.
     ENTER TAL "FNAMECOLLAPSE"      USING WS-CATALOG-NAME
                                          WS-CATALOG-SUBVOL.       INITIALIZE COLUMNS, KEYS, INDEXES.       PERFORM B100-GET-COLUMNS.
      PERFORM B200-GET-PARTS.
      DISPLAY ";".
      PERFORM B300-GET-INDEXES.
      STOP RUN.
*************************************
 B100-GET-COLUMNS            SECTION.
*************************************
      DISPLAY "CREATE TABLE " WS-TABLENAME.
      DISPLAY "(". *---- Set up the Columns WS area
      MOVE WS-TABLENAME                TO COLUMNS-TABLENAME.
      STRING WS-CATALOG-SUBVOL            DELIMITED BY SPACES
            ".COLUMNS"                    DELIMITED BY SIZE
                                     INTO GET-COLUMNS-FILE
      MOVE COLUMNS-TABLENAME           TO GET-COLUMNS-TABLENAME.
      MOVE GET-COLUMNS                 TO WS-CURSOR. *---- Prepare the cursor
      EXEC SQL PREPARE WS_CURSOR FROM :WS-CURSOR END-EXEC.
      IF SQLCODE < 0
         DISPLAY "FATAL ERROR PREPARING WS-CURSOR"
         STOP RUN.       EXEC SQL DECLARE GET_TABLE_COLUMNS CURSOR FOR WS_CURSOR END-EXEC.       EXEC SQL OPEN  GET_TABLE_COLUMNS END-EXEC.
      INITIALIZE WS-COLUMNS.
 B100-LOOP.
      INITIALIZE COLUMNS.
      EXEC SQL FETCH GET_TABLE_COLUMNS INTO
                 :COLUMNS-TABLENAME          ,
                 :COLUMNS-COLNUMBER          ,
                 :COLUMNS-COLNAME            ,
                 :COLUMNS-COLCLASS           ,
                 :COLUMNS-DATATYPE           ,
                 :COLUMNS-FSDATATYPE         ,
                 :COLUMNS-COLSIZE            ,
                 :COLUMNS-SCALE              ,
                 :COLUMNS-PRECISION          ,
                 :COLUMNS-OFFSET             ,
                 :COLUMNS-UNIQUEENTRYCOUNT   ,
                 :COLUMNS-SECONDHIGHVALUE    ,
                 :COLUMNS-SECONDLOWVALUE     ,
                 :COLUMNS-NULLALLOWED        ,
                 :COLUMNS-DEFAULTCLASS       ,
                 :COLUMNS-DEFAULTVALUE       ,
                 :COLUMNS-PICTURETEXT        ,
                 :COLUMNS-DATETIMESTARTFIELD ,
                 :COLUMNS-DATETIMEENDFIELD   ,
                 :COLUMNS-DATETIMEQUALIFIER  ,
                 :COLUMNS-UPSHIFT-FLAG       ,
                 :COLUMNS-HEADING-FLAG       ,
                 :COLUMNS-HEADINGTEXT
      END-EXEC.
      IF SQLCODE NOT = 0
         GO TO B100-END.
      ADD 1, COLUMNS-COLNUMBER     GIVING X.
      MOVE COLUMNS-COLNAME             TO WS-COLUMN (X).       MOVE SPACES                      TO WS-PICTURE.
      IF LEN OF COLUMNS-PICTURETEXT > 0
         MOVE VAL OF COLUMNS-PICTURETEXT (1:LEN OF COLUMNS-PICTURETEXT)
                                       TO WS-PICTURE
      ELSE
         IF COLUMNS-PRECISION > 0
            MOVE COLUMNS-PRECISION TO WS-PRECISION
            MOVE COLUMNS-SCALE     TO WS-SCALE
            STRING COLUMNS-DATATYPE  DELIMITED BY "   "
                   "("               DELIMITED BY SIZE
                   WS-PRECISION      DELIMITED BY SIZE
                   ","               DELIMITED BY SIZE
                   WS-SCALE          DELIMITED BY SIZE
                   ")"               DELIMITED BY SIZE
                                INTO WS-PICTURE
         ELSE
            MOVE COLUMNS-COLSIZE          TO WS-NBR
            STRING COLUMNS-DATATYPE  DELIMITED BY " "
                   " ("              DELIMITED BY SIZE
                   WS-NBR            DELIMITED BY SIZE
                   ")"               DELIMITED BY SIZE
                                     INTO WS-PICTURE
      .
      IF LEN      OF COLUMNS-DATETIMEQUALIFIER > 0
         MOVE SPACES TO WS-PICTURE
         STRING "DATETIME "
          VAL OF COLUMNS-DATETIMEQUALIFIER (1:LEN OF COLUMNS-DATETIMEQUALIFIER)
                DELIMITED BY SIZE
                                     INTO WS-PICTURE.
   
      DISPLAY "   " COLUMNS-COLNAME "   " WS-PICTURE.
      IF COLUMNS-UPSHIFT-FLAG = "Y"
         DISPLAY "                                    "
                 "UPSHIFT".
      IF COLUMNS-DEFAULTCLASS = "S"
         DISPLAY "                                    "
                 "DEFAULT SYSTEM".
      IF COLUMNS-NULLALLOWED = "N"
         DISPLAY "                                    "
                 "NOT NULL".
      IF COLUMNS-HEADING-FLAG = "Y"
         DISPLAY "                                    "
                 "HEADING "
                 QUOTE
                 VAL OF COLUMNS-HEADINGTEXT (1:LEN OF COLUMNS-HEADINGTEXT)
                 QUOTE
                 ","
      ELSE
         DISPLAY "   ,".
      GO TO B100-LOOP.
 B100-END.
      MOVE WS-TABLENAME      TO INDEXES-TABLENAME.
      PERFORM B110-GET-PRIMARY-KEY.
 B100-EXIT. EXIT. *===================================*
 B110-GET-PRIMARY-KEY        SECTION.
*===================================*
 B110-INIT.
      DISPLAY "   PRIMARY KEY"
      MOVE "("                         TO WS-COMMA.
      MOVE SPACES                      TO WS-CURSOR.
      STRING
         "SELECT "          DELIMITED BY SIZE
         " TABLENAME  ,"    DELIMITED BY SIZE
         " INDEXNAME  ,"    DELIMITED BY SIZE
         " TABLECODE  ,"    DELIMITED BY SIZE
         " COLCOUNT   ,"    DELIMITED BY SIZE
         " CREATETIME ,"    DELIMITED BY SIZE
         " KEYTAG     ,"    DELIMITED BY SIZE
         " UNIQUEVALUE,"    DELIMITED BY SIZE
         " VALIDDEF   ,"    DELIMITED BY SIZE
         " VALIDDATA  ,"    DELIMITED BY SIZE
         " INDEXLEVELS,"    DELIMITED BY SIZE
         " ROWSIZE,    "    DELIMITED BY SIZE
         " FILENAME    "    DELIMITED BY SIZE
         "  FROM "          DELIMITED BY SIZE
         WS-CATALOG-SUBVOL  DELIMITED BY SPACES
         ".INDEXES "        DELIMITED BY SIZE
         " WHERE TABLENAME = '" DELIMITED BY SIZE
           WS-TABLENAME     DELIMITED BY SPACES
         "' AND KEYTAG = 0" DELIMITED BY SIZE
         "  BROWSE ACCESS"  DELIMITED BY SIZE
                                     INTO WS-CURSOR.
      EXEC SQL PREPARE WS_CURSOR2 FROM :WS-CURSOR END-EXEC.
      IF SQLCODE < 0
         DISPLAY "FATAL ERROR PREPARING INDEX CURSOR"
         STOP RUN.
      EXEC SQL DECLARE GET_INDEX_CURSOR  CURSOR FOR WS_CURSOR2 END-EXEC.       EXEC SQL OPEN  GET_INDEX_CURSOR  END-EXEC.
      EXEC SQL FETCH GET_INDEX_CURSOR
            INTO :INDEXES-TABLENAME      ,
                 :INDEXES-INDEXNAME      ,
                 :INDEXES-TABLECODE      ,
                 :INDEXES-INDEX-COLCOUNT ,
                 :INDEXES-CREATETIME     ,
                 :INDEXES-KEYTAG         ,
                 :INDEXES-UNIQUEVALUE    ,
                 :INDEXES-VALIDDEF       ,
                 :INDEXES-VALIDDATA      ,
                 :INDEXES-INDEXLEVELS    ,
                 :INDEXES-ROWSIZE        ,
                 :INDEXES-FILENAME
      END-EXEC.
      IF SQLCODE NOT = 0
         GO TO B110-EXIT.
      MOVE INDEXES-INDEX-COLCOUNT      TO WS-PRIKEY-COLCOUNT.
      MOVE WS-PRIKEY-COLCOUNT          TO WS-MAX-KEYSEQ.
      MOVE INDEXES-KEYTAG              TO WS-KEYTAG9.
      MOVE INDEXES-INDEXNAME           TO KEYS-INDEXNAME.
      MOVE SPACES                      TO WS-CURSOR.
      STRING
          "SELECT INDEXNAME,KEYSEQNUMBER ,"       DELIMITED BY SIZE
                 "TABLECOLNUMBER, ORDERING FROM " DELIMITED BY SIZE
                  WS-CATALOG-SUBVOL               DELIMITED BY SPACES
                  ".KEYS "                        DELIMITED BY SIZE
                  "WHERE  INDEXNAME = '"          DELIMITED BY SIZE
                   KEYS-INDEXNAME                 DELIMITED BY SPACES
                  "' ORDER BY KEYSEQNUMBER "      DELIMITED BY SIZE
                  "BROWSE ACCESS"                 DELIMITED BY SIZE
                                         INTO WS-CURSOR.
      EXEC SQL PREPARE WS_CURSOR3 FROM :WS-CURSOR END-EXEC.
      IF SQLCODE < 0
         DISPLAY "FATAL ERROR PREPARING INDEX CURSOR"
         STOP RUN.
      EXEC SQL DECLARE GET_KEYS_CURSOR  CURSOR FOR WS_CURSOR3 END-EXEC.
      EXEC SQL OPEN    GET_KEYS_CURSOR END-EXEC.
 B110-LOOP.
      EXEC SQL FETCH GET_KEYS_CURSOR INTO
                 :KEYS-INDEXNAME,
                 :KEYS-KEYSEQNUMBER,
                 :KEYS-TABLECOLNUMBER,
                 :KEYS-ORDERING
      END-EXEC.
      IF SQLCODE NOT = 0
      OR KEYS-KEYSEQNUMBER NOT < WS-MAX-KEYSEQ
         EXEC SQL CLOSE GET_KEYS_CURSOR END-EXEC
         GO TO B110-END.
      INITIALIZE COLUMNS.
      MOVE INDEXES-TABLENAME           TO COLUMNS-TABLENAME.
      ADD 1 TO KEYS-TABLECOLNUMBER GIVING X.
      IF KEYS-ORDERING = "A" MOVE "ASC " TO WS-DESC ELSE
      IF KEYS-ORDERING = "D" MOVE "DESC" TO WS-DESC ELSE
                             MOVE "____" TO WS-DESC.
      DISPLAY "   " WS-COMMA "  " WS-COLUMN (X)  WS-DESC.
      MOVE ","                         TO WS-COMMA.
      GO TO B110-LOOP.
 B110-END.
      DISPLAY "   )".
      DISPLAY ")".
      MOVE SPACES                      TO WS-CURSOR.
      STRING
          "SELECT FILETYPE, "     DELIMITED BY SIZE
                 "BLOCKSIZE, "    DELIMITED BY SIZE
                 "MAXEXTS,   "    DELIMITED BY SIZE
                 "PRIMARYEXT, "   DELIMITED BY SIZE
                 "SECONDARYEXT  " DELIMITED BY SIZE
                 "FROM "          DELIMITED BY SIZE
                  WS-CATALOG-SUBVOL    DELIMITED BY SPACES
                  ".FILES "            DELIMITED BY SIZE
                  "WHERE  FILENAME = '"          DELIMITED BY SIZE
                   WS-TABLENAME        DELIMITED BY SPACES
                  "' BROWSE ACCESS"    DELIMITED BY SIZE
                                     INTO WS-CURSOR.
      EXEC SQL PREPARE WS_CURSOR4 FROM :WS-CURSOR END-EXEC.
      IF SQLCODE < 0
         DISPLAY "FATAL ERROR PREPARING INDEX CURSOR"
         STOP RUN.
      EXEC SQL DECLARE GET_FILES_CURSOR CURSOR FOR WS_CURSOR4 END-EXEC.
      EXEC SQL OPEN    GET_FILES_CURSOR END-EXEC.
      EXEC SQL FETCH   GET_FILES_CURSOR INTO
                       :FILES-FILETYPE  ,
                       :FILES-BLOCKSIZE ,
                       :FILES-MAXEXTS   ,
                       :FILES-PRIMARYEXT,
                       :FILES-SECONDARYEXT
      END-EXEC.
      MOVE SPACES                      TO WS-CURSOR.
      STRING
          "SELECT SECURITYVECTOR " DELIMITED BY SIZE
                 "FROM "           DELIMITED BY SIZE
                  WS-CATALOG-SUBVOL    DELIMITED BY SPACES
                  ".TABLES "           DELIMITED BY SIZE
                  "WHERE  TABLENAME = '" DELIMITED BY SIZE
                   WS-TABLENAME        DELIMITED BY SPACES
                  "' BROWSE ACCESS"    DELIMITED BY SIZE
                                     INTO WS-CURSOR.
      EXEC SQL PREPARE WS_CURSOR5 FROM :WS-CURSOR END-EXEC.
      IF SQLCODE < 0
         DISPLAY "FATAL ERROR PREPARING INDEX CURSOR"
         STOP RUN.
      EXEC SQL DECLARE GET_TABLES_CURSOR CURSOR FOR WS_CURSOR5 END-EXEC.
      EXEC SQL OPEN    GET_TABLES_CURSOR END-EXEC.
      EXEC SQL FETCH   GET_TABLES_CURSOR INTO
           :TABLES-SECURITYVECTOR
      END-EXEC.       DISPLAY "CATALOG " WS-CATALOG-SUBVOL.
      IF FILES-FILETYPE = "K"
         DISPLAY "ORGANIZATION KEY SEQUENCED"
      ELSE
         DISPLAY "ORGANIZATION RELATIVE     ".
      DISPLAY "SECURE " QUOTE TABLES-SECURITYVECTOR QUOTE.
      DISPLAY "EXTENT (" FILES-PRIMARYEXT "," FILES-SECONDARYEXT ")".
      DISPLAY "MAXEXTENTS " FILES-MAXEXTS.
 B110-EXIT. EXIT.
*************************************
 B200-GET-PARTS              SECTION.
*************************************
 B200-INIT.
      INITIALIZE PARTNS-REC.
      MOVE SPACES                    TO WS-CURSOR.
      STRING
         "SELECT "                     DELIMITED BY SIZE
         " P.PARTITIONNAME,"           DELIMITED BY SIZE
         " P.FIRSTKEY,"                DELIMITED BY SIZE
         " F.PRIMARYEXT,"              DELIMITED BY SIZE
         " F.SECONDARYEXT,"           DELIMITED BY SIZE
         " F.MAXEXTS"                  DELIMITED BY SIZE
         "  FROM "                     DELIMITED BY SIZE
         WS-CATALOG-SUBVOL             DELIMITED BY SPACES
         ".PARTNS P, "                 DELIMITED BY SIZE
         WS-CATALOG-SUBVOL             DELIMITED BY SPACES
         ".FILES F"                    DELIMITED BY SIZE
         " WHERE P.FILENAME = '"       DELIMITED BY SIZE
           WS-TABLENAME                DELIMITED BY SPACES
         "' AND P.PRIMARYPARTITION = 'N'" DELIMITED BY SIZE
         "  AND F.FILENAME = P.PARTITIONNAME" DELIMITED BY SIZE
         "  BROWSE ACCESS"             DELIMITED BY SIZE
                                     INTO WS-CURSOR.
      EXEC SQL PREPARE WS_CURSOR6 FROM :WS-CURSOR END-EXEC.
      IF SQLCODE < 0
         DISPLAY "FATAL ERROR PREPARING PARTNS CURSOR"
         STOP RUN.
      EXEC SQL DECLARE GET_PARTNS_CURSOR CURSOR FOR WS_CURSOR6 END-EXEC.
      EXEC SQL OPEN    GET_PARTNS_CURSOR END-EXEC.
      EXEC SQL FETCH   GET_PARTNS_CURSOR INTO
           :PARTNS-PARTITIONNAME,
           :PARTNS-FIRSTKEY,
           :FILES-PRIMARYEXT,
           :FILES-SECONDARYEXT,
           :FILES-MAXEXTS
      END-EXEC.
      IF SQLCODE NOT = ZERO
         EXEC SQL CLOSE GET_PARTNS_CURSOR END-EXEC
         GO TO B200-EXIT.
 B200-LOOP.
      DISPLAY " ".
      DISPLAY "PARTITION".
      DISPLAY "   (".
      DISPLAY "   " PARTNS-PARTITIONNAME.
      DISPLAY "   CATALOG " WS-CATALOG-SUBVOL.
      DISPLAY "   EXTENT (" FILES-PRIMARYEXT "," FILES-SECONDARYEXT ")".
      DISPLAY "   MAXEXTENTS "  FILES-MAXEXTS.
      DISPLAY "   FIRST KEY " PARTNS-VAL (1:PARTNS-LEN).
      DISPLAY "   )".
      EXEC SQL FETCH   GET_PARTNS_CURSOR INTO
           :PARTNS-PARTITIONNAME,
           :PARTNS-FIRSTKEY,
           :FILES-PRIMARYEXT,
           :FILES-SECONDARYEXT,
           :FILES-MAXEXTS
      END-EXEC.
      IF SQLCODE = 0
         GO TO B200-LOOP.
 B200-END.
      EXEC SQL CLOSE GET_PARTNS_CURSOR END-EXEC.
 B200-EXIT. EXIT. *************************************
 B300-GET-INDEXES            SECTION.
*************************************
       MOVE SPACES                     TO WS-CURSOR.
       STRING
         "SELECT " DELIMITED BY SIZE
         " TABLENAME,"          DELIMITED BY SIZE
         " INDEXNAME,"          DELIMITED BY SIZE
         " TABLECODE,"          DELIMITED BY SIZE
         " COLCOUNT,"           DELIMITED BY SIZE
         " CREATETIME,"         DELIMITED BY SIZE
         " KEYTAG,"             DELIMITED BY SIZE
         " UNIQUEVALUE,"        DELIMITED BY SIZE
         " VALIDDEF,"           DELIMITED BY SIZE
         " VALIDDATA,"          DELIMITED BY SIZE
         " INDEXLEVELS,"        DELIMITED BY SIZE
         " ROWSIZE,"            DELIMITED BY SIZE
         " FILENAME"            DELIMITED BY SIZE
         " FROM "               DELIMITED BY SIZE
         WS-CATALOG-SUBVOL      DELIMITED BY SPACES
         ".INDEXES"             DELIMITED BY SIZE
         " WHERE TABLENAME = '" DELIMITED BY SIZE
         WS-TABLENAME           DELIMITED BY SPACES
         "' AND KEYTAG > 0 "    DELIMITED BY SIZE
         " ORDER BY KEYTAG"     DELIMITED BY SIZE
         " BROWSE ACCESS"       DELIMITED BY SIZE
                                     INTO WS-CURSOR.
      EXEC SQL PREPARE WS_CURSOR7 FROM :WS-CURSOR END-EXEC.
      IF SQLCODE < 0
         DISPLAY "FATAL ERROR PREPARING INDEX CURSOR"
         STOP RUN.
      EXEC SQL DECLARE GET_INDEXES_CURSOR CURSOR FOR WS_CURSOR7 END-EXEC.
      EXEC SQL OPEN    GET_INDEXES_CURSOR END-EXEC.
 B300-LOOP.
      EXEC SQL FETCH GET_INDEXES_CURSOR INTO
                 :INDEXES-TABLENAME      ,
                 :INDEXES-INDEXNAME      ,
                 :INDEXES-TABLECODE      ,
                 :INDEXES-INDEX-COLCOUNT ,
                 :INDEXES-CREATETIME     ,
                 :INDEXES-KEYTAG         ,
                 :INDEXES-UNIQUEVALUE    ,
                 :INDEXES-VALIDDEF       ,
                 :INDEXES-VALIDDATA      ,
                 :INDEXES-INDEXLEVELS    ,
                 :INDEXES-ROWSIZE        ,
                 :INDEXES-FILENAME
      END-EXEC.
      IF SQLCODE NOT = ZEROS
         EXEC SQL CLOSE GET_INDEXES_CURSOR END-EXEC
         GO TO B300-END.       MOVE SPACES                      TO WS-DISPLAY.
      IF INDEXES-UNIQUEVALUE = "Y"
         STRING "CREATE "                 DELIMITED BY SIZE
                "UNIQUE"                  DELIMITED BY SPACES
                " INDEX "                 DELIMITED BY SIZE
                INDEXES-INDEXNAME         DELIMITED BY SPACES
                " ON "                    DELIMITED BY SIZE
                WS-TABLENAME              DELIMITED BY SPACES
                                     INTO WS-DISPLAY
         MOVE INDEXES-INDEX-COLCOUNT   TO WS-MAX-KEYSEQ
      ELSE
         STRING "CREATE INDEX "           DELIMITED BY SIZE
                INDEXES-INDEXNAME         DELIMITED BY SPACES
                " ON "                    DELIMITED BY SIZE
                WS-TABLENAME              DELIMITED BY SPACES
                                     INTO WS-DISPLAY
         COMPUTE WS-MAX-KEYSEQ = INDEXES-INDEX-COLCOUNT - WS-PRIKEY-COLCOUNT.
      DISPLAY WS-DISPLAY.
      MOVE INDEXES-INDEXNAME           TO KEYS-INDEXNAME
      MOVE SPACES                      TO WS-CURSOR.
      STRING
         " SELECT"                        DELIMITED BY SIZE
         "  INDEXNAME,"                   DELIMITED BY SIZE
         "  KEYSEQNUMBER,"                DELIMITED BY SIZE
         "  TABLECOLNUMBER,"              DELIMITED BY SIZE
         "  ORDERING"                     DELIMITED BY SIZE
         "  FROM "                        DELIMITED BY SIZE
         WS-CATALOG-SUBVOL                DELIMITED BY SPACES
         ".KEYS WHERE  INDEXNAME = '"     DELIMITED BY SIZE
         KEYS-INDEXNAME                   DELIMITED BY SPACES
         "' AND TABLECOLNUMBER < 9999"    DELIMITED BY SIZE
         " ORDER BY KEYSEQNUMBER"         DELIMITED BY SIZE
         " BROWSE ACCESS"                 DELIMITED BY SIZE
                                     INTO WS-CURSOR.
      EXEC SQL PREPARE WS_CURSOR8 FROM :WS-CURSOR END-EXEC.
      IF SQLCODE < 0
         DISPLAY "FATAL ERROR PREPARING KEYS2 CURSOR"
         STOP RUN.
      MOVE "("                         TO WS-COMMA.
      EXEC SQL DECLARE GET_KEYS2_CURSOR CURSOR FOR WS_CURSOR8 END-EXEC.
      EXEC SQL OPEN    GET_KEYS2_CURSOR END-EXEC.
 B300-GET-KEYS-COLUMNS.
      EXEC SQL FETCH GET_KEYS2_CURSOR INTO
                 :KEYS-INDEXNAME,
                 :KEYS-KEYSEQNUMBER,
                 :KEYS-TABLECOLNUMBER,
                 :KEYS-ORDERING
      END-EXEC.
      IF SQLCODE NOT = 0
      OR KEYS-KEYSEQNUMBER NOT < WS-MAX-KEYSEQ
         EXEC SQL CLOSE GET_KEYS2_CURSOR END-EXEC
         GO TO  B300-GET-KEYS-COLUMNS-END.       IF KEYS-ORDERING = "A" MOVE "ASC " TO WS-DESC ELSE
      IF KEYS-ORDERING = "D" MOVE "DESC" TO WS-DESC ELSE
                             MOVE "____" TO WS-DESC.
      ADD 1, KEYS-TABLECOLNUMBER GIVING X.
      DISPLAY "   " WS-COMMA " " WS-COLUMN (X) "    " WS-DESC.
      MOVE ","                         TO WS-COMMA.
      GO TO B300-GET-KEYS-COLUMNS.
 B300-GET-KEYS-COLUMNS-END.
      DISPLAY "   )".
      DISPLAY "   CATALOG " WS-CATALOG-SUBVOL.
      MOVE INDEXES-KEYTAG                TO WS-KEYTAG9.
      DISPLAY "   KEYTAG " QUOTE WS-KEYTAGX QUOTE.
      ENTER TAL "FNAMECOLLAPSE"       USING INDEXES-INDEXNAME
                                            WS-FILENAME.
      ENTER TAL "FILEINFO"            USING OMITTED
                                            WS-ERROR
                                            WS-FILENAME
                                            OMITTED
                                            OMITTED
                                            FILES-PRIMARYEXT
                                            OMITTED
                                            OMITTED
                                            OMITTED
                                            OMITTED
                                            FILES-SECONDARYEXT
                                            OMITTED
                                            OMITTED
                                            OMITTED
                                            OMITTED
                                            TABLES-SECURITYVECTOR
                                            OMITTED
                                            OMITTED
                                            OMITTED
                                            OMITTED
                                            WS-FILETYPE
                                            FILES-MAXEXTS
                                            OMITTED
                                            OMITTED
                                            OMITTED
                                            OMITTED.
      DISPLAY "   EXTENT (" FILES-PRIMARYEXT "," FILES-SECONDARYEXT ")"
*     DISPLAY "   SECURE " QUOTE TABLES-SECURITYVECTOR QUOTE.
      DISPLAY "   MAXEXTENTS " FILES-MAXEXTS.
      DISPLAY ";".
      GO TO B300-LOOP.
 B300-END.
 B300-EXIT. EXIT. *
*FILE-IO-SECTION SECTION.
*     COPY DATE-PROCESSING            OF \CP1.$SYSTEM.LIB.COBLIB.
Sat 
10/02/2010 11:38:49
 jim  Declaratives
 IDENTIFICATION            DIVISION.
    PROGRAM-ID. FILESTAT.
 DATA                      DIVISION.
 WORKING-STORAGE           SECTION.
?SECTION FILE-STAT-MESSAGE
 01 FILE-STAT-MESSAGE.
    05 FILE-STAT           PIC X(02)  VALUE "00".
       88 VALID-KEY                   VALUE "00".
    05 FILLER              PIC X(01)  VALUE ":" .
    05 FILE-GUARDIAN-ERR   PIC 9(04)  VALUE 0.
    05 FILLER              PIC X(01)  VALUE " ".
    05 FILE-STAT-MSG       PIC X(62)  VALUE " ".
 01 FILE-GUARDIAN-DESC     PIC X(80)  VALUE " ".
/*******************
 PROCEDURE DIVISION.
********************
?SECTION FILE-STAT-DECLARATIVES
 DECLARATIVES.
 INPUT-SECTION.  
     USE AFTER STANDARD ERROR PROCEDURE ON INPUT.
     PERFORM FILE-STAT-EDIT.
 I-O-SECTION.  
     USE AFTER STANDARD ERROR PROCEDURE ON I-O.
     PERFORM FILE-STAT-EDIT.
 OUTPUT-SECTION.  
     USE AFTER STANDARD ERROR PROCEDURE ON OUTPUT.
     PERFORM FILE-STAT-EDIT.
 EXTEND-SECTION.  
     USE AFTER STANDARD ERROR PROCEDURE ON EXTEND.
     PERFORM FILE-STAT-EDIT.
?SECTION FILE-STAT-EDIT    
 FILE-STAT-EDIT.
     IF FILE-STAT = "00"
        CONTINUE
     ELSE
        EVALUATE FILE-STAT
        WHEN "04"  MOVE "Short Record READ*"      TO FILE-STAT-MSG
        WHEN "05"  MOVE "FILE*"                   TO FILE-STAT-MSG
        WHEN "07"  MOVE "Fast I/O or Tape*"       TO FILE-STAT-MSG
        WHEN "10"  MOVE "End of File*"            TO FILE-STAT-MSG
        WHEN "14"  MOVE "End of Relative File*"   TO FILE-STAT-MSG
        WHEN "30"  MOVE "Operation*"              TO FILE-STAT-MSG
        WHEN "21"  MOVE "Key Changed on Rewrite*" TO FILE-STAT-MSG
        WHEN "22"  MOVE "Duplicate Key*"          TO FILE-STAT-MSG
        WHEN "23"  MOVE "Key not found*"          TO FILE-STAT-MSG
        WHEN "24"  MOVE "Write Past Eof*"         TO FILE-STAT-MSG
        WHEN "30"  MOVE "Temporary Error*"        TO FILE-STAT-MSG
        WHEN "34"  MOVE "Seq Write Past Eof*"     TO FILE-STAT-MSG
        WHEN "35"  MOVE "Open File Error*"        TO FILE-STAT-MSG
        WHEN "37"  MOVE "Device Open Error*"      TO FILE-STAT-MSG
        WHEN "38"  MOVE "Open Parameter Error*"   TO FILE-STAT-MSG
        WHEN "39"  MOVE "File SELECT Mismatch*"   TO FILE-STAT-MSG
        WHEN "41"  MOVE "File is NOT Closed*"     TO FILE-STAT-MSG
        WHEN "42"  MOVE "File is NOT Opened*"     TO FILE-STAT-MSG
        WHEN "43"  MOVE "Del/Rewrite not Read*"   TO FILE-STAT-MSG
        WHEN "44"  MOVE "Rewrite Size Differs*"   TO FILE-STAT-MSG
        WHEN "46"  MOVE "Read Next not Started*"  TO FILE-STAT-MSG
        WHEN "47"  MOVE "Read/Start Open*"        TO FILE-STAT-MSG
        WHEN "48"  MOVE "Open is incompatible*"   TO FILE-STAT-MSG
        WHEN "49"  MOVE "File not Opened I/O*"    TO FILE-STAT-MSG
        WHEN "90"  MOVE "Open Not Timed I/O*"     TO FILE-STAT-MSG
        WHEN "91"  MOVE "I-O*"                    TO FILE-STAT-MSG
        WHEN "97"  MOVE "Read/Start*"             TO FILE-STAT-MSG
        WHEN OTHER MOVE "Unknown condition*"      TO FILE-STAT-MSG.
         
        MOVE GUARDIAN-ERR                         TO FILE-GUARDIAN-ERR
        EVALUATE FILE-GUARDIAN-ERR
        WHEN  01 MOVE "EOF*"                      TO FILE-GUARDIAN-ERR-DESC
        WHEN  06 MOVE "$RECEIVE*"                 TO FILE-GUARDIAN-ERR-DESC
        WHEN  09 MOVE "Locked Record*"            TO FILE-GUARDIAN-ERR-DESC
        WHEN  10 MOVE "Duplicate Record*"         TO FILE-GUARDIAN-ERR-DESC
        WHEN  11 MOVE "Does Not Exist*"           TO FILE-GUARDIAN-ERR-DESC
        WHEN  14 MOVE "Device Does Not Exist*"    TO FILE-GUARDIAN-ERR-DESC
        WHEN  18 MOVE "Node Does Not Exist*"      TO FILE-GUARDIAN-ERR-DESC
        WHEN  23 MOVE "Out of Bounds*"            TO FILE-GUARDIAN-ERR-DESC
        WHEN  40 MOVE "Timed Out*"                TO FILE-GUARDIAN-ERR-DESC
        WHEN  45 MOVE "File is Full*"             TO FILE-GUARDIAN-ERR-DESC
        WHEN  46 MOVE "Bad Position*"             TO FILE-GUARDIAN-ERR-DESC
        WHEN  73 MOVE "Locked*"                   TO FILE-GUARDIAN-ERR-DESC
        WHEN OTHER MOVE "*"                       TO FILE-GUARDIAN-ERR-DESC.
        STRING FILE-STAT-MSG                         DELIMITED BY "*"
               ":"                                   DELIMITED BY SIZE
               FILE-GUARDIAN-ERR-DESC                DELIMITED BY "*"
                                                INTO FILE-STAT-MSG.
    END DECLARATIVES.
    END PROGRAM FILESTAT.
Fri 
10/01/2010 07:00:59
 jim  Declaratives
 01 FILE-STAT-MESSAGE.
    05 FILE-I-O-TYPE       PIC X(06)  JUST RIGHT.
    05 FILLER              PIC X(01)  VALUE " ".
    05 FILE-FAILED         PIC X(06)  VALUE " ".
    05 FILLER              PIC X(01)  VALUE " ".
    05 FILE-STAT-MSG       PIC X(21)  VALUE " ".
    05 FILLER              PIC X(01)  VALUE " " .
    05 FILE-STAT           PIC X(02)  VALUE "00".
       88 VALID-KEY                   VALUE "00".
    05 FILLER              PIC X(01)  VALUE ":" .
    05 FILE-GUARDIAN-ERR   PIC 9(03)  VALUE ZERO.
/*******************
 PROCEDURE DIVISION.
********************
 DECLARATIVES.
 INPUT-SECTION  SECTION.   USE AFTER STANDARD ERROR PROCEDURE ON INPUT.
     MOVE "INPUT"          TO FILE-I-O-TYPE.
     PERFORM EDIT-FILE-STAT.
 I-O-SECTION    SECTION.   USE AFTER STANDARD ERROR PROCEDURE ON I-O.
     MOVE "OUTPUT"         TO FILE-I-O-TYPE.
     PERFORM EDIT-FILE-STAT.
 OUTPUT-SECTION SECTION.   USE AFTER STANDARD ERROR PROCEDURE ON OUTPUT.
     MOVE "I-O"            TO FILE-I-O-TYPE.
     PERFORM EDIT-FILE-STAT.
 EXTEND-SECTION SECTION.   USE AFTER STANDARD ERROR PROCEDURE ON EXTEND.
     MOVE "EXTEND"         TO FILE-I-O-TYPE.
     PERFORM EDIT-FILE-STAT.
 EDIT-FILE-STAT SECTION.
     MOVE GUARDIAN-ERR     TO FILE-GUARDIAN-ERR.
     IF FILE-STAT = "00"
        MOVE "Worked"      TO FILE-FAILED
        MOVE "Successfully        " TO FILE-STAT-MSG
     ELSE
        MOVE "Failed"      TO FILE-FAILED
        MOVE 999           TO DISK-ERRORS
        EVALUATE FILE-STAT
          WHEN "10"  MOVE "End of File         " TO FILE-STAT-MSG
          WHEN "30"  MOVE "Permanent Error     " TO FILE-STAT-MSG
          WHEN "21"  MOVE "Rewrite Error       " TO FILE-STAT-MSG
          WHEN "22"  MOVE "Duplicate Key       " TO FILE-STAT-MSG
          WHEN "23"  MOVE "No Record Exist     " TO FILE-STAT-MSG
          WHEN "24"  MOVE "Write Past Eof      " TO FILE-STAT-MSG
          WHEN "30"  MOVE "Temporary Error     " TO FILE-STAT-MSG
          WHEN "34"  MOVE "Seq Write Past Eof  " TO FILE-STAT-MSG
          WHEN "35"  MOVE "Open File Error     " TO FILE-STAT-MSG
          WHEN "37"  MOVE "Device Open Error   " TO FILE-STAT-MSG
          WHEN "38"  MOVE "Open Parameter Error" TO FILE-STAT-MSG
          WHEN "41"  MOVE "File is NOT Closed  " TO FILE-STAT-MSG
          WHEN "42"  MOVE "File is NOT Opened  " TO FILE-STAT-MSG
          WHEN "43"  MOVE "UnRead Del./Rewrite " TO FILE-STAT-MSG
          WHEN "44"  MOVE "Rewrite Size Differs" TO FILE-STAT-MSG
          WHEN "46"  MOVE "UnStarted Read Next " TO FILE-STAT-MSG
          WHEN "47"  MOVE "Read/Start Open Err " TO FILE-STAT-MSG
          WHEN "48"  MOVE "Write Open Error    " TO FILE-STAT-MSG
          WHEN "49"  MOVE "File not Opened  I/O" TO FILE-STAT-MSG
          WHEN "90"  MOVE "Open Not Timed I/O  " TO FILE-STAT-MSG
          WHEN "91"  MOVE "EditReadUnit Failed " TO FILE-STAT-MSG
          WHEN OTHER MOVE "Unknown condition   " TO FILE-STAT-MSG.
     IF GUARDIAN-ERR = 40
        MOVE "98"          TO FILE-STAT.
 END DECLARATIVES.
Fri 
10/01/2010 06:54:16
 jim  Binding an Escort/AutoTmf to a user lib
bind
@select list * off
@add * from myuserlib
@add * from $system.escort.escruntm
@set like $system.escort.escruntm
@set highpin on
@set highrequestors on
@build mylib!
Thu 
07/29/2010 20:37:48
 jim  PathMake example
?TACL MACRO
comment *******************************************************************
comment * This Macro Creates a Cold start obey file for a runnig pathway  *
comment *-----------------------------------------------------------------*
comment * This example uses $EXP as a pathmon name                        *
comment * To run this macro, enter                                        *
comment *                                                                 *
comment *     PATHCFG $EXP                                                *
comment *                                                                 *
comment * The Cold Start obey file this will create will be called GOEXP  *
comment * To bring up $EXP using the cold start file enter:               *
comment *                                                                 *
comment *     O GOEXP                                                     *
comment *                                                                 *
comment * This will create a cool start file for $EXP called EXPCTL       *
comment * The log1 file will be called EXPLOG                             *
comment * GOEXP, EXPCTL, EXPLOG will be created in the current subvolume  *
comment * The configuration's pathway will be call $P.#PATHMON.EXP        *
comment *                                                                 *
comment * This macro can also be run for several pathmons by entering:    *
comment *                                                                 *
comment *     PATHCFG $EXP $MNTF $STORE $ZVPT                             *
comment *                                                                 *
comment *-----------------------------------------------------------------*
[#if [#empty %1%] |then|
 #output They Syntax is: PATHCTL $PW
 #output where $PW is a running pathway system
|else| [#DEF ascii STRUCT
BEGIN
BYTE byt0  VALUE 7;  CHAR bell   REDEFINES byt0;
BYTE byt1  VALUE 27; CHAR esc    REDEFINES byt1;
BYTE byt2a VALUE 36; CHAR dollar REDEFINES byt2a;
BYTE byt2  VALUE 37; CHAR perc   REDEFINES byt2;
BYTE byt3  VALUE 38; CHAR amp    REDEFINES byt3;
BYTE byt4  VALUE 64; CHAR at     REDEFINES byt4;
BYTE byt5 (0:1) VALUE 27 73;
CHAR clr (0:1) REDEFINES byt5; == escape sequence
END;
]
#push Norm Blink Invert Dim
#set  Norm   [ascii:esc]6[ascii:at]
#set  Blink  [ascii:esc]6b
#set  Invert [ascii:esc]6[ascii:dollar]
#set  Dim    [ascii:esc]6[ascii:perc] #push PathwayProcess PathWayLen PathwayName
#set  PathwayProcess %1%
#set  PathWayLen [#Compute [#charcount PathwayProcess] - 1]
#set  PathwayName [#charget PathwayProcess 2 for [#Compute [#charcount PathwayProcess] - 1]]
#output
comment #output [Dim]                            [invert]Pathcfg %1%[Dim]                            [norm]
#output [Dim]Builds an obey file called [invert]GO[PathwayName] [Dim] to start [invert]%1%[norm]
#output To run this %1% should be up and running
[#case [#INPUT [BLINK]Should I proceed "Y" ?[NORM ]]
|Y| #output Please wait...
PURGE GO[PathwayName]
PATHCOM %1%;INFO/OUT GO[PathwayName]/PATHWAY,OBEYFORM
edit GO[PathwayName]!;99990/LOG1 [PathwayName]LOG/;NA;E
edit GO[PathwayName];10000/START PATHWAY COLD !/;NA;E
PATHCOM %1%;INFO/OUT GO[PathwayName]/TCP*,OBEYFORM
PATHCOM %1%;INFO/OUT GO[PathwayName]/SERVER *,OBEYFORM
PATHCOM %1%;INFO/OUT GO[PathwayName]/PROGRAM *,OBEYFORM
PATHCOM %1%;INFO/OUT GO[PathwayName]/TERM    *,OBEYFORM ==
edit GO[PathwayName];CQF/-- /A;NA;10000/-- EXIT/;NA;E
edit GO[PathwayName];.01/COMMENT *------------------------------------------------/;e
edit GO[PathwayName];.02/COMMENT *----- Obey GO[PathwayName] to start $[PathwayName]/;e
edit GO[PathwayName];.03/COMMENT *------------------------------------------------/;e
edit GO[PathwayName];.04/#PUSH INLINEPREFIX/;E
edit GO[PathwayName];.05/#SET  INLINEPREFIX --/;E
edit GO[PathwayName];.06/assign PATHCTL, [PathwayName]CTL/;E
edit GO[PathwayName];.07/PURGE [PathwayName]LOG/;E
edit GO[PathwayName];.08/FUP CREATE [PathwayName]LOG,TYPE E, REC 132, EXT(100,100), MAXEXTENTS 100/;E
edit GO[PathwayName];.09"PATHMON/cpu 2,name $[PathwayName],nowait,term $vhs/3";E
edit GO[PathwayName];.10"PATHCOM/inline,out $P.#PATHWAY.[PathwayName]/$[PathwayName]";na;e
|OTHERWISE| #output OK. POOF! I'm gone.
]
#output
[#if [#empty %2%] |then| |else|
  run PATHCFG %2 to 99%
]
] == First If
Thu 
07/29/2010 20:35:46
 jim  ZMacros w/CNL - Needs Adapting
== Macros:
== COMP  srcfile1 srcfile2           Compiles, with the nolist option
== COMPP srcfile1 srcfile2 ...       Compiles to $P.#srctype.srcfile
== COMPF srcfile1 srcfile2 ...       Compiles to $dev2.TESTLST
== CK srcfile                        Checks your subvolumes.srcfile to TEST's
?SECTION set_SysIni MACRO
var CdVol          \test.$dev2.TEST
var LstVol         \test.$dev2.TESTLST
var SrcVol         \test.$dev2.TESTSRC [#case [#charget [#shiftstring SrcFile] 1 for 3]
|SUB|       var TST_OBJ \test.$dev2.subobj.[SrcFile]O
            var ObjVol  \test.$dev2.subobj
            var TST_REN \test.$dev2.OLDobj.[SrcFile]X
|otherwise| var TST_OBJ \test.$dev2.TESTOBJ.[SrcFile]O
            var ObjVol  \test.$dev2.TESTOBJ
            var TST_REN \test.$dev2.OLDobj.[SrcFile]X
]
var TST_POBJ       \test.$dev1.FEDROBJ.FED1
var ObeyVol_VOL    \test.$dev1.TEST ?section doc macro
volume $dev2.TESTdoc ?section fil macro
volume $DEV4.TURBOFIL ?section blk macro
volume $dev2.TESTBLK ?section OB macro
echo volume $dev2.TESTOBEY ?section LIB macro
ECHO VOLUME $dev1.COPYSRC ?section LST macro
echo volume $dev2.TESTLST ?section SRC MACRO
[#if [#empty %1%] |then|
  volume $dev2.TESTSRC
|else|
  #set SrcFile %1%
  set_SysIni
] ?SECTION ENF MACRO
echo VOLUME $dev2.TESTENF ?section gl macro
 var SrcFile
 echo edit $dev2.TESTlst.[SrcFile]S ?section ck macro
var SrcFile %1%
[#case [#charget [#shiftstring SrcFile] 1 for 1]
|N|         fup info (%1%,dev1.COPYSRC.%1%)
|otherwise| fup info (%1%,$dev2.TESTSRC.%1%)
] ?SECTION Echoto MACRO
var EchoOut %1% ?section ECHO macro
#output %*%
%*% ?section var  macro
[#if [#variableinfo/existence/ %1%] |else| #push %1%]
[#if [#empty %2%] |then| |else| #set %1% %2 to 99%]
?section FREEZE MACRO
var PcServer
var PcName
[#IF [#EMPTY %1%] |THEN|
|else|
  #set PCServer %1%
] [#IF [#EMPTY %1%] |THEN|
|else|
    [#IF [#EMPTY %2%] |THEN|
        var PcServer %1%
    |else|
        var PcName %1%
        var PcServer %2%
    ]
]
[#if [#emptyv PcName] |then|
   var PcName [#input Enter the Pathway System: ($MNTF):]
]
[#if [#emptyv PcServer] |then|
   var PcServer [#input Enter the Pathway Server (TESTPOST-SERVER):]
] PATHCOM [PcName];FREEZE [PCServer]
PATHCOM [PcName];STOP   [PCServer]
PATHCOM [PcName];STOP   [PCServer]
[#if [#empty %2%] |then| |else| FREEZE %2 TO 99%] ?section THAW   MACRO
var PcServer
[#IF [#EMPTY %1%] |THEN|
|else|
  #SET PCServer %1%
]
PATHCOM [PcName];THAW   [PCServer]
[#if [#empty %3%] |then| |else| THAW %1%  %3 TO 99%]
?section START  MACRO
var PcServer
[#IF [#EMPTY %1%] |THEN|
|else|
  #SET PCServer %1%
]
PATHCOM [PcName];START  [PCServer]
[#if [#empty %3%] |then| |else| START %1%  %3 TO 99%]
=======================
?section debugon macro
======================
[#IF [#EMPTY %1%] |THEN|
|else|
    [#IF [#EMPTY %2%] |THEN|
        var PcServer %1%
    |else|
    var PcName %1%
    var PcServer %2%
    ]
]
[#if [#emptyv PcName] |then|
   var PcName [#input Enter the Pathway System: ($MNTF):]
]
[#if [#emptyv PcServer] |then|
   var PcServer [#input Enter the Pathway Server (TESTPOST-SERVER):]
]
#push me
#set  me [#myterm] freeze
echo pathcom [PcName];alter [PCServer],hometerm [me],debug on
thaw
#pop me ?section debugoff macro
=======================
var PcName %1%
var PcServer %2%
freeze
pathcom [PcName];alter [PCServer],hometerm $VHS,debug off
thaw ?section copy macro
fup dup %1%,%2%,saveall
fup secure %2%,"nnnn" ?section cinfo macro
var SrcFile
[#IF [#EMPTY %1%] |THEN|
|ELSE|
  #SET SrcFile %1%
  set_SysIni
]
fup/inline/
--  info $dev2.TESTSRC.[SrcFile]s
--  info $dev2.TESTOBJ.[SrcFile]o
--  exit ?section pout macro
#SET  #INLINEPREFIX --
peruse /inline/$ppls
-- ll;le/out TESTlst.x/a;del
-- ll;le/out TESTlst.x/a;del
-- ll;le/out TESTlst.x/a;del
-- ll;le/out TESTlst.x/a;del
-- ll;le/out TESTlst.x/a;del
-- ll;le/out TESTlst.x/a;del
-- ll;le/out TESTlst.x/a;del
-- ll;le/out TESTlst.x/a;del
-- ll;le/out TESTlst.x/a;del
-- cqf/`/
-- dq/`                                                 /
-- cqa/`//a
-- e ?section fs alias
 finddata
?section grep alias
 finddata %*% ?section OK macro
[#case [#input RUN %*% (y)?] |y Y| echo %*% |otherwise|]
#output ---------------------------------------------
?SECTION PCLS MACRO
 SPOOLCOM $SPLS;JOB (OWNER),DELETE !
 SPOOLCOM $PPLS;JOB (OWNER),DELETE ! ?SECTION SV MACRO
 FUP SUBVOLS %*% ?section Type macro
 fup copy %1% ?section p macro
[#if [#empty %1%] |then| peruse $PPLS |else| peruse $SPLX]
?SECTION INFODEFINE MACRO
#FRAME
#PUSH X1 X2 X3 X4
#SETMANY X1 X2 X3 X4,[#DEFINEINFO %1%]
#OUTPUT/HOLD/ADD DEFINE %1%
#OUTPUT/HOLD,COLUMN 25/,CLASS [X2]
#OUTPUT/COLUMN 40/,[X3] [X4]
#UNFRAME
[#if [#empty %2%] |then| |else| INFODEFINE %2 to 99%] ?SECTION CREATEDEFINES MACRO
PURGE XD
INFO/OUT XD/DEFINE =*
EDIT XD;DQN/=/;CQ/ Define Name / INFODEFINE /A;E
PURGE DEFINES
#PUSH #OUT
#SET #OUT DEFINES
O XD
#POP #OUT
EDIT DEFINES;DQ/INFODEFINE/;E
EDIT DEFINES
[#if [#empty %2%] |then| |else| INFODEFINE %2 to 99%]
?SECTION ST MACRO
[#IF [#EMPTY %1%]
|THEN| STATUS *,TERM
|ELSE| STATUS %*%
] ?SECTION DelY    MACRO
[#IF [#FILEINFO/EXISTENCE/%1%] |THEN|
   FILEINFO %1%
   [#CASE [#INPUT Do you wish to delete this (y)?]
      |y Y| purge %1%
      |otherwise|
   ]
] ?SECTION FS ALIAS
FINDDATA ?SECTION CALC ALIAS
COMPUTE ?SECTION COMPARE macro
$dev2.jimobj.COMPARE %*% ?section PC MACRO
var PcName
[#if [#empty %1%]
|then| ECHO pathcom [PcName]
|else| #set PcName %*%
       ECHO pathcom %*%]
?section OBJ MACRO
ECHO $dev2.TESTOBJ
?section TL macro
LOAD/KEEP 1/$dev2.TESTSRC.ZMACROS ?section GT macro
edit $dev2.TESTSRC.ZMACROS;set tabs 10 20 30 40 50 60 70;%1 TO 9% ?section R    macro
var TST_OBJ
var Src
[#if [#empty %1%] |then| |else| SRC %1%]
ECHO RUN [TST_OBJ] %2 to 99% ?section RD   macro
var TST_OBJ
[#if [#empty %1%] |then| |else| SRC %1%]
RUND [TST_OBJ] ?section DEFINESX macro
[#if [#empty %*%] |then| echo INFO DEFINE =* |ELSE| echo INFO DEFINE %*%] ?section CD macro
[#if [#empty %1%] |then| |else| Var CdVol %1%]
volume [CdVol] ?section G macro
var EditLastSrc %*%
EDIT;SET TABS 10 20 30 40 50 60 70;SET JOIN 80;G [EditLastSrc] ?section GS macro
var SrcFile %*%
EDIT;SET TABS 10 20 30 40 50 60 70;SET JOIN 80;G [SrcFile]S ?section O macro
var ObeyVol %1%
[#if [#emptyv ObeyVol] |then|
     #output ([ObeyVol]) doesn't exist.
|else|
   [#if [#fileinfo/existence/[ObeyVol]] |then|
      #push Found
      edit /OUTV Found,PRI 139/[ObeyVol] R;LB/?SECTION/RB/ ROUTINE/RN/*/;E
      [#if [#linecount Found] > 2 |then|
         echo T [ObeyVol]
      |ELSE|
         echo OBEY [ObeyVol]
      ]
      #pop  Found
   |else|
      #output The default Obey File hasn't been set yet. Try: O obeyfile
   ]
]
[#if [#empty %2%] |then| |else| O %2 to 99%] ?section BYE       macro
========================
CSAVE
LOGOFF ?section CLOAD     macro
========================
#PUSH WS_VOLUME
#SET WS_VOLUME [#DEFAULTS]
VOLUME
O DEFAULTS
VOLUME [WS_VOLUME]
#POP WS_VOLUME ?section CSAVE     macro
========================
#push WS_VOLUME
#set  WS_VOLUME [#DEFAULTS]
VOLUME
#FRAME
#PUSH #INLINEPREFIX
#SET  #INLINEPREFIX --
edit/INLINE/DEFAULTS !
-- DQ ! F/L
-- na;100 /#set PCName      [PCName]/
-- na;100 /#set PCServer    [PCServer]/
-- na;100 /#set SrcFile     [SrcFile]/
-- na;100 /#set ObeyVol     [ObeyVol]/
-- na;100 /#set CdVol       [CdVol]/
-- na;100 /#set SrcFile     [SrcFile]/
-- na;100 /#set COut        [COut]/
-- na;100 /#set EditLastSrc [EditLastSrc]/
-- na;100 /#set CdVol       [CdVol]/
-- E
VOLUME [WS_VOLUME]
#UNFRAME ?section FILESPEC macro
[#if [#fileinfo /existence/ %1%] |then|
    #output /hold/ [#fileinfo/fullname/ %1%]
    #output /column 35,hold/
    [#case [#fileinfo /filestructure/ %1%]
         |0| #output /hold/ U:
         |1| #output /hold/ R:
         |2| #output /hold/ E:
         |3| #output /hold/ K:
         |otherwise| ]
    #output /column 37,hold/ [#fileinfo/eof/ %1%]
    #output /column 44,hold/&
        [_CONTIME_TO_TEXT [#CONTIME [#fileinfo/modification/%1%]]]
    #output /column 72,hold/ [#fileinfo/owner/ %1%]
|else|
    #output /hold/ File %1% does not exist ]
#output ?section SCUPINFO macro
#frame
#push OUTLIST
SCUP /OUTV OUTLIST/INFO %*%
#output [#LINEGET OUTLIST 1 FOR 1]
#output [#LINEGET OUTLIST 5 FOR 1]
#unframe ?section CCOMPARE macro
=======================
var SrcFile %1% set_SrcFile [SrcFile]
compare [SrcFile]s, $tech1d.source.[SrcFile]s
[#if [#empty %2%] |then| |else| CCOMPARE %2 to 99%] ?section set_SrcFile macro
========================= var SrcFile %1%
set_SysIni
?section COMPF    macro
=======================
var  PrintFile file
COMP_CheckSrc %1%
[#if [#empty %2%] |then| |else| COMPF %2 TO 99%] ?SECTION CL ALIAS
COMPP
?section COMPP    macro
=======================
var  PrintFile print
COMP_CheckSrc %1%
[#if [#empty %2%] |then| |else| COMPP %2 TO 99%] ?SECTION CNL ALIAS
COMP ?section COMP     macro
=======================
var  PrintFile none
COMP_CheckSrc %1%
[#if [#empty %2%] |then| |else| COMP  %2 TO 99%] ?section COMP_CheckSrc macro
=======================
[#IF [#FILEINFO/EXISTENCE/DEFINES] |THEN| O DEFINES]
set_SrcFile %1%
SET_SrcLanguage [#case [PrintFile]
|file|
echo FUP PURGE $dev2.TESTLST.[SrcFile]!
#set PrintFile $dev2.TESTLST.[SrcFile] |print|
echo SPOOLCOM $PPLS;JOB (LOC #[SrcLanguage].[SrcFile]),DELETE!
#set PrintFile $P.#[SrcLanguage].[SrcFile]
|otherwise| #set PrintFile
] [#case [SrcLanguage]
   |SQL|       COMP_SQL
   |SCOBOL|    COMP_SCOBOL
   |C|         COMP_C
   |TAL|       COMP_TAL
   |otherwise| >>>> Can't Compile [SrcFile]
        ]
?section SET_SrcLanguage macro
var SrcFile
#push TMP_SRC TMP_OBJ
[#if [#fileinfo/existence/ [SrcFile]S] |then|
   #set TMP_SRC [SrcFile]S
   #set TMP_OBJ [SrcFile]O
|else|
   [#if [#fileinfo/existence/ [SrcFile]] |then|
      #set TMP_SRC [SrcFile]
      #set TMP_OBJ [SrcFile]
   ]
] [#if  [#empty [TMP_SRC]]
|then|
   #output Cannot locate [SrcFile]
|else|
   CheckSource [TMP_SRC] [TMP_OBJ]
]
#pop TMP_SRC
?section CheckSource macro
==========================
var SrcLanguage SQL #push Found
edit /OUTV Found,PRI 139/%1% R;LB/ SCREEN /RB/ SECTION/RN/*/;E
[#if [#linecount Found] > 2 |then| #SET SrcLanguage SCOBOL ]
#pop  Found #push Found
edit /OUTV Found,PRI 139/%1% R;LB/ $SYSTEM.SYSTEM.EXTDECS/;E
[#if [#linecount Found] > 2 |then| #SET SrcLanguage TAL ]
#pop  Found #push Found
edit /OUTV Found,PRI 139/%1% R;LB/#include/r/[#if [#linecount Found] > 2 |then| #SET SrcLanguage C ]
#pop  Found
#output ------ SOURCE IS [SrcLanguage]
#push Found
#set  Found %1%
[#case [#charget [#shiftstring Found] 1 for 1]
|N| SrcLanguage
|otherwise|
]
#pop  Found ?section COMP_SCOBOL macro
#OUTPUT ------------------------ SCOBOL ------------------------------
#PUSH MYS
#SET  MYS [#FILEINFO/VOLUME/[SrcFile]S].[#FILEINFO/SUBVOL/[SrcFile]S]
echo  VOLUME $dev1.COPYSRC [#IF [#EMPTYV PrintFile] |THEN|
   echo SCOBOLX/IN [MYS].[SrcFile]S/[TST_POBJ];NOLIST
|ELSE|
   echo SCOBOLX/IN [MYS].[SrcFile]S,OUT [PrintFile]/[TST_POBJ]
]
[#IF (_COMPLETION:COMPLETIONCODE > 1) |THEN|
     #OUTPUT **** ERROR **** CHECK %1%
] ECHO VOLUME [MYS]
#POP MYS
#OUTPUT -------------------------------------------------------------- ?section COMP_TAL macro
=========================
#push MYS
#set  MYS [#FILEINFO/VOLUME/[SrcFile]S].[#FILEINFO/SUBVOL/[SrcFile]S]
echo  VOLUME $dev1.COPYSRC
#output ------------------------------------------------------------ TAL BEG [#IF [#EMPTYV PrintFile] |THEN|
echo TAL/IN [MYS].[SrcFile]S/[TST_OBJ];RUNNABLE;NOLIST
|ELSE|
echo TAL/IN [MYS].[SrcFile]S/[TST_OBJ];RUNNABLE
   echo TAL/IN [MYS].[SrcFile]S,OUT [PrintFile]/[TST_POBJ]
]
[#IF (_COMPLETION:COMPLETIONCODE > 1) |THEN|
     #OUTPUT **** ERROR **** CHECK %1%
] echo VOLUME [MYS]
#pop MYS
#output ------------------------------------------------------------ TAL END ?section COMP_C macro
========================= #PUSH MYS
#push MYS
#set  MYS [#FILEINFO/VOLUME/[SrcFile]S].[#FILEINFO/SUBVOL/[SrcFile]S]
echo  VOLUME $dev1.COPYSRC
#output -------------------------------------------------------------- C BEG [#IF [#EMPTYV PrintFile] |THEN|
echo C/IN [MYS].[SrcFile]S/[TST_OBJ];RUNNABLE,NOLIST
|ELSE|
echo C/IN [MYS].[SrcFile]S,OUT [PrintFile]/[TST_OBJ];RUNNABLE,NOLIST
]
[#IF (_COMPLETION:COMPLETIONCODE > 1) |THEN|
     #OUTPUT **** ERROR **** CHECK %1%
]
ECHO VOLUME [MYS]
#POP MYS
#output -------------------------------------------------------------- C END
?SECTION COMP_SQL MACRO
=======================
#PUSH MYS
#push MYS
#set  MYS [#FILEINFO/VOLUME/[SrcFile]S].[#FILEINFO/SUBVOL/[SrcFile]S]
echo  VOLUME $dev1.COPYSRC
echo PARAM SYMBOL-BLOCKS 8
[#IF [#fileinfo/existence/ [TST_REN]] |then|
     ECHO SQLCI;PURGE [TST_REN] !;EXIT]
[#IF [#fileinfo/existence/ [TST_OBJ]] |then|
   ECHO SQLCI;FUP RENAME [TST_OBJ],[TST_REN];EXIT] #output ---------------------------------------------------------COBOL85 BEG
[#IF [#EMPTYV PrintFile] |THEN|
     echo COBOL85/IN [MYS].[SrcFile]S/[TST_OBJ];nolist;SUPPRESS;ENV COMMON
|else|
     echo cobol85/IN [MYS].[SrcFile]S,OUT [PrintFile]/[TST_OBJ];ENV COMMON
] ECHO VOLUME [MYS]
[#IF (_COMPLETION:COMPLETIONCODE > 1) |THEN|
    #OUTPUT **** COBOL85 ERROR ****
|ELSE|
    #OUTPUT ---- COBOL85 SUCCESSFULL
    #output ---------------------------------------------------------COBOL85 END
    COMP_SQLCOMP %1%
] ?SECTION COMP_SQLCOMP MACRO
===========================
#PUSH LstVol
#output -------------------------------------------------------- SQLCOMP BEG
echo SQLCOMP/IN [TST_OBJ],OUTV LstVol/CATALOG $DEV3.MISCCATL
[#IF ([#LINEFIND LstVol 1 No SQL source ]>0) |THEN|
    #OUTPUT Sql Compiling is not needed for this program
|ELSE|
   [#IF (_COMPLETION:COMPLETIONCODE < 0) |THEN|
       #OUTPUT *** SQLCOMP WARNING *** CHECK $P.#COBOL.[SrcFile]
       #PUSH #OUT
       #SET #OUT $P.#SQLCOMP.[SrcFile]
       #OUTPUTV LstVol
       #POP #OUT
   |ELSE|
      [#IF (_COMPLETION:COMPLETIONCODE > 1) |THEN|
          #OUTPUT **** SQLCOMP ERROR **** CHECK $P.#SQLCOMP.[SrcFile]
          #PUSH #OUT
          #SET #OUT $P.#SQLCOMP.[SrcFile]
          #OUTPUTV LstVol
          #POP #OUT
      |ELSE|
          #output SQLCOMP successful: [_COMPLETION:COMPLETIONCODE]
          #PUSH #OUT
          #SET #OUT $P.#SQLCOMP.[SrcFile]
          #OUTPUTV LstVol
          #POP #OUT
]  ]  ]
#output -------------------------------------------------------- SQLCOMP END #POP LstVol ?SECTION PRINT MACRO
FUP COPY %1%,$P
[#if [#empty %2%] |then| |else| PRINT %2 to 99%] ?SECTION SQCOST MACRO
SQLCOMP/IN $dev2.TESTOBJ.%1%,OUT $P.#SQCOST/ &
STOREDDEFINES EXPLAIN PLAN NORECOMPILE ?section LOG macro
[#if [#empty %1%] |then|
  EDIT $dev2.TEST.LOG2009;XVS L-20;E
|else|
  #frame
  #push #out
  #set  #width 230
  #push  wYY wMM wDD wHH wMI
  #setmany  wYY wMM wDD wHH wMI, [#contime [#timestamp]]
  [#IF [wYY]< 10 |THEN| #SET wYY 0[wYY]]
  [#IF [wMM]< 10 |THEN| #SET wMM 0[wMM]]
  [#IF [wDD]< 10 |THEN| #SET wDD 0[wDD]]
  [#IF [wHH]< 10 |THEN| #SET wHH 0[wHH]]
  [#IF [wMI]< 10 |THEN| #SET wMI 0[wMI]]
  #set  #out $dev2.TEST.LOG[wYY]
  #output [wMM]/[wDD]/[wYY] [wHH]:[wMI]-> %*%
  #set  #width 80
  #pop  #out
  #unframe
]
?section dir ALIAS
fileinfo ?section sv macro
fup subvols %1% ?SECTION CLS MACRO
#FRAME
 [#DEF ascii STRUCT
  BEGIN
  BYTE byt5(0:1)
   value 27 73;
  CHAR clr(0:1)
   redefines byt5;
  END;
 ]
#OUTPUT [ascii:clr(0:1)]
#UNFRAME ?section tt macro
var tfile %1%
t [tfile]
?section file macro
volume $dev2.testfile
Thu 
07/22/2010 07:05:39
 jim  zMenu
?tacl macro
[#DEF ascii STRUCT
BEGIN
BYTE byt0  VALUE 7;  CHAR bell   REDEFINES byt0;
BYTE byt1  VALUE 27; CHAR esc    REDEFINES byt1;
BYTE byt2a VALUE 36; CHAR dollar REDEFINES byt2a;
BYTE byt2  VALUE 37; CHAR perc   REDEFINES byt2;
BYTE byt3  VALUE 38; CHAR amp    REDEFINES byt3;
BYTE byt4  VALUE 64; CHAR at     REDEFINES byt4;
BYTE byt5 (0:1) VALUE 27 73;
CHAR clr (0:1) REDEFINES byt5; == escape sequence
END;
]
varq Norm   [ascii:esc]6[ascii:at]
varq Blink  [ascii:esc]6b
varq Invert [ascii:esc]6[ascii:dollar]
varq Dim    [ascii:esc]6[ascii:perc] ==var Line25 [ascii:esc]o[ascii:esc]6[ascii:amp]
#output [blink]************[norm][invert] MENU [norm][blink]***********[norm]
#output 1 - Load Macros
#output 2 - Files
#output 3 - $data5.AUTOTABS
#output 4 - Check BLK files using BKP number
#output 5 - Locate a Spoolcom Report
[#case [#input [dim]Enter a Selection:[norm]]
|1|
    o $dev2.jimmenu.zload
    menu
|2|
    Files
    menu
|3|
    dir $data5.autotabs.*
    menu
|4|
    dir $data*.blk*[#input Enter the BLK number:]*.*
    menu
|5|
    #push mypart
    #set mypart [#input Enter a portion of the reports name: ]
    purge Zjunk1,Zjunk2
    spoolcom/out Zjunk1/\PROD.$SPLS;job
    edit Zjunk1;DQBN/[mypart]/;c5:80//a;cqf/spoolcom \prod.$spls;job /a;e
    spoolcom/out Zjunk2/\PROD.$MPLS;job
    edit Zjunk2;DQBN/[mypart]/;c5:80//a;cqf/spoolcom \prod.$mpls;job /a;e
    EDIT ZJunk1;g Zjunk2 to l;lua;e
    o zjunk1
|otherwise|
    #output -- Sniff ! Sniff ! --- Bye
]
Fri 
03/19/2010 10:19:56
 jim  Tandem Manuals

<< 01/2010 < 03/2010 Calendar 02/2011 > 01/2012 >>Sign InView Other Logs