tldm-universe/Ardent/UV/APP.PROGS/CONVERT.PGMS

136 lines
4.4 KiB
Plaintext
Raw Normal View History

2024-09-09 21:51:08 +00:00
$INCLUDE UNIVERSE.INCLUDE MTF.INCL.H
$OPTIONS A
*****************************************************************************
*
* Enter names of BASIC program files; save into &SAVEDLISTS&; resize
* files; delete old object
*
* 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.
* 08/05/92 9887 PVW del last changes as changes made in GET.PGMS
* 07/16/92 9550 PVW add in REALITY.FORMAT and INFORMATION.FORMAT
* flavours for deleting object code from files.
* 07/15/92 9045 PVW allow option to select file resizing type
* 1/19/91 7673 DTM Put in final changes
* 11/7/90 7673 DTM Added Motif Menuing
* 08/18/90 7373 JWT correct spelling error
* 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10.
*
******************************************************************************
* This subroutine will accept as an argument the value of the operation
* to perform. It can perform the following functions on spooler jobs:
******************************************************************************
id = "%W%"
******************************************************************************
* In this section, we draw the first screen, print the menu bar and help
* areas, and put up the first title and form to fill out.
******************************************************************************
Q=NULL
ID="CONVERT.PGMS"
FVSAVEDLISTS=NULL
FVVOC=NULL
REC=NULL
CALL *GET.PGMS(ID,Q,FVSAVEDLISTS,FVVOC,REC,SOURCE.MACHINE)
CALL *DRAW.SCRN.B(UVREADMSG(073715,""),1)
CALL *HELP.PRINT.B(UVREADMSG(073009,""),2)
IF Q = "XX" OR Q = "xx" OR Q = "^" THEN
STOP
END
*
* prompt to get file type for resize
*
existing.type=FALSE
file.type="1"
text=UVREADMSG(073751,"")
text.length=LEN(text)+4
b.option=0
b.array=""
b.array<1>=3
b.array<2>="1"
b.array<3>="19"
b.array<4>=UVREADMSG(073750,"")
CALL *HELP.PRINT.B(UVREADMSG(073752,""),2)
CALL *CHOICE.BOX.B(8,3,text.length,text,b.array,b.option,"")
IF b.option=-1 THEN GOTO 9999
b.option+=2
IF b.option=4 THEN
existing.type=TRUE
end else
existing.type=FALSE
file.type=b.array<b.option>
end
*
flag=1
CALL *HELP.PRINT.B(UVREADMSG(073716,""),2)
CALL *YES.NO.BOX.B(8,UVREADMSG(073152,""),flag)
IF flag=0 THEN
GOTO 9999
END
NBR.PROGRAMS = DCOUNT( REC, @AM )
message1=UVREADMSG(073717,"")
message2=UVREADMSG(073718,"")
******************************************************************************
FOR I = 1 TO NBR.PROGRAMS
*
* Delete the old object code.
*
CALL *HELP.PRINT.B("",3)
CALL *HELP.PRINT.B(message1:REC<I>:".",2)
IF SOURCE.MACHINE = "MICRODATA" OR SOURCE.MACHINE = "PRIME" THEN
OPEN "", REC< I > TO FVJUNK ELSE
CALL *HELP.PRINT.B(UVREADMSG(073005,REC<I>),2)
SLEEP 3
GOTO 79
END
file.opened = TRUE
SELECT FVJUNK
EOF = 0
LOOP
READNEXT PGM.ID ELSE EOF = 1
UNTIL EOF DO
IF PGM.ID[ 1, 1 ] = "$" THEN
DELETE FVJUNK, PGM.ID
END
REPEAT
END ELSE
file.opened = FALSE
PERFORM "CLEAR.FILE DICT " : REC< I >
END
*
* Resize file
*
If existing.type THEN
IF NOT(file.opened) THEN
OPEN "", REC< I > TO FVJUNK ELSE
CALL *HELP.PRINT.B(UVREADMSG(073005,REC<I>),2)
SLEEP 3
GOTO 79
END
END
STATUS stat.variable FROM FVJUNK THEN
file.type=stat.variable<21>
END ELSE
file.type="1"
END
END
*
CALL *HELP.PRINT.B(message2<1>:REC<I>:message2<2>:file.type:message2<3>,2)
PERFORM "RESIZE " : REC< I > :" ": file.type
79 NEXT I
*
9999 STOP
*
*
END