	program ADBACK
**************************************************************
*                                                            *
* PK backup using a virtual terminal			     *
*                                                            *
* Development Environment:RSX11M			     *
*                                                            *
* Programmer : Bruce Prendergast                             *
*                                                            *
* Date : November 1, 1992				     *
*                                                            *
* Program structure:                                         *
*                                                            *
*                This program issues commands to VTDRV, the  *
*		 virtual terminal driver. Status is read from*
*		 the virtual terminal.			     *
*							     *
*		 This program is an element of the plotting/ *
*		 backup system.				     *
*							     *
*		 Files are merged from DM1:[1,5], DM3:[1,5], *
*		 and DM4:[1,5] to DR0:[10,1]. From there the *
*		 system uses BRU to place the information on *
*		 tape(with a verify). The next phase is to   *
*		 load the studyset into a rotating disk pool *
*		 in DR1:[10,1], DR2:[10,1], or DR3:[10,1].   *
*		 					     *
**************************************************************
**************************************************************
C	FILES USED
C
C	BRUERR.DAT used as an interlock for plotting. The existence
C		   of this file to PLOTB.TSK implies that backup is
C		   not finished and control files will not be de-
C		   leted. This file will contain textual messages as
C		   to the progress of the archive process.
C
C	ADWORK.DEF found in DM1:[1,5] and is the next patient study
C	           to be archived and plotted.
C
C	ADLAST.DEF found in DM2:[3,7] and is the study number of the
C	           last study archived. This is done to insure that
C		   everything is in monotonic order.
C
C	ADREST.DEF This file will contain the restart number for program
C		   restarts. This includes new tapes also. ADLAST.DEF can
C		   be found in DM2:[3,7].
C
C	ADLOG.DEF  A log entry file for each study which contains the
C		   complete patient biographical information along with
C		   a diagnosis. This file used to reside in DM2:[3,6] and
C		   was known as LOG.DAT but now resides in DM2:[3,7].
C 
C	ADBTCH.LOG In DM2:[3,7], all the responses from the virtual term-
C		   inal including the commands. The commands will be pre-
C		   faced with '**'.
C
C

C---------------------------------
C *** variables ***
C
C acqcnt:   I   file count returned from ADCPY
C alount:   I   last allocation unit; "1", "3" or "4"
C arctxt:   C   archived .TXT file name
C cr:	    C	constant, cr for terminating MCRINP
C dskpol:   C 	disk pool sequence ("123", "231", "312"
C dskunt:   C   last pool unit "1", "2", or "3"
C eol:      L   numerical equivalent to CR above
C ftnnsf:   I   constant "29", FCS error code for "NO-SUCH-FILE"
C label:    C   tape label from DM1:[1,5]ACQLAB.DEF 
C		(imbedded in NEWLAB adn OLDLAB)
C line1:    C	first line of .TXT file (biographical info)
C line2:    C   second line of .TXT file (biographical info)
C logcnt    I   error message count returned from virtual terminal driver
C loglst:   C	first ten error messages from virtual terminal although
C		there may be more. 
C loglun:   I	log file logical unit number
C lstone:   C	last study archived
C mcrinp:   C 	MCR input buffer
C mcrout:   C 	MCR message return buffer
C newlab:   C   new tape label
C oldlab:   C   old tape label
C rstcmd:   C   restart command: "MERGE", "TAPE", "LOAD", "LOG"
C study:    C	study number
C spwmcr:   C   command line to spawn MCR
C spwcnt:   C   SPWMCR line length
C vtlun:    I	virtual terminal logical unit number (must be "1")
 

	character mcrinp*84,mcrout*84,cr*1,lf*1,null*1,study*4,lstone*4,
     1	    loglst(20)*84,bacex1*5,bacex2*26,bacex3*15,acqlst(200)*13,
     2	    spwcmd*48,acqlgn*18,bacex4*47,dskpol*3,dskunt*1,line1*80,
     3	    line2*80,label*3,rstcmd*5,arctxt*18,oldlab*84,newlab*84

	logical*1 lcr,llf,lnull

	equivalence (lcr,cr),(llf,lf),(lnull,null)
	integer vtsts,vtlun,wrkunt,ftnnsf,logcnt,alount,alorem,aloexp,
     1	    acqsiz(200),spwcnt,acqlgs,acqcnt

	integer*4 alloc

700	format(a4)
701	format(i4)
702	format(1x,a4)

	lcr=13
	llf=10
	lnull=0

	VTLUN=1				! virtual terminal
	wrkunt=2
	loglun=3			! logfile

	TRUE=.TRUE.
	FALSE=.FALSE.
	ftnnsf=29
	call errset(ftnnsf,true,false,true,false,true,1000)

	call assign(6,'TI:')

C-----------------
C *** study number
C-----------------
	open(unit=wrkunt,name='dm1:[1,5]adwork.def',form='formatted',
     1	    status='old',err=9000)
	read(wrkunt,700)study
	close(unit=wrkunt)

C------------------------------------------------
C *** get adlast.def (last study number archived)
C------------------------------------------------
	open(unit=wrkunt,name='dm2:[3,7]adlast.def',form='formatted',
     1	    status='old',err=9010)
	read(wrkunt,702)lstone
	close(unit=wrkunt)

C--------------------------------------
C *** STUDY SHOULD BE EQUAL TO LSTONE+1
C--------------------------------------

C-----------------------
C *** CONVERT TO NUMERIC
C-----------------------
	DECODE(4,701,STUDY)I
	DECODE(4,701,LSTONE)J

C----------------------------------------
C *** is the study in the proper sequence
C----------------------------------------
	if (i .ne. (j+1)) then
	    write(6,*)' Study not archived in proper sequence!'
	    call exit
	end if
C----------------------
C *** expected messages
C----------------------
	bacex1='    >'
	bacex1(1:1)=null
	bacex1(2:2)=null
	bacex1(3:3)=cr
	bacex1(4:4)=lf
	bacex2='    PIP -- No such file(s)'
	bacex2(1:4)=bacex1(1:4)
	bacex3='BRU - Completed'
	BACEX4='PIP -- Allocation failure - no contiguous space'

C------------------------------------------------------------
C *** BRUERR.DAT is an artifact from the old system but it
C     is necessary to interlock the plot system. If it exists
C     then processing was in progress. If it was in progess
C     then use the restart point from ADREST.DEF
C------------------------------------------------------------
	open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',form='formatted',
     1	    status='old',err=100)

C---------------------------------------
C *** BRUERR.DAT was found, do a restart
C---------------------------------------
	call close(wrkunt)
	open(unit=wrkunt,name='DM2:[3,7]ADREST.DEF',form='formatted',
     1	    status='old')
	read(wrkunt,900)rstcmd
	call close(wrkunt)
	if (rstcmd .eq. 'MERGE') goto 500
	
	if (rstcmd .eq. 'NEW') then
	    write(6,*)' Restarting NEW tape copy'
	    goto 505
	end if

	if (rstcmd .eq. 'TAPE') then
	    write(6,*)' Restarting tape copy'
	    goto 510
	end if

	if (rstcmd .eq. 'LOAD') then
	    write(6,*)' Restarting pool load'
	    goto 520
	end if

	if (rstcmd .eq. 'LOG') then
	    write(6,*)' Restarting log entry and termination'
	    goto 530
	end if

	write(6,*)' Unable to restart from ADREST.DEF, ADBACK aborted'
	call exit

C-------------------------------------------------------
C *** BRUERR.DAT was not found, restart is not necessary
C-------------------------------------------------------
100	call errsns(ih)
	if (ih .ne. 0) then
	    if (ih .ne. 29) then
	    	write(6,*)' Fatal error opening BRUERR.DAT ',ih
	    	call exit
	    end if
C-----------------------
C *** declare BRUERR.DAT
C-----------------------
	    open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',form='formatted',
     1	    	status='new')
	    write(wrkunt,*)' Backup in process for study: ',study
	end if
	close(unit=wrkunt)

C-------------------------------------------------------------------
C *** declare first restart point (really nothing accomplished yet!)
C-------------------------------------------------------------------
	open(unit=wrkunt,name='DM2:[3,7]ADREST.DEF',form='formatted',
     1	    status='UNKNOWN')
	write(wrkunt,900)'MERGE'
	close(unit=wrkunt)

C---------------------------------------
C *** RESTART POINT 1 (ERASE DR0:[10,1])
500	CONTINUE
C---------------------------------------

C---------------------
C *** ERASE DR0:[10,1]
C---------------------
C@@DEBUG
	write(6,*)' Clearing DR0:[10,1]'

	MCRINP='PIP DR0:[10,1]*.*;*/DE'
	mcrlen=22
C-------------------------------------------------------
C *** USE THE VIRTUAL TERMINAL TO ISSUE AN ERASE COMMAND
C-------------------------------------------------------	
	call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,loglst,logcnt)

C----------------------------
C *** I know what is expected
C----------------------------
	if ((loglst(1)(1:5) .ne. bacex1) .and. 
     1	    (loglst(1)(1:26) .ne. bacex2)) then
	    write(6,*)' Unexpected error erasing DR0:[10,1]'
	    write(6,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',
     1		FORM='formatted',access='append',type='old')
	    write(wrkunt,*)' Unexpected error erasing DR0:[10,1]'
	    write(wrkunt,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    call exit
	end if

C----------------------------------
C *** BUILD A LIST OF FILES TO MOVE
C----------------------------------
	acqlgn='DM1:[1,5]XXXX.LOG'
	acqlgn(10:13)=study
	acqlgs=17
	call ADCPY(wrkunt,acqlgn,acqlgs,alorem,aloexp,acqlst,
     1	    acqsiz,acqcnt,alount)
	alloc=aloexp*32786+alorem

C------------------------------
C *** move what there is on DM1
C------------------------------
C@@DEBUG

	WRITE(6,*)' Copying DM1:[1,5] to DR0:[10,1]'

	MCRINP='PIP DR0:[10,1]=DM1:[1,5]XXXX*.*'
	mcrinp(25:28)=study
	mcrlen=31
	call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,loglst,logcnt)

	if (loglst(1)(1:5) .ne. bacex1) then
	    write(6,*)' Unexpected error copying DM1:[1,5] to DR0:[10,1]'
	    write(6,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',
     1		FORM='formatted',access='append',type='old')
	    write(wrkunt,*)
     1		' Unexpected error copying DM1:[1,5] to DR0:[10,1]'
	    write(wrkunt,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    call exit
	end if

C------------------------------
C *** move what there is on DM3
C------------------------------
	if (alount .gt. 1) then

C@@DEBUG
	    WRITE(6,*)' Merging DM3:[1,5] with DR0:[10,1]'

	    MCRINP='PIP DR0:[10,1]/NV=DM3:[1,5]XXXX*.*'
	    mcrinp(28:31)=study
	    mcrlen=34
	    call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,loglst,logcnt)

	    if (loglst(1)(1:5) .ne. bacex1) then
	    	write(6,*)
     1		    ' Unexpected error copying DM3:[1,5] to DR0:[10,1]'
	    	write(6,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    	open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',
     1		    FORM='formatted',access='append',type='old')
	    	write(wrkunt,*)
     1		    ' Unexpected error copying DM3:[1,5] to DR0:[10,1]'
	    	write(wrkunt,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    	call exit
	    end if
	end if


C------------------------------
C *** move what there is on DM4
C------------------------------
	if (alount .gt. 3) then

C@@DEBUG
	    WRITE(6,*)' Merging DM4:[1,5] with DR0:[10,1]'

	    MCRINP='PIP DR0:[10,1]/NV=DM4:[1,5]XXXX*.*'
	    mcrinp(28:31)=study
	    mcrlen=34
	    call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,loglst,logcnt)

	    if (loglst(1)(1:5) .ne. bacex1) then
	    	write(6,*)
     1		    ' Unexpected error copying DM4:[1,5] to DR0:[10,1]'
	    	write(6,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    	open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',
     1		    FORM='formatted',access='append',type='old')
	    	write(wrkunt,*)
     1		    ' Unexpected error copying DM4:[1,5] to DR0:[10,1]'
	    	write(wrkunt,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    	call exit
	    end if
	end if

C-----------------------------
C *** combine end-muscle tests
C-----------------------------
C@@DEBUG
	WRITE(6,*)' Combining END-MUSCLE tests'
	
	MCRINP='RUN dm2:[4,6]ADEND'
	MCRLEN=18
	call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,loglst,logcnt)
C--------------------------
C *** and the quick stretch
C--------------------------
C@@DEBUG
	WRITE(6,*)' Combining QUICK-STRETCH-MUSCLE tests'

	MCRINP='RUN dm2:[4,6]ADQCK'
	MCRLEN=18
	call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,loglst,logcnt)

C-----------------------------------------
C *** and lastly, the maximal muscle tests
C-----------------------------------------
C@@DEBUG
	WRITE(6,*)' Combining MAXIMAL-MUSCLE tests'

	MCRINP='RUN DM2:[4,6]ADMMT'
	MCRLEN=18
	call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,loglst,logcnt)

C---------------------
C *** purge DR0:[10,1]
C---------------------
C@@DEBUG
	WRITE(6,*)' Purging DR0:[10,1]'

	MCRINP='PIP DR0:[10,1]*.*/PU'
	mcrlen=20
C------------------------------------------------------
C *** USE THE VIRTUAL TERMINAL TO ISSUE A PURGE COMMAND
C------------------------------------------------------	
	call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,loglst,logcnt)
	if (loglst(1)(1:5) .ne. bacex1) then
	    write(6,*)' Unexpected error purging DR0:[10,1]'
	    write(6,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',
     1		FORM='formatted',access='append',type='old')
	    write(wrkunt,*)' Unexpected error purging DR0:[10,1]'
	    write(wrkunt,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    call exit
	end if

C-------------------------------------------------------------
C *** declare second restart point, all files have been merged
C-------------------------------------------------------------
	open(unit=wrkunt,name='DM2:[3,7]ADREST.DEF',form='formatted',
     1	    status='UNKNOWN')
	write(wrkunt,900)'TAPE'
	close(unit=wrkunt)
	GOTO 510
C-----------------------------------
C *** ALTERNATE SECOND RESTART POINT
C-----------------------------------
505	CONTINUE
C------------------------------------------------------------------
C *** THE FIRST THING TO DO IS TO VERIFY THAT THE TAPE LABEL IS NEW
C------------------------------------------------------------------
	open(unit=wrkunt,name='DM1:[1,5]ACQLAB.DEF',
     1	    FORM='FORMATTED',STATUS='OLD')
	read(wrkunt,900)newlab
	call close(wrkunt)
	open(unit=wrkunt,name='dm2:[3,7]ADOLLB.DEF',
     1	    form='formatted',status='old')
	read(wrkunt,900)oldlab
	call close(wrkunt)
	if (oldlab .eq. newlab) then
	    write(6,*)
     1		' Unable to proceed. Tape label has not been changed'
	    call exit
	end if
C------------------------------------------------------
C *** label has been changed, put a label on the tape 
C     so that all studysets are archived in append mode
C------------------------------------------------------
C@@DEBUG
	WRITE(6,*)' Using BRU to place label BRULAB.BCK on tape'

	MCRINP=
     1	'BRU /REW/MOU/VER/BAC:BRULAB.BCK DM1:[1,5]ACQLAB.DEF MS0:'
	MCRLEN=56
	call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,loglst,logcnt)
C-------------------------
C *** see if BRU completed
C-------------------------
	do 105 i=1,logcnt
	    if (loglst(i)(5:19) .eq. bacex3) goto 510
105	continue
C------------------------
C *** BRU never completed
C------------------------
	write(6,*)' Unexpected error writing tape label to MS0:'
	write(6,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',
     1	    FORM='formatted',access='append',type='old')
	write(wrkunt,*)' Unexpected error writing tape label to MS0:'
	write(wrkunt,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	call exit

C--------------------------------------------------
C *** RESTART POINT 2 (BRU to tape from DR0:[10,1])
510	CONTINUE
C--------------------------------------------------
C----------------------------------
C *** BUILD A LIST OF FILES TO MOVE
C----------------------------------
C------------------------------------------------------
C     This has already been done before the files were
C     merged but this may be a reload in which case the
C     list doesn't exit.
C------------------------------------------------------
	acqlgn='DR0:[10,1]XXXX.LOG'
	acqlgn(11:14)=study
	acqlgs=18
	call ADCPY(wrkunt,acqlgn,acqlgs,alorem,aloexp,acqlst,
     1	    acqsiz,acqcnt,alount)
	alloc=aloexp*32786+alorem
C-----------------------
c *** now put it on tape
C-----------------------
C@@DEBUG
	WRITE(6,*)' Using BRU to place DR0:[10,1] on tape'

C------------------------------------------------------
C *** use a DIR so a full REW is not done during verify
C------------------------------------------------------
	MCRINP='BRU /DIR MS0:'
	MCRLEN=13
	call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,loglst,logcnt)
C-------------------------------------------------------------
C *** IGNORE THE OUTPUT SINCE IT WAS ONLY FOR TAPE POSITIONING
C-------------------------------------------------------------

	MCRINP='BRU /VER/APP/MOU/BAC:SUBXXXX.BCK DR0:[10,1] MS0:'
	mcrlen=48
	mcrinp(25:28)=study
C----------------------------------------------------
C *** USE THE VIRTUAL TERMINAL TO ISSUE A BRU COMMAND
C----------------------------------------------------	
	call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,loglst,logcnt)
C-------------------------------------------------
C *** the completed message will be last but there 
C     may be some warning messages first.
C-------------------------------------------------
	do 110 i=1,logcnt
	    if (loglst(i)(5:19) .eq. bacex3) goto 120
	    if (index(loglst(i),'Mount Tape 2') .ne. 0) then
C---------------
C *** abort bru!
C---------------
		spwcmd='ABO ...BRU'
		spwcnt=10
		call spwmcr(spwcmd,spwcnt)
		write(6,*)' BRU requests another tape, BRU aborted'
		open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',
     1	            FORM='formatted',access='append',type='old')
		write(wrkunt,*)loglst(i)
		write(wrkunt,*)' BRU requests another tape, BRU aborted'
		call close(wrkunt)
C--------------------------------
C *** REMEMBER THE OLD TAPE LABEL
C--------------------------------
		open(unit=wrkunt,name='DM1:[1,5]ACQLAB.DEF',
     1		    FORM='FORMATTED',STATUS='OLD')
		read(wrkunt,900)oldlab
		call close(wrkunt)
		open(unit=wrkunt,name='dm2:[3,7]ADOLLB.DEF',
     1		    form='formatted',status='unknown')
		write(wrkunt,900)oldlab
		call close(wrkunt)
C--------------------------------------------------
C *** change the restart point from "TAPE" to "NEW"
C--------------------------------------------------
		open(wrkunt,name='DM2:[3,7]ADREST.DEF',
     1		    FORM='FORMATTED',STATUS='UNKNOWN')
		write(wrkunt,900)'NEW'
		call close(wrkunt)
		call exit
	    end if
110	continue
C---------------------------------------------
C *** to be here BRU did no terminate normally 
C     since there is no completed message
C---------------------------------------------
	write(6,*)' Unexpected error using BRU DR0:[10,1] to MS0:'
	write(6,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',
     1	    FORM='formatted',access='append',type='old')
	write(wrkunt,*)' Unexpected error using BRU DR0:[10,1] to MS0:'
	write(wrkunt,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	call exit
C-------------------------------------------
C *** here on a complete message even though 
C     there may have been soft errors
C-------------------------------------------
120	CONTINUE
C-------------------------------------------------------
C *** declare third restart point, tape copy is complete
C-------------------------------------------------------
	open(unit=wrkunt,name='DM2:[3,7]ADREST.DEF',form='formatted',
     1	    status='UNKNOWN')
	write(wrkunt,900)'LOAD'
	close(unit=wrkunt)

C------------------------------------------------------------
C *** RESTART POINT 3 (load the rotating pool)
520 	continue
C------------------------------------------------------------
C----------------------------------
C *** BUILD A LIST OF FILES TO MOVE
C----------------------------------
C-------------------------------------------------------
C     This has already been done before the files were
C     merged but this may be a restart in which case the
C     list doesn't exit.
C-------------------------------------------------------
	acqlgn='DR0:[10,1]XXXX.LOG'
	acqlgn(11:14)=study
	acqlgs=18
	call ADCPY(wrkunt,acqlgn,acqlgs,alorem,aloexp,acqlst,
     1	    acqsiz,acqcnt,alount)
	alloc=aloexp*32786+alorem

C-----------------------------------
C *** do a DecNet copy. One node for 
C     now but a pool list later on. 
C-----------------------------------
C@@DEBUG
	WRITE(6,*)' Starting DecNet copy'

	MCRINP=
     1	'DCL COPY DR0:[10,1]*.* ATHENA"USER USER"::DUB0:[EMGPOOL]'
	mcrlen=56
	call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,loglst,logcnt)
	if (loglst(1)(1:5) .ne. bacex1) then
C-------------------------------
C *** apparent error target disk 
C-------------------------------
	    write(6,*)' Unexpected error using DecNet'
	    write(6,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',
     1	    	FORM='formatted',access='append',type='old')
	    write(wrkunt,*)' Unexpected error using DecNet'
	    write(wrkunt,*)
     1	    	' Please examine DM2:[3,6]ADBTCH.LOG'
	    call exit
	end if

C-------------------------------------------
C *** reload the study set to ascertain that
C     it is loadable into the rotating pool
C------------------------------------------
C@@DEBUG
	WRITE(6,*)' Starting pool load'

C-------------------------
C *** find the disk to use
C-------------------------
130	open(unit=wrkunt,name='DM2:[3,7]ADDISK.DEF',form='formatted',
     1	    status='OLD')
	read(wrkunt,900)dskunt
	call close(wrkunt)
C-------------------------------------------
C *** may be a restart, do a selective clear
C-------------------------------------------
	MCRINP='PIP DRX:[10,1]XXXX*.*;*/DE'
	mcrinp(7:7)=dskunt
	mcrinp(15:18)=study
	mcrlen=26
	call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,
     1	    loglst,logcnt)
	if ((loglst(1)(1:5) .ne. bacex1) .and. 
     1	    (loglst(1)(1:26) .ne. bacex2)) then
C-------------------------------
C *** apparent error target disk 
C-------------------------------
	    mcrinp=' Unexpected error clearing DRX:[10,1]'
	    mcrinp(30:30)=dskunt
	    write(6,*)mcrinp
	    write(6,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',
     1	    	FORM='formatted',access='append',type='old')
	    write(wrkunt,*)mcrinp
	    write(wrkunt,*)
     1	    	' Please examine DM2:[3,6]ADBTCH.LOG'
	    call exit
	end if

C----------------------
C *** now move the data
C----------------------
	MCRINP='PIP DRX:[10,1]=DR0:[10,1]*.*'
	mcrlen=28
	MCRINP(7:7)=dskunt

C------------------
C *** do the reload
C------------------
	call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,loglst,
     1	    logcnt)
	do 140 i=1,logcnt
	    if (loglst(i)(5:51) .eq. BACEX4) then
C-------------------------------------------------
C *** disk full, erase what has been loaded so far
C-------------------------------------------------
		MCRINP='PIP DRX:[10,1]XXXX*.*;*/DE'
		mcrinp(7:7)=dskunt
		mcrinp(15:18)=study
		mcrlen=26
		call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,
     1		    loglst,logcnt)
		if ((loglst(1)(1:5) .ne. bacex1) .and. 
     1		    (loglst(1)(1:26) .ne. bacex2)) then
C---------------------------------------------------
C *** apparent error erasing the partial load, abort
C--------------------------------------------------- 
		    mcrinp=' Unexpected error clearing DRX:[10,1]'
		    mcrinp(30:30)=dskunt
		    write(6,*)mcrinp
		    write(6,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    	    open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',
     1		    	FORM='formatted',access='append',type='old')
		    write(wrkunt,*)mcrinp
		    write(wrkunt,*)
     1			' Please examine DM2:[3,6]ADBTCH.LOG'
		    call exit
	    	end if
C-----------------------------
C *** select next disk in pool
C-----------------------------
		open(unit=wrkunt,name='DM2:[3,7]ADDISK.DEF',
     1		    status='OLD',form='formatted')
		read(wrkunt,900)dskpol
		dskpol(1:2)=dskpol(2:3)
		dskpol(3:3)=dskunt
		dskunt=dskpol(1:1)
		rewind(wrkunt)
		write(wrkunt,900)dskpol
		call close(wrkunt)
C-----------------------
C *** clear the new disk
C-----------------------
		MCRINP='PIP DRX:[10,1]*.*;*/DE'
		mcrinp(7:7)=dskunt
		mcrlen=22
		call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,
     1		    loglst,logcnt)
		if ((loglst(1)(1:5) .ne. bacex1) .and. 
     1		    (loglst(1)(1:26) .ne. bacex2)) then
C-------------------------------
C *** apparent error target disk 
C-------------------------------
		    mcrinp=' Unexpected error clearing DRX:[10,1]'
		    mcrinp(30:30)=dskunt
		    write(6,*)mcrinp
		    write(6,*)' Please examine DM2:[3,6]ADBTCH.LOG'
		    open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',
     1		    	FORM='formatted',access='append',type='old')
		    write(wrkunt,*)mcrinp
		    write(wrkunt,*)
     1		    	' Please examine DM2:[3,6]ADBTCH.LOG'
		    call exit
		end if

		goto 130
	    end if
140	continue
C----------------------------------------------------
C *** here with no allocation problems, but make sure
C----------------------------------------------------
	IF (LOGLST(1)(1:5) .NE. BACEX1) THEN
C------------------------------------------
C *** apparent error during the load, abort
C------------------------------------------ 
	    mcrinp=' Unexpected error loading pool disk DRX:[10,1]'
	    mcrinp(39:39)=dskunt
	    write(6,*)mcrinp
	    write(6,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',
     1	    	FORM='formatted',access='append',type='old')
	    write(wrkunt,*)mcrinp
	    write(wrkunt,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    call exit
	END IF

C------------------------------------------------------------
C *** archiving complete, update ADLAST (last study archived)
C------------------------------------------------------------
C-------------------------------------------------------------------
C *** declare the last restart point, actually reset to beginning
C     there are times when making a log entry only is desired. This
C     is the place for it. Note that there is only one try, so it
C     had better be good. If it isn't them someone is fooling around
C     too much and everything will be suspect anyway.
C-------------------------------------------------------------------
	open(unit=wrkunt,name='DM2:[3,7]ADREST.DEF',form='formatted',
     1	    status='UNKNOWN')
	write(wrkunt,900)'MERGE'
	close(unit=wrkunt)

C---------------------------------------
C *** RESTART POINT 4 (create log entry)
530	CONTINUE
C---------------------------------------
C----------------------------------
C *** BUILD A LIST OF FILES TO MOVE
C----------------------------------
C------------------------------------------------------
C     This has already been done before the files were
C     merged but this may be a reload in which case the
C     list doesn't exit.
C------------------------------------------------------
	acqlgn='DR0:[10,1]XXXX.LOG'
	acqlgn(11:14)=study
	acqlgs=18
	call ADCPY(wrkunt,acqlgn,acqlgs,alorem,aloexp,acqlst,
     1	    acqsiz,acqcnt,alount)
	alloc=aloexp*32786+alorem
C---------------------------------------------
C *** record the last studyset number archived
C---------------------------------------------
C@@DEBUG
	WRITE(6,*)' Reload complete, making log entry'

	open(unit=wrkunt,name='DM2:[3,7]ADLAST.DEF',status='unknown',
     1	    form='formatted')
	write(wrkunt,702)study
	call close(wrkunt)
C-------------------------------------------------------------------
C *** make a log entry, get the biographical info from the .TXT file
C-------------------------------------------------------------------
	arctxt='DR0:[10,1]XXXX.TXT'	
	arctxt(11:14)=study
	open(unit=wrkunt,name=arctxt,form='formatted',status='old')
	read(wrkunt,900)line1
	read(wrkunt,900)line2
	call close(wrkunt)
C-------------------------------
C *** get the tape volume number
C-------------------------------
	open(unit=wrkunt,name='DM1:[1,5]ACQLAB.DEF',form='formatted',
     1	    status='old')
	read(wrkunt,900)mcrinp
	call close(wrkunt)
	i=index(mcrinp,'label')
	label=mcrinp(i+6:i+8)

C----------------------
C *** update system log
C----------------------
	open(unit=wrkunt,name='DM2:[3,7]ADLOG.DEF',access='APPEND',
     1	    status='unknown')
	write(wrkunt,900)line1
	write(wrkunt,900)line2
910	format(a12,a3,a6,i3,a6)
	write(wrkunt,910)' TAPE LABEL=',LABEL,' WITH ',ACQCNT+6,' FILES'
	call close(wrkunt)
C------------------------------------------------
C *** the original datasets have not been deleted
C------------------------------------------------
C--------------------------------------------------------
C *** erase original studyset after merging on dr0:[10,1]
C--------------------------------------------------------
	MCRINP='PIP DM1:[1,5]XXXX*.*;*/DE'
	mcrinp(14:17)=study
	mcrlen=25
	call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,
     1	    loglst,logcnt)
	if (loglst(1)(1:5) .ne. bacex1) then
C-------------------------------------------------------------
C *** apparent error erasing the studyset collection directory
C-------------------------------------------------------------
	    write(6,*)' Unexpected error clearing DM1:[1,5]'
	    write(6,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',
     1		FORM='formatted',access='append',type='old')
	    write(wrkunt,*)' Unexpected error clearing DM1:[1,5]'
	    write(wrkunt,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    call exit
	end if
C----------------------------------
C *** erase the first overflow area 
C----------------------------------
	if (alount .gt. 1) then
	    MCRINP='PIP DM3:[1,5]XXXX*.*;*/DE'
	    mcrinp(14:17)=study
	    mcrlen=25
	    call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,
     1		loglst,logcnt)
	    if (loglst(1)(1:5) .ne. bacex1) then
C----------------------------------------------------------
C *** apparent error erasing the first overflow area, abort
C---------------------------------------------------------- 
	    	write(6,*)' Unexpected error clearing DM3:[1,5]'
		write(6,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    	open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',
     1		    FORM='formatted',access='append',type='old')
	    	write(wrkunt,*)' Unexpected error clearing DM3:[1,5]'
		write(wrkunt,*)' Please examine DM2:[3,6]ADBTCH.LOG'
		call exit
	    end if
	end if
C-------------------------------------
C *** and clear the last overflow area
C-------------------------------------
	if (alount .gt. 3) then
	    MCRINP='PIP DM4:[1,5]XXXX*.*;*/DE'
	    mcrinp(14:17)=study
	    mcrlen=25
	    call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,
     1		loglst,logcnt)
	    if (loglst(1)(1:5) .ne. bacex1) then
C-----------------------------------------------------------
C *** apparent error erasing the second overflow area, abort
C-----------------------------------------------------------
	    	write(6,*)' Unexpected error clearing DM4:[1,5]'
		write(6,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    	open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',
     1		    FORM='formatted',access='append',type='old')
	    	write(wrkunt,*)' Unexpected error clearing DM4:[1,5]'
		write(wrkunt,*)' Please examine DM2:[3,6]ADBTCH.LOG'
		call exit
	    end if
	end if
C----------------------
C *** delete BRUERR.DAT
C----------------------
	MCRINP='PIP DM1:[1,5]BRUERR.DAT;*/DE'
	mcrlen=28
	call VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,
     1	    loglst,logcnt)
	if ((loglst(1)(1:5) .ne. bacex1) .and. 
     1	    (loglst(1)(1:26) .ne. bacex2)) then
C---------------------------------------
C *** apparent error deleting BRUERR.DAT
C---------------------------------------
	    write(6,*)
     1		' Unexpected error deleting DM1:[1,5]BRUERR.DAT'
	    write(6,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	    open(unit=wrkunt,name='DM1:[1,5]BRUERR.DAT',
     1	        FORM='formatted',access='append',type='old')
	    write(wrkunt,*)
     1		' Unexpected error deleting DM1:[1,5]BRUERR.DAT'
	    write(wrkunt,*)' Please examine DM2:[3,6]ADBTCH.LOG'
	end if
	call exit
	

C-----------------------------------------------------
c *** error opening dm1:[1,5]adwork.def, no work to do
C-----------------------------------------------------
9000	call errsns(ih)
	if (ih .eq. 29) then
	    write(6,*)' No work to do!'
	else
	    write(6,*)' Fatal error when opening ADWORK.DEF:',ih
	end if
	call exit

C----------------------------------
C *** dm2:[3,7]ADLAST.DEF not found
C----------------------------------
9010	call errsns(ih)
	write(6,*)' Fatal system error',ih,' when error opening ADLAST.DEF'
	call exit

900	format(a)
	include 'dm2:[4,6]acqlog.fmt'
	END

C*******************************************************************
C*******************************************************************
C*******************************************************************
C*******************************************************************

	subroutine VTIO(mcrinp,mcrout,mcrlen,vtlun,loglun,
     1	    loglst,logcnt)

C------------------------------------------------------------------
C	MCRINP MCR input buffer
C	MCROUT MCR output buffer. Text will be placed in ADBTCH.log
C	MCRLEN MCR input text length
C	VTSTS status from virtual terminal
C	VTLUN virtual terminal unit number
C
	integer vtsts,vtlun,loglun
	
	character mcrinp*84,mcrout*84,cr*1,loglst(20)*84
	logical*1 eol
	equivalence (eol,cr)

	integer logcnt
	eol=13

C----------------------
C *** terminate command
C----------------------
	mcrinp(mcrlen+1:mcrlen+1)=cr
C--------------------
C *** log the command
C--------------------
	open(unit=loglun,name='dm2:[3,7]adbtch.log',
     1	    form='formatted',status='unknown')
	write(loglun,*)' ** ',mcrinp(1:mcrlen+1)

C-----------------------------------
C *** issue virtual terminal command
C-----------------------------------
	vtsts=0
	logcnt=0
	idir=1
	call NMCR(MCRINP,vtsts,idir,vtlun)

	if (vtsts .LT. 0) then
	    write(loglun,*)' Unable to access virtual terminal'
	    call close(loglun)
	    call exit
	end if

	IDIR=0
678	call NMCR(MCROUT,vtsts,idir,vtlun)

	IF (VTSTS .LT. 0) then
	    write(loglun,*)
     1		' fatal error accessing virtual terminal for input'
	    call close(loglun)
	    call exit
	end if

C----------------------
C *** log MCR responses
C----------------------
	logcnt=logcnt+1
	write(loglun,900)mcrout
	loglst(logcnt)=mcrout

	if (index(mcrout,'Mount Tape') .ne. 0) then
	    call close(loglun)
	    return
	end if

	if (index(mcrout,'contiguously') .ne. 0) then
	    call close(loglun)
	    return
	end if
C---------------------------------
C *** maximum of than 20 responses
C---------------------------------
	if (logcnt .lt. 20) then
	    if (vtsts .eq. 0)goto 678
	end if
	call close(loglun)
	return
900	format(a)
	end

*******************************************************************
*******************************************************************
*******************************************************************
*******************************************************************
	SUBROUTINE ADCPY(wrkunt,acqlgn,acqlgs,alorem,aloexp,
     1	    acqlst,acqsiz,acqcnt,unit)
**************************************************************
*                                                            *
* Program for creating unique file name list		     *
*                                                            *
* Development Environment:RSX11M			     *
*                                                            *
* Programmer : Bruce Prendergast                             *
*                                                            *
* Date : May 18, 1989          			             *
*                                                            *
* Program structure:                                         *
*                                                            *
*                Build a unique list of file names in ACQLST *
*		 for verification during the backup process  *
*							     *
*		 This program is an element of the plotting/ *
*		 backup system.				     *
**************************************************************
C
C	wrkunt	log file logical unit
C	study	study number
C	alloc	total study set allocated space
C	acqlst	acq file name list
C	acqcnt	acq file count
C	unit	1 3 or 4 for last allocated unit
C	acqlgn  log file name DM1:[1,5]XXXX.LOG or DR0:[10,1]XXXX.LOG
C	acqlgs	log file name size
C
	integer acqcnt,wrkunt,unit,size,acqsiz(200),aloexp,alorem,
     1	    acqlgs
	integer*4 alloc
	
	character acqlst(200)*13,acqnam*13,acqlgn

	open(wrkunt,file=acqlgn(1:acqlgs),form='formatted',
     1	    status='old',readonly)
100	read(wrkunt,830,err=120,end=120)acqnam,junit,size
	if (junit .ne. unit) unit=junit
	do 110 i=1,acqcnt
	    if(acqnam(1:13) .eq. acqlst(i)(1:13)) then
C---------------------------------------------------------------------
C *** make sure the duplicate name is last since unit may have changed
C---------------------------------------------------------------------
	        do 105 k=i,acqcnt-1
		    acqlst(k)=acqlst(k+1)
		    acqsiz(k)=acqsiz(k+1)
105		continue
		acqsiz(acqcnt)=size
	        acqlst(acqcnt)=acqnam	
		goto 100
	   end if
110	continue

	acqcnt=acqcnt+1
	acqlst(acqcnt)=acqnam
	acqsiz(acqcnt)=size
	goto 100
C-----------
C *** an eof
C-----------
120	call close(wrkunt)

C-----------------------------
C *** get the total allocation
C-----------------------------
	do 130 k=1,acqcnt
	    alloc=alloc+acqsiz(k)
130	continue
C--------------------------------
C *** convert to single precision
C--------------------------------
140	aloexp=0
150	alorem=alloc
	if (alloc .ge. 32768) then
	    aloexp=aloexp+1
	    alloc=alloc-32768
	    goto 150
	end if
	return

	include 'dm2:[4,6]acqlog.fmt'
	end
**************************************************************
**************************************************************
**************************************************************
**************************************************************
	subroutine spwmcr(cmdsrc,lensrc)
**************************************************************
*                                                            *
* abort BRU started by virtual terminal			     *	
*                                                            *
* Development Environment:RSX11M			     *
*                                                            *
* Programmer : Bruce Prendergast                             *
*                                                            *
* Date : November 23, 1992                                   *
*                                                            *
* Program structure:                                         *
*                                                            *
*                This program is used by ADBACK for aborting *
*		 BRU when there is a "mount tape 2"	     *
**************************************************************
**************************************************************

	character cmdlin*48,cmdsrc*48
	data CMDLIN/'ABO ...BRU'/

	integer*4 dspnam
	data dspnam/6RMCR.../

	INTEGER IDSW,LINLEN,lensrc

C-----------------------------------
C *** AVOID AN ERROR -98 FROM SPAWNN
C-----------------------------------
	linlen=lensrc
	DO 35 I=1,LINLEN
	    CMDLIN(I:I)=CMDSRC(I:I)
35	CONTINUE

45	CALL SPAWNN(DSPNAM,,,21,,,,CMDLIN,LINLEN,0,,IDSW)
C-------------------------
C *** PROCESS SPAWN STATUS
C-------------------------
	IF (IDSW)50,52,54
C----------------
C *** spawn error
C----------------
50	write(5,700)idsw
700	format('+','<< Spawn error, DSW =',i3)
	call exit
C----------------------------------------
C *** wait for significant event, spawn
C     error due to insufficient resources
C----------------------------------------
52	call wfsne
	goto 45
C-------------------------
C *** wait for MCR to exit
C-------------------------
54	call waitfr(21)
	return
	end
