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/
