tldm-universe/Ardent/UV/APP.PROGS/TL.RELEASE.B
2024-09-09 17:51:08 -04:00

249 lines
7.1 KiB
Plaintext
Executable File

$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