10	FUNCTION LONG EXT_SCRIPT_INTERP(STRING SCRIPT_NAME, &
		SCRIPT_TYPE, LONG SCR_FILE)

	!======================================================================
	!PROGRAM---------------------VERSION-------------------LANGUAGE--------
	!EXT_SCRIPT_INTERP 		3			BASIC
	!
	!DESCRIPTION-----------------------------------------------------------
	!Script interpreter for EXTERNAL facility
	!Runs the script specified by the file SCRIPT_NAME.  SCR_FILE is
	!channel number to use for script file.  SCRIPT_TYPE indicates the type
	!of script being run (facility/connect/disconnect)
	!This routine is recursive, since the DIAL command in a script will
	!run a connect script.
	!
	!======================================================================

	%TITLE "Script Interpreter"
	%IDENT "EXT_SCRIPT_INTERP  88.10.07"
	%SBTTL "DOCUMENTATION SECTION"

	!**********************************************************************
	!			OPTIONS
	!**********************************************************************

	OPTION	TYPE = EXPLICIT			! Explicit declarations only

100	!**********************************************************************
	!			DOCUMENTATION SECTION
	!**********************************************************************
	!
	!======================================================================
	!			MODIFICATION HISTORY
	!======================================================================
	!VERSION--------AUTHOR------------------DATE------------APPROVAL-------
	!   1		Keith Walker		88.01.25	1723
	!   2		Keith Walker		88.03.31	M102-0-23
	!   3		Keith Walker		88.10.07	1741
	!
	!======================================================================
	!			COMPILE/LINK INSTRUCTIONS
	!======================================================================
	!$BASIC EXT_SCRIPT_INTERP
	!$LINK/NOTRACE EXTERNAL,-
	!EXT_UNSOL_MBX_AST, EXT_READ_PORT_AST,-
	!EXT_PROC_BUF_AST, EXT_WRITE_TERM_AST,-
	!EXT_SCRIPT_INTERP, EXT_SCREEN_HDR,-
	!EXT_MENU, EXT_CONNECT_LOOP, CHKRDB
	!======================================================================

	!**********************************************************************
	!			FILES ACCESSED
	!**********************************************************************
	!     NAME	    MODE    CHANNEL		  DESCRIPTION
	!--------------	   ------   -------	-------------------------------
	!		
	!**********************************************************************

	%PAGE
	%SBTTL "DECLARATION SECTION"
200	!======================================================================
	!			DECLARATION SECTION
	!======================================================================

	!**********************************************************************
	!			%INCLUDE FILE DECLARATIONS
	!**********************************************************************

	%INCLUDE "EXT_COMMON.BAS"

	!**********************************************************************
	!			CONSTANTS
	!**********************************************************************

	DECLARE WORD CONSTANT &
		N_PARAMS = 10,	!max number of parameters allowed	&
		L_SCRIPT = 100, !max length of user script	&
		N_FLAGS = 4	!number of condition flags

	!**********************************************************************
	!			RECORDS
	!**********************************************************************

	!**********************************************************************
	!			MAPS
	!**********************************************************************

	!**********************************************************************
	!			COMMONS
	!**********************************************************************

	COMMON (DIAL_COM) &
		STRING	DIAL_NUM = 80	!number to be dialled

	!**********************************************************************
	!			VARIABLES
	!**********************************************************************

	DECLARE WORD &
		END_OF_FILE,	!TRUE if end of file reached &
		NUM_LABELS,	!number of labels in user script	&
		NUM_PARAMS,	!number of parameters in current command &
		NUM_SCRIPT_LINES,	!length of user script	&
		SAVE_SCRIPT_LINE,	! &
		SAVE_VIEW_FLAG,	!saved view flag &
		SEND_PAUSE	!1Oths of sec. to pause between char

	DECLARE LONG &
		BAUD_RATE,	!baud rate for port &
		ERR_CHAN,	!channel for error file &
		FUNC_STATUS,	!function return status &
		GI_COUNT,	! &
		GI_INTERVAL,	! &
		GI_PAR_OMITTED,	! &
		GI_STRING_COUNT,! &
		I,		!miscellaneous loop control etc	&
		J,		!miscellaneous loop control etc	&
		JUNK,		!accepts function returns &
		PARITY_FLAGS,	!flag bits to set parity &
		SCRIPT_PTR,	! &
		TERM_WRITE_CODE	!

	DECLARE QUAD &
		BINARY_TIME

	DECLARE STRING &
		ABORT_TEXT,	!text of abort message &
		BUF_FER,	! &
		DEBUG_FLAG,	!indicates type of debugging; values:	&
				!0: no debugging	&
				!1: print script parsing info	&
				!2: print scripts & labels	&
				!3: print interpreted lines	&
				!4: print INPUT/REPLY parameters	&
		DELTA_TIME,	! &
		ERROR_DIR,	!directory for error file, &
		ERROR_EXT,	!extension for error file &
		SAVE_QUOTE,	! &
		SCRIPT_BUF,	!buffer for script text &
		SCRIPT_DIR,	!directory for script file, &
		SCRIPT_EXT,	!extension for script file &
		SNOOZE_SECS,	! &
		START_TIME	!

	!**********************************************************************
	!			ARRAYS
	!**********************************************************************

	DIMENSION STRING &
		LABEL_NAME(L_SCRIPT),	!names of labels in user script	&
		SCR_PARAM(N_PARAMS),	!parameters of current command &
		SCR_SEP(N_PARAMS),	!parameter terminators	&
		SCRIPT(L_SCRIPT)	!holds user script

	DIMENSION WORD &
		COND_FLAG(N_FLAGS),	!condition flags (0 is timeout) &
		LABELS(L_SCRIPT),	!array index for user script labels &
		PORT_OUT_IOSB(3),	! &
		SCR_PTR(N_PARAMS)	!starting position of each parameter

	!**********************************************************************
	!			FUNCTIONS
	!**********************************************************************

	DECLARE WORD FUNCTION &
		ERRORS,		!prints error message	&
		SNOOZE  	!sleep mode for process

	DECLARE STRING FUNCTION &
		GET_STRING,	!strips quotes from string, inserts CR &
		NOW

	!**********************************************************************
	!			EXTERNAL CONSTANTS
	!**********************************************************************

	EXTERNAL LONG CONSTANT &
		IO$_SETMODE, &
		IO$_WRITEVBLK, &
		IO$M_BREAKTHRU, &
		IO$M_NOFORMAT, &
		RMS$_FNF, &
		SS$_ABORT, &
		SS$_NORMAL, &
		TT$C_BAUD_110, &
		TT$C_BAUD_300, &
		TT$C_BAUD_1200, &
		TT$C_BAUD_2400, &
		TT$C_BAUD_4800, &
		TT$C_BAUD_9600, &
		TT$C_BAUD_19200, &
		TT$M_ALTDISPAR, &
		TT$M_ALTFRAME, &
		TT$M_ALTRPAR, &
		TT$M_DISPARERR, &
		TT$M_DS_DTR, &
		TT$M_EIGHTBIT, &
		TT$M_HOSTSYNC, &
		TT$M_MECHTAB, &
		TT$M_MODEM, &
		TT$M_NOBRDCST, &
		TT$M_NOTYPEAHD, &
		TT$M_ODD, &
		TT$M_PARITY, &
		TT$M_TTSYNC, &
		TT2$M_PASTHRU

	!**********************************************************************
	!			EXTERNAL FUNCTIONS
	!**********************************************************************

	EXTERNAL LONG FUNCTION &
		EXT_SCRIPT_INTERP,		!this is us, for recursive call &
		SYS$BINTIM, &
		SYS$DALLOC, &
		SYS$DASSGN, &
		SYS$HIBER, &
		SYS$NUMTIM, &
		SYS$QIOW, &
		SYS$SCHDWK, &
		SYS$SETAST

	!**********************************************************************
	!			EXTERNAL SUBPROGRAMS
	!**********************************************************************

	EXTERNAL SUB &
		LIB$GET_SYMBOL, &
		LIB$SET_SYMBOL, &
		LIB$SYS_TRNLOG, &
		SYS$CANCEL, &
		EXT_CONNECT_LOOP, &
		EXT_SCREEN_HDR

	%PAGE
	%SBTTL "INITIALIZATION SECTION"
300	!======================================================================
	!			INITIALIZATION SECTION
	!======================================================================

	ON ERROR GOTO ERROR_HANDLING
	FUNC_STATUS = CTRLC

	!**********************************************************************
	!			PRINT USING FORMATS
	!**********************************************************************

	!**********************************************************************
	!			VARIABLES
	!**********************************************************************

	FUNC_STATUS = SS$_NORMAL
	ERR_CHAN = SCR_FILE + 1%	!channel for error file

	FOR I = 1 TO L_SCRIPT
	  LABELS(I) = 0
	  SCRIPT(I) = ""
	NEXT I
	NUM_LABELS = 0
	NUM_SCRIPT_LINES = 0

	CALL LIB$SYS_TRNLOG("LP_ERROR_DIR", , ERROR_DIR)
	CALL LIB$SYS_TRNLOG("LP_ERROR_EXT", , ERROR_EXT)
	CALL LIB$SYS_TRNLOG("LP_SCRIPT_DIR", , SCRIPT_DIR)
	CALL LIB$SYS_TRNLOG("LP_SCRIPT_EXT", , SCRIPT_EXT)
	IF SCRIPT_TYPE = "C" OR SCRIPT_TYPE = "D" THEN
	  SCRIPT_EXT = "." + SCRIPT_TYPE + SEG$(SCRIPT_EXT, 2, LEN(SCRIPT_EXT))
	END IF
	CALL LIB$GET_SYMBOL("DEBUG", DEBUG_FLAG)

	TERM_WRITE_CODE = IO$_WRITEVBLK OR IO$M_BREAKTHRU OR IO$M_NOFORMAT

	%PAGE
	%SBTTL "MAIN LOGIC SECTION"
1000	!======================================================================
	!			MAIN LOGIC SECTION
	!======================================================================

	!open the script file...
	WHEN ERROR IN
	  OPEN SCRIPT_DIR + SCRIPT_NAME + SCRIPT_EXT FOR INPUT &
		AS FILE #SCR_FILE, &
		ACCESS READ, ALLOW MODIFY
	USE
	  ABORT_TEXT = "Unable to find " + &
	  	SCRIPT_DIR + SCRIPT_NAME + SCRIPT_EXT
	  CALL LIB$SET_SYMBOL("ABORT_TEXT", ABORT_TEXT, 1%)
	  FUNC_STATUS = RMS$_FNF
	  CONTINUE END_OF_PROGRAM
	END WHEN

	!read the script...
	GOSUB READ_SCRIPT

	!run the script...
	SCRIPT_PTR = 1
	WHILE SCRIPT_PTR <= NUM_SCRIPT_LINES
	  SCRIPT_BUF = SCRIPT(SCRIPT_PTR)
	  IF POS(DEBUG_FLAG, "3", 1) > 0 THEN
	    PRINT "          Interpreting line "; SCRIPT_TYPE; SCRIPT_PTR; &
		", text:"
	    PRINT "          "; SCRIPT_BUF
	  END IF
	  GOSUB PARSE_SCRIPT
	  SCRIPT_PTR = SCRIPT_PTR + 1
	  GOSUB PROCESS_COMMAND
	NEXT

	!exit...
	FUNC_STATUS = SS$_NORMAL
	GOTO END_OF_PROGRAM

	%PAGE
	%SBTTL "SUBROUTINE DEFINITION SECTION"
15000	!======================================================================
	!			SUBROUTINE DEFINITION SECTION
	!======================================================================

 GO_ONLINE:
 	!**********************************************************************
	!connects the user's terminal
	!**********************************************************************

	!prepare for online session...
	START_TIME = NOW
	CALL LIB$SET_SYMBOL("START_TIME", START_TIME, 1%)

	JUNK = RCTRLC
	CALL EXT_SCREEN_HDR("Connected to " + TRM$(FACILITY_NAME), &
		"Enter <CTRL\> to exit")
	LOG_FLAG = TRUE		!log the session
	SAVE_VIEW_FLAG = VIEW_FLAG	!remember the view flag
	VIEW_FLAG = TRUE	!let the user see the session

	!set the terminal to passthru..
	TERM_MODE(0) = OLD_TERM_MODE(0)
	TERM_MODE(1) = OLD_TERM_MODE(1)
	TERM_MODE(2) = OLD_TERM_MODE(2) OR TT2$M_PASTHRU
	JUNK = SYS$QIOW(!efn!, TERM_CHAN BY VALUE, &
	     	   		IO$_SETMODE BY VALUE,	&
				,,,    	&
				TERM_MODE(0) BY REF,		&
				12% BY VALUE,,,,)

	!now loop to copy stuff from terminal to port...
	CALL EXT_CONNECT_LOOP

	!finish off the log file...
 	IF LOG_PTR > 0% THEN
	  PUT #LOG_FILE, COUNT LOG_PTR
	END IF
	LOG_FLAG = FALSE
	VIEW_FLAG = SAVE_VIEW_FLAG

	RETURN

 GET_LINE:
 	!**************************************************
	!read line from script
	!**************************************************

	WHEN ERROR IN
	  LINPUT #SCR_FILE, SCRIPT_BUF
	USE
	  END_OF_FILE = TRUE
	END WHEN

	RETURN

 PARSE_SCRIPT:
	!**************************************************
	!assume SCRIPT_BUF holds a line
	!parse line into SCR_PARAM, SCR_SEP, SCR_PTR
	!set NUM_PARAMS
	!**************************************************

	SCRIPT_BUF = EDIT$(SCRIPT_BUF, 408%) + " "	!remove excess spaces
	!parse line:
	J = 0
	FOR I = 0 TO N_PARAMS
	  SCR_SEP(I) = ""
	  SCR_PTR(I) = LEN(SCRIPT_BUF) + 1
	  SCR_PARAM(I) = ""
	NEXT I
	SCR_PTR(0) = 1

	FOR I = 1 TO LEN(SCRIPT_BUF)
	  SELECT SEG$(SCRIPT_BUF, I, I)
	    CASE = "!"
	      SCR_PARAM(J) = SEG$(SCRIPT_BUF, SCR_PTR(J), I)
	      I = LEN(SCRIPT_BUF)
	      SCR_SEP(J) = " "
	      J = J + 1
	      SCR_PTR(J) = I + 1
	    CASE = " ", ","
	      SCR_SEP(J) = SEG$(SCRIPT_BUF, I, I)
	      SCR_PARAM(J) = SEG$(SCRIPT_BUF, SCR_PTR(J), I - 1)
	      J = J + 1
	      I = I + 1 IF SEG$(SCRIPT_BUF, I + 1, I + 1) = " "
	      SCR_PTR(J) = I + 1
	    CASE = '"', "'"
	      SAVE_QUOTE = SEG$(SCRIPT_BUF, I, I)
	      I = I + 1
	      WHILE SEG$(SCRIPT_BUF, I, I) <> SAVE_QUOTE AND &
			I < LEN(SCRIPT_BUF) - 1
	        I = I + 1
	      NEXT
	  END SELECT
	  GOTO PARSE_ENOUGH IF J > N_PARAMS
	NEXT I

 PARSE_ENOUGH:
	NUM_PARAMS = J - 1
	SCR_PARAM(0) = EDIT$(SCR_PARAM(0), 32)	!uppercase command

	IF POS(DEBUG_FLAG, "1", 1) > 0 THEN
	  PRINT
	  PRINT "          "; SCRIPT_BUF
	  PRINT "123456789 "; FOR I = 1 TO 8
	  PRINT
	  FOR I = 0 TO NUM_PARAMS
	    PRINT I, SCR_PTR(I), SCR_PARAM(I), ">"; SCR_SEP(I); "<"
	  NEXT I
	END IF

	RETURN

 PROCESS_COMMAND:
	!**************************************************
	!assume SCR_PARAM, SCR_SEP, SCR_PTR hold command
	!processes the command 
	!**************************************************

	SELECT SCR_PARAM(0)
	  CASE = 'LABEL', '!', ''	!ignore it
	  CASE = 'SET'	!SET option - process it
	    IF NUM_PARAMS < 1 THEN
	      JUNK = ERRORS("Not enough parameters - command ignored")
	      GOTO FORCE_ABORT		!force an abort
	    ELSE
	      SCR_PARAM(1) = EDIT$(SCR_PARAM(1), 32)	!upper case
	      SELECT SCR_PARAM(1)
	        CASE = "PAUSE"
	          IF NUM_PARAMS < 2 THEN
	            JUNK = ERRORS("Not enough parameters - command ignored")
	            GOTO FORCE_ABORT		!force an abort
	          ELSE
	            WHEN ERROR IN
	              SEND_PAUSE = VAL%(SCR_PARAM(2))	!get 10ths of second
	            USE
	              JUNK = ERRORS("Invalid parameter value - command ignored")
	              CONTINUE FORCE_ABORT	!force an abort
	            END WHEN
	          END IF
	        CASE = "VIEW" 
	          VIEW_FLAG = TRUE
	        CASE = "NOVIEW" 
	          VIEW_FLAG = FALSE
	        CASE = "ECHO" 
	          ECHO_FLAG = TRUE
	        CASE = "NOECHO" 
	          ECHO_FLAG = FALSE
	        CASE = "DATABITS"
	          IF NUM_PARAMS < 2 THEN
	            JUNK = ERRORS("Not enough parameters - command ignored")
	            GOTO FORCE_ABORT		!force an abort
	          ELSE
	            PARITY_FLAGS = TT$M_ALTDISPAR OR TT$M_DISPARERR
	            SELECT SCR_PARAM(2)
	              CASE = "7", "SEVEN"
	                PARITY_FLAGS = PARITY_FLAGS OR TT$M_ALTFRAME OR 7%
	              CASE = "8", "EIGHT"
	                PARITY_FLAGS = PARITY_FLAGS OR TT$M_ALTFRAME OR 8%
	              CASE ELSE
	                JUNK = ERRORS("Invalid databits - command ignored")
	                GOTO FORCE_ABORT       	       	!force an abort
	            END SELECT
	            IF NUM_PARAMS >= 3 THEN
	              SELECT SCR_PARAM(3)
	                CASE = "NONE", "NOPARITY"
	                  PARITY_FLAGS = PARITY_FLAGS OR TT$M_ALTRPAR
	                CASE = "ODD"
	                  PARITY_FLAGS = PARITY_FLAGS OR TT$M_ALTRPAR OR &
				TT$M_PARITY OR TT$M_ODD
	                CASE = "EVEN"
	                  PARITY_FLAGS = PARITY_FLAGS OR TT$M_ALTRPAR OR &
				TT$M_PARITY
	                CASE ELSE
	                  JUNK = ERRORS("Invalid parity - command ignored")
	                  GOTO FORCE_ABORT       	      	!force an abort
	              END SELECT
	            END IF
	            JUNK = SYS$QIOW(!efn!, PORT_CHAN BY VALUE, &
	     	    		IO$_SETMODE BY VALUE,	&
				,,,    	&
				PORT_MODE(0) BY REF,		&
				12% BY VALUE,,,	&
				PARITY_FLAGS BY VALUE,)
      	          END IF
	        CASE = "SPEED"
	          IF NUM_PARAMS < 2 THEN
	            JUNK = ERRORS("Not enough parameters - command ignored")
	            GOTO FORCE_ABORT		!force an abort
	          ELSE
	            SELECT SCR_PARAM(2)
	              CASE = "110"
	                BAUD_RATE = TT$C_BAUD_110
	              CASE = "300"
	                BAUD_RATE = TT$C_BAUD_300
	              CASE = "1200"
	                BAUD_RATE = TT$C_BAUD_1200
	              CASE = "2400"
	                BAUD_RATE = TT$C_BAUD_2400
	              CASE = "4800"
	                BAUD_RATE = TT$C_BAUD_4800
	              CASE = "9600"
	                BAUD_RATE = TT$C_BAUD_9600
	              CASE = "19200"
	                BAUD_RATE = TT$C_BAUD_19200
	              CASE ELSE
	                JUNK = ERRORS("Invalid speed - command ignored")
	                GOTO FORCE_ABORT       	       	!force an abort
	            END SELECT
	            JUNK = SYS$QIOW(!efn!, PORT_CHAN BY VALUE, &
	     	    		IO$_SETMODE BY VALUE,	&
				,,,    	&
				PORT_MODE(0) BY REF,		&
				12% BY VALUE,	&
				BAUD_RATE BY VALUE,,,)
	          END IF
	      END SELECT
	    END IF
	  CASE = 'GOTO'
	    IF NUM_PARAMS < 1 THEN
	      JUNK = ERRORS("Not enough parameters - command ignored")
	      GOTO FORCE_ABORT		!force an abort
	    ELSE
	      FOR I = 1 TO NUM_LABELS
	        IF LABEL_NAME(I) = EDIT$(SCR_PARAM(1), 32) THEN
	          SCRIPT_PTR = LABELS(I)
	          GOTO GOTO_LABEL
	        END IF
	      NEXT I
	      JUNK = ERRORS("Label not found - command ignored")
	      GOTO FORCE_ABORT		!force an abort
 GOTO_LABEL:
	    END IF
	  CASE = 'SEND'
	    IF NUM_PARAMS < 1 THEN
	      JUNK = ERRORS("Not enough parameters - command ignored")
	      GOTO FORCE_ABORT		!force an abort
	    ELSE
	      FOR J = 1 TO NUM_PARAMS
	        FOR I = 1 TO LEN(SCR_PARAM(J))
	          GOTO SEND_STRING IF SEG$(SCR_PARAM(J), I, I) < '0' OR &
		      	SEG$(SCR_PARAM(J), I, I) > '9'
	        NEXT I
	        WHEN ERROR IN
	          SCR_PARAM(J) = CHR$(VAL%(SCR_PARAM(J)))
	        USE
	          JUNK = ERRORS("Invalid parameter value - command ignored")
	          CONTINUE FORCE_ABORT	!force an abort
	        END WHEN
	        GOTO SEND_ANY

 SEND_STRING:
	        IF SCR_PARAM(J) = '#' THEN
	          !send number saved by DIAL command:
	          SCR_PARAM(J) = EDIT$(DIAL_NUM, 128)
	        ELSE
	          SCR_PARAM(J) = GET_STRING(SCR_PARAM(J), FALSE)
	        END IF
 SEND_ANY:
	        JUNK = SYS$SETAST(0% BY VALUE)	!no interruptions
	        LOG_BUF_S = ""		!clear buffer
	        LOG_PTR = 0		!clear buffer pointer
	        JUNK = SYS$SETAST(1% BY VALUE)	!interruptions OK
	        !copy output to port:
	        IF SEND_PAUSE > 0 THEN
	          FOR I = 1 TO LEN(SCR_PARAM(J))
	            BUF_FER = SEG$(SCR_PARAM(J), I, I)
	            JUNK = SYS$QIOW(, PORT_CHAN BY VALUE,	&
		    			TERM_WRITE_CODE BY VALUE,	&
					PORT_OUT_IOSB() BY REF,,,	&
					BUF_FER BY REF,		&
					1% BY VALUE,,,,)
	            JUNK = SNOOZE(SEND_PAUSE)
	          NEXT I
	        ELSE
	          BUF_FER = SCR_PARAM(J)
	          JUNK = SYS$QIOW(, PORT_CHAN BY VALUE,	&
		    			TERM_WRITE_CODE BY VALUE,	&
					PORT_OUT_IOSB() BY REF,,,	&
					BUF_FER BY REF,		&
					LEN(BUF_FER) BY VALUE,,,,)
	        END IF
	      NEXT J
	    END IF
	  CASE = 'TYPE'
	    IF NUM_PARAMS < 1 THEN
	      JUNK = ERRORS("Not enough parameters - command ignored")
	      GOTO FORCE_ABORT		!force an abort
	    ELSE
	      SCR_PARAM(1) = GET_STRING(SCR_PARAM(1), TRUE)
	      I = POS(SCR_PARAM(1), CHR$(13), 1)
	      WHILE I > 0
	        !insert <LF> after <CR>:
	        SCR_PARAM(1) = SEG$(SCR_PARAM(1), 1, I) + CHR$(10) + &
			SEG$(SCR_PARAM(1), I + 1, LEN(SCR_PARAM(1)))
	        I = POS(SCR_PARAM(1), CHR$(13), I + 1)
	      NEXT
	      !type it:
	      PRINT SCR_PARAM(1);
	      SLEEP 1
	    END IF
	  CASE = 'INPUT'
	    GOSUB GET_INPUT	!read input from port & set flags
	  CASE = 'IF', 'IFNOT'
	    GOSUB IF_IFNOT	!process conditional
	  CASE = 'DIAL'
	    IF NUM_PARAMS < 1 THEN
	      JUNK = ERRORS("Not enough parameters - command ignored")
	      GOTO FORCE_ABORT		!force an abort
	    ELSE
	      SCR_PARAM(1) = GET_STRING(SCR_PARAM(1), FALSE)
	      DIAL_NUM = SCR_PARAM(1)
	      GOSUB PROCESS_DIAL	!contains re-entrant call
	    END IF
	  CASE = 'CONNECT'
	    GOSUB GO_ONLINE		!connect the user
	  CASE = 'ABORT'
	    GOSUB DUMP_ERROR		!dump the buffer contents
	    ABORT_TEXT = GET_STRING(SCR_PARAM(1), FALSE)
	    CALL LIB$SET_SYMBOL("ABORT_TEXT", EDIT$(ABORT_TEXT, 4%), 1%)
	    FUNC_STATUS = SS$_ABORT
	    GOTO END_OF_PROGRAM
	  CASE = 'WAIT'
	    IF NUM_PARAMS < 1 THEN
	      JUNK = ERRORS("Not enough parameters - command ignored")
	      GOTO FORCE_ABORT		!force an abort
	    ELSE
	      WHEN ERROR IN
	        I = VAL%(SCR_PARAM(1))	!get 10ths of second
	      USE
	        JUNK = ERRORS("Invalid parameter value - command ignored")
	        CONTINUE FORCE_ABORT	!force an abort
	      END WHEN
	      JUNK = SNOOZE(I)	!sleep specified time
	    END IF
	  CASE ELSE		!nothing else allowed - ignore it
	    JUNK = ERRORS("Illegal command - ignored")
	    GOTO FORCE_ABORT		!force an abort
	END SELECT
	GOTO IGNORE_CMD

 FORCE_ABORT:
	SCR_PARAM(0) = "ABORT"
	SCR_PARAM(1) = "Script syntax error"
	NUM_PARAMS = 1%
	GOSUB PROCESS_COMMAND	!re-entrant call

 IGNORE_CMD:
	RETURN

 GET_INPUT:
 	!**************************************************
	!get input from port 
	!applies min & max times
	!sets condition flags
	!**************************************************

	!find interval & count
	GI_INTERVAL = -1
	GI_COUNT = -1
	GI_PAR_OMITTED = 0
	GI_INTERVAL = VAL%(SCR_PARAM(1))	!see if max or min specified
	GI_COUNT = VAL%(SCR_PARAM(2))
	IF GI_INTERVAL = -1 OR SCR_PARAM(1) = '' THEN
	  !no interval spec: default 1 SECOND
	  GI_PAR_OMITTED = GI_PAR_OMITTED + 1
	  GI_INTERVAL = 1
	END IF
	IF GI_COUNT = -1 OR SCR_PARAM(2) = '' THEN
 	  !no count spec: default ONCE
	  GI_PAR_OMITTED = GI_PAR_OMITTED + 1
	  GI_COUNT = 1
	END IF

	GI_STRING_COUNT = NUM_PARAMS - 2 + GI_PAR_OMITTED
	!ignore excess parameters:
	GI_STRING_COUNT = N_FLAGS IF GI_STRING_COUNT > N_FLAGS
	FOR J = 3 - GI_PAR_OMITTED TO GI_STRING_COUNT + 2 - GI_PAR_OMITTED
	  SCR_PARAM(J) = GET_STRING(SCR_PARAM(J), TRUE)
	NEXT J
	IF POS(DEBUG_FLAG, "4", 1) > 0 THEN
	  PRINT
	  PRINT "          GET_INPUT debugging:"
	  PRINT "          "; GI_INTERVAL, GI_COUNT
	  PRINT "          "; 
	  FOR I = 1 TO GI_STRING_COUNT
	    PRINT SCR_PARAM(I + 2 - GI_PAR_OMITTED); " ";
	  NEXT I
 	  PRINT
	  PRINT "          parameters omitted: "; GI_PAR_OMITTED
	END IF

	!now have all parameters, so do the command:
	COND_FLAG(I) = FALSE FOR I = 0 TO N_FLAGS	!clear flags
	I = 0
	WHILE I < GI_COUNT
	  SLEEP GI_INTERVAL		!wait specified time
	  I = I + 1
	  FOR J = 3 - GI_PAR_OMITTED TO GI_STRING_COUNT + 2 - GI_PAR_OMITTED
	    IF POS(LOG_BUF_S, SCR_PARAM(J), 1) > 0 THEN
	      !found a match on the Jth string
	      COND_FLAG(J - 2 + GI_PAR_OMITTED) = TRUE
	      JUNK = SYS$SETAST(0% BY VALUE)	!no interruptions
	      LOG_BUF_S = ""		!clear buffer
	      LOG_PTR = 0		!clear buffer pointer
	      JUNK = SYS$SETAST(1% BY VALUE)	!interruptions OK
	      GOTO GET_INPUT_EXIT	!stop checking
	    ELSE
	      IF POS(DEBUG_FLAG, "4", 1) > 0 THEN
	        PRINT
	        PRINT "          No match on string:"
	        PRINT SCR_PARAM(J)
	        PRINT
	        PRINT LOG_PTR
	        FOR JUNK = 0 TO 159
	          PRINT USING "### "; LOG_BUF(JUNK);
	          PRINT IF MOD(JUNK, 20%) = 19%
	        NEXT JUNK
	        PRINT
	      END IF
	    END IF
	  NEXT J
	NEXT
	!drop through loop means no match; i.e. timeout
	COND_FLAG(0) = TRUE

	IF POS(DEBUG_FLAG, "5", 1) > 0 THEN
	  PRINT "          INPUT Condition flags: ";
	  FOR I = 0 TO N_FLAGS
	    IF COND_FLAG(I) = TRUE THEN
	      PRINT "T";
	    ELSE
	      PRINT "F";
	    END IF
	  NEXT I
	  PRINT
	END IF

 GET_INPUT_EXIT:
	RETURN

 IF_IFNOT:
 	!**************************************************
	!checks condition flag and branches if set/not set
	!
	!IF_IFNOT calls PROCESS_COMMAND re-entrantly
	!
	!**************************************************

	IF POS(DEBUG_FLAG, "5", 1) > 0 THEN
	  PRINT "          IF/IFNOT Condition flags: ";
	  FOR I = 0 TO N_FLAGS
	    IF COND_FLAG(I) = TRUE THEN
	      PRINT "T";
	    ELSE
	      PRINT "F";
	    END IF
	  NEXT I
	  PRINT
	END IF
 
	I = -1
	SELECT SCR_PARAM(1)
	  CASE = 'ECHO'
	    IF ((SCR_PARAM(0) = 'IF') AND (NOT ECHO_FLAG)) THEN
	      GOTO  END_IF_IFNOT	!condition is false
	    END IF
	    IF ((SCR_PARAM(0) = 'IFNOT') AND (ECHO_FLAG)) THEN
	      GOTO  END_IF_IFNOT	!condition is false
	    END IF
	    !condition is true...
	    I = 2%	!'goto' parameter
	    GOTO IF_IFNOT_BRANCH
	  CASE = 'VIEW'
	    IF ((SCR_PARAM(0) = 'IF') AND (NOT VIEW_FLAG)) THEN
	      GOTO  END_IF_IFNOT	!condition is false
	    END IF
	    IF ((SCR_PARAM(0) = 'IFNOT') AND (VIEW_FLAG)) THEN
	      GOTO  END_IF_IFNOT	!condition is false
	    END IF
	    !condition is true...
	    I = 2%	!'goto' parameter
	    GOTO IF_IFNOT_BRANCH
	  CASE = 'CLASS'
	    SCR_PARAM(2) = GET_STRING(SCR_PARAM(2), FALSE)
	    IF ((SCR_PARAM(0) = 'IF') AND &
		(SCR_PARAM(2) <> TRM$(MODEM_CLASS))) THEN
	      GOTO END_IF_IFNOT	!condition is false
	    END IF
	    IF ((SCR_PARAM(0) = 'IFNOT') AND &
		(SCR_PARAM(2) = TRM$(MODEM_CLASS))) THEN
	      GOTO END_IF_IFNOT	!condition is false
	    END IF
	    I = 3%	!'goto' parameter
	    GOTO IF_IFNOT_BRANCH
	  CASE = 'MODEM'
	    SCR_PARAM(2) = GET_STRING(SCR_PARAM(2), FALSE)
	    IF ((SCR_PARAM(0) = 'IF') AND &
		(SCR_PARAM(2) <> TRM$(MODEM_TYPE))) THEN
	      GOTO END_IF_IFNOT	!condition is false
	    END IF
	    IF ((SCR_PARAM(0) = 'IFNOT') AND &
		(SCR_PARAM(2) = TRM$(MODEM_TYPE))) THEN
	      GOTO END_IF_IFNOT	!condition is false
	    END IF
	    I = 3%	!'goto' parameter
	    GOTO IF_IFNOT_BRANCH
	  CASE = 'NODE'
	    SCR_PARAM(2) = GET_STRING(SCR_PARAM(2), FALSE)
	    IF ((SCR_PARAM(0) = 'IF') AND &
		(SCR_PARAM(2) <> TRM$(NODE_NAME))) THEN
	      GOTO END_IF_IFNOT	!condition is false
	    END IF
	    IF ((SCR_PARAM(0) = 'IFNOT') AND &
		(SCR_PARAM(2) = TRM$(NODE_NAME))) THEN
	      GOTO END_IF_IFNOT	!condition is false
	    END IF
	    I = 3%	!'goto' parameter
	    GOTO IF_IFNOT_BRANCH
	  CASE = 'PORT'
	    SCR_PARAM(2) = GET_STRING(SCR_PARAM(2), FALSE)
	    IF ((SCR_PARAM(0) = 'IF') AND &
		(SCR_PARAM(2) <> TRM$(PORT_NAME))) THEN
	      GOTO END_IF_IFNOT	!condition is false
	    END IF
	    IF ((SCR_PARAM(0) = 'IFNOT') AND &
		(SCR_PARAM(2) = TRM$(PORT_NAME))) THEN
	      GOTO END_IF_IFNOT	!condition is false
	    END IF
	    I = 3%	!'goto' parameter
	    GOTO IF_IFNOT_BRANCH
	  CASE = 'TIMEOUT'
	    I = 0
	  CASE ELSE	!should be a condition flag in range 1-N_FLAGS...
	    I = VAL%(SCR_PARAM(1))
	END SELECT
	IF I < 0 OR I > N_FLAGS THEN
	  JUNK = ERRORS('Condition flag out of range - command ignored')
	  GOSUB PROCESS_COMMAND	!force an abort
	  GOTO END_IF_IFNOT
	END IF

	!check condition flag:
	IF SCR_PARAM(0) = 'IF' AND COND_FLAG(I) = FALSE THEN
	  GOTO END_IF_IFNOT
	END IF
	IF SCR_PARAM(0) = 'IFNOT' AND COND_FLAG(I) = TRUE THEN
	  GOTO END_IF_IFNOT
	END IF
	I = 2%		!'goto' parameter

 IF_IFNOT_BRANCH:
	SCR_PARAM(0) = 'GOTO'		!fake a goto
	IF SCR_PARAM(I) = 'GOTO' THEN
	  SCR_PARAM(1) = SCR_PARAM(I+1)	!label
	ELSE
	  SCR_PARAM(1) = SCR_PARAM(I)	!label
	END IF
	NUM_PARAMS = 1
	GOSUB PROCESS_COMMAND		!re-entrant call for GOTO

 END_IF_IFNOT:
	RETURN

 DUMP_ERROR:
	!**********************************************************************
	!in event of an error, dumps input buffer to file
	!**********************************************************************

	OPEN ERROR_DIR + "EXT_" + NOW + ERROR_EXT FOR OUTPUT &
	     	AS FILE #ERR_CHAN,	&
		ORGANIZATION SEQUENTIAL FIXED,	&
		ACCESS WRITE,	&
		MAP LOG_BUF_MAP

	PUT #ERR_CHAN	!dump buffer to file
	CLOSE #ERR_CHAN

	RETURN

 READ_SCRIPT:
 	!**************************************************
	!reads specified script 
	!**************************************************

	END_OF_FILE = FALSE
	SCRIPT_PTR = 0
	WHILE NOT (END_OF_FILE)
	  GOSUB GET_LINE
	  GOSUB PARSE_SCRIPT
	  IF NOT END_OF_FILE THEN
	    SELECT SCR_PARAM(0)
	      CASE = 'ABORT'
	        IF SCRIPT_TYPE <> "D" THEN
	          SAVE_SCRIPT_LINE = TRUE
	        ELSE
	          SAVE_SCRIPT_LINE = FALSE
	          JUNK = ERRORS("Can't use ABORT command in " + &
			"disconnect script - ignored")
	        END IF
	      CASE = 'DIAL', 'CONNECT'
	        IF SCRIPT_TYPE = "S" THEN
	          SAVE_SCRIPT_LINE = TRUE
	        ELSE
	          SAVE_SCRIPT_LINE = FALSE
	          JUNK = ERRORS("Can't use " + SCR_PARAM(0) + " command in " + &
			"connect/disconnect script - ignored")
	        END IF
	      CASE = 'LABEL' 	!save labels
	        SAVE_SCRIPT_LINE = FALSE
	        IF NUM_PARAMS < 1 THEN
	          JUNK = ERRORS("Not enough parameters - label ignored")
	        ELSE
	          NUM_LABELS = NUM_LABELS + 1
	          LABEL_NAME(NUM_LABELS) = EDIT$(SCR_PARAM(1), 32)
	          LABELS(NUM_LABELS) = SCRIPT_PTR + 1
	        END IF
	      CASE = "!", ""
		!don't save comments or blank lines:
	        SAVE_SCRIPT_LINE = FALSE
	      CASE ELSE
	        SAVE_SCRIPT_LINE = TRUE
	    END SELECT
	    IF SAVE_SCRIPT_LINE THEN
	      SCRIPT_PTR = SCRIPT_PTR + 1
	      SCRIPT(SCRIPT_PTR) = SCRIPT_BUF
	    END IF
	  END IF
	NEXT
	CLOSE #SCR_FILE
	NUM_SCRIPT_LINES = SCRIPT_PTR

	IF POS(DEBUG_FLAG, "2", 1) > 0 THEN
	  PRINT
	  PRINT "          "; SCRIPT_TYPE; "SCRIPT:"
	  PRINT
	  FOR I = 1 TO SCRIPT_PTR
	    PRINT I, SCRIPT(I)
	  NEXT I
	  PRINT
	  PRINT "          "; SCRIPT_TYPE; "LABELS:"
	  PRINT
	  FOR I = 1 TO NUM_LABELS
	    PRINT I, LABEL_NAME(I), LABELS(I)
	  NEXT I
	  SLEEP 3
	END IF

	RETURN

 PROCESS_DIAL:
 	!**************************************************
	!runs the connection (dial) script
	!
	!PROCESS_DIAL calls PROCESS_COMMAND re-entrantly
	!
	!**************************************************

	!run the connect script...
	JUNK = EXT_SCRIPT_INTERP(TRM$(MODEM_TYPE), "C", SCR_FILE+1%)

	!check for trouble...
	IF (JUNK AND 1%) = 0% THEN
	  FUNC_STATUS = JUNK
	  GOTO END_OF_PROGRAM
	END IF

	RETURN

	%PAGE
	%SBTTL "FUNCTION DEFINITION SECTION"
20000	!======================================================================
	!			FUNCTION DEFINITION SECTION
	!======================================================================

	!**************************************************
	!handles syntax errors
	!**************************************************

	DEF WORD ERRORS(STRING ERR_TEXT)

	SCR_PARAM(0) = "ABORT"	!force an abort
	SCR_PARAM(1) = "Script Syntax Error"
	NUM_PARAMS = 1

	PRINT
	PRINT "Script syntax error - Contact Computer Services"
	PRINT "  Script line: "; SCRIPT_BUF
	PRINT "  "; ERR_TEXT
	SLEEP 3
	ERRORS = 0

20099	END DEF

20100	!**************************************************
	!accept string
	!strip quotes
	!replace "^" with CRLF
	!**************************************************

	DEF STRING GET_STRING(STRING GS_STRING, WORD GS_LINEFEED)

	DECLARE STRING GS_TEMP

	GS_TEMP = GS_STRING
	!strip quotes:
	I = LEN(GS_TEMP)
	IF (SEG$(GS_TEMP, 1, 1) = "'" OR &
		    SEG$(GS_TEMP, 1, 1) = '"') AND &
	    SEG$(GS_TEMP, I, I) = SEG$(GS_TEMP, 1, 1) THEN
	  GS_TEMP = SEG$(GS_TEMP, 2, I - 1)
	END IF
	!insert CRs:
	I = POS(GS_TEMP, "^", 1)
	WHILE I > 0
	  IF GS_LINEFEED THEN
	    GS_TEMP = SEG$(GS_TEMP, 1, I - 1) + CHR$(13) + &
			CHR$(10) + SEG$(GS_TEMP, I + 1, LEN(GS_TEMP))
	  ELSE
	    GS_TEMP = SEG$(GS_TEMP, 1, I - 1) + CHR$(13) + &
			SEG$(GS_TEMP, I + 1, LEN(GS_TEMP))
	  END IF
	  I = POS(GS_TEMP, "^", 1)
	NEXT
	GET_STRING = GS_TEMP

20199	END DEF

20500	!**********************************************************************
	! snooze function accepts a time in 10ths of a second and places the
	! process in a hibernate state for the requested length of time (max 
	! of 60 seconds).
	!**********************************************************************

	DEF WORD SNOOZE(WORD SNOOZE_TIME)

	SNOOZE_SECS = NUM1$(SNOOZE_TIME / 10)
	SNOOZE_SECS = SNOOZE_SECS + "." IF POS(SNOOZE_SECS, ".", 1) = 0
	WHILE POS(SNOOZE_SECS, ".", 1) < 3
	  SNOOZE_SECS = "0" + SNOOZE_SECS
	NEXT
	WHILE LEN(SNOOZE_SECS) < 5
	  SNOOZE_SECS = SNOOZE_SECS + "0"
	NEXT
	DELTA_TIME = "0 00:00:" + SNOOZE_SECS
	
	! convert input time to binary time format
	CALL SYS$BINTIM(DELTA_TIME, BINARY_TIME BY REF)

	! set schedule wake up call
	CALL SYS$SCHDWK(,,BINARY_TIME BY REF,)

	! place process in hibernate until wake up call
	CALL SYS$HIBER()

	SNOOZE = 0
20599	END DEF

	!**********************************************************************
     	!returns current date/time as YYMMDDHHMMSS
	!**********************************************************************

	DEF STRING NOW

	DECLARE WORD &
		NOW_BUF(6)

	DECLARE LONG &
		NOW_LONG

	DECLARE STRING &
		NOW_STR

	JUNK = SYS$NUMTIM(NOW_BUF(0), !timadr!)
	NOW_LONG = 1000000% + NOW_BUF(3) * 10000% + &
		NOW_BUF(4) * 100% + NOW_BUF(5)
	NOW_STR = SEG$(NUM1$(NOW_LONG), 2, 7)
	NOW_LONG = NOW_BUF(0) * 10000% + &
		NOW_BUF(1) * 100% + NOW_BUF(2)
	NOW_STR = SEG$(NUM1$(NOW_LONG), 3, 8) + NOW_STR
	NOW = NOW_STR
	END DEF

	%PAGE                                                                  
	%SBTTL "ERROR HANDLING SECTION"
25000	!======================================================================
	!			ERROR HANDLING SECTION
	!======================================================================

 ERROR_HANDLING:
	IF ERR = 28% THEN	!^C trap
	  FUNC_STATUS = SS$_ABORT
	  CALL LIB$SET_SYMBOL("ABORT_TEXT", "Interrupted by user")
	  RESUME END_OF_PROGRAM
	END IF
	ON ERROR GOTO 0

	!======================================================================
	!			END OF PROGRAM
	!======================================================================

 END_OF_PROGRAM:
	CLOSE #SCR_FILE
	EXIT FUNCTION FUNC_STATUS

32767	END FUNCTION
