Listing of file='START' on disk='vmedia/701-2606C.wvd.zip'
# Sector 149, program filename = 'START'
0010 REM START, RELEASE 2.3, (12/11/80) THIS PROGRAM IS A COPYRIGHT PRODUCT OF
WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED
0170 COM S2,Q1,Q1$8,Q0$(9)3,S0$8,S$8,S,M$(4)64,M2,N,Q$1,Q0,S$(15)8,S0$(15)1,N2
$60
: DIM A6$(8)124,A7$(8)124
: DIM Q6$80,U9$8,Q6,Q7,Q8,Q9,U9
: DIM Q$(2)80,Q6$80,Q7$80,Q3,Q4,Q5,Q6,Q7,Q8,Q9
: DIM I,F1$8,K1$8,T$(3)48,R9$(16),P$16,V$18
4000 MAT REDIM M$(4)62
: S2=#PART
: $PSTAT="Starting"
: FOR I=1TO 16
: Q6$=$PSTAT(I)
: ERRORGOTO 4060
4060 IF STR(Q6$,11,1)<>HEX(01)THEN Q7$="u"
: NEXT I
: Q6$=$PSTAT(1)
: I=0
: IF STR(Q6$,9,1)="M"THEN S0$,S$="GBS"
: UNPACK(##)STR(Q6$,12,2)TO Q8,Q9
: IF Q8+Q9/100<=5AND Q7$="u"THEN S$="GBS"
4130 SELECT @PARTS$
: ERRORIF I=0THEN PRINT HEX(0306);"Waiting for universal global partition"
: I=1
: $BREAK255
: $RELEASETERMINAL
: GOTO 4130
4140 I=0
4150 IF @Q1>0THEN 4200
: IF I=0THEN PRINT HEX(0306);"Waiting for system date"
: $BREAK255
: I=1
: GOTO 4150
4200 IF Q1>0THEN LOAD T"SYS MENU"
: Q1=@Q1
: V$=@V$
4230 SELECT @PARTS0$
: ERRORIF I=0THEN PRINT HEX(0306);"Waiting for global partition"
: I=1
: $BREAK255
: $RELEASETERMINAL
: GOTO 4230
4250 PRINT HEX(03);TAB(30);"GBS/MVP Release 2.3"
: GOSUB '123(Q1)
: Q1$=U9$
: PRINT AT(5,0);"Today's date is ";Q1$
: PRINT "The Julian date is";Q1
: PRINT "This is station ";S2
4310 Q9=0
: GOSUB '100("0","207",3,0,"ENTER COMPANY NUMBER",0)
: U9$="FILEF01"&BIN(Q9+48)
: DATA LOAD DC OPEN TU9$
: ERRORPRINT AT(3,0,80);"Company";Q9;"is not available, re-enter.";HEX(07)
: GOTO 4310
4350 S=Q9
: Q6$="The information in the company file cannot be read."
: DATA LOAD DC Q0$(),N2$,P$,S0$()
: ERRORGOTO 5250
4380 DATA LOAD DC A6$()
: ERRORGOTO 5250
4390 DATA LOAD DC A7$()
: ERRORGOTO 5250
4400 DATA SAVE DC CLOSE
: Q6$=ALL(81)
: PRINT AT(1,0);"ENTER COMPANY PASSWORD";AT(2,0);STR(Q6$,,16);AT(2,0)
: Q6$,Q7$=" "
: Q9=0
4460 KEYIN Q6$,4470,4470
4470 KEYIN Q6$,4490,4490
: GOTO 4470
4490 IF Q6$=HEX(1F)THEN 4310
: IF Q6$=HEX(0D)THEN 4560
: IF Q6$<HEX(1F)THEN 4460
: Q9=Q9+1
: STR(Q7$,Q9,1)=Q6$
: PRINT AT(2,Q9);
: IF Q9<16THEN 4460
4560 IF Q7$=P$THEN 4590
: PRINT AT(3,0,80);"Invalid password, try again.";HEX(07)
: GOTO 4310
4590 PRINT AT(4,0,80);N2$
: GOSUB '100("Y,N","YyY Nn",1,1,"IS THIS THE RIGHT COMPANY (Y OR N)",2)
: IF Q6$="N"THEN 4310
: Q6$=N2$
: N2$=" "
: STR(N2$,31-LEN(Q6$)/2)=Q6$
: Q6$="N"
: GOSUB '100("Y,N","YyY Nn",1,1,"DO YOU WANT A FILE STATUS REPORT",3)
: IF Q6$="N"THEN 5230
: MAT REDIM A6$(90)11
: MAT REDIM A7$(48)20
4700 PRINT HEX(03);TAB(19);" F I L E S T A T U S R E P O R T"
: PRINT AT(4,0);"File description Space used"
: FOR I=1TO 48
: F1$=A6$(I)
: IF F1$=" "THEN 5180
: SELECT #2<STR(A6$(I),9,3)>
: $OPEN #2
: LIMITS T#2,F1$,A2,E2,X2,A9
: ERRORA9=0
4790 IF A9<>2THEN 4980
: DATA LOAD BA T#2,(E2)R9$()
: STR(R9$(),32+S2,1)=" "
: DATA SAVE BA T#2,(E2)R9$()
: $CLOSE#2
: IF I>24OR A6$(I+48)=" "THEN 4980
: K1$=F1$
: STR(K1$,5,2)="K1"
: SELECT #1<STR(A6$(I+48),9,3)>
: LIMITS T#1,K1$,A1,Q9,Q9,Q9
: ERRORQ9=0
4890 IF Q9=2THEN 4930
: PRINT AT(1,0,80);HEX(07);"Key file not catalogued - ";A7$(I)
: GOSUB '254
: GOTO 4980
4930 DATA LOAD DA T#1,(A1)Q9,T$()
: DATA LOAD BA T#2,(E2-1)R9$()
: IF STR(R9$(),3,144)=T$()THEN 4980
: PRINT AT(1,0,80);HEX(07);"Error in key descriptor record - ";A7$(I)
: GOSUB '254
4980 J=J+1
: PRINT AT(5+J,0,80);A7$(I);TAB(22);
: Q9=0
: IF A9=2THEN Q9=(X2-2)/MAX((E2-A2-1),1)
: $UNPACK(F=V$)T$(2)TO T0,T2$,Q2$,V2$,T8,V6$,V3$,Q3$,V8$
: Q7=MOD(VAL(Q2$,2)+VAL(V6$),65536)/(VAL(Q3$,2)+1)
: IF STR(F1$,,7)="INVTF03"OR STR(F1$,,7)="BOMSF02"THEN Q7=0
: Q8=(VAL(V2$,2)-1)/(VAL(V3$,2))
5060 IF I<=24AND A6$(I+48)>" "THEN Q9=MAX(Q7,Q8)
: IF A9=2THEN PRINTUSING "###% full.",Q9*100;
: Q6$=" "
: IF Q9>.8THEN Q6$="File nearly full."
: IF Q9=1THEN Q6$="File full."
: IF STR(F1$,,3)="GBS"THEN Q6$="File always full."
: IF A9<>2THEN Q6$="File not available."
: PRINT TAB(34);Q6$
: IF J<16THEN 5180
: GOSUB '254
: J=0
: PRINT AT(6,0,)
5180 NEXT I
: IF J>0THEN GOSUB '254
: PRINT AT(5,0,)
: Q6$="System menu is not available."
5230 LOAD T"SYS MENU"
: ERRORGOTO 5250
5250 PRINT HEX(03)
: PRINT HEX(0A)
: PRINT Q6$
: END
9999 DEFFN'29"Q$=";HEX(22);"START";HEX(22);":SCRATCH TQ$:SAVET$()Q$";HEX(0D)