tldm-universe/Ardent/UV/APP.PROGS/TL.RELEASE.B

$INCLUDE UNIVERSE.INCLUDE MTF.INCL.H
$INCLUDE UNIVERSE.INCLUDE FILENAMES.H
$INCLUDE UNIVERSE.INCLUDE MACHINE.NAME
$INCLUDE UNIVERSE.INCLUDE TLOG.H
******************************************************************************
*
*   System Admin Transaction Logging - Release A Single Log
*
*	Module	%M%	Version	%I% 	Date	%H%
*
*	(c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
*	This is unpublished proprietary source code of Ardent Software Inc.
*	The copyright notice above does not evidence any actual or intended
*	publication of such source code.
*
*******************************************************************************
*
*	Maintenence log - insert most recent change descriptions at top
*
*	Date.... GTAR# WHO Description........................................
*	10/14/98 23801 SAP Change copyrights. 
*	06/28/95 16790 GMH Add release of tape devices
*	11/02/94 15225 DTM Added 'Working...' message
*	10/12/94 15101 DTM Changed length of log number field
*	08/22/94 14725 DTM Ended program normally, preventing fall through
*	07/19/94 13286 DTM Made it display status message after successful release
*	05/15/94 13286 DTM Initial programming
*
*******************************************************************************
id = "%W%"
*******************************************************************************

*******************************************************************************
*	Call initialization routines
*******************************************************************************
TPRINT @(-1)
temp = NULL
CALL *ISUSER.B(0, temp)
IF temp = 0 THEN
    TPRINT UVREADMSG(071000,"")
    SLEEP 3
    STOP
END

* look in command line for TAPE
PARAMS = convert(" ",@FM,@sentence)
if PARAMS<dcount(PARAMS,@fm)> = "TAPE" then
   TAPE.REL = 1
end else
   TAPE.REL = 0
end
GOSUB init.form

*******************************************************************************
*	Begin processing
*******************************************************************************
CALL *DRAW.SCRN.B("Release A Single Log",1)
GOSUB init.menu
CALL *MNU.BAR.PR.B(Menu.Bar,1)

CALL *HELP.PRINT.B(UVREADMSG(073009,""),2)
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)

help.loop:

CALL *HELP.PRINT.B(form<form.line,4>,1)

input.loop:

TPRINT form<1,2>:
temp=temp.form<form.line>
CALL *CINPUT.B(SEC.PRMPT,temp,special,form<form.line,6>,0)

IF special # 0 THEN
	BEGIN CASE
		CASE special = F.1
			CALL *HELP.PRINT.B(form<1,5>,3)
			GOTO input.loop
		CASE special = ESCAPE
			STOP @(-1)
		;* CASE special = F.4
		;* 	temp="*"
		CASE special = F.10
			action.value=1
			CALL *DO.MNU.BAR.B(Menu.Bar,action.value,form.size,form,temp.form)
			BEGIN CASE
				CASE action.value = 1
					STOP @(-1)
				CASE action.value = 2
					STOP @(-1)
				CASE action.value = 3
					message=UVREADMSG(073634,"")
					CONVERT @FM TO " " IN message
					CALL *HELP.BOX.B(3,10,60,message)
				CASE action.value = 4
					message=UVREADMSG(076001,"")
					CONVERT @FM TO " " IN message
					CALL *HELP.BOX.B(3,10,60,message)
				CASE action.value = 5
					CALL *HELP.BOX.B(3,10,45,UVREADMSG(076000,""))
			END CASE
			CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
			GOTO help.loop
	END CASE
END
ELSE
	IF ( temp NE NULL ) THEN
		temp.form< 1 > = temp
		log.number	= temp
		GOSUB release.log
	END
	ELSE
		GOTO input.loop
	END
END

STOP @(-1)

*************************************************************************
*  Init.form 
*     This routine is used TO initialize the form TO be printed on the 
*     screen for data input.  It also sets up the default answers, if
*     any
*
*************************************************************************
init.form:
	form=NULL
	temp.form=NULL
	scratch=UVREADMSG(073302,"")
	form<1,1>=@(5,9)
	form<1,2>=@(40,9)
if not(TAPE.REL) then
	form<1,3>="Enter the Log Sequence Number"
	form<1,4>="Enter the sequence number of the Log to release."
	Sel.Stmt = "SELECT UV_LOGS WITH STATUS = 'Full' BY @ID SAVING @ID"
end else
	form<1,3>="Enter Tape Device Name"
	form<1,4>="Enter the &DEVICE name of the tape device to release."
	Sel.Stmt = "SELECT &DEVICE& WITH OTHER # '' BY @ID SAVING @ID"
end
	form<1,5>=form<1,4>
	form<1,6>=9
	EXECUTE Sel.Stmt RTNLIST tmpl CAPTURING junk1

	READNEXT JUNK FROM tmpl THEN
		temp.form<1>=JUNK
	END

	IF temp.form<1> = "" THEN
if not(TAPE.REL) then
		message = "No Files are available to be released"
end else
      message = "No tape devices need to be released"
end
		CALL *HELP.BOX.B( 11, 10, 60, message )
		STOP
	END
	form.size=1
	form.line=1
RETURN

***************************************************************************
* release.log
***************************************************************************
release.log:
	CALL *HELP.PRINT.B( "Working...", 3 )
if not(TAPE.REL) then
	command.string	= "RELEASE.LFILE ":log.number
	EXECUTE command.string CAPTURING trash
	trash = trash[1,LEN(trash)-1]
end else
	trash = ""
	open "&DEVICE&" to dev.file then
		readu rec from dev.file,log.number then
			if rec<18> = "LG_FULL" then
				rec<18> = ""
				write rec on dev.file,log.number else
					trash = "Unable to release device ":log.number:"."
				end
			end else
				trash = "Tape device ":log.number:" does not need to be released."
			end
		end else
			trash = "Unable to read ":log.number:" from &DEVICE& file."
		end
      release dev.file,log.number
	end else
		trash = "Unable to open &DEVICE& file."
	end
end
	retry = 0
	IF trash # "" THEN
		CALL *ERROR.BOX.B(7, 8, 0, trash, retry, "No help")
		IF retry THEN 
			STOP @(-1) 
		END
		ELSE 
			CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
			GOTO input.loop
		END
	END
	ELSE
if not(TAPE.REL) then
		message = "Log File ":log.number:" has been released."
end else
		message = "Tape device ":log.number:" has been released."
end
		CALL *HELP.BOX.B(11,10,60,message)
	END
RETURN

***************************************************************************
* init.menu - initializes menu bar
***************************************************************************
init.menu:
	scratch=UVREADMSG(073087,"")
    Menu.Bar =	NULL
    Menu.Bar<1,1> = 3		;* Number of Items in Menu.Bar
    Menu.Bar<1,2> = 1		;* Line # on which to print the Menu Bar
* First Item
    Menu.Bar<2,1,1>=scratch<1>	;* SubMenu Title
    Menu.Bar<2,1,2>=1		;* # of items in SubMenu
* SubMenu #1
    Menu.Bar<2,2,1>=scratch<6>	;* SubMenu Item
    Menu.Bar<2,2,2>=1		;* Action Code (Returned to calling process)
    Menu.Bar<2,2,3>=scratch<7>
* Second Item
    Menu.Bar<3,1,1>=scratch<8>	;* SubMenu Title
    Menu.Bar<3,1,2>=1		;* # of items in SubMenu
* SubMenu #1
    Menu.Bar<3,2,1>=scratch<6>	;* SubMenu Item
    Menu.Bar<3,2,2>=2		;* Action Code
    Menu.Bar<3,2,3>=scratch<7>
	scratch=UVREADMSG(073089,"")
	Menu.Bar<4,1,1>=scratch<1>
	Menu.Bar<4,1,2>=3
	Menu.Bar<4,2,1>=scratch<2>
	Menu.Bar<4,2,2>=3
	Menu.Bar<4,2,3>=scratch<3>
	Menu.Bar<4,3,1>=scratch<4>
	Menu.Bar<4,3,2>=4
	Menu.Bar<4,3,3>=scratch<5>
	Menu.Bar<4,4,1>=scratch<6>
	Menu.Bar<4,4,2>=5
	Menu.Bar<4,4,3>=scratch<7>
RETURN
STOP @(-1)
END