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) 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