*     Name        - ATTLIST
*     Called By   - TCL
*     Description - Utilities - Attribute Useage for File
*     Version     - 25 Nov 2000 - INTERNET
*     Written - Nine Elms Solutions Ltd
*
*<-----------------------------------  COPYRIGHT NOTICE  ----------------------------------->
*                 Copyright 2000 - code@nineelms.com
*
*     THIS HEADER MUST REMAIN INTACT IN THIS AND ANY CHANGED VERSION OF THIS ROUTINE
*
* ATTLIST may be used and modified free of charge by anyone so long as this
* copyright notice and comments above remain intact. By using this code you
* agree to indemnify Nine Elms Solutions Ltd from any liability that may arise from its use.
*
* Selling the code for this program without prior written consent is
* expressly forbidden. In other words, please ask first before you try and
* make money off my program.
*
* Obtain permission before redistributing this software over the Internet or
* in any other medium. In all cases copyright and the header must remain intact
*
*<------------------------------------------------------------------------------------------>
*
   PROMPT ""
*
   EQU TILDE TO CHAR(126)
   EQU BUZ TO CHAR(7), SVM TO CHAR(252), VM TO CHAR(253), AM TO CHAR(254)
   REVON       = '' ;* Set to your own Preference
   REVOFF      = '' ;* Set to your own Preference
   EOL         = @(-4)
   EOS         = @(-3)
   ESC         = CHAR(27)
   COMMAND     = SENTENCE()
   FILENAME    = FIELD(COMMAND,' ',2)
   TODAY       = OCONV(DATE(),'D4')
   BUF         = ''
   WHO         = OCONV('','U50BB')
   PORT        = FIELD(WHO,' ',1)
   ACCOUNT     = FIELD(WHO,' ',2)
   PROGNAME    = "ATTLIST"
   FINISHED    = "0"
   HDRS        = STR('*',79) 
   HDRP        = STR('*',119)
   SCREENTITLE = "Utilities - Attribute Useage for File"
*
   OPEN "MD"       TO MD       ELSE X = 'MD' ;GOTO 9001
*
   USERNAME = 'Enter your User name here'
   VOIDIT = '*'
   ICOMS  = '*<'
   SYST = 'Nine Elms Solutions Ltd'
*
   DIM COL(50),ROW(50),MAX(50),IVAL(50),HMESS(50),SC(50),SPC(50)
   MAT SC = '' ;MAT COL = '' ;MAT ROW = '';MAT MAX = '';MAT IVAL = '' ;MAT HMESS = '';MAT SPC = '0'
*
   FOR J = 1 TO 4
     COL(J) = '32' ;ROW(J) = 3+J ;SPC(J) = '31' ;IVAL(J) = 'X '
   NEXT J
   MAX(1) = 1 ;MAX(2) = 1 ;MAX(3) = 35 ;MAX(4) = 3 ;MAX(5) = 3 ;IVAL(3) = 'X.-? '
*
* Initialise variables
*
   INP = ''

   IF FILENAME NE '' THEN
     INP = FILENAME
     GOSUB VERIFY.FILENAME

     IF NOT(ERROR) THEN
       INP      = FILENAME
       FINISHED = 1
     END
   END ELSE FINISHED = 0
*
* Pick up a valid FILENAME if not in TCL Statement
*
   GOSUB 3000 ;* Call screen setup routines

   IF NOT(FINISHED) THEN
     OK = 0

     LOOP UNTIL OK DO
       CRT @(0,10):EOS:@(10,10):"Enter a valid Filename ('":VOIDIT:"' OR 'E' to exit) : ":;INPUT INP

       IF INP = VOIDIT OR INP = 'E' THEN STOP
       FILENAME = INP
       GOSUB VERIFY.FILENAME

       IF NOT(ERROR) THEN
         INP = FILENAME
         OK  = 1
       END
     REPEAT
   END
*
   IF INP = '' THEN
     GOTO 7000 
   END ELSE
     IF ATTREC = '' THEN GOTO 6000 ELSE GOTO 6500
   END
*
   3000 ***   Displays skeleton screen
*
   CRT CHAR(12):@(0,0):TODAY : @(20,0):SCREENTITLE:@(65):PROGNAME 'R#15'
   G  = LEN(USERNAME)
   SP = INT((79-G)/2)
   CRT @(0,1):SPACE(SP):USERNAME
   TXT =  'Filename ':FILENAME
   G   = LEN(TXT)
   SP2 = INT((79-G)/2)
   CRT @(0,2):SPACE(SP2):TXT
*
* Redisplay data area of screen
*
   3100    RETURN
*
* Process File and set up Display Record
*
   6000
   CNT  = 0
   ATTS = ''
   CRT @(10,12): 'Processing ':FILENAME:
   SELECT FNAM
   FINISHED = 0

   LOOP
     READNEXT ID ELSE FINISHED = 1
   UNTIL FINISHED DO

     READ REC FROM FNAM,ID THEN
       CNT = CNT + 1
       IF INT(CNT/1000) = CNT/1000 THEN CRT @(40,12):CNT 'L#6'
       NO.OF.ATTS = DCOUNT(REC,AM)
*
       FOR ATTLINE = 1 TO NO.OF.ATTS

         IF REC<ATTLINE> NE '' THEN
           ATTS<ATTLINE,2> = ATTS<ATTLINE,2> + 1
         END
         IF DCOUNT(REC<ATTLINE>,VM) GT 1 THEN ATTS<ATTLINE,3> = 'mv'
         IF DCOUNT(REC<ATTLINE>,SVM) GT 1 THEN ATTS<ATTLINE,4> = 'smv'
       NEXT ATTLINE
     END
   REPEAT
   CRT @(40,12):CNT 'L#6'
*
* Now Insert Dictionary Descriptions into ATTS array
*
   IF DICTITEMS THEN
     FINISHED = 0
     SELECT DFNAM
     DICTN = '' ;* To hold all numeric Dictionary Items Used
*
     LOOP
       READNEXT ID ELSE FINISHED = 1
     UNTIL FINISHED DO

       IF NOT(ID = FILENAME OR ID = 'ATTLIST') THEN

         READ REC FROM DFNAM,ID THEN
           NUMERIC.ID = 0

           IF ID = REC<2> THEN
             NUMERIC.ID = 1
             IF DICTN<REC<2>+1> THEN NUMERIC.ID = 0
           END
*
           IF REC<1> EQ 'S' OR REC<1> = 'A' THEN
             ATTNO = REC<2>

             IF NOT(ATTNO = 99 OR ATTNO = 0 OR ATTNO GT "200") THEN

               IF NOT(REC<8>[1,1] EQ 'A' OR REC<8>[1,1] EQ 'F') AND NOT(DICTN<REC<2>+1>) OR NUMERIC.ID THEN
                 DESC = CONVERT(REC<3>,VM,' ')
                 DESC = CONVERT(DESC,'-','')
                 DESC = CONVERT(DESC,'_','')
                 DESC = TRIM(DESC)
                 DESC = OCONV(DESC,'MCT')

                 IF DESC NE '' THEN
                   ATTS<ATTNO,1> = DESC
                 END
                 IF REC<7>[1,1] = 'D' OR REC<7>[1,1]='M' THEN ATTS<ATTNO,5> = REC<7>
                 IF REC<8>[1,1] = 'D' OR REC<8>[1,1]='M' THEN ATTS<ATTNO,6> = REC<8>
                 IF NUMERIC.ID THEN DICTN<REC<2>+1> = 1
               END
               LOCATE ID IN ATTS<ATTNO,7>,1 BY 'AL' SETTING POSFND ELSE NULL
               INS ID BEFORE ATTS<ATTNO,7,POSFND>
             END
           END
         END
       END
     REPEAT
*
     NO.OF.FIELDS = DCOUNT(ATTS,AM)
     FOR XX = 1 TO NO.OF.FIELDS
       IF ATTS<XX,1> = '' THEN ATTS<XX,1> = XX
     NEXT XX
     WRITE ATTS ON DFNAM,'FILENOTE'
   END
*
   GOSUB 3000
   ATTRECORD = ''
   TEXT      = 'Att  Description''L#31':'No''R#6':' mv smv ICONV OCONV Dict Id'
   FILE.DESC = 'File Name : - ''R#30':FILENAME:' on ACCOUNT : - ':ACCOUNT
   CRT @(0,3):'  ':TEXT

*
   FOR XX = 1 TO NO.OF.FIELDS
     DET = XX 'R#3':'  '
     DET = DET : ATTS<XX,1> 'L#25': ' '
     DET = DET : ATTS<XX,2>'R#6':' '
     DET = DET : ATTS<XX,3> 'L#3'
     DET = DET : ATTS<XX,4>'L#4'
     DET = DET : ATTS<XX,5>'L#5':' '
     DET = DET : ATTS<XX,6>'L#5':' '
     DET = DET : ATTS<XX,7,1>'L#10'
     IF XX GT 200 THEN DET = DET :ID
     LINE = MOD(XX,18)
     IF NOT(LINE) THEN LINE = 18
     LINE = LINE + 3
     CRT @(2,LINE):DET
*
     IF XX/18 = INT(XX/18) THEN
       CRT @(0,23):'Press RTN to Page or "':VOIDIT:'" to END':;INPUT TX
       IF TX = VOIDIT THEN STOP

       CRT CHAR(12):@(0,0):TODAY : @(20,0):SCREENTITLE:@(65):PROGNAME 'R#15'
       CRT @(0,1):SPACE(SP):USERNAME
       CRT @(0,2):SPACE(SP2):TXT
       CRT @(0,3):'  ':TEXT:EOS:
     END
     ATTRECORD<-1> = DET
   NEXT XX
*
   CRT @(0,23):EOL:@(0,23): 'Press RTN ':;INPUT TX
   INS TEXT BEFORE ATTRECORD<1>
   INS FILE.DESC BEFORE ATTRECORD<1>
   WRITE ATTRECORD ON DFNAM,'ATTLIST'
   GOTO 7000
*
* Display Existing Details
*
   6500
   FOR XX = 1 TO 2
     DEL ATTREC<1>
   NEXT XX
   NO.OF.FIELDS = DCOUNT(ATTREC,AM)

   GOSUB 3000
   TEXT = 'Att  Description''L#31':'No''R#6':' mv smv ICONV OCONV Dict ID'
   CRT @(0,3):'  ':TEXT
*
   FOR XX = 1 TO NO.OF.FIELDS
     DET  = ATTREC<XX>
     LINE = MOD(XX,18)
     IF NOT(LINE) THEN LINE = 18
     LINE = LINE + 3
     CRT @(2,LINE):DET

     IF XX/18 = INT(XX/18) THEN
       CRT @(0,23):'Press RTN to Page or "':VOIDIT:'" to END':;INPUT TX
       IF TX = VOIDIT THEN STOP

       CRT CHAR(12):@(0,0):TODAY : @(20,0):SCREENTITLE:@(65):PROGNAME 'R#15'
       CRT @(0,1):SPACE(SP):USERNAME
       CRT @(0,2):SPACE(SP2):TXT
       CRT @(0,3):'  ':TEXT:EOS:
     END
   NEXT XX
   CRT @(0,23):EOL:@(0,23):'Press RTN ':;INPUT TX,1:
   GOTO 7000
*
   7000 *
   STOP
*
* Check that the File and Dictionary exist on the Account
*
   VERIFY.FILENAME:
   ERROR  = 0
   ATTREC = ''

   IF FILENAME = 'MD' THEN 
     ERROR = 3
   END ELSE

     READ REC FROM MD,FILENAME THEN
*
       BEGIN CASE
         CASE REC<1>[1,1] = 'P'
           ERROR = 2
*
         CASE REC<1> = 'Q' OR REC<1>[1,1] = 'D'
           OPEN FILENAME TO FNAM ELSE ERROR = 1
           DICTITEMS = 1
*
           IF NOT(ERROR) THEN
             OPEN 'DICT',FILENAME TO DFNAM ELSE DICTITEMS = 0
*
             IF DICTITEMS THEN
               READ ATTREC FROM DFNAM,'ATTLIST' ELSE ATTREC = ''
*
               IF ATTREC NE '' THEN
                 GOSUB 3000
                 ENTEREDOK = 0
*
                 LOOP UNTIL ENTEREDOK DO
                   CRT @(0,4):EOL:@(10,4): 'Reuse Previous Details Y/N/E ':;INPUT TX
                   BEGIN CASE
                     CASE TX = 'N' ;ATTREC = '';ENTEREDOK = 1
                     CASE TX = 'Y' ;ENTEREDOK = 1
                     CASE TX = 'E' ;STOP
                   END CASE
                 REPEAT
               END
             END
           END
*
         CASE 1
           ERROR = 1
       END CASE
     END ELSE ERROR = 1
   END
*
   IF ERROR THEN
     BEGIN CASE
       CASE ERROR = 1
         ERRMSG = 'The Filename ':FILENAME:' entered is not recognised on this Account'
       CASE ERROR = 2
         ERRMSG = 'The name ':FILENAME:' entered is that of a system VERB or PROC'
       CASE ERROR = 3
         ERRMSG = 'The MASTER DICTIONARY name is not permitted'
     END CASE
     CRT @(0,23):EOL:@(0,23):ERRMSG:;INPUT TX
     CRT @(0,23):EOL:
   END
   RETURN
*
*   Fatal Error Routines
*
   9000  MESS = "This Program Must be Run from a Proc";GOTO 9999
   9001  MESS = "No ":X:" file";GOTO 9999
   9002  MESS = "You are not privileged to use this option";GOTO 9999
*
   9999  CRT @(0,23):EOL:@(5,23):MESS:
   INPUT ANS,1:
   END