*******************************************************************************
*
*	uniVerse port of PI/open ENTRO.AS.IBAS subroutine
*
*	Module	%M%	Version	%I% 	Date	%H%
*
*	(c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
*	This is unpublished proprietary source code of Ardent Software Inc.
*	The copyright notice above does not evidence any actual or intended
*	publication of such source code.
*
*******************************************************************************
*
*	Maintenance log - insert most recent change descriptions at top
*
*	Date.... GTAR# WHO Description.........................................
*	10/14/98 23801 SAP Change copyrights. 
*	02/24/93 11038 PVW Check for '@' being phrase instead of '@ID'.
*	12/07/92 10213 DPB Misc. Fixes
*	12/02/92 10213 PVW Further changes
*	12/02/92 10213 PVW Change UVPRINTMSG to *UVPRINTMSG
*	11/12/92 10213 PVW Port PI/open ENTRO to replace uniVerse REVISE.
*
*******************************************************************************

$OPTIONS INFORMATION

      SUBROUTINE REVISE.ASSOC (MAT SYMBOLS, MAT MACRO,
         SENT, NOUN, MAT D.D, PROCESS.ITEM, MAT VERIFY,
         STRIPSTRINGS, EXPAND, DICT.DATA.FILE, FNAME,
         ORIGINAL.SENTENCE, NUMBER.OF.PROMPTS, MAXIMUM.PROMPTS)

$INCLUDE UNIVERSE.INCLUDE REVISE.H
$INCLUDE UNIVERSE.INCLUDE VERBINSERT.H

      @SYSTEM.SET = 0
      ERROR.CODE = 0

      DIM SYMBOLS(20)
      DIM MACRO(20)
      DIM D.D(20)
      DIM VERIFY(20)

      GROUPS = ''
      NO.GROUPS = ''
      GROUP.XREF = ''
      AT.REVISE.REC = ''

      MACRO.ID = RV$AT.REVISE
      READ AT.REVISE.REC FROM DICT.DATA.FILE, MACRO.ID THEN
         IF AT.REVISE.REC<2> = '' THEN
            @SYSTEM.SET = -1

            CALL *UVPRINTMSG(001596,"")  ;* insufficient privileges
            STOP
         END
      END

      IF SYMBOLS(NOUN) = '' THEN
         GOSUB PROCESS.MACRO
      END

      NUMBER.OF.PROMPTS = 0
      HadId = 0
      SINGLE.VALUES.ONLY = TRUE
      GOSUB PROCESS.NOUNS
      SINGLE.VALUES.ONLY = FALSE
      GOSUB PROCESS.NOUNS
*
*     Verify that file id has been mentioned once and only once.
*
      MAT VERIFY = ''
      ID.FOUND = FALSE
      FOR I = 1 TO NUMBER.OF.PROMPTS
         IF D.D(I)<1,RV$PRO.FLD.LOCATION> = 0 THEN
            ID.FOUND = TRUE
            IF I # 1 THEN
               TEMP.D.D = D.D(I)
               D.D(I) = D.D(1)
               D.D(1) = TEMP.D.D
            END
         END
      NEXT I

      IF NOT(ID.FOUND) THEN
PROCESS.AT.ID:
         READ AT.ID.REC FROM DICT.DATA.FILE,RV$AT.ID ELSE
            AT.ID.REC = @FM:0:@FM:@FM:'RECORD ID':@FM:'25L'
         END
         IF AT.ID.REC<4> EQ '' THEN AT.ID.REC<4> = 'RECORD ID'

         FOR I = NUMBER.OF.PROMPTS TO 1 STEP -1
            D.D(I+1) = D.D(I)
         NEXT I

         D.D(1) = FNAME
         D.D(1)<1,RV$PRO.FLD.LOCATION> = AT.ID.REC<2>
         D.D(1)<1,RV$PRO.FLD.CONVERSION> = AT.ID.REC<3>
         D.D(1)<1,RV$PRO.FLD.DISPLAY> = AT.ID.REC<4>
         D.D(1)<1,RV$PRO.FLD.FORMAT> = AT.ID.REC<5>

         NUMBER.OF.PROMPTS += 1

         IF NUMBER.OF.PROMPTS >= MAXIMUM.PROMPTS THEN
            @SYSTEM.SET = -1
            STOP 'The Maximum number of prompt fields (':MAXIMUM.PROMPTS:') allowed in REVISE has been exceeded'
         END

      END
      RETURN

***** subroutines follow ******************************************************
*
*     The following subroutine processes the list of nouns in
*     the symbol table. 'I' types are handled under SYMBOLS(ITYPE).
*
PROCESS.NOUNS:
      I = 1
      LOOP Q = SYMBOLS(NOUN)<I> UNTIL Q = '' DO

         ID = Q<1,1>
         WORD.NO = Q<1,2>
         DICT.REC = SYMBOLS(WORD.NO)

         IF NOT(NUM(DICT.REC<2>)) THEN
            @SYSTEM.SET = -1
            PRINT "The location (":DICT.REC<2>:") for token '":ID:"' is not valid."
            STOP
         END

         GRP.NAME = ""
         IF DICT.REC[1,1] = 'D' THEN
            SINGLE.VALUE = TRUE
            IF DICT.REC<6>[1,1] = 'M' THEN
               SINGLE.VALUE = FALSE
               GRP.NAME = DICT.REC<7>
            END
         END ELSE
            SINGLE.VALUE = FALSE
            BEGIN CASE
            CASE DICT.REC<4>[1,2] = 'C;' OR DICT.REC<8>[1,3] = 'D1;'
               GRP.NAME = 'DC':DICT.REC<2>
            CASE DICT.REC<4>[1,2] = 'D;' OR DICT.REC<8>[1,3] = 'D2;'
               GRP.NAME = 'DC':FIELD(DICT.REC<4>,';',2)
            CASE 1
               GRP.NAME = ''
            END CASE
         END

         BEGIN CASE
            CASE SINGLE.VALUES.ONLY AND NOT(SINGLE.VALUE)
               NULL
            CASE NOT(SINGLE.VALUES.ONLY) AND SINGLE.VALUE
               NULL
            CASE GRP.NAME NE ''
               IF INDEX(GROUPS:@FM,@FM:GRP.NAME:@FM,1) THEN
                  * group already done *
                  NULL
               END ELSE
                  GOSUB PROCESS.GROUP
               END
            CASE 1
               IF DICT.REC<2,1> = 0 AND HadId = 1 THEN GOTO SKIPTO
               HadId = 1
               NUMBER.OF.PROMPTS += 1
               IF NUMBER.OF.PROMPTS >= MAXIMUM.PROMPTS THEN
                  @SYSTEM.SET = -1
                  PRINT 'The Maximum number of prompt fields (':MAXIMUM.PROMPTS:') allowed in REVISE has been exceeded'
                  STOP
               END

               D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.LOCATION> = DICT.REC<2,1>
               IF DICT.REC<1> = 'D' THEN
                  D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.CONVERSION> = DICT.REC<3,1>
                  D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.FORMAT> = DICT.REC<5,1>
                  NAME = DICT.REC<4>
               END ELSE
                  D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.CONVERSION> = DICT.REC<8>
                  D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.FORMAT> = DICT.REC<10,1>:DICT.REC<9,1>
                  NAME = DICT.REC<3>
               END

               D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.BRIEFHELP> = ID
               D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.NAME> = ID

               GOSUB GET.DISPLAY.NAME

               IF NOT(SINGLE.VALUE) THEN
                  GOSUB FORMAT.DISPLAY.NAME
                  NO.GROUPS += 1
                  IF NO.GROUPS EQ 1 THEN
                     PROCESS.ITEM<RV$PRO.SCREEN.HEADING,1> = UVREADMSG(010269,"")
                  END
                  D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.SCREEN.NO> = NO.GROUPS + 1
                  GRP.NAME = Q<1,1>
                  PROCESS.ITEM<RV$PRO.SCREEN.HEADING,NO.GROUPS + 1> = GRP.NAME
                  GROUPS := @FM:GRP.NAME
               END
         END CASE
SKIPTO:
         I += 1
      REPEAT
      RETURN
*
*     The following subroutine processes associations.
*
PROCESS.GROUP:
      READ GRP FROM DICT.DATA.FILE,GRP.NAME ELSE
         @SYSTEM.SET = -1
         PRINT "The Association name in field ",Q<1,1>,"is not defined on the "
         PRINT "Dictionary of",FNAME
         STOP
      END
* GET THE ASSOCIATION PHRASE
      FMC=2
      X=''
MORE.GRP:
      X := GRP<FMC>
      IF X[LEN(X),1]='_' THEN
         X=X[1,LEN(X)-1]:' '
         FMC+=1
         GO MORE.GRP
      END
      GRP=TRIM(X)
      NO.GROUPS+=1                      ;* NEW ASSOCIATION
      IF NO.GROUPS EQ 1 THEN
         PROCESS.ITEM<RV$PRO.SCREEN.HEADING,1> = UVREADMSG(010269,"")
      END
      GROUPS := @FM:GRP.NAME
      PROCESS.ITEM<RV$PRO.SCREEN.HEADING,NO.GROUPS + 1> = GRP

      J=1
      LOOP ID = FIELD(GRP,' ',J) UNTIL ID='' DO
         READ DICT.REC FROM DICT.DATA.FILE,ID ELSE
            @SYSTEM.SET = -1
            PRINT "Member",ID,"in Association",GRP.NAME,"is not defined on the Dictionary of",FNAME
            STOP
         END

         IF DICT.REC[1,1] = 'D' OR DICT.REC[1,1] = 'A' OR DICT.REC[1,1] = 'S' THEN 

            NUMBER.OF.PROMPTS += 1
            IF NUMBER.OF.PROMPTS >= MAXIMUM.PROMPTS THEN
               @SYSTEM.SET = -1
               STOP 'The Maximum number of prompt fields (':MAXIMUM.PROMPTS:') allowed in REVISE has been exceeded'
            END

            D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.LOCATION> = DICT.REC<2,1>
            IF DICT.REC[1,1] = 'D' THEN
               D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.CONVERSION> = DICT.REC<3,1>
               D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.FORMAT> = DICT.REC<5,1>
               NAME = DICT.REC<4>
            END ELSE
               D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.CONVERSION> = DICT.REC<7,1>
               D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.FORMAT> = DICT.REC<10,1>:DICT.REC<9,1>
               NAME = DICT.REC<3>
            END

            D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.BRIEFHELP> = ID

            GOSUB GET.DISPLAY.NAME

            IF NOT(INDEX(@FM:SYMBOLS(NOUN),@FM:ID:@VM,1)) THEN
               D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.DISPLAYONLY> = 1
            END
            IF D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.DISPLAY> = '' THEN
               D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.DISPLAY> = ID
            END

            IF D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.LOCATION> = 0
            THEN
               D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.NAME> = "RECORD ID"
            END
            ELSE
               D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.NAME> = ID
            END

            GOSUB FORMAT.DISPLAY.NAME

            GROUP.XREF<NO.GROUPS,-1> = NUMBER.OF.PROMPTS
            D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.SCREEN.NO> = NO.GROUPS + 1
         END
         J += 1
      REPEAT
      RETURN
*
*     The following subroutine formats the display name
*
GET.DISPLAY.NAME:
      IF NAME = '' THEN
         IF D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.LOCATION> = 0 THEN
            NAME = "RECORD ID"
         END
         ELSE
            NAME = ID
         END
      END ELSE
         IF INDEX(NAME,@VM,1) THEN CONVERT @VM TO ' ' IN NAME
      END
      D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.DISPLAY> = NAME
      RETURN
*
*     The following subroutine ensures the field is wide enough to
*     display the column header.
*
FORMAT.DISPLAY.NAME:
      FORMAT=D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.FORMAT>
      FOR Y=1 TO 10 UNTIL NUM(FORMAT[Y,1]) ; NEXT Y
      FOR X=Y TO 10 WHILE NUM(FORMAT[X,1]) ; NEXT X
      WIDE=FORMAT[Y,X-Y]

      COLUMN.HEADER.WIDTH = LEN(D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.NAME>)

      IF WIDE < COLUMN.HEADER.WIDTH THEN
         COLUMN.HEADER.WIDTH = LEN(D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.DISPLAY>)
         FORMAT=FORMAT[1,Y-1]:COLUMN.HEADER.WIDTH:FORMAT[X,10]
         D.D(NUMBER.OF.PROMPTS)<1,RV$PRO.FLD.FORMAT> = FORMAT
      END
      RETURN
*
*     The following subroutine processes the macro.
*
PROCESS.MACRO:
      IF AT.REVISE.REC NE '' THEN
         MATPARSE MACRO FROM AT.REVISE.REC,@FM
      END ELSE
         MACRO.ID = '@'
         MATREAD MACRO FROM DICT.DATA.FILE,MACRO.ID ELSE
            CALL @REVISE.PHRASE(DICT.DATA.FILE,X)
            IF X = '' THEN RETURN TO PROCESS.AT.ID
            MATPARSE MACRO FROM X, @FM
         END
      END
      IF MACRO(1)[1,2] = 'PH' THEN
MORE.MACRO:
         IF MACRO(2)[LEN(MACRO(2)),1] = '_' THEN
            MACRO(2) = TRIM(MACRO(2)[1,LEN(MACRO(2))-1])
            MORE.FLAG = TRUE
         END ELSE
            MORE.FLAG = FALSE
         END
         SENT := ' ':MACRO(2)

         IF MORE.FLAG THEN
            MACRO(2) = MACRO(0)<1>
            IF MACRO(2) NE '' THEN
               MACRO(0) = DELETE(MACRO(0),1,0,0)
               GO MORE.MACRO
            END
         END

         OUTBUF=''
         CALL @STRIPSTRINGS(SENT,MAT SYMBOLS)
         CALL @EXPAND(SENT,OUTBUF,MAT SYMBOLS, ERROR.CODE)

         IF ERROR.CODE THEN
            @SYSTEM.SET = -1
            STOP
         END

         SENT=OUTBUF
      END ELSE
         @SYSTEM.SET = -1
         CALL *UVPRINTMSG(001600,MACRO.ID)   ;* record not PHrase
         STOP
      END
      RETURN

   END