Hi Barb, Here's a program I wrote a long time ago that searches through all of the DICT items in all of the files on the system for whatever is desired that makes use of multiple active lists. This runs on an ROI Systems U2 environment and would need tweaking for other U2 environments in respect to the printing output headings and output device selection. The way this works is through use of the 'SELECT TO' and 'READLIST FROM' statement/options. U2 allows up to 10 active lists (list 0 through list 9) but I've never seen anyone use more than two.....
I'm not sure if this group accepts attachments or not, so I've just included the text. Hope this helps! Any questions, feel free to call me! Anyone wanting the original program in attachment form just send an email directly to me and I'll send it to you so we don't bog the listserver down. * Release Info * CUSTOM * SEARCH.ALL.DICTS - Search dicts everywhere for something or other Version="~Ver=~7.0.4~1746729103~" *===/============================================================\===* * / Written by Allen E. Elwood 07/07/95 - AK Savage Software \ * =We= *<------------------------------------------------------------------>* =Be= * \ (c) Copyright 1995 by AK Savage Software - All Rights Reserved / * =Bad!= *===\============================================================/===* * * Yeah, I know I could have written a screen for this and it would have looked * a whole lot better, but then it takes more work to install and that's a pain * *#* COPY COPY.TOOLS.BP STANDARD.VARIABLES.1 (REPLACING PGM.NAME BY SEARCH.ALL.DICTS, FN.NAME BY SEARCH.ALL.DICTS, IO.OPEN.OPTS BY TERM.DATA:LOCK) ;*#* Copied Source Follows (06-25-03) $INCLUDE STANDARD.COMMON.VARIABLES FROM COPY.TOOLS.BP $INCLUDE STANDARD.COMMON.APP.PROGRAMS FROM COPY.TOOLS.BP $INCLUDE STANDARD.VARIABLES.END FROM COPY.TOOLS.BP PGM.NAME='SEARCH.ALL.DICTS'; FN.NAME ='SEARCH.ALL.DICTS' CALL IO.OPEN('TERM.DATA:LOCK',PASSWORDS) *#* $INCLUDE COM.ECA FROM COPY.TOOLS.BP $INCLUDE COM.PRINTER FROM COPY.TOOLS.BP *=========================================================================== ==== GOSUB GET.INPUTS GOSUB SELECT.FILES GOSUB MAIN.PROCESS */\/\/\* STOP *\/\/\/* *=========================================================================== ==== GET.INPUTS:* LOOP PRINT 'Search all dicts for what : ':;INPUT SEARCH.VALUE PRINT 'Will search for : "':SEARCH.VALUE:'"' PRINT 'OK? (Y/N/END) ':;INPUT YORN LOOP YORN = UPCASE(YORN) IF YORN = 'END' THEN STOP IF YORN = 'Y' THEN EXIT IF YORN = 'N' THEN EXIT REPEAT IF YORN = 'Y' THEN EXIT REPEAT LOOP PRINT 'Custom or all dicts (C/ALL) : ':;INPUT CUSTOM.FLAG CUSTOM.FLAG = UPCASE(CUSTOM.FLAG) IF CUSTOM.FLAG # 'C' AND CUSTOM.FLAG # 'ALL' THEN CONTINUE IF CUSTOM.FLAG = 'C' THEN PRINT 'Will search Custom dicts only' END ELSE PRINT 'Will search ALL dicts' END PRINT 'OK? (Y/N/END) ':;INPUT YORN LOOP YORN = UPCASE(YORN) IF YORN = 'END' THEN STOP IF YORN = 'Y' THEN EXIT IF YORN = 'N' THEN EXIT REPEAT IF YORN = 'Y' THEN EXIT REPEAT LOOP PRINT 'You can search the entire dict record, or just attrs 1-9 where ' PRINT 'the meaninful stuff is. Searching Entire will be ...S.L.O.W...' PRINT 'Slow or Quick(S/Q) : ':;INPUT SLOW.QUICK SLOW.QUICK = UPCASE(SLOW.QUICK) IF SLOW.QUICK = 'S' THEN PRINT 'Search S.L.O.W' IF SLOW.QUICK = 'Q' THEN PRINT 'Search Quick' IF SLOW.QUICK # 'S' AND SLOW.QUICK # 'Q' THEN CONTINUE PRINT 'OK? (Y/N/END) ':;INPUT YORN LOOP YORN = UPCASE(YORN) IF YORN = 'END' THEN STOP IF YORN = 'Y' THEN EXIT IF YORN = 'N' THEN EXIT REPEAT IF YORN = 'Y' THEN EXIT REPEAT RPT.TITLE = 'Search All Dicts' IF CUSTOM.FLAG = 'C' THEN CUSTOM.MSG = 'Custom Dicts only' END ELSE CUSTOM.MSG = 'All Dicts' END RPT.TITLE<2> = 'Search ':CUSTOM.MSG:' for ':SEARCH.VALUE LINE.SIZE = P_I.Max_Cols_Per_Line MAX.LINES = P_I.Lines_Per_Page *#* COPY COPY.TOOLS.BP STANDARD.REPORT.HEADING.1 ;*#* Copied Source Follows * ACCT.TITLE = ('Sys ':SYS.NAME<1>:' Acct ':LOGON.ACCOUNT)[40] CALL GET.TD(TIME.DAY.DATE,'LSF','','','','') * ACCT.LEN = LEN(ACCT.TITLE) TD.LEN = LEN(TIME.DAY.DATE) CO.LEN = LEN(COMPANY.NAME[1,30]) LEN.MIDDLE = (ACCT.LEN + TD.LEN + CO.LEN) SPACING = (((93-LEN.MIDDLE)*(LEN.MIDDLE<93))+((98-LEN.MIDDLE)*(LEN.MIDDLE>=93))) CO.LEN = (30-((4-SPACING)*(SPACING<4))); SPACING += (30-CO.LEN) * HEAD.1 = FMT(FN.NAME,'L#21'):' ':TIME.DAY.DATE:SPACE(SPACING/2):COMPANY.NAME[1,CO.LEN]:SPACE(SPACING/2):ACC T.TITLE:' Page ' HEAD.2 = SPACE(66-LEN(RPT.TITLE<1>)/2):RPT.TITLE<1> HEAD.3 = SPACE(66-LEN(RPT.TITLE<2>)/2):RPT.TITLE<2> HEAD.4 = SPACE(66-LEN(RPT.TITLE<3>)/2):RPT.TITLE<3> HEAD.5 = SPACE(66-LEN(RPT.TITLE<4>)/2):RPT.TITLE<4> PAGE.CNT = 0 LINE.CNT = 99 * *#* LINE.SIZE = P_I.Max_Cols_Per_Line MAX.LINES = P_I.Lines_Per_Page RETURN *=========================================================================== ==== SELECT.FILES:* MSG = 'SELECT VOC WITH F1 EQ "F" "DIR" TO 2' PRINT MSG PERFORM MSG SELECTED = @SYSTEM.RETURN.CODE IF SELECTED < 1 THEN PRINT 'Apparently all the files are gone, oh, my....God....' STOP END RETURN *=========================================================================== ==== MAIN.PROCESS:* CNTR = 0 LOOP READNEXT FILE.ID FROM 2 ELSE EXIT * No Q !!!! FINDSTR 'Q.' IN FILE.ID SETTING SKIP.IT ELSE SKIP.IT = '' CNTR += 1 IF NOT(MOD(CNTR,10)) THEN CRT CNTR IF SKIP.IT THEN CONTINUE MSG = '' GOSUB OUTPUT.LINE MSG = 'Search DICT file: ':FILE.ID GOSUB OUTPUT.LINE OPEN 'DICT', FILE.ID TO DICT.HANDLE ELSE MSG = 'Could not open dict for ':FILE.ID GOSUB OUTPUT.LINE CONTINUE END GOSUB SEARCH.DICTS REPEAT RETURN *=========================================================================== ==== SEARCH.DICTS:* GOSUB SELECT.DICTS IF SELECTED < 1 THEN RETURN LOOP READNEXT DICT.ID FROM 3 ELSE EXIT READ DICT.REC FROM DICT.HANDLE, DICT.ID ELSE DICT.REC = '' GOSUB SEARCH.ONE.RECORD REPEAT RETURN *=========================================================================== ==== SEARCH.ONE.RECORD:* ATTR.COUNT = DCOUNT(DICT.REC,@AM) IF SLOW.QUICK = 'Q' THEN ATTR.COUNT = 9 FINDSTR SEARCH.VALUE IN DICT.ID SETTING FOUND ELSE FOUND = 0 IF FOUND THEN MSG = 'Found: ':SEARCH.VALUE:' in the id of dict; ':DICT.ID:', file:':FILE.ID GOSUB OUTPUT.LINE END FOR I = 1 TO ATTR.COUNT FINDSTR SEARCH.VALUE IN DICT.REC<I> SETTING FOUND ELSE FOUND = 0 IF FOUND THEN MSG = 'Found: ':SEARCH.VALUE:' in file: ':FILE.ID:', dict: ':DICT.ID MSG := ' Value: ':DICT.REC<I> GOSUB OUTPUT.LINE EXIT END NEXT I RETURN *=========================================================================== ==== SELECT.DICTS:* MSG = 'SELECT DICT ':FILE.ID IF CUSTOM.FLAG = 'C' THEN MSG:=" WITH F60 EQ 'Y'" END MSG:= ' TO 3' PERFORM MSG CAPTURING USELESS.TEXT SELECTED = @SYSTEM.RETURN.CODE RETURN *=========================================================================== ==== OUTPUT.LINE:* CALL PRINTER.ON("","") MSG.OUT='.NF':@AM:MSG CALL FORMAT.TEXT(MSG.OUT,LINE.SIZE,MSGO,MSGC) FOR EYE=1 TO MSGC IF LINE.CNT > MAX.LINES THEN GOSUB HEADINGS LINE.CNT+=1 PRINT MSGO<EYE> NEXT EYE PRINT LINE.CNT+=1 CALL PRINTER.OFF("","") RETURN *=========================================================================== ==== HEADINGS:* PAGE.CNT+=1 PRINT TOP.OF.PAGE[DO.FF]; DO.FF = 1 PRINT HEAD.1:PAGE.CNT PRINT HEAD.2 PRINT HEAD.3 PRINT HEAD.4 PRINT LINE.CNT=5 RETURN *=========================================================================== ==== *=========================================================================== ==== * This *is* THE END END Allen E. Elwood Senior Programmer Analyst Curnayn and Associates Direct (818) 361-5251 Fax (818) 361-5251 Cell (818) 359-8162 Home (818) 361-7217 -----Original Message----- From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED] Behalf Of Riffel-Darter, Barbara We are writing unibasic programs to create extract files for pivotlink and very new to unidata environment. Is there anyway to have two or more active savedlist at any one time keeping the readnext pointers in sync? ===rest of orig msg snipped=== * Release Info * CUSTOM * SEARCH.ALL.DICTS - Search dicts everywhere for something or other Version="~Ver=~7.0.4~1746729103~" *===/============================================================\===* * / Written by Allen E. Elwood 07/07/95 - AK Savage Software \ * =We= *<------------------------------------------------------------------>* =Be= * \ (c) Copyright 1995 by AK Savage Software - All Rights Reserved / * =Bad!= *===\============================================================/===* * * Yeah, I know I could have written a screen for this and it would have looked * a whole lot better, but then it takes more work to install and that's a pain * *#* COPY COPY.TOOLS.BP STANDARD.VARIABLES.1 (REPLACING PGM.NAME BY SEARCH.ALL.DICTS, FN.NAME BY SEARCH.ALL.DICTS, IO.OPEN.OPTS BY TERM.DATA:LOCK) ;*#* Copied Source Follows (06-25-03) $INCLUDE STANDARD.COMMON.VARIABLES FROM COPY.TOOLS.BP $INCLUDE STANDARD.COMMON.APP.PROGRAMS FROM COPY.TOOLS.BP $INCLUDE STANDARD.VARIABLES.END FROM COPY.TOOLS.BP PGM.NAME='SEARCH.ALL.DICTS'; FN.NAME ='SEARCH.ALL.DICTS' CALL IO.OPEN('TERM.DATA:LOCK',PASSWORDS) *#* $INCLUDE COM.ECA FROM COPY.TOOLS.BP $INCLUDE COM.PRINTER FROM COPY.TOOLS.BP *============================================================================ === GOSUB GET.INPUTS GOSUB SELECT.FILES GOSUB MAIN.PROCESS */\/\/\* STOP *\/\/\/* *============================================================================ === GET.INPUTS:* LOOP PRINT 'Search all dicts for what : ':;INPUT SEARCH.VALUE PRINT 'Will search for : "':SEARCH.VALUE:'"' PRINT 'OK? (Y/N/END) ':;INPUT YORN LOOP YORN = UPCASE(YORN) IF YORN = 'END' THEN STOP IF YORN = 'Y' THEN EXIT IF YORN = 'N' THEN EXIT REPEAT IF YORN = 'Y' THEN EXIT REPEAT LOOP PRINT 'Custom or all dicts (C/ALL) : ':;INPUT CUSTOM.FLAG CUSTOM.FLAG = UPCASE(CUSTOM.FLAG) IF CUSTOM.FLAG # 'C' AND CUSTOM.FLAG # 'ALL' THEN CONTINUE IF CUSTOM.FLAG = 'C' THEN PRINT 'Will search Custom dicts only' END ELSE PRINT 'Will search ALL dicts' END PRINT 'OK? (Y/N/END) ':;INPUT YORN LOOP YORN = UPCASE(YORN) IF YORN = 'END' THEN STOP IF YORN = 'Y' THEN EXIT IF YORN = 'N' THEN EXIT REPEAT IF YORN = 'Y' THEN EXIT REPEAT LOOP PRINT 'You can search the entire dict record, or just attrs 1-9 where ' PRINT 'the meaninful stuff is. Searching Entire will be ...S.L.O.W...' PRINT 'Slow or Quick(S/Q) : ':;INPUT SLOW.QUICK SLOW.QUICK = UPCASE(SLOW.QUICK) IF SLOW.QUICK = 'S' THEN PRINT 'Search S.L.O.W' IF SLOW.QUICK = 'Q' THEN PRINT 'Search Quick' IF SLOW.QUICK # 'S' AND SLOW.QUICK # 'Q' THEN CONTINUE PRINT 'OK? (Y/N/END) ':;INPUT YORN LOOP YORN = UPCASE(YORN) IF YORN = 'END' THEN STOP IF YORN = 'Y' THEN EXIT IF YORN = 'N' THEN EXIT REPEAT IF YORN = 'Y' THEN EXIT REPEAT RPT.TITLE = 'Search All Dicts' IF CUSTOM.FLAG = 'C' THEN CUSTOM.MSG = 'Custom Dicts only' END ELSE CUSTOM.MSG = 'All Dicts' END RPT.TITLE<2> = 'Search ':CUSTOM.MSG:' for ':SEARCH.VALUE LINE.SIZE = P_I.Max_Cols_Per_Line MAX.LINES = P_I.Lines_Per_Page *#* COPY COPY.TOOLS.BP STANDARD.REPORT.HEADING.1 ;*#* Copied Source Follows * ACCT.TITLE = ('Sys ':SYS.NAME<1>:' Acct ':LOGON.ACCOUNT)[40] CALL GET.TD(TIME.DAY.DATE,'LSF','','','','') * ACCT.LEN = LEN(ACCT.TITLE) TD.LEN = LEN(TIME.DAY.DATE) CO.LEN = LEN(COMPANY.NAME[1,30]) LEN.MIDDLE = (ACCT.LEN + TD.LEN + CO.LEN) SPACING = (((93-LEN.MIDDLE)*(LEN.MIDDLE<93))+((98-LEN.MIDDLE)*(LEN.MIDDLE>=93))) CO.LEN = (30-((4-SPACING)*(SPACING<4))); SPACING += (30-CO.LEN) * HEAD.1 = FMT(FN.NAME,'L#21'):' ':TIME.DAY.DATE:SPACE(SPACING/2):COMPANY.NAME[1,CO.LEN]:SPACE(SPACING/2):ACCT .TITLE:' Page ' HEAD.2 = SPACE(66-LEN(RPT.TITLE<1>)/2):RPT.TITLE<1> HEAD.3 = SPACE(66-LEN(RPT.TITLE<2>)/2):RPT.TITLE<2> HEAD.4 = SPACE(66-LEN(RPT.TITLE<3>)/2):RPT.TITLE<3> HEAD.5 = SPACE(66-LEN(RPT.TITLE<4>)/2):RPT.TITLE<4> PAGE.CNT = 0 LINE.CNT = 99 * *#* LINE.SIZE = P_I.Max_Cols_Per_Line MAX.LINES = P_I.Lines_Per_Page RETURN *============================================================================ === SELECT.FILES:* MSG = 'SELECT VOC WITH F1 EQ "F" "DIR" TO 2' PRINT MSG PERFORM MSG SELECTED = @SYSTEM.RETURN.CODE IF SELECTED < 1 THEN PRINT 'Apparently all the files are gone, oh, my....God....' STOP END RETURN *============================================================================ === MAIN.PROCESS:* CNTR = 0 LOOP READNEXT FILE.ID FROM 2 ELSE EXIT * No Q !!!! FINDSTR 'Q.' IN FILE.ID SETTING SKIP.IT ELSE SKIP.IT = '' CNTR += 1 IF NOT(MOD(CNTR,10)) THEN CRT CNTR IF SKIP.IT THEN CONTINUE MSG = '' GOSUB OUTPUT.LINE MSG = 'Search DICT file: ':FILE.ID GOSUB OUTPUT.LINE OPEN 'DICT', FILE.ID TO DICT.HANDLE ELSE MSG = 'Could not open dict for ':FILE.ID GOSUB OUTPUT.LINE CONTINUE END GOSUB SEARCH.DICTS REPEAT RETURN *============================================================================ === SEARCH.DICTS:* GOSUB SELECT.DICTS IF SELECTED < 1 THEN RETURN LOOP READNEXT DICT.ID FROM 3 ELSE EXIT READ DICT.REC FROM DICT.HANDLE, DICT.ID ELSE DICT.REC = '' GOSUB SEARCH.ONE.RECORD REPEAT RETURN *============================================================================ === SEARCH.ONE.RECORD:* ATTR.COUNT = DCOUNT(DICT.REC,@AM) IF SLOW.QUICK = 'Q' THEN ATTR.COUNT = 9 FINDSTR SEARCH.VALUE IN DICT.ID SETTING FOUND ELSE FOUND = 0 IF FOUND THEN MSG = 'Found: ':SEARCH.VALUE:' in the id of dict; ':DICT.ID:', file:':FILE.ID GOSUB OUTPUT.LINE END FOR I = 1 TO ATTR.COUNT FINDSTR SEARCH.VALUE IN DICT.REC<I> SETTING FOUND ELSE FOUND = 0 IF FOUND THEN MSG = 'Found: ':SEARCH.VALUE:' in file: ':FILE.ID:', dict: ':DICT.ID MSG := ' Value: ':DICT.REC<I> GOSUB OUTPUT.LINE EXIT END NEXT I RETURN *============================================================================ === SELECT.DICTS:* MSG = 'SELECT DICT ':FILE.ID IF CUSTOM.FLAG = 'C' THEN MSG:=" WITH F60 EQ 'Y'" END MSG:= ' TO 3' PERFORM MSG CAPTURING USELESS.TEXT SELECTED = @SYSTEM.RETURN.CODE RETURN *============================================================================ === OUTPUT.LINE:* CALL PRINTER.ON("","") MSG.OUT='.NF':@AM:MSG CALL FORMAT.TEXT(MSG.OUT,LINE.SIZE,MSGO,MSGC) FOR EYE=1 TO MSGC IF LINE.CNT > MAX.LINES THEN GOSUB HEADINGS LINE.CNT+=1 PRINT MSGO<EYE> NEXT EYE PRINT LINE.CNT+=1 CALL PRINTER.OFF("","") RETURN *============================================================================ === HEADINGS:* PAGE.CNT+=1 PRINT TOP.OF.PAGE[DO.FF]; DO.FF = 1 PRINT HEAD.1:PAGE.CNT PRINT HEAD.2 PRINT HEAD.3 PRINT HEAD.4 PRINT LINE.CNT=5 RETURN *============================================================================ === *============================================================================ === * This *is* THE END END ------- u2-users mailing list [EMAIL PROTECTED] To unsubscribe please visit http://listserver.u2ug.org/
