C DATATRIEVE INTERFACE FUNCTIONS
c optional for VAX VMS AnalytiCalc
C Include by linking with DTRIF.FOR
C Exclude by linking with DTRIF.FTN
C
c
c Attempt to provide a reasonable interface to DTR by
c allowing passing of commands to DTR both interactively and
c from within a cell, and retrieving numbers and text into
c cells. Also permit sending replies to DTR (for replies in
c procedures) from text in cells or numbers (values) in cells
c so that interaction is two-way.
c
C GLENN EVERHART 1985
	SUBROUTINE DTRINI
C INITIALIZE DATATRIEVE
C CALLED AT START OF PROGRAM, ONCE-FOR-ALL.
C ***
c
c FORTRAN DATATRIEVE Access Block
c
	LOGICAL*1 DAB$B_BID, DAB$B_BLN, DAB$B_VER_LETTER, DAB(100)
	INTEGER*2 DAB$W_MSG_BUF_LEN, DAB$W_MSG_LEN,
	1	  DAB$W_AUX_BUF_LEN, DAB$W_AUX_LEN,
	2	  DAB$W_IDI, DAB$W_STATE, DAB$W_REC_LENGTH,
	3	  DAB$W_VERSION, DAB$W_LEVEL, DAB$W_BASE_LEVEL,
	4	  DAB$W_UDK_INDEX, DAB$W_COLUMNS_PAGE,
	5	  DAB$W_TT_CHANNEL
	LOGICAL*4 DAB$A_MSG_BUF, DAB$A_AUX_BUF,
	1	  DAB$L_CONDITION, DAB$L_FLAGS, DAB$L_OPTIONS
	COMMON /DAB_COMMON/ 
	1	DAB$B_BID, 
	2	DAB$B_BLN, 
	3	DAB$L_CONDITION,
	4	DAB$A_MSG_BUF,
	5 	DAB$W_MSG_BUF_LEN, 
	6	DAB$W_MSG_LEN,
	7	DAB$A_AUX_BUF, 
	8	DAB$W_AUX_BUF_LEN, 
	9	DAB$W_AUX_LEN,
	1	DAB$W_IDI, 
	2	DAB$W_STATE, 
	3	DAB$L_FLAGS, 
	4	DAB$L_OPTIONS,
	5	DAB$W_REC_LENGTH, 
	6	DAB$W_VERSION, 
	7	DAB$W_LEVEL, 
	8	DAB$B_VER_LETTER, 
	9	DAB$W_BASE_LEVEL, 
	1	DAB$W_UDK_INDEX,
	2	DAB$W_COLUMNS_PAGE,
	3	DAB$W_TT_CHANNEL
	EQUIVALENCE (DAB, DAB$B_BID)
	INTEGER    DTR$K_STL_CMD, DTR$K_STL_PRMPT, DTR$K_STL_LINE,
	1	   DTR$K_STL_MSG, DTR$K_STL_PGET, DTR$K_STL_PPUT,
	2	   DTR$K_STL_CONT, DTR$K_STL_UDK, DTR$K_STL_END_UDK
	PARAMETER (DTR$K_STL_CMD=1,
 	1	   DTR$K_STL_PRMPT=2,
	2	   DTR$K_STL_LINE=3,
	3	   DTR$K_STL_MSG=4,
	4	   DTR$K_STL_PGET=5,
	5	   DTR$K_STL_PPUT=6,
	6	   DTR$K_STL_CONT=7,
	7	   DTR$K_STL_UDK=8,
	8	   DTR$K_STL_END_UDK=9)
	INTEGER DTR$K_SEMI_COLON_OPT, DTR$K_UNQUOTED_LIT,
	1	DTR$K_SYNTAX_PROMPT, DTR$K_IMMED_RETURN,
	2	DTR$K_FORMS_ENABLE, DTR$K_VERIFY, DTR$K_CONTEXT_SEARCH,
	3	DTR$K_HYPHEN_DISABLED, DTR$K_MORE_COMMANDS, DTR$K_ABORT,
	4	DTR$K_LOCK_WAIT
	PARAMETER (DTR$K_SEMI_COLON_OPT=1,
	1	   DTR$K_UNQUOTED_LIT=16,
	2	   DTR$K_SYNTAX_PROMPT=32,
	3	   DTR$K_IMMED_RETURN=64,
	4	   DTR$K_FORMS_ENABLE=128,
	5	   DTR$K_VERIFY=256,
	6	   DTR$K_CONTEXT_SEARCH=2048,
	7	   DTR$K_HYPHEN_DISABLED=4096,
	8	   DTR$K_MORE_COMMANDS=8192,
	9	   DTR$K_ABORT=16384,
	1	   DTR$K_LOCK_WAIT=32768)
	INTEGER	   DTR$M_OPT_CMD, DTR$M_OPT_PRMPT,   DTR$M_OPT_LINE,
	1	   DTR$M_OPT_MSG, DTR$M_OPT_PGET, DTR$M_OPT_PPUT,
	2	   DTR$M_OPT_CONT, DTR$M_OPT_UDK, DTR$M_OPT_DTR_UDK,
	3	   DTR$M_OPT_END_UDK, DTR$M_OPT_UNWIND, 
	4	   DTR$M_OPT_CONTROL_C, DTR$M_OPT_STARTUP, 
	5	   DTR$M_OPT_FOREIGN, DTR$M_OPT_BANNER, DTR$M_OPT_REMOVE_CTLC
	PARAMETER (DTR$M_OPT_CMD=1,
	1	   DTR$M_OPT_PRMPT=2,
	2	   DTR$M_OPT_LINE=4,
	3	   DTR$M_OPT_MSG=8,
	4	   DTR$M_OPT_PGET=16,
	5	   DTR$M_OPT_PPUT=32,
	6	   DTR$M_OPT_CONT=64,
	7	   DTR$M_OPT_UDK=128,
	8	   DTR$M_OPT_DTR_UDK=256,
	9	   DTR$M_OPT_END_UDK=512,
	1	   DTR$M_OPT_UNWIND=1024,
	2	   DTR$M_OPT_CONTROL_C=2048,
	3	   DTR$M_OPT_STARTUP=4096,
	4	   DTR$M_OPT_FOREIGN=8192,
	5	   DTR$M_OPT_BANNER=16384,
	6	   DTR$M_OPT_REMOVE_CTLC=32768)
	INTEGER    DTR$K_UDK_SET, DTR$K_UDK_SET_NO, DTR$K_UDK_SHOW,
	1	   DTR$K_UDK_STATEMENT,  DTR$K_UDK_COMMAND
	PARAMETER (DTR$K_UDK_SET=1,	
	1	   DTR$K_UDK_SET_NO=2,
	2	   DTR$K_UDK_SHOW=3,
	3	   DTR$K_UDK_STATEMENT=4,
	4	   DTR$K_UDK_COMMAND=5)
	INTEGER	   DTR$K_TOK_TOKEN, DTR$K_TOK_PICTURE, 
	1	   DTR$K_TOK_FILENAME, DTR$K_TOK_COMMAND,
	2	   DTR$K_TOK_TEST_TOKEN
	PARAMETER (DTR$K_TOK_TOKEN=1,
	1	   DTR$K_TOK_PICTURE=2,
	2	   DTR$K_TOK_FILENAME=3,
	3	   DTR$K_TOK_COMMAND=4,
	4	   DTR$K_TOK_TEST_TOKEN=5)
	INTEGER*4 DTR$INIT
	INTEGER RET_STATUS
	CHARACTER*232  MSG_BUFF
	CHARACTER*232  AUX_BUFF
	COMMON /DTR$BUFFERS/MSG_BUFF,AUX_BUFF
	EXTERNAL   DTR$_SUCCESS,SS$_NORMAL
C ***
C ********>>>>>>>><<<<<<<<********
	RET_STATUS=DTR$INIT(DAB,100,MSG_BUFF,AUX_BUFF,
     1  DTR$K_SEMI_COLON_OPT+DTR$K_FORMS_ENABLE+
     2  DTR$K_UNQUOTED_LIT)
C DTR NOW STALLS AT COMMAND INPUT AWAITING INPUT.
C LET *U FUNCTIONS HANDLE FROM THERE.
	IF(RET_STATUS.NE.%LOC(SS$_NORMAL))THEN
	CALL UVT100(1,1,1)
	WRITE(6,1000)RET_STATUS
1000	FORMAT(' *** DATATRIEVE INITIALIZATION FAILED. ***',I6)
	END IF
	RETURN
	END
	SUBROUTINE DTRFIN
C INITIALIZE DATATRIEVE
C CALLED AT END OF PROGRAM, ONCE-FOR-ALL.
C ***
c
c FORTRAN DATATRIEVE Access Block
c
	LOGICAL*1 DAB$B_BID, DAB$B_BLN, DAB$B_VER_LETTER, DAB(100)
	INTEGER*2 DAB$W_MSG_BUF_LEN, DAB$W_MSG_LEN,
	1	  DAB$W_AUX_BUF_LEN, DAB$W_AUX_LEN,
	2	  DAB$W_IDI, DAB$W_STATE, DAB$W_REC_LENGTH,
	3	  DAB$W_VERSION, DAB$W_LEVEL, DAB$W_BASE_LEVEL,
	4	  DAB$W_UDK_INDEX, DAB$W_COLUMNS_PAGE,
	5	  DAB$W_TT_CHANNEL
	LOGICAL*4 DAB$A_MSG_BUF, DAB$A_AUX_BUF,
	1	  DAB$L_CONDITION, DAB$L_FLAGS, DAB$L_OPTIONS
	COMMON /DAB_COMMON/ 
	1	DAB$B_BID, 
	2	DAB$B_BLN, 
	3	DAB$L_CONDITION,
	4	DAB$A_MSG_BUF,
	5 	DAB$W_MSG_BUF_LEN, 
	6	DAB$W_MSG_LEN,
	7	DAB$A_AUX_BUF, 
	8	DAB$W_AUX_BUF_LEN, 
	9	DAB$W_AUX_LEN,
	1	DAB$W_IDI, 
	2	DAB$W_STATE, 
	3	DAB$L_FLAGS, 
	4	DAB$L_OPTIONS,
	5	DAB$W_REC_LENGTH, 
	6	DAB$W_VERSION, 
	7	DAB$W_LEVEL, 
	8	DAB$B_VER_LETTER, 
	9	DAB$W_BASE_LEVEL, 
	1	DAB$W_UDK_INDEX,
	2	DAB$W_COLUMNS_PAGE,
	3	DAB$W_TT_CHANNEL
	EQUIVALENCE (DAB, DAB$B_BID)
	INTEGER    DTR$K_STL_CMD, DTR$K_STL_PRMPT, DTR$K_STL_LINE,
	1	   DTR$K_STL_MSG, DTR$K_STL_PGET, DTR$K_STL_PPUT,
	2	   DTR$K_STL_CONT, DTR$K_STL_UDK, DTR$K_STL_END_UDK
	PARAMETER (DTR$K_STL_CMD=1,
 	1	   DTR$K_STL_PRMPT=2,
	2	   DTR$K_STL_LINE=3,
	3	   DTR$K_STL_MSG=4,
	4	   DTR$K_STL_PGET=5,
	5	   DTR$K_STL_PPUT=6,
	6	   DTR$K_STL_CONT=7,
	7	   DTR$K_STL_UDK=8,
	8	   DTR$K_STL_END_UDK=9)
	INTEGER DTR$K_SEMI_COLON_OPT, DTR$K_UNQUOTED_LIT,
	1	DTR$K_SYNTAX_PROMPT, DTR$K_IMMED_RETURN,
	2	DTR$K_FORMS_ENABLE, DTR$K_VERIFY, DTR$K_CONTEXT_SEARCH,
	3	DTR$K_HYPHEN_DISABLED, DTR$K_MORE_COMMANDS, DTR$K_ABORT,
	4	DTR$K_LOCK_WAIT
	PARAMETER (DTR$K_SEMI_COLON_OPT=1,
	1	   DTR$K_UNQUOTED_LIT=16,
	2	   DTR$K_SYNTAX_PROMPT=32,
	3	   DTR$K_IMMED_RETURN=64,
	4	   DTR$K_FORMS_ENABLE=128,
	5	   DTR$K_VERIFY=256,
	6	   DTR$K_CONTEXT_SEARCH=2048,
	7	   DTR$K_HYPHEN_DISABLED=4096,
	8	   DTR$K_MORE_COMMANDS=8192,
	9	   DTR$K_ABORT=16384,
	1	   DTR$K_LOCK_WAIT=32768)
	INTEGER	   DTR$M_OPT_CMD, DTR$M_OPT_PRMPT,   DTR$M_OPT_LINE,
	1	   DTR$M_OPT_MSG, DTR$M_OPT_PGET, DTR$M_OPT_PPUT,
	2	   DTR$M_OPT_CONT, DTR$M_OPT_UDK, DTR$M_OPT_DTR_UDK,
	3	   DTR$M_OPT_END_UDK, DTR$M_OPT_UNWIND, 
	4	   DTR$M_OPT_CONTROL_C, DTR$M_OPT_STARTUP, 
	5	   DTR$M_OPT_FOREIGN, DTR$M_OPT_BANNER, DTR$M_OPT_REMOVE_CTLC
	PARAMETER (DTR$M_OPT_CMD=1,
	1	   DTR$M_OPT_PRMPT=2,
	2	   DTR$M_OPT_LINE=4,
	3	   DTR$M_OPT_MSG=8,
	4	   DTR$M_OPT_PGET=16,
	5	   DTR$M_OPT_PPUT=32,
	6	   DTR$M_OPT_CONT=64,
	7	   DTR$M_OPT_UDK=128,
	8	   DTR$M_OPT_DTR_UDK=256,
	9	   DTR$M_OPT_END_UDK=512,
	1	   DTR$M_OPT_UNWIND=1024,
	2	   DTR$M_OPT_CONTROL_C=2048,
	3	   DTR$M_OPT_STARTUP=4096,
	4	   DTR$M_OPT_FOREIGN=8192,
	5	   DTR$M_OPT_BANNER=16384,
	6	   DTR$M_OPT_REMOVE_CTLC=32768)
	INTEGER    DTR$K_UDK_SET, DTR$K_UDK_SET_NO, DTR$K_UDK_SHOW,
	1	   DTR$K_UDK_STATEMENT,  DTR$K_UDK_COMMAND
	PARAMETER (DTR$K_UDK_SET=1,	
	1	   DTR$K_UDK_SET_NO=2,
	2	   DTR$K_UDK_SHOW=3,
	3	   DTR$K_UDK_STATEMENT=4,
	4	   DTR$K_UDK_COMMAND=5)
	INTEGER	   DTR$K_TOK_TOKEN, DTR$K_TOK_PICTURE, 
	1	   DTR$K_TOK_FILENAME, DTR$K_TOK_COMMAND,
	2	   DTR$K_TOK_TEST_TOKEN
	PARAMETER (DTR$K_TOK_TOKEN=1,
	1	   DTR$K_TOK_PICTURE=2,
	2	   DTR$K_TOK_FILENAME=3,
	3	   DTR$K_TOK_COMMAND=4,
	4	   DTR$K_TOK_TEST_TOKEN=5)
	CHARACTER*232  MSG_BUFF
	CHARACTER*232  AUX_BUFF
	COMMON /DTR$BUFFERS/MSG_BUFF,AUX_BUFF
	EXTERNAL   DTR$_SUCCESS
C ***
C ********>>>>>>>><<<<<<<<********
	CALL DTR$FINISH(DAB)
C CALLED JUST BEFORE EXIT. IF IT FAILS, TOO BAD...
C however, gives DTR a chance to clean up prior to image exit.
	RETURN
	END
	SUBROUTINE DTRCMD(LINE)
	LOGICAL*1 LINE(80)
	CHARACTER*62 LINEC
C	EQUIVALENCE(LINEC,LINE(1))
	INCLUDE 'VKLUGPRM.FTN'
C COPYRIGHT (C) 1983 GLENN EVERHART
C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS
C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY.
	INTEGER RETCD
	LOGICAL*1 AVBLS(20,27),WRK(128),VBLS(8,RRWP,RCLP)
	INTEGER*2 TYPE(RRWP,RCLP),VLEN(9)
	REAL*8 XAC,XVBLS(RRWP,RCLP)
	REAL*8 TAC,UAC,VAC,WAC,YAC
	REAL*8 TMP
	INTEGER*4 JVBLS(2,RRWP,RCLP)
	EQUIVALENCE(WAC,AVBLS(1,23)),(YAC,AVBLS(1,25))
	EQUIVALENCE(XAC,AVBLS(1,27))
	EQUIVALENCE(TAC,AVBLS(1,20))
	EQUIVALENCE(UAC,AVBLS(1,21))
	EQUIVALENCE(VAC,AVBLS(1,22))
	EQUIVALENCE(VBLS(1,1,1),JVBLS(1,1,1))
	EQUIVALENCE(VBLS(1,1,1),XVBLS(1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
	INTEGER*2 XTNCNT,XTCFG,IPSET
	LOGICAL*1 XTNCMD(80)
	INTEGER*2 FORMFG,RCFGX,PZAP,RCONE
	INTEGER*2 IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6
	COMMON/DOLLR/IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6
	INTEGER*2 RRWACT,RCLACT
	COMMON/RCLACT/RRWACT,RCLACT
	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE
	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C LOOP CONTROL FOR VARY FUNCTION. SET ZERO IN SPREDSHT AND
C MUST BE SET POSITIVE HERE IF WE NEED ITERATIONS.
C (IMPLEMENT FOR VAX ONLY)
	INTEGER KALKIT
	COMMON/VARYIT/KALKIT
C ARGUMENTS COME IN IN ARGUMENTS IN LINE
C RESULTS GO INTO PERCENT (XAC) AND WHEREVER ELSE DESIRED...
	INTEGER*2 PROW,PCOL,DROW,DCOL,DRWV,DCLV
	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	DIMENSION NRDSP(DRW,DCL),NCDSP(DRW,DCL)
	COMMON/D2R/NRDSP,NCDSP
C ADD DATATRIEVE DATA STMTS HERE
C ***
c
c FORTRAN DATATRIEVE Access Block
c
	LOGICAL*1 DAB$B_BID, DAB$B_BLN, DAB$B_VER_LETTER, DAB(100)
	INTEGER*2 DAB$W_MSG_BUF_LEN, DAB$W_MSG_LEN,
	1	  DAB$W_AUX_BUF_LEN, DAB$W_AUX_LEN,
	2	  DAB$W_IDI, DAB$W_STATE, DAB$W_REC_LENGTH,
	3	  DAB$W_VERSION, DAB$W_LEVEL, DAB$W_BASE_LEVEL,
	4	  DAB$W_UDK_INDEX, DAB$W_COLUMNS_PAGE,
	5	  DAB$W_TT_CHANNEL
	LOGICAL*4 DAB$A_MSG_BUF, DAB$A_AUX_BUF,
	1	  DAB$L_CONDITION, DAB$L_FLAGS, DAB$L_OPTIONS
	COMMON /DAB_COMMON/ 
	1	DAB$B_BID, 
	2	DAB$B_BLN, 
	3	DAB$L_CONDITION,
	4	DAB$A_MSG_BUF,
	5 	DAB$W_MSG_BUF_LEN, 
	6	DAB$W_MSG_LEN,
	7	DAB$A_AUX_BUF, 
	8	DAB$W_AUX_BUF_LEN, 
	9	DAB$W_AUX_LEN,
	1	DAB$W_IDI, 
	2	DAB$W_STATE, 
	3	DAB$L_FLAGS, 
	4	DAB$L_OPTIONS,
	5	DAB$W_REC_LENGTH, 
	6	DAB$W_VERSION, 
	7	DAB$W_LEVEL, 
	8	DAB$B_VER_LETTER, 
	9	DAB$W_BASE_LEVEL, 
	1	DAB$W_UDK_INDEX,
	2	DAB$W_COLUMNS_PAGE,
	3	DAB$W_TT_CHANNEL
	EQUIVALENCE (DAB, DAB$B_BID)
C DAB$W_STATE VALUES:
C	1	CMD STALL
C	2	VALUE-IN-RESPONSE-TO-PROMPT STALL
C	3	PRINTLINE AVAIL STALL (HAS PRINTLINE)
C	4	MESSAGE STALL (HAS MSG)
C	5	PORT REC AVAIL FOR PGM TO RECEIVE
C	6	DTR WAITING FOR PGM TO SEND A RECORD TO PORT
C	7	NOT APPLICABLE HERE ... DTR ASYNCH READY
C	8	NOT APPL. DTR USER DEFINED KEYWORD
C	9	NOT APPL. DTR END USER DEF KEYWORD
	INTEGER    DTR$K_STL_CMD, DTR$K_STL_PRMPT, DTR$K_STL_LINE,
	1	   DTR$K_STL_MSG, DTR$K_STL_PGET, DTR$K_STL_PPUT,
	2	   DTR$K_STL_CONT, DTR$K_STL_UDK, DTR$K_STL_END_UDK
	PARAMETER (DTR$K_STL_CMD=1,
 	1	   DTR$K_STL_PRMPT=2,
	2	   DTR$K_STL_LINE=3,
	3	   DTR$K_STL_MSG=4,
	4	   DTR$K_STL_PGET=5,
	5	   DTR$K_STL_PPUT=6,
	6	   DTR$K_STL_CONT=7,
	7	   DTR$K_STL_UDK=8,
	8	   DTR$K_STL_END_UDK=9)
	INTEGER DTR$K_SEMI_COLON_OPT, DTR$K_UNQUOTED_LIT,
	1	DTR$K_SYNTAX_PROMPT, DTR$K_IMMED_RETURN,
	2	DTR$K_FORMS_ENABLE, DTR$K_VERIFY, DTR$K_CONTEXT_SEARCH,
	3	DTR$K_HYPHEN_DISABLED, DTR$K_MORE_COMMANDS, DTR$K_ABORT,
	4	DTR$K_LOCK_WAIT
	PARAMETER (DTR$K_SEMI_COLON_OPT=1,
	1	   DTR$K_UNQUOTED_LIT=16,
	2	   DTR$K_SYNTAX_PROMPT=32,
	3	   DTR$K_IMMED_RETURN=64,
	4	   DTR$K_FORMS_ENABLE=128,
	5	   DTR$K_VERIFY=256,
	6	   DTR$K_CONTEXT_SEARCH=2048,
	7	   DTR$K_HYPHEN_DISABLED=4096,
	8	   DTR$K_MORE_COMMANDS=8192,
	9	   DTR$K_ABORT=16384,
	1	   DTR$K_LOCK_WAIT=32768)
	INTEGER	   DTR$M_OPT_CMD, DTR$M_OPT_PRMPT,   DTR$M_OPT_LINE,
	1	   DTR$M_OPT_MSG, DTR$M_OPT_PGET, DTR$M_OPT_PPUT,
	2	   DTR$M_OPT_CONT, DTR$M_OPT_UDK, DTR$M_OPT_DTR_UDK,
	3	   DTR$M_OPT_END_UDK, DTR$M_OPT_UNWIND, 
	4	   DTR$M_OPT_CONTROL_C, DTR$M_OPT_STARTUP, 
	5	   DTR$M_OPT_FOREIGN, DTR$M_OPT_BANNER, DTR$M_OPT_REMOVE_CTLC
	PARAMETER (DTR$M_OPT_CMD=1,
	1	   DTR$M_OPT_PRMPT=2,
	2	   DTR$M_OPT_LINE=4,
	3	   DTR$M_OPT_MSG=8,
	4	   DTR$M_OPT_PGET=16,
	5	   DTR$M_OPT_PPUT=32,
	6	   DTR$M_OPT_CONT=64,
	7	   DTR$M_OPT_UDK=128,
	8	   DTR$M_OPT_DTR_UDK=256,
	9	   DTR$M_OPT_END_UDK=512,
	1	   DTR$M_OPT_UNWIND=1024,
	2	   DTR$M_OPT_CONTROL_C=2048,
	3	   DTR$M_OPT_STARTUP=4096,
	4	   DTR$M_OPT_FOREIGN=8192,
	5	   DTR$M_OPT_BANNER=16384,
	6	   DTR$M_OPT_REMOVE_CTLC=32768)
	INTEGER    DTR$K_UDK_SET, DTR$K_UDK_SET_NO, DTR$K_UDK_SHOW,
	1	   DTR$K_UDK_STATEMENT,  DTR$K_UDK_COMMAND
	PARAMETER (DTR$K_UDK_SET=1,	
	1	   DTR$K_UDK_SET_NO=2,
	2	   DTR$K_UDK_SHOW=3,
	3	   DTR$K_UDK_STATEMENT=4,
	4	   DTR$K_UDK_COMMAND=5)
	INTEGER	   DTR$K_TOK_TOKEN, DTR$K_TOK_PICTURE, 
	1	   DTR$K_TOK_FILENAME, DTR$K_TOK_COMMAND,
	2	   DTR$K_TOK_TEST_TOKEN
	PARAMETER (DTR$K_TOK_TOKEN=1,
	1	   DTR$K_TOK_PICTURE=2,
	2	   DTR$K_TOK_FILENAME=3,
	3	   DTR$K_TOK_COMMAND=4,
	4	   DTR$K_TOK_TEST_TOKEN=5)
	INTEGER*2 DTRENA
	COMMON/DTRCMN/DTRENA
	LOGICAL *1 LINECL(82)
C	CHARACTER*70 LINEC
	EQUIVALENCE(LINEC,LINECL(1))
	CHARACTER*80 SCRBUF
	LOGICAL*1 LBUF(128)
	CHARACTER*9 FMTB
	EQUIVALENCE (FMTB,LBUF(120))
	CHARACTER*11 FMTBF
	LOGICAL*1 IFVLD
	LOGICAL*1 MSGBUF(110)
	EQUIVALENCE(MSGBUF(1),MSG_BUFF)
	CHARACTER*232  MSG_BUFF
	CHARACTER*232  AUX_BUFF
	COMMON /DTR$BUFFERS/MSG_BUFF,AUX_BUFF
	EXTERNAL   DTR$_SUCCESS
C ***
C ********>>>>>>>><<<<<<<<********
C NULL OUT ANY TRAILING BLANKS ON COMMAND LINE
	DO 3332 N=1,80
	NN=81-N
	IF(LINE(NN).GT.32)GOTO 3333
	LINE(NN)=0
3332	CONTINUE
3333	CONTINUE
C SPACE FILL ENTIRE ARRAY
	DO 3334 N=1,82
3334	LINECL(N)=32
C CALL DTR$COMMAND TO DO COMMAND FROM COMMAND LEVEL.
	RETCD=1
C HANDLE DTRCMD FUNCTIONS. LINE ARRAY PASSED IN HERE
C STARTS AFTER THE "DTR" SO WE CAN DECODE IT.
C EXECUTE DTR COMMAND
C  DTRCMD (COMMAND) GIVES DTR COMMAND FACILITY AT COMMAND
C LEVEL.
C ALLOW DTRIMM COMMAND TO USE DTR IMMEDIATE TERMINAL
C INTERFACE. THE REST CAN USE SAME COMMAND NAMES AS AFTER
C THE "DB" IN *U DBXXXX COMMANDS.
	call scmp(LINE,%REF('IMM'),3,ICODE)
	IF(ICODE.NE.1)GOTO 1000
c move line down to pass the "imm" stuff and one space
	do 1005 n=1,56
	NN=N
	IF(LINE(N+4).LT.32)GOTO 1006
C	NNN=N
1005	linec(N:N)=char(line(n+4))
1006	CONTINUE
	LINEC(NN:NN)=CHAR(32)
	CALL DTR$COMMAND(DAB,LINEC(1:NN))
c just allow normal DTR handling of the rest...
        CALL DTR$DTR(DAB,DTR$M_OPT_CMD)
	RETURN
1000	continue
	call scmp(LINE,%REF('INT'),3,ICODE)
	IF(ICODE.NE.1)GOTO 1400
C DTRINT - DO INTERACTIVE DTR STUFF.
c move line down to pass the "int" stuff and one space
	do 1405 n=1,60
	NN=N
	IF(LINE(N+4).LT.32)GOTO 1406
C	NNN=N
1405	linec(N:N)=char(line(n+4))
1406	CONTINUE
	LINEC(NN:NN)=CHAR(32)
	IF(DAB$W_STATE.EQ.DTR$K_STL_CMD)THEN
	CALL DTR$COMMAND(DAB,%DESCR(LINEC(1:NN)))
	END IF
c just allow normal DTR handling of the rest...
	CALL DTR$CONTINUE(DAB)
        CALL DTR$DTR(DAB,DTR$M_OPT_UNWIND)
	RETURN
1400	CONTINUE
	CALL SCMP(LINE,%REF('CMD'),3,ICODE)
	IF(ICODE.NE.1)GOTO 100
C *U DBCMD COMMAND
C EXECUTE DTR COMMAND
C CONSTRUCT A DESCRIPTOR...
	DO 8 N=1,70
8	LINECL(N)=0
	DO 10 N=1,60
	NN=N
	M=LINE(4+N)
C COPY CHARACTER ARRAY INTO STRING
	IF(M.LT.32)GOTO 11
C	NNN=N
	LINEC(N:N)= CHAR(M)
10	CONTINUE
11	CONTINUE
	LINEC(NN:NN)=CHAR(32)
	CALL DTR$COMMAND(DAB,LINEC(1:NN))
C CHECK STATUS
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 20
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 20
	CALL DTR$DTR(DAB,DTR$M_OPT_CMD)
C LET DTR$DTR HANDLE MESSAGES AND SO ON UNTIL BACK AT
C COMMAND STALLPOINT. NOTE THAT THIS TAKES CARE OF COMMANDS THAT
C UNEXPECTEDLY CALL FOR MESSAGES OR INPUTS.
	GOTO 9999
20	CONTINUE
	CALL DTR$CONTINUE(DAB)
C FLUSH ALL MESSAGES...IF MORE THAN ONE
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 20
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 20
C JUST CONTINUE IF WE ONLY GOT A MESSAGE OR PRINT LINE HERE.
c no provision for printing it and we normally want to avoid
c prints of this anyway.
	GOTO 9999
100	CONTINUE
	CALL SCMP(LINE,%REF('VAL'),3,ICODE)
	IF(ICODE.NE.1)GOTO 200
	LSKIP=(LINE(4))-57
	IF(LSKIP.LT.1.OR.LSKIP.GT.9)LSKIP=0
	IVV=4
	IF(LINE(5).EQ.ICHAR('.'))THEN
	IVV=IVV+1
	END IF
	DO 110 N=1,60
	NN=N
	M=LINE(IVV+N)
C COPY CHARACTER ARRAY INTO STRING
	IF(M.LT.32)GOTO 111
C	NNN=N
	LINEC(N:N)=CHAR(M)
110	CONTINUE
111	CONTINUE
	LINEC(NN:NN)=CHAR(32)
	CALL DTR$COMMAND(DAB,LINEC(1:NN))
C CHECK STATUS
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 120
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 130
	CALL DTR$DTR(DAB,DTR$M_OPT_CMD)
C LET DTR$DTR HANDLE MESSAGES AND SO ON UNTIL BACK AT
C COMMAND STALLPOINT. NOTE THAT THIS TAKES CARE OF COMMANDS THAT
C UNEXPECTEDLY CALL FOR MESSAGES OR INPUTS.
	GOTO 9999
120	CONTINUE
	CALL DTR$CONTINUE(DAB)
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 120
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 130
	GOTO 9999
130	CONTINUE
	IF(LSKIP.GT.0)THEN
	DO 3346 N=1,LSKIP
3346	CALL DTR$CONTINUE(DAB)
C SKIP EXTRA PRINT LINES IF NEEDED TO DO SO
	END IF
	IF(IVV.GE.5)THEN
	IQ=0
	DO 135 N=1,110
135	IF(MSGBUF(N).EQ.ICHAR('.'))IQ=1
	IVVV=0
	DO 138 N=1,80
	IF(MSGBUF(NN).EQ.ICHAR(':'))IVVV=N+1
	NN=81-N
	IF(MSGBUF(NN).GT.32)GOTO 139
138	CONTINUE
139	IF(IQ.EQ.0)MSGBUF(NN+1)=46
C 46 IS ASCII PERIOD
C IF WE HAVE . AS FIRST CHAR OF COMMAND THEN
C ADD DECIMAL TO END OF TEXT AND START TEXT AFTER THE : OF A
C POSSIBLE LIST COMMAND. ONLY ADD THE DECIMAL IF NONE IS IN
C THE STRING ALREADY AND ONLY SKIP COLON IF ONE EXISTS.
	IF(IVVV.GT.0)THEN
	K=1
	DO 137 N=IVVV,NN+1
	MSGBUF(K)=MSGBUF(N)
	K=K+1
137	CONTINUE
	DO 136 N=K,110
136	MSGBUF(K)=32
	END IF
	END IF
C GET VALUE BACK
C FORTRAN-77 HACK. USE INTERNAL READ
C GETS RESULT INTO % ACCUMULATOR.
	READ(MSG_BUFF,140,ERR=9990)XAC
c use wide format to allow correct readin of many formats
140	FORMAT(D30.15)
	GOTO 120
C JUST CONTINUE IF WE ONLY GOT A MESSAGE OR PRINT LINE HERE.
200	CONTINUE
	CALL SCMP(LINE,%REF('TXT'),3,ICODE)
	IF(ICODE.NE.1)GOTO 300
c get cell name now and skip the comma after it...
C *U DBTXT CELL,COMMAND
C  GETS REPLY INTO CELL. IF NO REPLY, CELL UNCHANGED.
	LO=4
	LHI=20
	LSTCHR=20
	CALL VARSCN(LINE,LO,LHI,LSTCHR,ID1,ID2,IVLD)
	IF(IVLD.EQ.0)GOTO 9990
C JUST SKIP COMMA, SO IT REALLY CAN BE ANY DELIMITER
C IF NO DELIMITER OTHER THAN SPACE WAS GIVEN, SKIP SENDING
C THE COMMAND.
	IF(LINE(LSTCHR).LE.32)GOTO 230
	DO 210 N=1,60
	NN=N
	M=LINE(LSTCHR+N)
C COPY CHARACTER ARRAY INTO STRING
	IF(M.LT.32)GOTO 211
C	NNN=N
	LINEC(N:N)=CHAR(M)
210	CONTINUE
211	CONTINUE
	LINEC(NN:NN)=CHAR(32)
	XAC=0.
	CALL DTR$COMMAND(DAB,LINEC(1:NN))
C CHECK STATUS
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 220
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 230
	CALL DTR$DTR(DAB,DTR$M_OPT_CMD)
C LET DTR$DTR HANDLE MESSAGES AND SO ON UNTIL BACK AT
C COMMAND STALLPOINT. NOTE THAT THIS TAKES CARE OF COMMANDS THAT
C UNEXPECTEDLY CALL FOR MESSAGES OR INPUTS.
	GOTO 9999
220	CONTINUE
	CALL DTR$CONTINUE(DAB)
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 220
	GOTO 9999
230	CONTINUE
C	IF(LINE(LSTCHR).EQ.ICHAR(';'))CALL DTR$CONTINUE(DAB)
C IF WE SEE ; DELIMITER FLUSH ONE EXTRA LINE.
	IF(LINE(LSTCHR).GE.ICHAR(':').AND.
     1   LINE(LSTCHR).LE.ICHAR('?'))THEN
	NNV=(LINE(LSTCHR))-57
C SKIP LINES BASED ON DELIMITER:
C : = 1 SKIP
C ; = 2 SKIPS
C < = 3 SKIPS
C = = 4 SKIPS
C > = 5 SKIPS
C ? = 6 SKIPS
	DO 3342 N=1,NNV
3342	CALL DTR$CONTINUE(DAB)
	END IF
C GET STRING BACK
C COPY MSG_BUFF BACK INTO CELL GIVEN
C ID1,ID2 ADDRESS CELL.
	IFVLD=-1
C FLAG AS TEXT
	CALL FVLDST(ID1,ID2,IFVLD)
C	IRX=(ID2-1)*RRW+ID1
	CALL REFLEC(ID2,ID1,IRX)
	CALL WRKFIL(IRX,LBUF,0)
C READ MEMORY ARRAY, MODIFY, THEN WRITE IT
	DO 233 N=1,110
233	LBUF(N)=0
	DO 234 N=1,109
234	LBUF(N)=MSGBUF(N)
C NULL OUT TRAILING BLANKS PRIOR TO STORING TEXT IN SHEET
	DO 235 N=1,109
	NN=110-N
	IF(LBUF(NN).GT.32)GOTO 236
	LBUF(NN)=0
235	CONTINUE
236	CONTINUE
	CALL WRKFIL(IRX,LBUF,1)
	XAC=1.
C FLAG SUCCESSFUL GETTING OF MESSAGE BY RETURNING 1 IN % ACCUMULATOR.
C LEAVE VALUE AT THIS CELL ALONE.
237	CALL DTR$CONTINUE(DAB)
C FLUSH ANY EXTRA LINES OF MESSAGES
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 237
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 237
	GOTO 9999
300	CONTINUE
	CALL SCMP(LINE,%REF('RPV'),3,ICODE)
	IF(ICODE.NE.1)GOTO 400
C FIRST ISOLATE CELL NAME
	LO=4
	LHI=20
	LSTCHR=20
	CALL VARSCN(LINE,LO,LHI,LSTCHR,ID1,ID2,IVLD)
	IF(IVLD.EQ.0)GOTO 9990
C JUST SKIP COMMA, SO IT REALLY CAN BE ANY DELIMITER
	IF(LINE(LSTCHR).LE.32)THEN
	  IF (DAB$W_STATE.EQ.DTR$K_STL_PRMPT)GOTO 340
C IF WE CAN'T GO TO SEND THE REPLY, NULL OUT COMMAND LINE
	  LINE(LSTCHR+1)=32
	  LINE(LSTCHR+2)=0
	ENDIF
	DO 310 N=1,60
	NN=N
	M=LINE(LSTCHR+N)
C COPY CHARACTER ARRAY INTO STRING
	IF(M.LT.32)GOTO 311
C	NNN=N
	LINEC(N:N)=CHAR(M)
310	CONTINUE
311	CONTINUE
	LINEC(NN:NN)=CHAR(32)
	XAC=0.
C REPLY WITH VALUE.
C THIS USES VALUE IN CELL FOR REPLY.
C SINCE DTR EXPECTS TEXT, USE DISPLAY FORMAT IN CELL TO CONVERT THE
C VALUE TO TEXT CHARACTERS.
	CALL DTR$COMMAND(DAB,LINEC(1:NN))
C CHECK STATUS
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 320
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 330
	IF (DAB$W_STATE.EQ.DTR$K_STL_PRMPT)GOTO 340
	CALL DTR$DTR(DAB,DTR$M_OPT_CMD)
C LET DTR$DTR HANDLE MESSAGES AND SO ON UNTIL BACK AT
C COMMAND STALLPOINT. NOTE THAT THIS TAKES CARE OF COMMANDS THAT
C UNEXPECTEDLY CALL FOR MESSAGES OR INPUTS.
	GOTO 9999
320	CONTINUE
330	CONTINUE
	CALL DTR$CONTINUE(DAB)
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 320
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 330
	IF (DAB$W_STATE.EQ.DTR$K_STL_PRMPT)GOTO 340
	GOTO 9999
340	CONTINUE
C WAITING FOR DTR$PUT_VALUE CALL. GO GET VALUE AND CONVERT AND SHOVE
C OUT.
	CALL XVBLGT(ID1,ID2,TMP)
C TMP IS REAL*8
C NOW HAVE VALUE IN CELL (DEFAULT IS 0. IF CELL NOT INITIALIZED)
C	IRX=(ID2-1)*RRW+ID1
	CALL REFLEC(ID2,ID1,IRX)
	CALL WRKFIL(IRX,LBUF,0)
C READ IN FORMULA BUFFER TO ALLOW US TO GET FORMAT TO USE.
	DO 341 N=1,9
	K=LBUF(119+N)
	IF(K.LT.32)K=32
342	LBUF(119+N)=K
341	CONTINUE
	FMTBF='(' // FMTB // ')'
C STASH FORMAT BUFFER IN THERE
C WE ALREADY MADE SURE IT HAS ALL SPACES OR FORMAT DATA
	WRITE(SCRBUF,FMTBF,ERR=348)TMP
C *****************&&&&&&&&&
	CALL DTR$PUT_VALUE(DAB,SCRBUF)
	XAC=1.
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 320
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 330
C FLUSH OUT THE REST
348	CALL DTR$DTR(DAB,DTR$M_OPT_CMD)
400	CONTINUE
	CALL SCMP(LINE,%REF('RPF'),3,ICODE)
C REPLY FROM FORMULA
	IF(ICODE.NE.1)GOTO 500
C FIRST ISOLATE CELL NAME
	LO=4
	LHI=20
	LSTCHR=20
	CALL VARSCN(LINE,LO,LHI,LSTCHR,ID1,ID2,IVLD)
	IF(IVLD.EQ.0)GOTO 9990
C JUST SKIP COMMA, SO IT REALLY CAN BE ANY DELIMITER
	IF(LINE(LSTCHR).LE.32)THEN
	  IF (DAB$W_STATE.EQ.DTR$K_STL_PRMPT)GOTO 440
C IF WE CAN'T GO TO SEND THE REPLY, NULL OUT COMMAND LINE
	  LINE(LSTCHR+1)=32
	  LINE(LSTCHR+2)=0
	ENDIF
	DO 410 N=1,60
	NN=N
	M=LINE(LSTCHR+N)
C COPY CHARACTER ARRAY INTO STRING
	IF(M.LT.32)GOTO 411
C	NNN=N
	LINEC(N:N)=CHAR(M)
410	CONTINUE
411	CONTINUE
	LINEC(NN:NN)=CHAR(32)
	XAC=0.
C REPLY FROM FORMULA SO WILL LATER GET REPLY FROM FORMULA TEXT RATHER
C THAN CURRENT VALUE.
	CALL DTR$COMMAND(DAB,LINEC(1:NN))
C CHECK STATUS
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 420
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 430
	IF (DAB$W_STATE.EQ.DTR$K_STL_PRMPT)GOTO 440
	CALL DTR$DTR(DAB,DTR$M_OPT_CMD)
C LET DTR$DTR HANDLE MESSAGES AND SO ON UNTIL BACK AT
C COMMAND STALLPOINT. NOTE THAT THIS TAKES CARE OF COMMANDS THAT
C UNEXPECTEDLY CALL FOR MESSAGES OR INPUTS.
	GOTO 9999
420	CONTINUE
430	CONTINUE
	CALL DTR$CONTINUE(DAB)
C FLUSH ALL EXTRA MESSAGES
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 420
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 430
	IF (DAB$W_STATE.EQ.DTR$K_STL_PRMPT)GOTO 440
	GOTO 9999
440	CONTINUE
C WAITING FOR DTR$PUT_VALUE CALL. GO EMIT FORMULA (UP TO 80 CHARACTERS
C  ANYHOW...)
C	IRX=(ID2-1)*RRW+ID1
	CALL REFLEC(ID2,ID1,IRX)
	CALL WRKFIL(IRX,LBUF,0)
C READ IN FORMULA BUFFER TO ALLOW US TO GET FORMAT TO USE.
	SCRBUF=' '
	DO 441 N=1,79
	K=LBUF(N)
	IF(K.LT.32)GOTO 443
442	SCRBUF(N:N)=CHAR(K)
441	CONTINUE
443	CONTINUE
C SEND OUT THE REPLY
	CALL DTR$PUT_VALUE(DAB,SCRBUF)
	XAC=1.
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 420
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 430
C FLUSH OUT THE REST
448	CALL DTR$DTR(DAB,DTR$M_OPT_CMD)
C
500	CONTINUE
C ENABLE/DISABLE FOR DTR FUNCTIONS
C SETTING DTRENA TO -1 IMPLIES DISABLE FUNCTIONS
	CALL SCMP(LINE,%REF('ENA'),3,ICODE)
	IF(ICODE.NE.1)GOTO 600
	DTRENA=1
	GOTO 9999
600	CONTINUE
	CALL SCMP(LINE,%REF('DIS'),3,ICODE)
	IF(ICODE.NE.1)GOTO 700
	DTRENA=-1
	GOTO 9999
700	CONTINUE
	GOTO 9999
9990	RETCD=3
C ERROR RETURN
9999	RETURN
	END
	SUBROUTINE DTRFCT(LINE,RETCD)
	INTEGER*2 RETCD
	LOGICAL*1 LINE(80)
	LOGICAL *1 LINECL(82)
	CHARACTER*62 LINEC
	EQUIVALENCE(LINEC,LINECL(1))
	INTEGER*2 DTRENA
	COMMON/DTRCMN/DTRENA
	INCLUDE 'VKLUGPRM.FTN'
C COPYRIGHT (C) 1983 GLENN EVERHART
C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS
C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY.
	LOGICAL*1 AVBLS(20,27),WRK(128),VBLS(8,RRWP,RCLP)
	INTEGER*2 TYPE(RRWP,RCLP),VLEN(9)
	REAL*8 XAC,XVBLS(RRWP,RCLP)
	REAL*8 TAC,UAC,VAC,WAC,YAC
	REAL*8 TMP
	INTEGER*4 JVBLS(2,RRWP,RCLP)
	EQUIVALENCE(WAC,AVBLS(1,23)),(YAC,AVBLS(1,25))
	EQUIVALENCE(XAC,AVBLS(1,27))
	EQUIVALENCE(TAC,AVBLS(1,20))
	EQUIVALENCE(UAC,AVBLS(1,21))
	EQUIVALENCE(VAC,AVBLS(1,22))
	EQUIVALENCE(VBLS(1,1,1),JVBLS(1,1,1))
	EQUIVALENCE(VBLS(1,1,1),XVBLS(1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
	INTEGER*2 XTNCNT,XTCFG,IPSET
	LOGICAL*1 XTNCMD(80)
	INTEGER*2 FORMFG,RCFGX,PZAP,RCONE
	INTEGER*2 IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6
	COMMON/DOLLR/IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6
	INTEGER*2 RRWACT,RCLACT
	COMMON/RCLACT/RRWACT,RCLACT
	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE
	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C LOOP CONTROL FOR VARY FUNCTION. SET ZERO IN SPREDSHT AND
C MUST BE SET POSITIVE HERE IF WE NEED ITERATIONS.
C (IMPLEMENT FOR VAX ONLY)
	INTEGER KALKIT
	COMMON/VARYIT/KALKIT
C ARGUMENTS COME IN IN ARGUMENTS IN LINE
C RESULTS GO INTO PERCENT (XAC) AND WHEREVER ELSE DESIRED...
	INTEGER*2 PROW,PCOL,DROW,DCOL,DRWV,DCLV
	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	DIMENSION NRDSP(DRW,DCL),NCDSP(DRW,DCL)
	COMMON/D2R/NRDSP,NCDSP
C ADD DATATRIEVE DATA STMTS HERE
C ***
c
c FORTRAN DATATRIEVE Access Block
c
	LOGICAL*1 DAB$B_BID, DAB$B_BLN, DAB$B_VER_LETTER, DAB(100)
	INTEGER*2 DAB$W_MSG_BUF_LEN, DAB$W_MSG_LEN,
	1	  DAB$W_AUX_BUF_LEN, DAB$W_AUX_LEN,
	2	  DAB$W_IDI, DAB$W_STATE, DAB$W_REC_LENGTH,
	3	  DAB$W_VERSION, DAB$W_LEVEL, DAB$W_BASE_LEVEL,
	4	  DAB$W_UDK_INDEX, DAB$W_COLUMNS_PAGE,
	5	  DAB$W_TT_CHANNEL
	LOGICAL*4 DAB$A_MSG_BUF, DAB$A_AUX_BUF,
	1	  DAB$L_CONDITION, DAB$L_FLAGS, DAB$L_OPTIONS
	COMMON /DAB_COMMON/ 
	1	DAB$B_BID, 
	2	DAB$B_BLN, 
	3	DAB$L_CONDITION,
	4	DAB$A_MSG_BUF,
	5 	DAB$W_MSG_BUF_LEN, 
	6	DAB$W_MSG_LEN,
	7	DAB$A_AUX_BUF, 
	8	DAB$W_AUX_BUF_LEN, 
	9	DAB$W_AUX_LEN,
	1	DAB$W_IDI, 
	2	DAB$W_STATE, 
	3	DAB$L_FLAGS, 
	4	DAB$L_OPTIONS,
	5	DAB$W_REC_LENGTH, 
	6	DAB$W_VERSION, 
	7	DAB$W_LEVEL, 
	8	DAB$B_VER_LETTER, 
	9	DAB$W_BASE_LEVEL, 
	1	DAB$W_UDK_INDEX,
	2	DAB$W_COLUMNS_PAGE,
	3	DAB$W_TT_CHANNEL
	EQUIVALENCE (DAB, DAB$B_BID)
	INTEGER    DTR$K_STL_CMD, DTR$K_STL_PRMPT, DTR$K_STL_LINE,
	1	   DTR$K_STL_MSG, DTR$K_STL_PGET, DTR$K_STL_PPUT,
	2	   DTR$K_STL_CONT, DTR$K_STL_UDK, DTR$K_STL_END_UDK
	PARAMETER (DTR$K_STL_CMD=1,
 	1	   DTR$K_STL_PRMPT=2,
	2	   DTR$K_STL_LINE=3,
	3	   DTR$K_STL_MSG=4,
	4	   DTR$K_STL_PGET=5,
	5	   DTR$K_STL_PPUT=6,
	6	   DTR$K_STL_CONT=7,
	7	   DTR$K_STL_UDK=8,
	8	   DTR$K_STL_END_UDK=9)
	INTEGER DTR$K_SEMI_COLON_OPT, DTR$K_UNQUOTED_LIT,
	1	DTR$K_SYNTAX_PROMPT, DTR$K_IMMED_RETURN,
	2	DTR$K_FORMS_ENABLE, DTR$K_VERIFY, DTR$K_CONTEXT_SEARCH,
	3	DTR$K_HYPHEN_DISABLED, DTR$K_MORE_COMMANDS, DTR$K_ABORT,
	4	DTR$K_LOCK_WAIT
	PARAMETER (DTR$K_SEMI_COLON_OPT=1,
	1	   DTR$K_UNQUOTED_LIT=16,
	2	   DTR$K_SYNTAX_PROMPT=32,
	3	   DTR$K_IMMED_RETURN=64,
	4	   DTR$K_FORMS_ENABLE=128,
	5	   DTR$K_VERIFY=256,
	6	   DTR$K_CONTEXT_SEARCH=2048,
	7	   DTR$K_HYPHEN_DISABLED=4096,
	8	   DTR$K_MORE_COMMANDS=8192,
	9	   DTR$K_ABORT=16384,
	1	   DTR$K_LOCK_WAIT=32768)
	INTEGER	   DTR$M_OPT_CMD, DTR$M_OPT_PRMPT,   DTR$M_OPT_LINE,
	1	   DTR$M_OPT_MSG, DTR$M_OPT_PGET, DTR$M_OPT_PPUT,
	2	   DTR$M_OPT_CONT, DTR$M_OPT_UDK, DTR$M_OPT_DTR_UDK,
	3	   DTR$M_OPT_END_UDK, DTR$M_OPT_UNWIND, 
	4	   DTR$M_OPT_CONTROL_C, DTR$M_OPT_STARTUP, 
	5	   DTR$M_OPT_FOREIGN, DTR$M_OPT_BANNER, DTR$M_OPT_REMOVE_CTLC
	PARAMETER (DTR$M_OPT_CMD=1,
	1	   DTR$M_OPT_PRMPT=2,
	2	   DTR$M_OPT_LINE=4,
	3	   DTR$M_OPT_MSG=8,
	4	   DTR$M_OPT_PGET=16,
	5	   DTR$M_OPT_PPUT=32,
	6	   DTR$M_OPT_CONT=64,
	7	   DTR$M_OPT_UDK=128,
	8	   DTR$M_OPT_DTR_UDK=256,
	9	   DTR$M_OPT_END_UDK=512,
	1	   DTR$M_OPT_UNWIND=1024,
	2	   DTR$M_OPT_CONTROL_C=2048,
	3	   DTR$M_OPT_STARTUP=4096,
	4	   DTR$M_OPT_FOREIGN=8192,
	5	   DTR$M_OPT_BANNER=16384,
	6	   DTR$M_OPT_REMOVE_CTLC=32768)
	INTEGER    DTR$K_UDK_SET, DTR$K_UDK_SET_NO, DTR$K_UDK_SHOW,
	1	   DTR$K_UDK_STATEMENT,  DTR$K_UDK_COMMAND
	PARAMETER (DTR$K_UDK_SET=1,	
	1	   DTR$K_UDK_SET_NO=2,
	2	   DTR$K_UDK_SHOW=3,
	3	   DTR$K_UDK_STATEMENT=4,
	4	   DTR$K_UDK_COMMAND=5)
	INTEGER	   DTR$K_TOK_TOKEN, DTR$K_TOK_PICTURE, 
	1	   DTR$K_TOK_FILENAME, DTR$K_TOK_COMMAND,
	2	   DTR$K_TOK_TEST_TOKEN
	PARAMETER (DTR$K_TOK_TOKEN=1,
	1	   DTR$K_TOK_PICTURE=2,
	2	   DTR$K_TOK_FILENAME=3,
	3	   DTR$K_TOK_COMMAND=4,
	4	   DTR$K_TOK_TEST_TOKEN=5)
	CHARACTER*232  MSG_BUFF
	CHARACTER*232  AUX_BUFF
	COMMON /DTR$BUFFERS/MSG_BUFF,AUX_BUFF
	EXTERNAL   DTR$_SUCCESS
	CHARACTER*80 SCRBUF
	LOGICAL*1 LBUF(128)
	CHARACTER*9 FMTB
	EQUIVALENCE (FMTB,LBUF(120))
	CHARACTER*11 FMTBF
	LOGICAL*1 IFVLD
	LOGICAL*1 MSGBUF(80)
	EQUIVALENCE(MSGBUF(1),MSG_BUFF)
C ***
C ********>>>>>>>><<<<<<<<********
	RETCD=1
	IF(DTRENA.LT.0)GOTO 9999
C NULL OUT ANY TRAILING BLANKS ON COMMAND LINE
	DO 3332 N=1,76
	NN=77-N
	IF(LINE(NN).GT.32)GOTO 3333
	LINE(NN)=0
3332	CONTINUE
3333	CONTINUE
C SPACE FILL ENTIRE ARRAY
	DO 3334 N=1,82
3334	LINECL(N)=32
	RETCD=1
C HANDLE *U DBXXXX FUNCTIONS. LINE ARRAY PASSED IN HERE
C STARTS AFTER THE "DB" SO WE CAN DECODE IT.
C *U DBCMD (COMMAND) PASSES COMMAND TO DTR FOR ACTION
C  HOWEVER THIS DOES NOT RETURN A VALUE. USE FOR
C  SETUP PURPOSES ONLY.
C
C INTERFACE DOCUMENTATION:
C
C *U DBCMD COMMAND
C  WILL PASS COMMAND AND FLUSH MESSAGES.
C *U DBVAL COMMAND
C  WILL PASS COMMAND AND RETRIEVE CONTENTS OF
C  MESSAGE BUFFER AS VALUE IN % ACCUMULATOR
C  *U DBTXT CELL,COMMAND
C  WILL PASS COMMAND AND RETRIEVE MESSAGE BUFFER.
C   MESSAGE BUFFER WILL BE PLACED IN CELL NAMED
C   AS ASCII TEXT.
C  *U DBRPV CELL
C   WILL TAKE VALUE IN CELL AND USE AS A REPLY TO A
C   DTR QUERY (AS IN KEYBOARD INPUTS TO PROCEDURES).
C  *U DBRPT CELL
C   WILL TAKE TEXT IN CELL AND USE AS A REPLY TO A
C   DTR QUERY AS ABOVE.
C
C ALL THE ABOVE CALLS WILL BE ALSO IMPLEMENTED AS
C DIRECT "DTRXXX" COMMANDS FOR COMMAND LEVEL USE.
C
C NO NEED TO INCLUDE ABILITY TO STORE COMMANDS IN CELLS
C FOR EDITING SINCE {CELL CONSTRUCT PROVIDES THIS ALREADY.
C (AND AT COMMAND LEVEL THE __{CELL CONSTRUCT DOES ALSO.)
	CALL SCMP(LINE,%REF('CMD'),3,ICODE)
	IF(ICODE.NE.1)GOTO 100
C *U DBCMD COMMAND
C EXECUTE DTR COMMAND
C CONSTRUCT A DESCRIPTOR...
	DO 10 N=1,60
	NN=N
	M=LINE(4+N)
C COPY CHARACTER ARRAY INTO STRING
	IF(M.LT.32)GOTO 11
C	NNN=N
	LINEC(N:N)=CHAR(M)
10	CONTINUE
11	CONTINUE
	LINEC(NN:NN)=CHAR(32)
	CALL DTR$COMMAND(DAB,LINEC(1:NN))
C CHECK STATUS
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 20
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 20
	CALL DTR$DTR(DAB,DTR$M_OPT_CMD)
C LET DTR$DTR HANDLE MESSAGES AND SO ON UNTIL BACK AT
C COMMAND STALLPOINT. NOTE THAT THIS TAKES CARE OF COMMANDS THAT
C UNEXPECTEDLY CALL FOR MESSAGES OR INPUTS.
	GOTO 9999
20	CONTINUE
	CALL DTR$CONTINUE(DAB)
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 20
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 20
C JUST CONTINUE IF WE ONLY GOT A MESSAGE OR PRINT LINE HERE.
c no provision for printing it and we normally want to avoid
c prints of this anyway.
	GOTO 9999
100	CONTINUE
	CALL SCMP(LINE,%REF('VAL'),3,ICODE)
	IF(ICODE.NE.1)GOTO 200
	LSKIP=(LINE(4))-57
	IF(LSKIP.LT.0.OR.LSKIP.GT.9)LSKIP=0
	IVV=4
	IF(LINE(5).EQ.ICHAR('.'))THEN
	IVV=IVV+1
	END IF
	DO 110 N=1,60
	M=LINE(IVV+N)
	NN=N
C COPY CHARACTER ARRAY INTO STRING
	IF(M.LT.32)GOTO 111
C	NNN=N
	LINEC(N:N)=CHAR(M)
110	CONTINUE
111	CONTINUE
	LINEC(NN:NN)=CHAR(32)
	CALL DTR$COMMAND(DAB,LINEC(1:NN))
C CHECK STATUS
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 120
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 130
	CALL DTR$DTR(DAB,DTR$M_OPT_CMD)
C LET DTR$DTR HANDLE MESSAGES AND SO ON UNTIL BACK AT
C COMMAND STALLPOINT. NOTE THAT THIS TAKES CARE OF COMMANDS THAT
C UNEXPECTEDLY CALL FOR MESSAGES OR INPUTS.
	GOTO 9999
120	CONTINUE
	CALL DTR$CONTINUE(DAB)
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 120
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 130
	GOTO 9999
130	CONTINUE
	IF(LSKIP.GT.0)THEN
	DO 3346 N=1,LSKIP
3346	CALL DTR$CONTINUE(DAB)
C SKIP EXTRA PRINT LINES IF NEEDED TO DO SO
	END IF
	IF(IVV.GE.5)THEN
	IQ=0
	DO 135 N=1,110
135	IF(MSGBUF(N).EQ.ICHAR('.'))IQ=1
	IVVV=0
	DO 138 N=1,80
	IF(MSGBUF(NN).EQ.ICHAR(':'))IVVV=N+1
	NN=81-N
	IF(MSGBUF(NN).GT.32)GOTO 139
138	CONTINUE
139	IF(IQ.EQ.0)MSGBUF(NN+1)=46
C 46 IS ASCII PERIOD
C IF WE HAVE . AS FIRST CHAR OF COMMAND THEN
C ADD DECIMAL TO END OF TEXT AND START TEXT AFTER THE : OF A
C POSSIBLE LIST COMMAND. ONLY ADD THE DECIMAL IF NONE IS IN
C THE STRING ALREADY AND ONLY SKIP COLON IF ONE EXISTS.
	IF(IVVV.GT.0)THEN
	K=1
	DO 137 N=IVVV,NN+1
	MSGBUF(K)=MSGBUF(N)
	K=K+1
137	CONTINUE
	DO 136 N=K,110
136	MSGBUF(K)=32
	END IF
	END IF
C GET VALUE BACK
C FORTRAN-77 HACK. USE INTERNAL READ
C GETS RESULT INTO % ACCUMULATOR.
	READ(MSG_BUFF,140,ERR=9990)XAC
c use wide format to allow correct readin of many formats
140	FORMAT(D30.15)
C LOOP BACK TO CLEAR ANY REMAINING READINS
	GOTO 120
C JUST CONTINUE IF WE ONLY GOT A MESSAGE OR PRINT LINE HERE.
200	CONTINUE
	CALL SCMP(LINE,%REF('TXT'),3,ICODE)
	IF(ICODE.NE.1)GOTO 300
c get cell name now and skip the comma after it...
C *U DBTXT CELL,COMMAND
C  GETS REPLY INTO CELL. IF NO REPLY, CELL UNCHANGED.
	LO=4
	LHI=20
	LSTCHR=20
	CALL VARSCN(LINE,LO,LHI,LSTCHR,ID1,ID2,IVLD)
	IF(IVLD.EQ.0)GOTO 9990
C JUST SKIP COMMA, SO IT REALLY CAN BE ANY DELIMITER
	IF(LINE(LSTCHR).LE.32)THEN
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 230
	LINE(LSTCHR+1)=32
	LINE(LSTCHR+2)=0
	ENDIF
	DO 210 N=1,60
	NN=N
	M=LINE(LSTCHR+N)
C COPY CHARACTER ARRAY INTO STRING
	IF(M.LT.32)GOTO 211
C	NNN=N
	LINEC(N:N)=CHAR(M)
210	CONTINUE
211	CONTINUE
	LINEC(NN:NN)=CHAR(32)
	XAC=0.
	CALL DTR$COMMAND(DAB,LINEC(1:NN))
C CHECK STATUS
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 220
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 230
	CALL DTR$DTR(DAB,DTR$M_OPT_CMD)
C LET DTR$DTR HANDLE MESSAGES AND SO ON UNTIL BACK AT
C COMMAND STALLPOINT. NOTE THAT THIS TAKES CARE OF COMMANDS THAT
C UNEXPECTEDLY CALL FOR MESSAGES OR INPUTS.
	GOTO 9999
220	CONTINUE
	CALL DTR$CONTINUE(DAB)
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 220
	GOTO 9999
230	CONTINUE
C	IF(LINE(LSTCHR).EQ.ICHAR(';'))CALL DTR$CONTINUE(DAB)
C SKIP ONE LINE IF WE SEE A ; AFTER CELL NAME INSTEAD OF COMMA.
	IF(LINE(LSTCHR).GE.ICHAR(':').AND.
     1   LINE(LSTCHR).LE.ICHAR('?'))THEN
	NNV=(LINE(LSTCHR))-57
C SKIP LINES BASED ON DELIMITER:
C : = 1 SKIP
C ; = 2 SKIPS
C < = 3 SKIPS
C = = 4 SKIPS
C > = 5 SKIPS
C ? = 6 SKIPS
	DO 3342 N=1,NNV
3342	CALL DTR$CONTINUE(DAB)
	END IF
C GET STRING BACK
C COPY MSG_BUFF BACK INTO CELL GIVEN
C ID1,ID2 ADDRESS CELL.
	IFVLD=-1
C FLAG AS TEXT
	CALL FVLDST(ID1,ID2,IFVLD)
C	IRX=(ID2-1)*RRW+ID1
	CALL REFLEC(ID2,ID1,IRX)
	CALL WRKFIL(IRX,LBUF,0)
C READ MEMORY ARRAY, MODIFY, THEN WRITE IT
	DO 233 N=1,110
233	LBUF(N)=0
	DO 234 N=1,80
234	LBUF(N)=MSGBUF(N)
C NULL OUT TRAILING BLANKS PRIOR TO STORING TEXT IN SHEET
	DO 235 N=1,109
	NN=110-N
	IF(LBUF(NN).GT.32)GOTO 236
	LBUF(NN)=0
235	CONTINUE
236	CONTINUE
	CALL WRKFIL(IRX,LBUF,1)
	XAC=1.
C FLAG SUCCESSFUL GETTING OF MESSAGE BY RETURNING 1 IN % ACCUMULATOR.
C LEAVE VALUE AT THIS CELL ALONE.
237	CALL DTR$CONTINUE(DAB)
C FLUSH ALL REMAINING MESSAGES...
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 237
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 237
	GOTO 9999
300	CONTINUE
	CALL SCMP(LINE,%REF('RPV'),3,ICODE)
	IF(ICODE.NE.1)GOTO 400
C FIRST ISOLATE CELL NAME
	LO=4
	LHI=20
	LSTCHR=20
	CALL VARSCN(LINE,LO,LHI,LSTCHR,ID1,ID2,IVLD)
	IF(IVLD.EQ.0)GOTO 9990
C JUST SKIP COMMA, SO IT REALLY CAN BE ANY DELIMITER
	IF(LINE(LSTCHR).LE.32)THEN
	IF (DAB$W_STATE.EQ.DTR$K_STL_PRMPT)GOTO 340
C MAKE CMD NULL IF NO COMMA THERE
	LINE(LSTCHR+1)=32
	LINE(LSTCHR+2)=0
	ENDIF
	DO 310 N=1,60
	NN=N
	M=LINE(LSTCHR+N)
C COPY CHARACTER ARRAY INTO STRING
	IF(M.LT.32)GOTO 311
C	NNN=N
	LINEC(N:N)=CHAR(M)
310	CONTINUE
311	CONTINUE
	LINEC(NN:NN)=CHAR(32)
	XAC=0.
C REPLY WITH VALUE.
C THIS USES VALUE IN CELL FOR REPLY.
C SINCE DTR EXPECTS TEXT, USE DISPLAY FORMAT IN CELL TO CONVERT THE
C VALUE TO TEXT CHARACTERS.
	CALL DTR$COMMAND(DAB,LINEC(1:NN))
C CHECK STATUS
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 320
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 330
	IF (DAB$W_STATE.EQ.DTR$K_STL_PRMPT)GOTO 340
	CALL DTR$DTR(DAB,DTR$M_OPT_CMD)
C LET DTR$DTR HANDLE MESSAGES AND SO ON UNTIL BACK AT
C COMMAND STALLPOINT. NOTE THAT THIS TAKES CARE OF COMMANDS THAT
C UNEXPECTEDLY CALL FOR MESSAGES OR INPUTS.
	GOTO 9999
320	CONTINUE
330	CONTINUE
	CALL DTR$CONTINUE(DAB)
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 320
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 330
	IF (DAB$W_STATE.EQ.DTR$K_STL_PRMPT)GOTO 340
	GOTO 9999
340	CONTINUE
C WAITING FOR DTR$PUT_VALUE CALL. GO GET VALUE AND CONVERT AND SHOVE
C OUT.
	CALL XVBLGT(ID1,ID2,TMP)
C TMP IS REAL*8
C NOW HAVE VALUE IN CELL (DEFAULT IS 0. IF CELL NOT INITIALIZED)
C	IRX=(ID2-1)*RRW+ID1
	CALL REFLEC(ID2,ID1,IRX)
	CALL WRKFIL(IRX,LBUF,0)
C READ IN FORMULA BUFFER TO ALLOW US TO GET FORMAT TO USE.
	DO 341 N=1,9
	K=LBUF(119+N)
	IF(K.LT.32)K=32
342	LBUF(119+N)=K
341	CONTINUE
	FMTBF='(' // FMTB // ')'
C STASH FORMAT BUFFER IN THERE
C WE ALREADY MADE SURE IT HAS ALL SPACES OR FORMAT DATA
	WRITE(SCRBUF,FMTBF,ERR=348)TMP
	CALL DTR$PUT_VALUE(DAB,SCRBUF(1:45))
	XAC=1.
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 320
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 330
C FLUSH OUT THE REST
348	CALL DTR$DTR(DAB,DTR$M_OPT_CMD)
400	CONTINUE
	CALL SCMP(LINE,%REF('RPF'),3,ICODE)
C REPLY FROM FORMULA
	IF(ICODE.NE.1)GOTO 500
C FIRST ISOLATE CELL NAME
	LO=4
	LHI=20
	LSTCHR=20
	CALL VARSCN(LINE,LO,LHI,LSTCHR,ID1,ID2,IVLD)
	IF(IVLD.EQ.0)GOTO 9990
C JUST SKIP COMMA, SO IT REALLY CAN BE ANY DELIMITER
	IF(LINE(LSTCHR).LE.32)THEN
	IF (DAB$W_STATE.EQ.DTR$K_STL_PRMPT)GOTO 440
	LINE(LSTCHR+1)=32
	LINE(LSTCHR+2)=0
	ENDIF
	DO 410 N=1,60
	NN=N
	M=LINE(LSTCHR+N)
C COPY CHARACTER ARRAY INTO STRING
	IF(M.LT.32)GOTO 411
C	NNN=N
	LINEC(N:N)=CHAR(M)
410	CONTINUE
411	CONTINUE
	LINEC(NN:NN)=CHAR(32)
	XAC=0.
C REPLY FROM FORMULA SO WILL LATER GET REPLY FROM FORMULA TEXT RATHER
C THAN CURRENT VALUE.
	CALL DTR$COMMAND(DAB,LINEC(1:NN))
C CHECK STATUS
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 420
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 430
	IF (DAB$W_STATE.EQ.DTR$K_STL_PRMPT)GOTO 440
	CALL DTR$DTR(DAB,DTR$M_OPT_CMD)
C LET DTR$DTR HANDLE MESSAGES AND SO ON UNTIL BACK AT
C COMMAND STALLPOINT. NOTE THAT THIS TAKES CARE OF COMMANDS THAT
C UNEXPECTEDLY CALL FOR MESSAGES OR INPUTS.
	GOTO 9999
420	CONTINUE
430	CONTINUE
	CALL DTR$CONTINUE(DAB)
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 420
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 430
	IF (DAB$W_STATE.EQ.DTR$K_STL_PRMPT)GOTO 440
	GOTO 9999
440	CONTINUE
C WAITING FOR DTR$PUT_VALUE CALL. GO EMIT FORMULA (UP TO 80 CHARACTERS
C  ANYHOW...)
C	IRX=(ID2-1)*RRW+ID1
	CALL REFLEC(ID2,ID1,IRX)
	CALL WRKFIL(IRX,LBUF,0)
C READ IN FORMULA BUFFER TO ALLOW US TO GET FORMAT TO USE.
	SCRBUF=' '
	DO 441 N=1,79
	K=LBUF(N)
	IF(K.LT.32)GOTO 443
	NNN=N
442	SCRBUF(N:N)=CHAR(K)
441	CONTINUE
443	CONTINUE
C SEND OUT THE REPLY
	CALL DTR$PUT_VALUE(DAB,SCRBUF(1:NNN))
	XAC=1.
	IF (DAB$W_STATE.EQ.DTR$K_STL_MSG)GOTO 420
	IF (DAB$W_STATE.EQ.DTR$K_STL_LINE)GOTO 430
C FLUSH OUT THE REST
448	CALL DTR$DTR(DAB,DTR$M_OPT_CMD)
C
500	CONTINUE
	GOTO 9999
9990	RETCD=3
C ERROR RETURN
9999	RETURN
	END
