**
**BASIC
**11-22-08 13:03:11
**11/25/06
**TOM PHILLIPS
**WWW.TOM-PHILLIPS.INFO
**Copyright 2008 by SQUASH. All rights reserved. 
**
*
* QDSEARCHA - A utility to search all dictionaries in an account
*             for items where ALL of the search strings are present.
*
*             The dictionary item search includes the key.
*
* Note: a change is needed for R83 based systems concerning the
*       master dictionary define file code (i.e. "D").
*
EQU GLBL.R83 TO 0;* SET TO 1 IF R83 BASED SYSTEM
*
*EQU AM TO @AM;* NORMALLY CHAR(254)
EQU AM TO CHAR(254)
PROMPT ''
PROCREAD PROC.RCD THEN PROC.RCD='';TERM.FLG=0 ELSE TERM.FLG=1
*
BEGIN CASE
 CASE (GLBL.R83)
  SRCH.FDC='D'
  MDCT.NAM='MD'
  MDCT.ITM='*A1'
 CASE 1
  SRCH.FDC='F'
  MDCT.NAM='VOC'
  MDCT.ITM='F1'
END CASE
OPEN '',MDCT.NAM TO MDCT ELSE PRINT \Can't open \:MDCT.NAM;STOP 
*
SRCH.CDE='"':SRCH.FDC:']"'
*
SRCH.IDX=0
SRCH.IDS=''
LOOP 
 IF (TERM.FLG) THEN PRINT 'Enter a search string: ':
 INPUT SRCH.ITM
UNTIL SRCH.ITM='' DO
 SRCH.IDX=SRCH.IDX+1
 SRCH.IDS<SRCH.IDX>=SRCH.ITM
REPEAT 
IF NOT(SRCH.IDX) THEN STOP 
*
EXEC.SEL='SSELECT ':MDCT.NAM:' WITH ':MDCT.ITM:' ':SRCH.CDE
EXECUTE EXEC.SEL
DICT.IDS=''
ITEM.END=0
LOOP
 READNEXT DICT.NAM ELSE ITEM.END=1
UNTIL (ITEM.END) DO
 DICT.IDS<-1>=DICT.NAM
REPEAT
LAST.LIN=DCOUNT(DICT.IDS,AM)
IF NOT(LAST.LIN) THEN STOP
*
FOR DICT.CTR=1 TO LAST.LIN
 DICT.NAM=DICT.IDS<DICT.CTR>
 OPEN 'DICT',DICT.NAM TO DFIL THEN
  SELECT DFIL
  ITEM.END=0
  LOOP 
   READNEXT ITEM.KEY ELSE ITEM.END=1
  UNTIL (ITEM.END) DO 
   READ ITEM.REC FROM DFIL,ITEM.KEY THEN
    IF INDEX('ASX',ITEM.REC<1>[1,1],1) THEN
     DISP.PRT=0
     ITEM.REC=INSERT(ITEM.REC,1;ITEM.KEY)
     FLAG.ALL=1
     FOR LOOP.IDX=1 TO SRCH.IDX
      IF NOT(INDEX(ITEM.REC,SRCH.IDS<LOOP.IDX>,1)) THEN
       LOOP.IDX=SRCH.IDX+1
       FLAG.ALL=0
      END
     NEXT LOOP.IDX
     IF (FLAG.ALL) THEN
      FOR LOOP.IDX=1 TO SRCH.IDX
       ITEM.LMT=DCOUNT(ITEM.REC,AM)
       FOR ITEM.LIN=1 TO ITEM.LMT
        IF INDEX(ITEM.REC<ITEM.LIN>,SRCH.IDS<LOOP.IDX>,1) THEN
         IF NOT(DISP.PRT) THEN
          HEADING ' '
          PRINT
          PRINT 'Dict: ':DICT.NAM:'  Item: ':ITEM.KEY
          DISP.PRT=1
         END
         IF ITEM.REC<ITEM.LIN>#ITEM.KEY THEN
          PRINT ITEM.LIN-1:': ':ITEM.REC<ITEM.LIN>
          IF SRCH.IDX>1 THEN ITEM.REC<ITEM.LIN>=''
         END
        END
       NEXT ITEM.LIN
      NEXT LOOP.IDX
     END
    END
   END
  REPEAT 
 END
NEXT DICT.CTR
*
STOP
*
END