C-----------------------------------------------------------------------------
C
C Subroutine:	BATCH
C
C Purpose:	Assign terminal I/O LUNs corresponding to the batch
C		status of TI:.
C
C Author:	Han Lasance
C		Digital Equipment B.V., Utrecht, Holland
C		for Neurophysiology Group, Organon Intern. B.V., Oss, Holland
C
C Date:		Nov-81
C
C Language:	Fortran-77
C
C Modified by:	Name			Date		Ident.	Version
C		Jan H. Belgraver	20-Mar-89	JB01	V1.1
C		Completed DOC-header, F77 style, and annotated.
C
C Call:		CALL BATCH (LUNBAT, PRCFLG, BATFLG, IER)
C
C Arguments:	Name	Type	I/O	Description
C
C		LUNBAT	L*2	 I	Answer file LUN 
C
C		PRCFLG	L*2	 O	Processing mode flag.
C					.TRUE. - process entire task 
C					.FALSE.- don't.
C
C		BATFLG	L*2	 O	Batch mode flag
C					.TRUE. - batch processing
C					.FALSE.- no batch.
C
C		IER	I*2	 O	Error/Success status
C					 1 - Success
C					-1 - Open failure on file
C					 0 - ^Z entered
C					<0 - I/O error code from BA:
C
C Calls to:	ASSIGN, CLOSE, GETADR, GETTSK, OPEN, R50ASC, SPAWN, 
C		STOPFR, WTQIO
C
C Event flags:	Number	Description
C		1	Used by WTQIO
C		2	Used by SPAWN
C
C LUNs:		Mode  BAT  PRC		LUN  Assignments
C		      FLG  FLG     5             6      LUNBAT
C
C		 No    F    T     TI:	        TI:      NL:
C		Fill   T    F     TI:	        TI:      BATCHTT0x.CTL
C		Use    T    T     BATCHTT0x.CTL TI:/NL:  TI:/NL: *)
C				  *) Carriagecontrol=NONE

C
C Description:	BATCH is used in conjuction with a private driver BADRV
C		and the Indirect Commandfile Processor.
C		For each terminal on this system (8 ports) BADRV stores
C		one of three possible conditions:
C
C				 0 = No batch (default)
C				-1 = Batch, fill answerfile
C				 1 = Batch, read answerfile
C
C		in the following integer table:
C
C				   word 1     word 2
C				+----------+----------+
C				| status 1 |   LUN 1  |
C				+----------+----------+
C				| status 2 |   LUN 2  |
C				+----------+----------+
C				|     .    |     .    |
C				|     .    |     .    |
C				+----------+----------+
C				| status 8 |   LUN 8  |
C				+----------+----------+
C
C		where LUN values are in octal.
C
C		Following a Read Logical Block QIO BADRV returns the terminal
C		number in word two of IBUF and the status in word one.
C		If the task is not started from within a command procedure,
C		the status is always zero.
C
C		The batch driver uses two maintenance tasks - INIBAT and EXB -
C		to set and clear the status flags. This can only be done from 
C		from within a command procedure. INIBAT asks the user for the 
C		required mode and sets the corresponding flag, whereas EXB 
C		clears the flag as soon as IND completes a Create or Use 
C		mode session on that particular terminal. EXB is started
C		by INIBAT.
C
C		In Create or answerfile fill mode BATCH opens on LUNBAT a
C		file BATCHTTxx.CTL, where xx is the terminal number.
C		Subsequently it writes an identification record to the file
C		of the following form:
C
C		***** <six character taskname string> *****
C
C		Next the user is given the option if in Use or answerfile
C		read mode the answers have to be displayed on the terminal.
C		As a result a second record is written that either contains
C		a Y or N. Any further answers are program dependent.

C
C		In Use or answerfile read mode BATCH tries to open a
C		BATCHTTxx.CTL file with the lowest possible number.
C		This means, that each time a task terminates, it's answerfile
C		must have been removed in order to be sure that the next task
C		reads the proper answerfile. This is done in BATCH by first
C		renaming the answerfile into a program specific one, e.g.
C
C			PIP EXAMPL.CTL/NV = BATCHTT03.CTL;-1
C
C		and secondly save it in a saved_answers file for that batch 
C		job. e.g.
C
C			PIP BATCHTTO3.SAV = EXAMPL.CTL/AP
C
C		The .SAV file is created by INIBAT and contains a header
C		record telling when and on which terminal the Create mode
C		session is started.
C		In order to prevent syntax error that would occur with tasks
C		installed as ...nnn, all dots are replaced by the letter D
C		first.
C		The PIP command strings are not submitted to PIP directly, but
C		via the MCR command dispatcher MCR... using SPAWN.
C		By default the renamed answerfile is deleted when the task
C		exits. If the append operation fails, however, the answerfile 
C		is kept.
C		A rename error is considered a severe error and results in 
C		an abort of the task's execution.
C
C-----------------------------------------------------------------------------

c
c
	SUBROUTINE	BATCH	(LUNBAT, PRCFLG, BATFLG, IER)
c
c
	LOGICAL		PRCFLG,		! Processing mode flag
	1		BATFLG		! Batch mode flag

	INTEGER*2	IBUF(2),	! BADRV buffer
	1		IPARM(6),	! QIO parameter block
	2		IESB(8)		! SPAWN status block

	LOGICAL*1	FNAME(18),	! Answerfile template
	1		REN(40),	! PIP rename command template
	2		APP(34),	! PIP append command template
	3		IOST(4),	! QIO status block
	4		TSKBUF(32),	! GETTSK buffer
	5		PRGREC(18),	! Program name header record
	6		YN		! TI: Y or N answerbuffer

	REAL*4		MCR		! R50 taskname string

	DATA	MCR	/6RMCR.../	! MCR command dispatcher

	DATA	IORLB	/"1000/		! QIO function code

	DATA	PRGREC	/5*'*',' ',6*0,' ',5*'*'/

	DATA	FNAME	/'S','Y','0',':','B','A','T','C','H','T',
	1		 'T','0',  0,'.','C','T','L',0/

	DATA	REN	/'P','I','P',' ',9*0,'.','C','T','L',
	1		 '/','N','V','=',9*0,'.','C','T','L',
	2		 ';','-','1','/','R','E'/

	DATA	APP	/'P','I','P',' ',9*0,'.','S','A','V',
	1		 '=',9*0,'.','C','T','L','/','A','P'/


	CALL	ASSIGN	(6, 'TI:')	! Separate LUN for TI: output
c
c	Set-up QIO parameter block for retrieving batch status of TI:.
c
	CALL	CLOSE	(LUNBAT)	! Required for reassignment
	CALL	ASSIGN	(LUNBAT, 'BA:')	! Assign to Batch driver

	CALL	GETADR	(IPARM(1), IBUF)! Move buffer address into 
c					! QIO parameter block
	IPARM(2)= 4			! Number of bytes to transfer
	CALL	WTQIO	(IORLB, LUNBAT, 1,, IOST, IPARM)	! Get status

	CALL	CLOSE	(LUNBAT)	! Done
	CALL	ASSIGN	(LUNBAT,'NL:')	! For later

	PRCFLG	= .TRUE.		! Preset for No-Batch mode
	BATFLG	= .FALSE.		! 

	IER	= IOST(1)		! I/O status code to be returned
	IF	(IER .LE. 0) GOTO 1000	! in case of error

	FNAME(13)=IBUF(2)+48		! Insert converted terminal 
c					! number into filename.
	IF	(IBUF(2) .GE. 8) THEN	! It is TT10:
	  FNAME(12) = '1'		! 
	  FNAME(13) = '0'		! 
	ENDIF


	IF	(IBUF(1) .EQ. 0) THEN	! No-Batch mode
	  GOTO	1000			! For Exit
c
c	Create Mode
c
	ELSE IF	(IBUF(1) .LT. 0) THEN	! Create mode

	  IER	= -1			! Preset, in case of OPEN error
	  PRCFLG= .FALSE.		! Set for no processing mode.

	  CALL	CLOSE	(LUNBAT)	! and close LUNBAT for 
	  OPEN	(UNIT = LUNBAT,		! creation of answer file.
	1	 NAME = FNAME,
	2	 TYPE = 'NEW',
	3	 CARRIAGECONTROL = 'LIST',
	4	 ERR = 1000)

	  CALL	GETTSK	(TSKBUF)	! Get taskname and insert in
	  CALL	R50ASC	(6, TSKBUF, PRGREC(7))	! PRoGram RECord in ASCII.
	  WRITE	(LUNBAT, 30) PRGREC	! Save in it answer file
30	  FORMAT(32A1)

	  IER	= 0			! Preset to Success
	  WRITE	(6, 40)	(PRGREC(I),I=7,12)
40	  FORMAT(/'$Print Questions, Answers and Errors for task "',
	1	 6A1, ' "[Y/N]: ')
	  READ	(5, 50, END=1000) YN
50	  FORMAT(A1)
	  WRITE	(LUNBAT, 50) YN		! Save in answer file
	  BATFLG= .TRUE.		! set Batch-mode flag
	  GOTO	160			! Exit with Success status

c
c	Use  Mode
c
	ELSE IF	(IBUF(1) .GT. 0) THEN	! Use mode

	  IER	= -1			! Preset, in case of error
	  BATFLG= .TRUE.		! set Batch-mode flag
	  CALL	CLOSE	(5)		! Terminal input  LUN
	  CALL	CLOSE	(6)		! Terminal output LUN

	  DO 110 I = 1,9		! Insert filename into <infile> of
	  REN(I+21)= FNAME(I+4)		! RENAME and
110	  APP(I+4) = FNAME(I+4)		! APPEND command strings.
	  CALL	GETTSK	(TSKBUF)	! Get taskname, and insert it
	  CALL	R50ASC	(6, TSKBUF, FNAME(5))	! in filename in ASCII.

	  DO 115 I = 1,6		! In case task installed as ...nnn
115	  IF	(FNAME(I+4) .EQ. '.') FNAME(I+4) = 'D'	! replace by D's.
	  DO 120 I = 1,9		! Insert filename into <outfile> of
	  REN(I+4) = FNAME(I+4)		! RENAME and
120	  APP(I+18)= FNAME(I+4)		! APPEND commands.

c	  Sent command strings via MCR command dispatchter to PIP

	  CALL	SPAWN	(MCR,,, 2,, IESB,, REN, 40,,, IDS)	! Rename
	  IF	(IDS .NE. 1)	STOP 'BATCH -F- Rename Error'
	  CALL	STOPFR	(2)		! Wait until MCR picked it up.

	  CALL	SPAWN	(MCR,,, 2,, IESB,, APP, 34,,, IDS)	! Append
	  IF	(IDS .EQ. 1)	GOTO 140! In case of success

125	  WRITE	(6, 130) IDS, IESB(1)
130	  FORMAT(/' BATCH -W- Unable to append .CTL file to .SAV file',
	1	 /' DSW= ', I4, ', PIP Exit Status= ', I2,
	2	 /12X, 'File will not be Deleted')

	  OPEN	(UNIT = 5,		! Assign renamed answerfile 
	1	 NAME = FNAME,		! to terminal_input LUN,
	2	 TYPE = 'OLD',		! but make sure to keep it
	3	 ERR  = 1000)		! when task exits.
	  GOTO	150			! For reading Display flag

140	  CALL	STOPFR	(2)		! Wait until MCR picked it up.
	  IF	(IESB(1) .NE.1 ) GOTO 125 ! In case PIP found error.

	  OPEN	(UNIT = 5,		! Assign renamed answerfile 
	1	 NAME = FNAME,		! to terminal_input LUN.
	2	 TYPE = 'OLD',
	3	 DISPOSE = 'DELETE',	! Should be deleted on task exit.
	4	 ERR  = 1000)


150	  READ	(5, 30) PRGREC		! Skip first record
	  READ	(5, 30) PRGREC		! Display answers flags

	  CALL	ASSIGN	(6, 'NL:')	! Preset to No Display
	  IF	(PRGREC(1) .NE. 'Y' .OR.
	1	 PRGREC(1) .NE. 'y') GOTO 160	! No Display wanted
	  CALL	ASSIGN	(6, 'TI:')	! Do Display answers.

	  CLOSE	(UNIT = LUNBAT)		! So, 
	  OPEN	(UNIT = LUNBAT,		! assign TI: accordingly.
	1	 NAME = 'TI:',
	2	 TYPE = 'OLD',
	3	 CARRIAGECONTROL = 'NONE',
	4	 ERR  = 1000)

	END IF

160	IER	= 1			! Exit with Success, and

1000	RETURN

	END