Tandem's Log |
Created: 5/31/2007 5:53:03 PM |
|
03/28/2011 10:00:20 Tandem Weeden Preserve Trail | Mon |||||||||||||||||||
03/28/2011 09:52:34 Tandem Weeden Preserve | Mon |||||||||||||||||||
01/12/2011 19:48:56 jim Tandem Shops II | Wed |||||||||||||||||||
Accenture , ACI Worldwide , Acision (acquired Logica CMG) , Adexus (Chile) , ADP Securities Industry Software , Advanced Business Systems , Advanced Computer Concepts (ACC) , Ageas (née Fortis Netherlands) , Aleri (acquired by Sybase) , Aleri (acquired by Wall Street Systems) , Allegheny Ludlum (ATI) , Alltel , Amdocs , America OnLine (AOL) , Ameriprise , Amtrak , ANZ Banking Group , Applied Industrial Technologies , Arbitron , Arcelor Mittal , Ascert , Assurant Specialty Property , AT&T , Atos Euronext (acquired by NYSE) , Atos Origin , Attunity , Automated Banking Services , Automated Banking Services , AXA Sun Life , Baldwin Hackett & Meeks , Banamex , Banco Caja Social (BCSC) , Banco Caja Social (BCSC) , Banco Cuscatlan (acquired by Citigroup) , Banco de Credito e Inversiones , Banco De Credito Del Peru , Banco Popular (Puerto Rico) , Banelco (Argentina) , Bank Central Asia (Indonesia) , Bank of America , Bank of England (UK) , Bank of Montreal (Canada) , Bankart (Slovenia) , Bankserv , Banksys , Bank-Verlag (Germany) , Baptist Health , Barclays Bank , Bausch & Lomb , Belgacom (Belgium) , Bell Canada , Bombay Stock Exchange (BSE) , Borica Ltd. (Bulgaria) , Bowden Systems , BrightStrand International , British Telecomm (BT) , Broadridge (née ADP) , Business Connexion , C.H. Robinson , C.R. Laurence , CA Technologies (nee Computer Associates) , CAIL , Caja Libertad , California Franchise Tax Board , Canadian Imperial Bank of Commerce , Cardinal Health , Caremark Rx , Carl Corporation (acquired by TLC) , CarrvScott Software , CBOSS (Disambiguation needed!) , CBOSS (Disambiguation needed!) , CEKAB , Chase Bank , Chase Paymentech Solutions , Chevron , Chicago Board of Trade (CBOT) , Chicago Mercantile Exchange , China Telecom , CMA Small Systems , COCC , Columbus Metropolitan Library , Comdata , Comercial Mexicana , ComForte , Community Bank , Computer Sciences Corporation (CSC) , Computer Security Products , Computer Services , Conexus , Continental Data Graphics , Cornerstone Software , Credibanco (VISA) , Crossroads Systems , Crystal Point , Daiwa Institute of Research , DataForce International , Dell Computers , Descartes (acquired Tradevision AB) , Deutsche Bank , DirecTV , Dubai Islamic Bank , Easyway , eFunds Corporation (FIS) , Elan Financial (acquired Genpass) , Elder-Beerman Stores , Emergis , Engineering Ingegneria Informatica , Equens , Esso Canada , Euroclear , Euronext Paris (NYSE) , EuroShell Cards , Everlink , Evertec (Central America) , Exxon Mobile GIS , ezTips (Korea) , FedEx , Fidelity Information services (eFunds) , First Commonwealth Systems , First Data Austria , First Data Corporation , Fifth Third Bank , First National Bank Of Omaha , Fiserv , Formis Computer Services , Fortis Netherlands (merged into ABN Amro) , Freescale , Future Electronics , Gallagher Bassett Services , GAP , GE Health Care (acquired IDX Systems) , Gemini Communications , Genpass (acquired by Élan Financial) , Giro Bankcard , Global Payments (GPI) , Golden 1 Credit Union , GoldenGate (acquired by Oracle) , Gravic , Greeen Shield Canada , GreenHouse Software , Gresham Computing , Greyhound Lines , Group Health Cooperative - ISD , HDFC Bank , Hellenic Bank , Hermes Plus (acquired by S&T) , Hertz , Hewlett Packard , Home Depot , Hong Kong Exchanges & Clearing , HSBC Bank UK , Huntington National Bank , Hwatai Bank (Taiwan) , Hyundai Card (Korea) , IBM , IBM Denmark , IBM Global Services , IBM Netherlands , IBM Software Group , ICICI Bank (India) , ICMA , Industrial Bank Korea , Infocom Corporation , Infosys Australia , ING Bank International , ING Bank Netherlands , Inova Health System , Intec (disambiguation needed!) , Intec (disambiguation needed!) , Intermountain Healthcare , International Capital Market Assoc. (ICMA) , Intertan Canada (acquired by Bell Canada) , Intrado , Iowa Health Systems (IHS) , IT Services Center (ISC-FDJP) , Itochu Techno-Solutions , IX Knowledge (Japan) , JC Penney , John Deere , JP Morgan Chase & Co , JP Morgan Chase Bank , KDDI (Japan) , Kettering Medical Center Network , Keybank , KFTC (Korea) , KIS (nee KITC (Korea)) , Kleinschmidt Inc. , KMB (Korea) , KOFIA (nee KSDA (Korea)) , Kohl's Department stores , Kookmin Bank (Korea) , Korea Computers, Inc. (KCI) , Korea Exchange Bank (KEB) , Korea Federation of Banks (KFB) , Korea Stock Exchange , KPN Netherlands , Krung Thai Computer Services , KTNET (Korea) , Legacy Health System , Legato Solutions & Services (Singapore) , Lehigh Valley Health Network , Link Interchange Network , Linkage , Liverpool Mexico , Loto Quebec , Lotte Card , Lucky Goldstar (LG) , MagSoft , Mahindra Satyam , Mahindra Satyam , Malayan Banking Berhad , Manaco International , Marshall Aerospace , Mashreq Bank , MasterCard International , Masterlink Securities , Mayo Clinic , McKesson Corporation , Memorial Healthcare System , Menon Group , Metavante (FIS subsidiary) , Mexico Stock Exchange , Military Manpower Admin (Korea) , Mitsubishi UFJ NICOS , Moneris Canada , Montefiore Medical Center , Motorola , MyTravel (merged into Thomas Cook) , NASDAQ , Nationwide Building Society , Nationwide Insurance , Navy Federal Credit Union , Nebraska Health System , Network Concepts , Network Technologies International , NICE Group (Korea) , Nordic Processor (IBM/Nordea) , Northrop Grumman IT , Northumbria Police , NTT Data Corporation , NYCE , NYSE Euronext , OCBC Bank (Singapore) , Odyssey Information Services , Oki Electric Industry , Oman International Bank , Oman Mobile Telecoms (OmanTel) , Openwave Systems , Opsol Integrators , Ordina , OSF Healthcare , OTP Bank , Outokumpu Stainless , Outrigger Hotels , Park Nicollet Health Services , Paymark (New Zealand) , Perceptive Software (acquired by Lexmark) , Perot Systems (acquired by Dell) , Pinnacle Group , Pitney Bowes , Polaris Securities , Postbank , PPG Industries , Prepay Technologies , Price Waterhouse Coopers , ProHealth Care , Pulse EFT , Quest Diagnostics , Rabobank , Rabobank Nederland , Rahaxi Processing , Raymond James & Associates , Redeban Multicolor , Redlink SA , Rockwell Automation (acquired CIE) , Royal Bank of Canada , Royal Bank of Scotland , S & T Hermes Plus , Sabre Holdings , Safeway , Sagawa Computer System , Sallie Mae , Samsung , Scandinavian Airlines System , Schroff , SCL Health System , Scotia Inverlat Casa de Bolsa , Scotiabank , Sears Roebuck de México , Shared Electronic Banking Services , Sharp Healthcare , Shazam (Iowa Transfer System) , Shenzhen Stock Exchange , SIA SSB , SIAC (acquired by NYSE Euronext) , Sierra Health (acquired by Unitedhealth) , Singtel Optus , Sistema , SIX Card Solutions (nee TeleKurs) , SIX Swiss Exchange , Smart and Final Stores , Sno-Isle Libraries , Softbank Telecom , Sogeti Nederland (CAP Gemini) , Speedway/SuperAmerica , Sprint Nextel , St. George Bank , St. Jude Medical , St. Olavs Hospital , Standish Group , Sunflower Comm , Sungard Brokerage , Suntrust Bank , Syniverse Technologies , SYSCOM Computer Engineering , System Connections , Taiwan Stock Exchange (TSE) , Target Stores , T-Chek Systems , TDC Mobil , Teamsun , Telcel , Telus Communications , The Library Corp (TLC (acquired Carl Corp)) , Tidal Software , Tieto Corporation (nee TietoEnator) , Tokyo Information Systems (TIS) , Tokyo Stock Exchange , Tong Yang Securities , Toronto Dominion Bank , Toronto Stock Exchange , TOSHIBA , Total Systems Services (TSYS) , TPG Capital , Travelers Express/Moneygram , Trisept Solutions , UC4 Software , UFJ Nicos (acquired by Mitsubishi) , Unibanco (Brazil) , Union Bank , Union Pacific Railroad , University of Central Florida , University of Chicago Hospitals , University of Virginia , University of Virginia Medical Center , USDA AMS Cotton Program , Vancouver Coastal Health , Verisign , Verizon Wireless , VISA , VISA Cash (Korea) , Vocalink , Vodacom , Wachovia (acquired by Wells Fargo) , Wake Forest Univ. Baptist Medical Cntr. , Walgreens , Washington Department of Revenue , Washington Mutual (acquired by JPMorgan Chase) , Wells Fargo Bank , Wells Fargo FIS , Wesco Distribution , West Corporation , Western Farmers Electric Coop , Western Union Financial Services , Westpac Banking , Wipro Technology , WM Data (acquired by Logica) , Woori Bank (Korea) , Wright Express , Xchanging , Yokogawa Digital Computer (YDC) , Zions Bancorporation |
01/07/2011 10:29:44 jim Bat file for testing network connections | Fri |||||||||||||||||||
ECHO OFF |
12/08/2010 13:50:42 jim SQLCreat - Program to extract a SQL Create Table s | Wed |||||||||||||||||||
?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. |
10/02/2010 11:38:49 jim Declaratives | Sat |||||||||||||||||||
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. |
10/01/2010 07:00:59 jim Declaratives | Fri |||||||||||||||||||
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. |
<< 03/2010 < 10/2010 Calendar 04/2011 > 03/2012 >> | Sign InView Other Logs |