PROGRAM DAG_ADD_DICTS
     * Add Dictionary Records from a Paragraph
     * by David A. Green -- 9/17/01
       Version="~Ver=~7.1.25~772608111~"
     *
     *#* COPY COPY.TOOLS.BP STANDARD.VARIABLES.1 (REPLACING PGM.NAME BY DAG_ADD_DICTS, FN.NAME BY DAG_ADD_DICTS) ;*#* Copied Source Follows (11-18-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='DAG_ADD_DICTS'; FN.NAME ='DAG_ADD_DICTS'
     CALL IO.OPEN('IO.OPEN.OPTS',PASSWORDS)
     *#*
     EQUATE TRUE TO 1, FALSE TO 0
     *
     GOSUB INIT
     GOSUB OPEN.FILES
     IF NOT(ABORT.FLAG) THEN GOSUB ADD.DICTS
     *
     IF NOT(ABORT.FLAG) THEN CLOSE D.FILE
     STOP
     !
INIT:
     ABORT.FLAG = FALSE
     PROMPT ''
     @USER.RETURN.CODE = 0
     DICT.ITEMS        = ""
     DICT.CNT          = 0
     ASSOCIATIONS      = ""
     *
     INPUT FILE.NAME
     INPUT FIELD.SEPS
     AM.SEP = FIELD.SEPS[1, 1]
     VM.SEP = FIELD.SEPS[2, 1]
     SM.SEP = FIELD.SEPS[3, 1]
     LOOP
        INPUT DICT.REC
     WHILE DICT.REC # "END" DO
        DICT.ITEMS<-1> = TRIMS(CONVERT(AM.SEP, @VM, DICT.REC))
        DICT.CNT += 1
     REPEAT
     RETURN
     !
OPEN.FILES:
     OPEN "DICT", FILE.NAME TO D.FILE ELSE
        PRINT "Can't open DICT ":FILE.NAME
        ABORT.FLAG = TRUE
     END
     RETURN
     !
ADD.DICTS:
     FOR DICT.PTR=1 TO DICT.CNT
        DICT.REC = RAISE(DICT.ITEMS<DICT.PTR>)
        GOSUB GET.DICT.NAME
        IF VM.SEP THEN SWAP VM.SEP WITH @VM IN DICT.REC
        IF SM.SEP THEN SWAP SM.SEP WITH @SM IN DICT.REC
        GOSUB GET.DICT.CNV
        GOSUB GET.DICT.TYPE
        GOSUB GET.DATA.TYPE
        GOSUB FORMAT.HEADING
        IF DICT.TYPE # "PH" THEN GOSUB WRITE.DICT.REC
        IF DICT.TYPE = "I" THEN GOSUB COMPILE.DICT
     NEXT DICT.PTR
     *
     IF ASSOCIATIONS THEN
        ASSOC.CNT = DCOUNT(ASSOCIATIONS<1>, @VM)
        FOR ASSOC.PTR = 1 TO ASSOC.CNT
           DICT.NAME = ASSOCIATIONS<1, ASSOC.PTR>
           DICT.REC    = "PH"
           DICT.REC<2> = CONVERT(@SM, " ", ASSOCIATIONS<2, ASSOC.PTR>)
           GOSUB WRITE.DICT.REC
        NEXT ASSOC.PTR
     END
     RETURN
     !
WRITE.DICT.REC:
     WRITE DICT.REC ON D.FILE, DICT.NAME
     RETURN
     !
GET.DICT.NAME:
     DICT.NAME = DICT.REC<1>
     DEL DICT.REC<1>
     RETURN
     !
GET.DICT.CNV:
     DICT.CNV = DICT.REC<3>
     IF DICT.CNV[1, 2] = "MD" THEN
        SWAP "CDEC" WITH CDEC IN DICT.CNV
        SWAP "PDEC" WITH PDEC IN DICT.CNV
        SWAP "SDEC" WITH SDEC IN DICT.CNV
        SWAP "QDEC" WITH QDEC IN DICT.CNV
        SWAP "IDEC" WITH IDEC IN DICT.CNV
     END ELSE
        SWAP "CDEC" WITH "MD":CDEC IN DICT.CNV
        SWAP "PDEC" WITH "MD":PDEC IN DICT.CNV
        SWAP "SDEC" WITH "MD":SDEC IN DICT.CNV
        SWAP "QDEC" WITH "MD":QDEC IN DICT.CNV
        SWAP "IDEC" WITH "MD":IDEC IN DICT.CNV
     END
     DICT.REC<3> = DICT.CNV
     RETURN
     !
GET.DICT.TYPE:
     DICT.TYPE = UPCASE(FIELD(DICT.REC<1>, " ", 1))
     IF DICT.TYPE = "V" THEN DICT.TYPE = "I"
     IF DICT.TYPE = "PH" THEN
        ASSOC.NAME = DICT.NAME
        DICT.NAME  = DICT.REC<2>
     END
     RETURN
     !
GET.DATA.TYPE:
     ASSOC.NAME = DICT.REC<7>
     BEGIN CASE
        CASE DICT.REC<6> = ""  ; DICT.REC<6> = "S"
        CASE DICT.REC<6> = "S" ; DICT.REC<7> = ""
        CASE ASSOC.NAME  # ""  ; GOSUB DO.ASSOC
     END CASE
     RETURN
     !
DO.ASSOC:
     LOCATE ASSOC.NAME IN ASSOCIATIONS<1, 1> SETTING VM.POS THEN
        LOCATE DICT.NAME IN ASSOCIATIONS<2, VM.POS, 1> SETTING SM.POS ELSE
           ASSOCIATIONS<2, VM.POS, -1> = DICT.NAME
        END
     END ELSE
        ASSOCIATIONS<1, -1> = ASSOC.NAME
        ASSOCIATIONS<2, -1> = DICT.NAME
     END
     RETURN
     !
FORMAT.HEADING:
     IF DCOUNT(DICT.REC<4>, @VM) = 1 THEN
        GOSUB GET.COL.LEN
        DICT.DATA = DICT.REC<4>
        HEAD.CNT  = 1
        FIELD.CNT = DCOUNT(DICT.DATA, " ")
        DICT.HEAD = FIELD(DICT.DATA, " ", 1)
        FOR FIELD.PTR = 2 TO FIELD.CNT
           WORD.HEAD = FIELD(DICT.DATA, " ", FIELD.PTR)
           IF (LEN(DICT.HEAD<1, HEAD.CNT>) + LEN(WORD.HEAD) + 1) > DICT.LEN THEN
              HEAD.CNT += 1
              DICT.HEAD<1, HEAD.CNT> = WORD.HEAD
           END ELSE
              DICT.HEAD<1, HEAD.CNT> := " ":WORD.HEAD
           END
        NEXT FIELD.PTR
        DICT.REC<4> = DICT.HEAD
     END
     RETURN
     !
GET.COL.LEN:
     DICT.FMT = DICT.REC<5>
     DICT.LEN = LEN(FIELD(FMT(SPACE(1024), DICT.FMT), @TM, 1))
     RETURN
     !
COMPILE.DICT:
     CMD = "COMPILE.DICT ":FILE.NAME:" ":DICT.NAME
     PERFORM CMD CAPTURING BUFF
     IF @SYSTEM.RETURN.CODE # 0 THEN
        @USER.RETURN.CODE = @SYSTEM.RETURN.CODE
        MORE.BUFF = (BUFF # "")
        LOOP WHILE MORE.BUFF DO
           ERR.LINE = REMOVE(BUFF, MORE.BUFF)
           PRINT ERR.LINE
        REPEAT
     END
     RETURN
     !
     END