SUBROUTINE ITRANS(RTN.VALUE, FILENAME, KEYS, IKEY, IMODE) * By David A. Green -- 08Nov99 * Translate to an I-Descriptor Subroutine. Version="~Ver=~7.0.20~165450149~" * COPYRIGHT 1999-2002 DAG Consulting * DAG Consulting - 480-813-1725 * Email = DGreen@DAGConsulting.com * URL = http://www.dagconsulting.com ! EQUATE TRUE TO 1, FALSE TO 0 COMMON /ITRANS/ FLAG, F.FILE, D.DICT ! ABORT.FLAG = FALSE RTN.VALUE = "" VM.PTR = 0 * IF FLAG # @WHO:FILENAME THEN GOSUB INIT IF NOT(ABORT.FLAG) THEN GOSUB SAVE.VARIABLES MV.FLAG = (DCOUNT(KEYS, @VM) > 1) KEYS = KEYS ;* Reset Remove Pointer since not assigned in Sub MORE.KEYS = (KEYS # "") LOOP WHILE MORE.KEYS DO KEY = REMOVE(KEYS, MORE.KEYS) @ID = KEY @DICT = D.DICT VM.PTR += 1 READ IDESC FROM @DICT, IKEY THEN READ @RECORD FROM F.FILE, @ID THEN IF MV.FLAG THEN RTN.VALUE<1, VM.PTR> = LOWER(ITYPE(IDESC)) END ELSE RTN.VALUE<1, VM.PTR> = ITYPE(IDESC) END END ELSE BEGIN CASE CASE IMODE = "X" ; RTN.VALUE<1, -1> = "" CASE IMODE = "C" ; RTN.VALUE<1, -1> = @ID CASE IMODE = "V" ; RTN.VALUE<1, -1> = @ID:" Not Found in ":FILENAME:"!" END CASE END END ELSE RTN.VALUE = "I-Descriptor ":IKEY:" Not Found!" MORE.KEYS = "" END REPEAT GOSUB RESTORE.VARIABLES END RETURN ! SAVE.VARIABLES: IF FILEINFO(@DICT, 0) = 0 THEN @DICT = "" SAVE.DICT = @DICT SAVE.RECORD = @RECORD SAVE.ID = @ID RETURN ! RESTORE.VARIABLES: @DICT = SAVE.DICT @RECORD = SAVE.RECORD @ID = SAVE.ID RETURN ! INIT: OPEN FILENAME TO F.FILE ELSE ABORT.FLAG = TRUE RTN.VALUE = "Can't open ":FILENAME END * IF NOT(ABORT.FLAG) THEN OPEN "DICT", FILENAME TO D.DICT ELSE ABORT.FLAG = TRUE RTN.VALUE = "Can't open DICT of ":FILENAME END END * IF NOT(ABORT.FLAG) THEN FLAG = @WHO:FILENAME RETURN ! END