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 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 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 MVMV1+9 THEN GOSUB display.field TPRINT @(COL1,LIN1):"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,LIN1):STR(SPACE,30) NEXT K FOR K=MV1 TO MV1+9 TPRINT @(COL1,LIN1):"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,1) input.loop: TPRINT form:STR(" ",form) ;* position cursor TPRINT form: ;* position cursor temp=temp.form CALL *CINPUT.B(SEC.PRMPT,temp,special,form,form) IF special # 0 THEN ;* if special character encountered BEGIN CASE CASE special = F.1 CALL *HELP.PRINT.B(form,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