C		SYST:[SYSLOGIN]LOGIN.FOR
C
C		This program defines standard symbols at login for each 
C		process and if the process is not a batch job it performs the 
C		necessary line assignment functions (i.e., defining SYS$PRINT).
C
C	Algorithm: 
C		The program first performs system service calls and sets up 
C		the following variables for use in later parts of the program:
C
C		Variable	Use
C		------------	----------------------------------
C		GROUP		The UIC group number of the user.
C		MODE		The mode of the process (0 = Other, 
C				  1 = Network, 2 = Batch, 3 = Interactive)
C		TERM64		64-byte, zero-filled, device name
C		TERM64_LEN	The length of the string return for the 
C				  device name
C		TERM		6-byte physical device name (null device is 
C				  not a virtual terminal).
C		DIALUP		Defined in TERMTESTER segment, TRUE if dialup 
C				  user.
C		REMOTE		Defined in TERMTESTER segment, TRUE if remote 
C				user (e.g. MODE = 1 or TERM64 = _RTAn:).
C
C	Written by Forrest L. Piehl 10/21/85 using parts of SYMBOL.FOR and 
C		TERMTESTER.FOR.  For information about calling system 
C		services consult the VAX/VMS System Services Reference Manual 
C		and the Guide to Programming on VAX/VMS (FORTRAN Edition).
C
C
	PROGRAM LOGIN
C
C		Include the definitions for the system service calls
C
	INCLUDE '($JPIDEF)'
	INCLUDE '($DVIDEF)'
C
C		Declare ITMLST for SYS$GETJPIW call
C
	STRUCTURE /JPI_ITMLST/
	 UNION
	  MAP
	   INTEGER*2 JPI_BUFLEN
	   INTEGER*2 JPI_CODE
	   INTEGER*4 JPI_BUFADR
	   INTEGER*4 JPI_RETLENADR
	  END MAP
	  MAP
	   INTEGER*4 JPI_END_LIST
	  END MAP
	 END UNION
	END STRUCTURE
	RECORD /JPI_ITMLST/ JPI_LIST(3)
C
C		Declare ITMLST for SYS$GETDVIW call
C
	STRUCTURE /DVI_ITMLST/
	 UNION
	  MAP
	   INTEGER*2 DVI_BUFLEN
	   INTEGER*2 DVI_CODE
	   INTEGER*4 DVI_BUFADR
	   INTEGER*4 DVI_RETLENADR
	  END MAP
	  MAP
	   INTEGER*4 DVI_END_LIST
	  END MAP
	 END UNION
	END STRUCTURE
	RECORD /DVI_ITMLST/ DVI_LIST(3)
C
	INTEGER*4 GROUP, GROUP_LEN, MODE, MODE_LEN, TERM64_LEN, TERM_LEN
	INTEGER*4 ISTATUS, SYS$GETJPIW, SYS$GETDVIW, LIB$SET_SYMBOL, 
	1 LIB$SET_LOGICAL, LIB$SIGNAL, SYS$SETDFPROT
	INTEGER*2 DEFPROT, IOSB(2)
	CHARACTER*91 GP19_ESC
	CHARACTER*64 TERM64
	CHARACTER*6 TERM
	CHARACTER*5 SR0324
	CHARACTER*4 ES
	CHARACTER*3 HOME, DW, DHT, DHB, SRNORM
	CHARACTER*1 BELL
	LOGICAL DIALUP		! TRUE if user is on one of the dialup lines
	LOGICAL REMOTE		! TRUE if user is on Network or used SET HOST
	LOGICAL NO_BANNER	! TRUE if terminal always displays short banner
	VOLATILE ISTATUS
C
	BELL = CHAR(7)
C
C		Make assignments for SYS$GETJPI call
C
	JPI_LIST(1).JPI_BUFLEN = 4
	JPI_LIST(1).JPI_CODE = JPI$_GRP
	JPI_LIST(1).JPI_BUFADR = %LOC(GROUP)
	JPI_LIST(1).JPI_RETLENADR = %LOC(GROUP_LEN)
	JPI_LIST(2).JPI_BUFLEN = 4
	JPI_LIST(2).JPI_CODE = JPI$_MODE
	JPI_LIST(2).JPI_BUFADR = %LOC(MODE)
	JPI_LIST(2).JPI_RETLENADR = %LOC(MODE_LEN)
	JPI_LIST(3).JPI_END_LIST = 0
	ISTATUS = SYS$GETJPIW (,,,JPI_LIST,IOSB,,)
	ISTATUS = IOSB(1)
	IF (.NOT. ISTATUS) CALL LIB$SIGNAL (%VAL(ISTATUS))
C
C		Make assignments for SYS$GETDVI call
C
	DVI_LIST(1).DVI_BUFLEN = 64
	DVI_LIST(1).DVI_CODE = DVI$_DEVNAM
	DVI_LIST(1).DVI_BUFADR = %LOC(TERM64)
	DVI_LIST(1).DVI_RETLENADR = %LOC(TERM64_LEN)
	DVI_LIST(2).DVI_BUFLEN = 6
	DVI_LIST(2).DVI_CODE = DVI$_TT_PHYDEVNAM
	DVI_LIST(2).DVI_BUFADR = %LOC(TERM)
	DVI_LIST(2).DVI_RETLENADR = %LOC(TERM_LEN)
	DVI_LIST(3).DVI_END_LIST = 0
	ISTATUS = SYS$GETDVIW (,,'tt:',DVI_LIST,IOSB,,,)
	ISTATUS = IOSB(1)
	IF (.NOT. ISTATUS) CALL LIB$SIGNAL (%VAL(ISTATUS))
C
C		Set default file protection to be (S:REWD,O:RWED,G,W)
C
	DEFPROT = 0
C
C		Set Group access to none.
C
	DEFPROT = IBSET (DEFPROT,8)
	DEFPROT = IBSET (DEFPROT,9)
	DEFPROT = IBSET (DEFPROT,10)
	DEFPROT = IBSET (DEFPROT,11)
C
C		Set World access to none.
C
	DEFPROT = IBSET (DEFPROT,12)
	DEFPROT = IBSET (DEFPROT,13)
	DEFPROT = IBSET (DEFPROT,14)
	DEFPROT = IBSET (DEFPROT,15)
	ISTATUS = SYS$SETDFPROT (%REF(DEFPROT),)
	IF (.NOT. ISTATUS) CALL LIB$SIGNAL(%VAL(ISTATUS))
C
C	PROVIDE STANDARD SYMBOL DEFINITIONS AT LOGIN FOR EACH PROCESS
C
C	4/19/85		MARY E. HAUG
C			KALAMAZOO COLLEGE
C
C	9/9/85 		R. D. PICCARD - REV. FOR COMMAND FILES
C
C
      ISTATUS = LIB$SET_SYMBOL('GET','@SYST:[SYSLOGIN]GET',2)
C
      ISTATUS = LIB$SET_SYMBOL('NEWFOOT',
     -'edit/tpu/section=syst:[syslogin]kazsecini
     -/command=syst:[syslogin]cleanfoot',2)
C
      ISTATUS = LIB$SET_SYMBOL('polyxfr','@syst:[polyxfr]hst',2)
C
      ISTATUS = LIB$SET_SYMBOL('SAY','WRITE SYS$OUTPUT',2)
C
      ISTATUS = LIB$SET_SYMBOL('SQ','@SYST:[SYSLOGIN]SHOWQUEUE',2)
C
      ISTATUS = LIB$SET_SYMBOL('TESTING','@Examiner:[product]TAKEONE',2)
C
      ISTATUS = LIB$SET_SYMBOL('krautnec',
     -'edit/tPU/SECTION=SYST:[SYSLOGIN]KAZSECINI
     -/command=syst:[syslogin]krautnec.TPU/output=[]krautnec.rno',2)
C
      ISTATUS = LIB$SET_SYMBOL('SUPER','@syst:[syslogin]SUPER',2)
C
      ISTATUS = LIB$SET_SYMBOL('nam*es','@syst:[sysprogs.nam]names',2)
C
      ISTATUS = LIB$SET_SYMBOL('for*tran','fortran/nooptimize',2)
C
      ISTATUS = LIB$SET_SYMBOL('PAS*CAL','PASCAL/nooptimize',2)
C
      ISTATUS = LIB$SET_SYMBOL('SOS','EDIT/SOS',2)
C
      ISTATUS = LIB$SET_SYMBOL('TECO','$SYS$SYSTEM:TECO TECO',2)
C
      ISTATUS = LIB$SET_SYMBOL('MAKE','$SYS$SYSTEM:TECO MAKE',2)
C
      ISTATUS = LIB$SET_SYMBOL('MENU','@SYS$SYSDEVICE:[SYSLOGIN]SYSMENU',2)
C
      ISTATUS = LIB$SET_SYMBOL('NEWS',
	1'@SYS$SYSDEVICE:[SYSPROGS.NEWSLETTER]SYSLETTER',2)
C
      ISTATUS = LIB$SET_SYMBOL('BANNER','TYPE SYST:[SYSLOGIN]BANNER.TXT',2)
C
      ISTATUS = LIB$SET_SYMBOL('ALBERS','RUN SYST:[SYSPROGS]ALBERS',2)
C
      ISTATUS = LIB$SET_SYMBOL('BIOSIM','@SYST:[SYSPROGS]BIOSIM',2)
C
      ISTATUS = LIB$SET_SYMBOL('CDSEARCH','RUN SYST:[SYSPROGS]CDSEARCH',2)
C
      ISTATUS = LIB$SET_SYMBOL('MINITAB','RUN SYS$MINITAB:MINITAB',2)
C
      ISTATUS = LIB$SET_SYMBOL('SPSSX','$ SPSSX',2)
C
      ISTATUS = LIB$SET_SYMBOL('SURFACE','@SYST:[SYSPROGS]FUNC',2)
C
      ISTATUS = LIB$SET_SYMBOL('SLOW ','SUBMIT/NOPRINTER/NOTIFY/QUEUE=
     -SYS$BATCH',2)
C
      ISTATUS = LIB$SET_SYMBOL('QUICK','SUBMIT/NOPRINTER/NOTIFY/QUEUE=
     -FASTBATCH',2)
C
      ISTATUS = LIB$SET_SYMBOL('REF','@SYST:[SYSLOGIN]REF',2)
C
      ISTATUS = LIB$SET_SYMBOL('MPGI','RUN SYS$SYSROOT:[SYSEXE]MPGI',2)
C
      ISTATUS = LIB$SET_SYMBOL('MATCOMP','RUN SYST:[SYSPROGS]MATCOMP',2)
C
      ISTATUS = LIB$SET_SYMBOL('MINIDYN','@SYS$SYSDEVICE:[SYSLOGIN]MINIDYN',2)
C
      ISTATUS = LIB$SET_SYMBOL('GLINK','@SYST:[SYSLOGIN]PLOTLINK',2)
C
      ISTATUS = LIB$SET_SYMBOL('HEYL','SET HOST HEYL',2)
C
      ISTATUS = LIB$SET_SYMBOL('HEYLOG','@SYS$SYSDEVICE:[SYSLOGIN]HEYLOG',2)
C
      ISTATUS = LIB$SET_SYMBOL('PRDEL','@SYS$SYSDEVICE:[SYSLOGIN]SYSPRDEL',2)
C
      ISTATUS = LIB$SET_SYMBOL('PRSPC','@SYS$SYSDEVICE:[SYSLOGIN]SYSPRSPC',2)
C
      ISTATUS = LIB$SET_SYMBOL('PRGO*OD','PRINT/NOFLAG/SETUP=LETTER',2)
C
      ISTATUS = LIB$SET_SYMBOL('PR*INT','PRINT/NOFLAG',2)
C
      ISTATUS = LIB$SET_SYMBOL('PRSQ*UEEZE','PRINT/NOFLAG/SETUP=CONDENSED',2)
C
      ISTATUS = LIB$SET_SYMBOL('LO*GOUT','@SYS$SYSDEVICE:[SYSLOGIN]SYSLOGOUT',2)
C
      ISTATUS = LIB$SET_SYMBOL('DEL*ETE','DELETE/CONFIRM',2)
C
C		Symbols for faculty and staff use
C
	IF ((GROUP .NE. '77'O) .AND. (GROUP .NE. 1)) GOTO 90
C
	ISTATUS = LIB$SET_SYMBOL('MAKING','@EXAMINER:[PRODUCT]FACULTY.COM',2)
C
	ISTATUS = LIB$SET_SYMBOL('NEWPAPER','@SYST:[SYSLOGIN]NEWPAPER',2)
C
	ISTATUS = LIB$SET_SYMBOL('NEC',
	1'PRINT/NOTIFY/NOFLAG/FORM=PLAIN/QUEUE=NEC$PRINT',2)
C
	ISTATUS = LIB$SET_SYMBOL('NECSPC','@SYST:[SYSLOGIN]NECSPC',2)
C
C		Let Batch Jobs skip screen control symbols and line 
C		assignments, and exit.
C
90	IF (MODE .EQ. 2) GOTO 3000
C
C		Screen control symbol definitions
C
C		Define ESC as the ESCAPE character
	ISTATUS = LIB$SET_SYMBOL('ESC',CHAR(27),2)
C		ES erases the screen
	ES = CHAR(27)//'[2J'
	ISTATUS = LIB$SET_SYMBOL('ES',ES,2)
C		HOME moves the cursor to the home position
	HOME = CHAR(27)//'[H'
	ISTATUS = LIB$SET_SYMBOL('HOME',HOME,2)
C		DW types the current line double width
	DW = CHAR(27)//'#6'
	ISTATUS = LIB$SET_SYMBOL('DW',DW,2)
C		DHT types the top part of the current line double heigth
	DHT = CHAR(27)//'#3'
	ISTATUS = LIB$SET_SYMBOL('DHT',DHT,2)
C		DHB types the bottom part of the current line double heigth
	DHB = CHAR(27)//'#4'
	ISTATUS = LIB$SET_SYMBOL('DHB',DHB,2)
C		SR0324 sets the scrolling region as lines 3 - 24
	SR0324 = CHAR(27)//'[3;r'
	ISTATUS = LIB$SET_SYMBOL('SR0324',SR0324,2)
C		SRNORM sets the scrolling region back to normal (lines 1 - 24)
	SRNORM = CHAR(27)//'[r'
	ISTATUS = LIB$SET_SYMBOL('SRNORM',SRNORM,2)
C
C     		Test terminal lines for assigning print queue, terminal type 
C		and terminal dependent commands.
C
C		written by m. haug 4/25/85
C		Modified 9/20/85 by Forrest Piehl for virtual terminals
C
C
C		Check for virtual terminal
C
	IF (INDEX(TERM64(1:TERM64_LEN),'_VTA') .EQ. 1) GOTO 99
C
C		Assign TERM correctly
C
	TERM = TERM64(1:6)
C
99	CONTINUE
C
C		Initialize DIALUP & REMOTE
C
	DIALUP = .FALSE.
	REMOTE = .FALSE.
	NO_BANNER = .FALSE.
C
C		define non-modem lines
C
      ISTATUS = LIB$SET_SYMBOL('PHONE_1',' FALSE',2)
C
C		define non-gigi terminal
C
      ISTATUS = LIB$SET_SYMBOL('GIGI_TERM','FALSE',2)
C
C		define non-GP-19 terminal
C
      ISTATUS = LIB$SET_SYMBOL('GP_19','FALSE',2)
C
C		define standard edit command
C
      ISTATUS = LIB$SET_SYMBOL('EDITEDT','EDIT/EDT',2)
      ISTATUS = LIB$SET_SYMBOL('ED*IT','EDIT/TPU/SECTION=SYST:[SYSLOGIN]KAZSECINI.GBL',2)
C
C		Test for remote
C
	IF ((MODE .EQ. 1) .OR. (INDEX(TERM,'_RTA') .EQ. 1)) THEN
		REMOTE = .TRUE.
		GOTO 2000
	ENDIF
C
C		test for operator console
C
      IF (TERM .NE. '_OPA0:') GOTO 100
      ISTATUS = LIB$SET_SYMBOL('VT_TERM','FALSE',2)     
	NO_BANNER = .TRUE.
      GOTO 2000
C
C
C		STUFF FOR H-19, THIS SHOULD BE PLACED IN THE CORRECT LINE 
C		ASSIGNMENT
C
C      ISTATUS = LIB$SET_SYMBOL('GP_19','TRUE',2)
C
C		Escape sequences for the H-19
C
C	GP19_ESC = CHAR(27)//':c  '//CHAR(27)//':18h  '//CHAR(27)//':8h  '//
C	1 CHAR(27)//':10h  '//CHAR(27)//':1p;'//CHAR(27)//'OP;  '//
C	2 CHAR(27)//':2p;'//CHAR(27)//'OQ; '//CHAR(27)//':3p;'//
C	3 CHAR(27)//'OR; '//CHAR(27)//':4p;'//CHAR(27)//'OS; '//
C	4 CHAR(27)//':6p;'//CHAR(27)//'Om; '//CHAR(27)//':7p;'//
C	5 CHAR(27)//'Ol; '//CHAR(27)//':5h'
C	WRITE (6,9990)GP19_ESC
C9990	FORMAT (' ',A91) 
C
C		BRANCH TO CORRECT CONTROLLER
C
100   IF (INDEX(TERM,'_TXB') .EQ. 1) GOTO 200
	IF (INDEX(TERM,'_TXC') .EQ. 1) GOTO 300
	IF (INDEX(TERM,'_TXD') .EQ. 1) GOTO 400
	IF (INDEX(TERM,'_TXE') .EQ. 1) GOTO 500
	IF (INDEX(TERM,'_TXF') .EQ. 1) GOTO 600
	IF (INDEX(TERM,'_TXG') .EQ. 1) GOTO 700
	IF (INDEX(TERM,'_TXH') .EQ. 1) GOTO 800
	IF (INDEX(TERM,'_TXI') .EQ. 1) GOTO 900
	IF (INDEX(TERM,'_TXJ') .EQ. 1) GOTO 1000
C
	IF (TERM .NE. '_TXA0:') GOTO 101
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      GOTO 2000
C
101   IF (TERM .NE. '_TXA1:') GOTO 102
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      GOTO 2000
C
102   IF (TERM .NE. '_TXA2:') GOTO 103
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      GOTO 2000
C
103   IF (TERM .NE. '_TXA3:') GOTO 104
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      GOTO 2000
C
104   IF(TERM .NE. '_TXA4:') GOTO 105
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      GOTO 2000
C
105   IF(TERM .NE. '_TXA5:') GOTO 106
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      GOTO 2000
C
106   IF(TERM .NE. '_TXA6:') GOTO 2000
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      GOTO 2000
C
C
C
200	IF (TERM .NE. '_TXB0:') GOTO 201
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      GOTO 2000
C
201   IF (TERM .NE. '_TXB1:') GOTO 202
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      GOTO 2000
C
202   IF (TERM .NE. '_TXB2:') GOTO 203
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      GOTO 2000
C
203   IF (TERM .NE. '_TXB3:') GOTO 204
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','LIB15',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','LIB101',,,)
      ISTATUS = LIB$SET_SYMBOL('GIGI_TERM','TRUE',2)
      ISTATUS = LIB$SET_LOGICAL('PLOT$TCS','SYS$LIBRARY:TCSREGSHR.EXE',,,)
      GOTO 2000
C
204   IF (TERM .NE. '_TXB4:') GOTO 205
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','LIB15',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','LIB101',,,)
      GOTO 2000
C
205   IF (TERM .NE. '_TXB5:') GOTO 206
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','LIB15',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','LIB101',,,)
      GOTO 2000
C
206	IF (TERM .NE. '_TXB6:') GOTO 300
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','LIB15',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','LIB101',,,)
      ISTATUS = LIB$SET_SYMBOL('GIGI_TERM','TRUE',2)
      ISTATUS = LIB$SET_LOGICAL('PLOT$TCS','SYS$LIBRARY:TCSREGSHR.EXE',,,)
C
C
300	IF (TERM .NE. '_TXC0:') GOTO 301
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      GOTO 2000
C
301   IF (TERM .NE. '_TXC1:') GOTO 302
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      GOTO 2000
C
302   IF (TERM .NE. '_TXC2:') GOTO 303
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','LIB15',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','LIB101',,,)
      ISTATUS = LIB$SET_SYMBOL('GIGI_TERM','TRUE',2)
      ISTATUS = LIB$SET_LOGICAL('PLOT$TCS','SYS$LIBRARY:TCSREGSHR.EXE',,,)
      GOTO 2000
C
303   IF (TERM .NE. '_TXC3:') GOTO 304
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','LIB15',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','LIB101',,,)
      GOTO 2000
C
304   IF (TERM .NE. '_TXC4:') GOTO 305
C		UNUSED 12/85
      GOTO 2000
C
305   IF (TERM .NE. '_TXC5:') GOTO 306
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      GOTO 2000
C
306	IF (TERM .NE. '_TXC6:') GOTO 2000
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
	GOTO 2000
C
C
C
400   IF (TERM .NE. '_TXD0:') GOTO 401
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      GOTO 2000
C
401   IF (TERM .NE. '_TXD1:') GOTO 402
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      GOTO 2000
C
402   IF (TERM .NE. '_TXD2:') GOTO 403
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      GOTO 2000
C
403   IF (TERM .NE. '_TXD3:') GOTO 404
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','LIB101',,,)
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','LIB15',,,)
      GOTO 2000
C
404   IF (TERM .NE. '_TXD4:') GOTO 405
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','LIB15',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','LIB101',,,)
      GOTO 2000
C
405   IF (TERM .NE. '_TXD5:') GOTO 406
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','LIB15',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','LIB101',,,)
      GOTO 2000
C
406   IF (TERM .NE. '_TXD6:') GOTO 2000
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','LIB15',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','LIB101',,,)
      GOTO 2000
C
C
500   CONTINUE
506   IF (TERM .NE. '_TXE6:') GOTO 2000
      ISTATUS = LIB$SET_SYMBOL('GIGI_TERM','TRUE',2)
	ISTATUS = LIB$SET_LOGICAL('PLOT$TCS','SYS$LIBRARY:TCSREGSHR.EXE',,,)
C	THIS IS A REAL GIGI
      GOTO 2000
C
C
600   CONTINUE
606   IF (TERM .NE. '_TXF6:') GOTO 607
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      GOTO 2000
607   IF (TERM .NE. '_TXF7:') GOTO 2000
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      GOTO 2000
C
C
700   IF (TERM .NE. '_TXG0:') GOTO 701
C	EMPTY LINE 12/85
      GOTO 2000
C
701   IF (TERM .NE. '_TXG1:') GOTO 702
C	EMPTY LINE 12/85
      GOTO 2000
C
702   IF (TERM .NE. '_TXG2:') GOTO 703
C	EMPTY LINE 12/85
      GOTO 2000
C
703   IF (TERM .NE. '_TXG3:') GOTO 704
C	EMPTY LINE 12/85
      GOTO 2000
C
704   IF (TERM .NE. '_TXG4:') GOTO 705
C	EMPTY LINE 12/85
      GOTO 2000
C
705   IF (TERM .NE. '_TXG5:') GOTO 706
C	EMPTY LINE 12/85
      GOTO 2000
C
706   IF (TERM .NE. '_TXG6:') GOTO 2000
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','OU310',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','OU310B',,,)
      GOTO 2000
C
C
800   CONTINUE
805   IF (TERM .NE. '_TXH5:') GOTO 2000
C	EMPTY LINE 12/85
      GOTO 2000
C
C
900	IF (TERM .NE. '_TXI0:') GOTO 901
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','LIB15',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','LIB101',,,)
	GOTO 2000
901	IF (TERM .NE. '_TXI1:') GOTO 902
      ISTATUS = LIB$SET_LOGICAL('SYS$PRINT','LIB15',,,)
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','LIB101',,,)
	GOTO 2000
902	IF (TERM .NE. '_TXI2:') GOTO 903
C		EMPTY LINE 12/85
	GOTO 2000
903	IF (TERM .NE. '_TXI3:') GOTO 904
C	Reserved for faculty
      ISTATUS = LIB$SET_SYMBOL('PHONE_1','TRUE',2)
	GOTO 910
904	IF (TERM .NE. '_TXI4:') GOTO 905
	GOTO 910
905	IF (TERM .NE. '_TXI5:') GOTO 906
	GOTO 910
906	IF (TERM .NE. '_TXI6:') GOTO 907
	GOTO 910
907	IF (TERM .NE. '_TXI7:') GOTO 2000
C
C	SET UP MODEM LINES
C	
910	ISTATUS = LIB$SET_SYMBOL('PR*INT',
	1 '@SYS$SYSDEVICE:[SYSLOGIN]SYSPRINT_DIALUP',2)
      ISTATUS = LIB$SET_SYMBOL('PRSQ*UEEZE',
	1 '@SYS$SYSDEVICE:[SYSLOGIN]SYSPRSQUEEZE_DIALUP',2)
      ISTATUS = LIB$SET_SYMBOL('PRGO*OD',
	1 '@SYS$SYSDEVICE:[SYSLOGIN]SYSPRGOOD_DIALUP',2)
      ISTATUS = LIB$SET_SYMBOL('NEC',
	1 '@SYST:[SYSLOGIN]SYSNEC_DIALUP',2)
C
C		Set DIALUP to TRUE
C
	DIALUP = .TRUE.
	GOTO 2000
C
C
1000  CONTINUE
1005  IF (TERM .NE. '_TXJ5:') GOTO 2000
      ISTATUS = LIB$SET_LOGICAL('NEC$PRINT','CDC10',,,)
	GOTO 2000
C
C
C
2000	IF (DIALUP .OR. REMOTE .OR. NO_BANNER) THEN 
C		WRITE (6,9998) BELL,BELL
		WRITE (6,9998) 
	ELSE
C		WRITE (6,9999) BELL,BELL
		WRITE (6,9999) 
	ENDIF
C		To include a bell beep:  change the above lines and put 
C		2A1 in the below format statements.
C
C
C		Banner for DIALUP, NETWORK, and NO_BANNER users
C
9998	FORMAT(' ',/,' Banner last changed on Thursday, December 19, 1985 at 10:00 AM. ',/,'
	7 ',/)
C
C		Banner for INTERACTIVE users
C
9999	FORMAT(' ',/,'
	3 For urgent problems, please contact Forrest Piehl (3-8528), Scott Rohlfing',/,'
	4 (3-8530), or Dr. Piccard (3-8528 or 3-8530) for assistance.  As usual, send',/,'
	5 MAIL to SYSTEM for print job requests or to report minor problems. ',/,'
	6 ',/,' 
	7       Type NEWS to read new SYSTEM NEWSLETTER.  There are new entries on:  ',/,'
	8 ',/,'
	9 ####--> 12/18 -- New, FASTER, editor;  use GET to obtain TPUINI.TPU',/,'
	1         12/18 -- New versions of system software. ',/,'
	2          9/26 -- Beware Password expiration!  ',/,'
	4 ',/,'
	6 @  Students using the system over break should contact Forrest Piehl to be   @',/,'
	7 @  placed on Security''s user list.  SIP printing requests needed by Monday,  @',/,'
	8 @                     Jan. 6, must be submitted by 12/26.                    @',/,'
	1 ',/,'
	1 ')
C
C		NO STOP COMMAND TO SUPPRESS THE "FORTRAN STOP"
C			MESSAGE FROM APPEARING ON THE SCREEN.
3000	END