337 lines
10 KiB
Plaintext
Executable File
337 lines
10 KiB
Plaintext
Executable File
SUBROUTINE GET.PGMS(ID,Q,fvsavedlists,fvvoc,REC,SOURCE.MACHINE)
|
|
$INCLUDE UNIVERSE.INCLUDE MTF.INCL.H
|
|
******************************************************************************
|
|
*
|
|
* Enter names of BASIC program files; save into &SAVEDLISTS&
|
|
*
|
|
* 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 Make valid machines same as CONVERT.VOC
|
|
* 05/13/91 8345 DTM changed print to tprints
|
|
* 05/09/91 8331 DTM Fixed Enter.box.b to handle F.4
|
|
* 03/19/91 8064 DTM Changed the way it asked for input
|
|
* 02/26/91 7673 DTM Changed parameter for ENTER.BOX.B for case conversion
|
|
* 01/13/91 7673 DTM Final changes
|
|
* 12/27/90 7403 DTM Initial programming
|
|
*
|
|
*******************************************************************************
|
|
* 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%"
|
|
******************************************************************************
|
|
* Various Prompts and Help string values
|
|
******************************************************************************
|
|
equ PRMPT.LOC to 2
|
|
equ SHRT.HELP to 4
|
|
equ LONG.HELP to 5
|
|
******************************************************************************
|
|
* Various other variables
|
|
******************************************************************************
|
|
equ Default to 1
|
|
equ PAINT to 1 ;* flag to paint forms
|
|
equ Yes to 1
|
|
equ No to 0
|
|
equ AM to char(254)
|
|
equ VM to char(253)
|
|
equ SVM to char(252)
|
|
******************************************************************************
|
|
CALL *DRAW.SCRN.B(UVREADMSG(073730,ID),1)
|
|
GOSUB init.files ;* Initialize /usr/spool/uv/sp.config
|
|
GOSUB init.form ;* Initialize forms to be used
|
|
GOSUB init.vars ;* initialize local variables
|
|
******************************************************************************
|
|
* 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.
|
|
******************************************************************************
|
|
CALL *HELP.PRINT.B(UVREADMSG(073009,""),2)
|
|
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,PAINT)
|
|
MV=0
|
|
Q=NULL
|
|
GOSUB refresh.data
|
|
FOR Z=1 TO LAST.FIELD
|
|
Q=NULL
|
|
ON Z GOSUB file.names,sourcem
|
|
IF Q="XX" THEN GOTO exit.routine
|
|
NEXT Z
|
|
NEW.ITEM=No
|
|
LOOP
|
|
|
|
CALL *HELP.PRINT.B(NULL,3)
|
|
70 temp=NULL
|
|
CALL *ENTER.BOX.B(17,5,5,UVREADMSG(073737,""),temp,1)
|
|
IF temp="*" THEN GOTO 70
|
|
Q=temp
|
|
UNTIL UPCASE(Q)="S" OR Q="." OR Q=-1 DO
|
|
IF Q="+" THEN Q="1,+"
|
|
Z=FIELD(Q,",",1)
|
|
BEGIN CASE
|
|
CASE Z>=1 AND Z<=2.99 AND NUM(Z)
|
|
Q=Q[COL2()+1,999]
|
|
ON Z GOSUB file.names,sourcem
|
|
MV=0
|
|
CASE UPCASE(Q)="XX"
|
|
GOTO exit.routine
|
|
CASE UPCASE(Q)="R"
|
|
GOSUB refresh.data
|
|
CASE Default
|
|
CALL *HELP.PRINT.B(UVREADMSG(073732,""),2)
|
|
END CASE
|
|
REPEAT
|
|
REC=RAISE(REC)
|
|
WRITE REC ON fvsavedlists,ID
|
|
IF LAST.FIELD=2 AND SYSTEM(1001)#1 THEN WRITEV format ON fvvoc,"RELLEVEL",4
|
|
RETURN
|
|
|
|
******************************************************************************
|
|
* Init.form
|
|
* This routine initializes all the positional parameters, help strings,
|
|
* text strings, and default values for the two forms used in this subroutine
|
|
******************************************************************************
|
|
|
|
init.form:
|
|
form.size=2
|
|
form.line=1
|
|
form=NULL
|
|
temp.form=NULL
|
|
form<1,1>=@(5,14)
|
|
form<1,2>=@(35,14)
|
|
form<1,3>=UVREADMSG(073735,"")
|
|
form<1,4>=UVREADMSG(073738,"")
|
|
form<1,5>=form<1,4>
|
|
form<1,6>=40
|
|
form<1,7>=1
|
|
form<2,1>=@(5,15)
|
|
form<2,2>=@(35,15)
|
|
form<2,3>=UVREADMSG(073736,"")
|
|
form<2,4>=UVREADMSG(073739,"")
|
|
form<2,5>=form<2,4>:UVREADMSG(073734,"")
|
|
form<2,6>=40
|
|
form<2,7>=1
|
|
RETURN
|
|
|
|
******************************************************************************
|
|
* Init.files
|
|
* It also opens up the &DEVICE& File so they can both be used to modify
|
|
* entries, existing or not, for printers on system.
|
|
******************************************************************************
|
|
init.files:
|
|
OPEN '','&SAVEDLISTS&' TO fvsavedlists ELSE
|
|
retry=0
|
|
m1="Press <Retry> to attempt to open file again"
|
|
CALL *ERROR.BOX.B(10,3,0,UVREADMSG(073005,'&SAVEDLISTS&'),retry,m1)
|
|
IF retry=0 THEN GOTO init.files
|
|
SLEEP 3
|
|
STOP @(-1)
|
|
END
|
|
init.files2:
|
|
OPEN '','VOC' TO fvvoc ELSE
|
|
retry=0
|
|
m1="Press <Retry> to attempt to open file again"
|
|
CALL *ERROR.BOX.B(10,3,0,UVREADMSG(073005,'VOC'),retry,m1)
|
|
IF retry=0 THEN GOTO init.files2
|
|
SLEEP 3
|
|
STOP @(-1)
|
|
END
|
|
RETURN
|
|
|
|
******************************************************************************
|
|
* Init.vars -
|
|
* Routine which initializes various global variables
|
|
******************************************************************************
|
|
init.vars:
|
|
MV1=1
|
|
COL1=24:AM:24:AM:24:AM:24:AM:24:AM:24:AM:24:AM:24:AM:24:AM:24
|
|
LIN1=4:AM:5:AM:6:AM:7:AM:8:AM:9:AM:10:AM:11:AM:12:AM:13
|
|
TPRINT @(24,3):" ":UVREADMSG(073731,""):
|
|
READV format FROM fvvoc, "RELLEVEL", 4 ELSE format=NULL
|
|
BEGIN CASE
|
|
CASE format = "INFORMATION.FORMAT"
|
|
SOURCE.MACHINE = "PRIME"
|
|
CASE format = "REALITY.FORMAT"
|
|
SOURCE.MACHINE = "MICRODATA"
|
|
CASE format = "IN2.FORMAT"
|
|
SOURCE.MACHINE = "IN2"
|
|
CASE 1
|
|
SOURCE.MACHINE = NULL
|
|
END CASE
|
|
IF SOURCE.MACHINE = "" THEN
|
|
LAST.FIELD=2
|
|
END ELSE
|
|
LAST.FIELD=1
|
|
temp.form<2>=SOURCE.MACHINE
|
|
END
|
|
ID="BASIC.PGM.FILES"
|
|
READ REC FROM fvsavedlists,ID THEN
|
|
NEW.ITEM=No
|
|
REC=LOWER(REC)
|
|
END ELSE
|
|
NEW.ITEM=Yes
|
|
REC=NULL
|
|
END
|
|
RETURN
|
|
******************************************************************************
|
|
* file.names - routine to update basic program file names
|
|
******************************************************************************
|
|
file.names:
|
|
VALUE.INSERTED=No
|
|
IF NEW.ITEM THEN MV=MV+1 ELSE
|
|
MV=FIELD(Z,".",2)
|
|
Z=INT(Z)
|
|
IF MV<1 THEN
|
|
IF Q="DE" OR Q="de" THEN
|
|
REC=NULL; MV=1; GOSUB display.field
|
|
END ELSE IF Q="+" THEN MV=1 ELSE
|
|
FOR MV=1 TO 99 UNTIL REC<1,MV>=NULL; NEXT MV
|
|
IF MV>MV1+10 THEN GOSUB display.field
|
|
END
|
|
END ELSE IF REC<1,MV>=NULL AND Q # "DE" THEN GOTO file.names
|
|
END
|
|
IF Q=NULL THEN
|
|
floop1:
|
|
form.line=1
|
|
GOSUB get.input
|
|
temp.form<1>=NULL
|
|
Q=temp
|
|
IF (Q="/" OR Q=NULL) AND NOT(VALUE.INSERTED) THEN MV=0; RETURN
|
|
END
|
|
IF Q="I" OR Q="i" THEN
|
|
VALUE.INSERTED=Yes; REC=INSERT(REC,1,MV,0,NULL)
|
|
GOSUB display.field; Q=NULL; GOTO floop1
|
|
END
|
|
IF Q="+" THEN MV=MV1+10;GOSUB display.field;RETURN
|
|
IF Q="DE" OR Q="de" THEN
|
|
REC=DELETE(REC,1,MV,0)
|
|
GOSUB display.field; RETURN
|
|
END
|
|
IF Q="^" OR Q="XX" THEN RETURN
|
|
OPEN "",Q TO fvjunk ELSE
|
|
CALL *HELP.PRINT.B(UVREADMSG(073005,Q),2)
|
|
GOTO floop1
|
|
END
|
|
REC<1,MV>=Q
|
|
IF MV<MV1 OR MV>MV1+9 THEN GOSUB display.field
|
|
TPRINT @(COL1<MOD(MV-1,10)+1>,LIN1<MOD(MV-1,10)+1>):"1.":MV"L#3":Q "L#25"
|
|
IF Q=NULL THEN
|
|
MV=0
|
|
RETURN
|
|
END
|
|
MV=MV+1
|
|
GOTO floop1
|
|
RETURN
|
|
******************************************************************************
|
|
* refresh.data - refresh data
|
|
******************************************************************************
|
|
refresh.data:
|
|
GOSUB display.field
|
|
IF LAST.FIELD=2 THEN
|
|
temp.form<2>=SOURCE.MACHINE
|
|
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,PAINT)
|
|
END
|
|
Q=NULL
|
|
RETURN
|
|
******************************************************************************
|
|
* exit.routine - exit the menu
|
|
******************************************************************************
|
|
exit.routine:
|
|
STOP @(-1)
|
|
RETURN
|
|
******************************************************************************
|
|
* display.field - display file names to choose from
|
|
******************************************************************************
|
|
display.field:
|
|
MV1=10*INT((MV-1)/10)+1
|
|
IF REC<1,MV1>=NULL AND Q="+" THEN MV1=1
|
|
FOR K=MV1 TO MV1+9
|
|
TPRINT @(COL1<MOD(K-1,10)+1>,LIN1<MOD(K-1,10)+1>):STR(SPACE,30)
|
|
NEXT K
|
|
FOR K=MV1 TO MV1+9
|
|
TPRINT @(COL1<MOD(K-1,10)+1>,LIN1<MOD(K-1,10)+1>):"1.":K"L#3":REC<1,K> "L#25"
|
|
NEXT K
|
|
TPRINT @(COL1<10>-1,LIN1<10>):
|
|
IF REC<1,K>#NULL THEN TPRINT "+" ELSE TPRINT "."
|
|
RETURN
|
|
******************************************************************************
|
|
* get.input - get any input that is needed
|
|
******************************************************************************
|
|
get.input:
|
|
|
|
help.loop:
|
|
|
|
CALL *HELP.PRINT.B(form<form.line,SHRT.HELP>,1)
|
|
|
|
input.loop:
|
|
|
|
TPRINT form<form.line,PRMPT.LOC>:STR(" ",form<form.line,6>) ;* position cursor
|
|
TPRINT form<form.line,PRMPT.LOC>: ;* position cursor
|
|
temp=temp.form<form.line>
|
|
CALL *CINPUT.B(SEC.PRMPT,temp,special,form<form.line,6>,form<form.line,7>)
|
|
IF special # 0 THEN ;* if special character encountered
|
|
BEGIN CASE
|
|
CASE special = F.1
|
|
CALL *HELP.PRINT.B(form<form.line,LONG.HELP>,3)
|
|
GOTO input.loop ;* get more input
|
|
CASE special = ESCAPE ;* escape was pressed
|
|
GOTO exit.routine
|
|
CASE special = NEXT.PAGE
|
|
Q="+"
|
|
MV=MV1+10
|
|
GOSUB display.field
|
|
GOTO help.loop
|
|
CASE Default
|
|
GOTO help.loop
|
|
END CASE ;* end of case
|
|
END ;* end of if statement
|
|
RETURN
|
|
******************************************************************************
|
|
* sourcem - routine to update source machine data
|
|
******************************************************************************
|
|
sourcem:
|
|
IF Q=NULL THEN
|
|
sloop1:
|
|
form.line=2
|
|
GOSUB get.input
|
|
Q=temp
|
|
END
|
|
Q=UPCASE(Q)
|
|
IF Q="^" OR Q="XX" THEN RETURN
|
|
IF Q=NULL THEN
|
|
CALL *HELP.PRINT.B(UVREADMSG(071004,""),2)
|
|
GOTO sloop1
|
|
END
|
|
BEGIN CASE
|
|
CASE Q="PRIME"
|
|
format = "INFORMATION.FORMAT"
|
|
CASE Q="MICRODATA"
|
|
format = "REALITY.FORMAT"
|
|
CASE Q="IN2"
|
|
format = "IN2.FORMAT"
|
|
CASE Q = "ADDS" OR Q = "ULTIMATE" OR Q = "IBM PC-XT"
|
|
format = "PICK.FORMAT"
|
|
CASE Default
|
|
CALL *HELP.PRINT.B(UVREADMSG(073734,""),2)
|
|
GOTO sloop1
|
|
END CASE
|
|
IF LEN(Q) > 12 THEN
|
|
CALL *HELP.PRINT.B(UVREADMSG(073733,""),2)
|
|
GOTO sloop1
|
|
END
|
|
SOURCE.MACHINE=Q
|
|
temp.form<2>=Q
|
|
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,PAINT)
|
|
RETURN
|
|
|
|
STOP @(-1)
|
|
END
|