Hmmm....looks familiar! This one works with files, or procs or programs. Never got around to making it truly structured....oops.... :)
Use: D filename D procname D programname * Release Information * MANAGE-2000 - VSI - Release 4.3g * D - Display the item based on the VOC Version="~Ver=~7.0.85~1584612803~" * ========================================================================= * Written by Allen E. Elwood, AK Savage Software 02-19-89 * (c) Copyright by AK Savage Software 1989,90,91,92,93,94,95,96,97 All Rights Reserved. * Upgraded from a simple shortcut to a replacement for LIST fname S * for version 6.2e when Unidata cut @UQ to a max of 100 attr's * This version handles display of proc's and basic programs based off of the * name, very similar to ROI's proc chase (note mine is MUCH older, ver 4.3) * and will also display all data in a record for which dict items exist. * Use SHOW.ME to look at files without dicts, or to view files in their raw * data state * ========================================================================= *#* COPY COPY.TOOLS.BP STANDARD.VARIABLES.2 (REPLACING PGM.NAME BY D., FN.NAME BY D, IO.OPEN.OPTS BY TERM.DATA:LOCK:XREF) ;*#* Copied Source Follows (08-25-97) $INCLUDE STANDARD.COMMON.VARIABLES FROM COPY.TOOLS.BP $INCLUDE STANDARD.COMMON.APP.PROGRAMS FROM COPY.TOOLS.BP $INCLUDE COM500 FROM COPY.TOOLS.BP $INCLUDE STANDARD.VARIABLES.END FROM COPY.TOOLS.BP PGM.NAME='D.'; FN.NAME ='D' CALL IO.OPEN('TERM.DATA:LOCK:XREF',PASSWORDS) *#* *=========================================================================== ==== EQU ESCAPE TO '' EQU MAXL TO 20 PRINT CLR:B4.T:L24:'Enter END to Exit': PRINT L(1):C(1):'D - Display an Item based on the VOC entry':AFT.T THE.FILE.NAME='' ; THE.ITEM.NAME='' IF EXTRA.IP#"?NO?" THEN SWAP ';' WITH ' ' IN EXTRA.IP THE.VOC.NAME=FIELD(EXTRA.IP,' ',1) END PRINT 'Proc/Program Name : ': IF THE.VOC.NAME = "" THEN INPUT THE.VOC.NAME END ELSE PRINT THE.VOC.NAME END THE.VOC.NAME=ICONV(THE.VOC.NAME,'MCU') IF THE.VOC.NAME#'END' THEN OPEN 'VOC' TO VOC ELSE STOP READ VOC.REC FROM VOC, THE.VOC.NAME ELSE PRINT 'NO VOC BUBA' STOP END BEGIN CASE CASE VOC.REC<1>='R' THE.FILE.NAME=VOC.REC<2> THE.ITEM.NAME=VOC.REC<3> CASE VOC.REC<1>='C' THE.FILE.NAME=FIELD(VOC.REC<3>,' ',1) THE.ITEM.NAME=FIELD(VOC.REC<3>,' ',2) CASE (VOC.REC<1>='F' OR VOC.REC<1>='DIR') IF THE.FILE.NAME[LEN(THE.FILE.NAME)-2,3]='.BP' THEN BP=1 ELSE BP=0 GOSUB DISPLAY.FILE STOP CASE 1 CALL SCREEN.MSG('D cannot access ':VOC.REC<1>:' type VOC records;b;c;h') STOP END CASE OPEN THE.FILE.NAME TO F.NAME ELSE ERM='Sorry, but file : ':B4.T:THE.FILE.NAME:AFT.T:' does not exist!;B;C;H' CALL SCREEN.MSG(ERM); PROMPT " " STOP END READ TEXT FROM F.NAME, THE.ITEM.NAME ELSE TEXT='NOT ON FILE!' END NUMBER=DCOUNT(TEXT,AM) HDS="CRT Listing of File: ":THE.FILE.NAME:', Item: ':THE.ITEM.NAME:' Page ':AM CALL SCROLL.INQ('I','',HDS,1 ,1,ACT,PARMS ,SC.WRK,1) IF ERROR THEN STOP FOR I=1 TO NUMBER TEXT<I>=CHANGE(TEXT<I>,ESCAPE,'[') TEXT<I>=ICONV(TEXT<I>,'MCP') IF NUMBER<100 THEN TEXT<I>=I"L#2":': ':ICONV(TEXT<I>,'MCC;~; ') END ELSE TEXT<I>=I"L#3":': ':ICONV(TEXT<I>,'MCC;~; ') END CALL SCROLL.INQ('N',TEXT<I>,HDS,1,1,ACT,PARMS,SC.WRK,1) IF ACT='END' THEN STOP IF ACT='X' THEN STOP NEXT I CALL SCROLL.INQ('F','',HDS,1,1,ACT,PARMS,SC.WRK,1) END STOP *=========================================================================== ==== DISPLAY.FILE: *On yer marks DO.DAA=SYSTEM(11) IF DO.DAA > 0 THEN PERFORM "SAVE.LIST Display":PROCESS.ID CAPTURING JUNK LIST.SAVED=1 END ELSE LIST.SAVED=0 END FILENAME=FIELD(EXTRA.IP,' ',1) *CRT CLR:'Display File : ':FILENAME *LOOP * CRT '1-Include Formatting, 2-Raw Data':;INPUT FMO * IF (FMO=1 OR FMO=2) THEN EXIT *REPEAT *Decided I was too busy to do this option, maybe later FMO=1 *=========================================================================== ==== *Get Set OPEN 'DICT', FILENAME TO DH ELSE CALL SCREEN.MSG('Cannot Open dict for ':FILENAME:';b;c;h') OPEN '', FILENAME TO FH ELSE CALL SCREEN.MSG('Cannot Open dict for ':FILENAME:';b;c;h') SS= 'SSELECT DICT ':FILENAME:' TO 9 BY LOC BY.DSND @ID WITH F1 LIKE "D..." ' SS:='AND WITH @ID UNLIKE "B$..." AND WITH F16 NE "S"' PERFORM SS CAPTURING JUNK [EMAIL PROTECTED] HD='' CV='' FM='' LO=0 *=========================================================================== ==== *Build Dict Control LOOP READNEXT DID FROM 9 ELSE EXIT IF (DID[1,1]='F' AND OCONV(DID[2,21],'MCA')="") THEN CONTINUE READ DICT.REC FROM DH, DID ELSE CONTINUE ATTR=DICT.REC<2> IF ATTR=0 THEN ID.HEAD=CHANGE(CHANGE(DICT.REC<4>,' ','') ,@VM,' ') END ELSE CV<ATTR>=DICT.REC<3> READV HD.DESC FROM DH, "F":ATTR, 61 THEN HD<ATTR>=TRIM(HD.DESC) END ELSE HD<ATTR>=TRIM(CHANGE(DICT.REC<4>,@VM,' ')) END FM<ATTR>=DICT.REC<5> END REPEAT NITEMS=DCOUNT(CV,@AM) *=========================================================================== ==== * How're we gonna process? IF LIST.SAVED THEN PERFORM 'GET.LIST Display':PROCESS.ID PERFORM 'DELETE.LIST Display':PROCESS.ID CAPTURING JUNK END ELSE MORE=FIELD(EXTRA.IP,' ',1) MORE=EXTRA.IP[COL2(),999] IF MORE THEN CRT 'SELECT ':FIELD(EXTRA.IP,' ',1):' ':MORE PERFORM 'SELECT ':FIELD(EXTRA.IP,' ',1):' ':MORE END ELSE SELECT FH END END *=========================================================================== ==== * Enough messing around, lets do it LOOP READNEXT ID ELSE EXIT READ FILE.REC FROM FH, ID ELSE CONTINUE PRINT PRINT FILENAME:' - ':ID LO+=1 IF LO>MAXL THEN GOSUB HEADINGS AC=DCOUNT(FILE.REC,@AM) IF NITEMS>AC THEN AC=NITEMS FOR I=1 TO AC IF FMO=1 THEN VC=DCOUNT(FILE.REC<I>,@VM) IF VC <= 1 THEN *PRINT (I:' ':HD<I>)"L#25":' ':FMT(OCONV(FILE.REC<I>,CV<I>),FM<I>) IF BP THEN PRINT I"L#5":OCONV(FILE.REC<I>,CV<I>) END ELSE PRINT (I:' ':HD<I>)"L#25":' ':OCONV(FILE.REC<I>,CV<I>) END LO+=1 IF LO>MAXL THEN GOSUB HEADINGS END ELSE FOR J=1 TO VC *PRINT (I:',':J:' ':HD<I>)"L#25":' ':FMT(OCONV(FILE.REC<I,J>,CV<I>),FM<I>) PRINT (I:',':J:' ':HD<I>)"L#25":' ':OCONV(FILE.REC<I,J>,CV<I>) LO+=1 IF LO>MAXL THEN GOSUB HEADINGS NEXT END END NEXT REPEAT RETURN *=========================================================================== ==== HEADINGS: PRINT 'Hit any key to stop': INPUT BUBA IF BUBA THEN PERFORM "CLEARSELECT";STOP LO=0 PRINT CLR:FILENAME:' - ':ID RETURN *=========================================================================== ==== -----Original Message----- From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED] Behalf Of [EMAIL PROTECTED] Sent: Thursday, February 07, 2008 12:52 To: u2-users@listserver.u2ug.org Subject: Re: [U2] a data view utility of great use Very nice. I changed LINES.PAGE under HOUSEKEEPING from <snip> ------- u2-users mailing list u2-users@listserver.u2ug.org To unsubscribe please visit http://listserver.u2ug.org/