image of READY prompt

Wang2200.org

Listing of file='FCSG120A' on disk='vmedia/701-2661A.wvd.zip'

# Sector 554, program filename = 'FCSG120A'
0010 REM FCSG120A, RELEASE 1-0, (06/14/79), THIS PROGRAM IS A COPYRIGHT PRODUC
     T OF WANG LABORATORIES., UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED,
     SIMULATOR DATA ACCESS
0170 COM A6$(1)36,C0$20,F7$3,I9,K(44),K1,K2,K3,K9,K1$9,K2$9,K2$(2)1,K3$8,K5$30
     ,K9$4,M$8,M6$1,P,P1,P$1,P$(12)3,P(13),P6$(14)2
   : COM A,A0,A0$1,A1,A1$1,A2,A3,A3$1,A4,A4$1,A5,B,B(13),B0,B1,B1(2,5),B2,B3,B
     4,B5,C0,C1,C2,C3,C5,D,D0,D1,D2,D3,D4,D5,G,G1,G2,Q2,Q4,Q7
0199 GOTO 4000
4000 DIM J$(8),D4$(1)63,K0$62,E6$3,K4$8,L8$5,R9$(16)
   : IF B1(1,1)=2THEN 4035
   : IF Q6$="DEMAND SIMULATOR"THEN M6$="D"
   : ELSE M6$="R"
   : Q6$="        KFAMOPENKFAMCODEINVFILE"&S0$(3)&"FINFILE"&S0$(3)&"SLSSTABVPR
     OFILE"&S0$(14)
   : GOTO 4040
4035 Q6$="        KFAMOPENKFAMCODE"
4040 Q=2
4050 DEFFN'99
   : Q2=Q0
   : Q4=VAL(Q0$(4))
   : Q7=VAL(Q0$(7))
   : Q6$=STR(Q6$,9)
   : IF Q6$=" "THEN 4170
   : LOAD TSTR(Q6$,,8)10,210BEG 199
   : ERRORGOTO 4530
4170 SELECT @PARTS0$
   : Q$=" "
   : GOSUB '91
   : GOTO 5100
4210 GOSUB '100("1","3",1,0,"ENTER SOURCE OF DATA (1=KEYBOARD 2=SIMULATOR FILE
       3=INVT. FILE)",1)
   : GOSUB 4620
   : Q6$="NEW      SIMULATORINVENTORY"
   : K2$=STR(Q6$,Q9*9-8,9)
   : IF Q9<>2THEN RETURN
   : PRINT AT(5,16,64);"1. DATA SOURCE = ";K2$
   : RETURN
4290 Q6$=F7$
   : GOSUB '100(" "," ",3,0,"ENTER DESIRED DISK ADDRESS",3)
   : GOSUB 4620
   : F7$=Q6$
   : MAT SEARCH"310320330350360370B10B20B30B50B60B70D10D11D12D13D14D15D20D21D2
     2D23D24D25D30D31D32D33D34D35D50D51D52D53D54D55D60D61D62D63D64D65D70D71D72
     D73D74D75",=F7$TO Q7$STEP 3
4340 IF STR(Q7$,,2)<>HEX(0000)THEN 4380
   : PRINT AT(3,0,80);HEX(07);"ADDRESS ";F7$;" IS INVALID"
   : F7$=" "
   : GOTO 4290
4380 SELECT #2<F7$>
   : PRINT AT(7,16,64);"3. DISK ADDRESS = ";F7$
   : RETURN
4420 PRINT AT(3,0,80);HEX(07);"DISK ERROR";ERR;"HAS OCCURRED"
   : CONVERT E7$TO Q9
   : E7$=" "
   : ON Q9GOTO 5320,5880
   : ON ERRORE6$,Q6$GOTO 4480
4480 PRINT HEX(010A);HEX(07);"AN ERROR ";E6$;" HAS OCCURED ON LINE  ";Q6$
   : SELECT @PARTS0$
   : GOSUB '254
   : GOSUB '31
4530 PRINT AT(1,0);Q6$;" IS UNAVAILABLE"
   : SELECT @PARTS0$
   : GOSUB '254
   : GOSUB '31
4580 GOSUB '100("Y,N","NnYyY ",1,1,"DO YOU WISH TO SAVE DATA (Y OR N)",2)
   : GOSUB 4620
   : RETURN
4620 IF Q6$<>HEX(1F)THEN RETURN
   : PRINT AT(1,0,80);HEX(07);"THE PROGRAM WILL BE TERMINATED"
   : GOSUB '31
4660 Q6$=K3$
   : GOSUB '100(" "," ",8,0,"ENTER FILE NAME",3)
   : GOSUB 4620
   : K3$=Q6$
   : PRINT AT(6,16,64);"2. FILE NAME = ";K3$
   : RETURN
4740 K0$=HEX(A00553025202500151015302A00153025202520252025202A0015004510550015
     002510250045004500453025302A01953025002A001A00150045004A01E)
   : RETURN
4770 K0$=HEX(5002A009500251025002A0045004A0145004A001)
   : RETURN
4800 DATA LOAD BA T#2,(H6,H7)R9$()
   : IF B8=K4AND STR(R9$(),4,5)="INVTS"THEN 4840
   : K0$="BAD"
   : GOTO 4920
4840 DBACKSPACE #2,BEG
   : DATA LOAD DC #2,M$()
   : GOSUB 4740
   : $UNPACK(F=K0$)M$()TO L8$,A,A0,B,B3,A1,A4$,A2,A3,A4,A5,B(),A3$,D4,D3,C1,C3
     ,C2,D2,B5,B4,B2,C5,Q6$,D1,C0,A1$,A0$,B0,B1,K5$
   : UNPACK(-########.#)Q6$TO D,D0,G2,G1,G
   : DATA LOAD DC #2,M$()
   : GOSUB 4770
   : $UNPACK(F=K0$)M$()TO K3,K1$,K1,K2,K9,K9$,I9,C0$,K(),K2$()
4920 GOSUB '219(K3$,2,S2,F7$,0)
   : RETURN
4950 GOSUB 4740
   : L8$="INVTS"
   : PACK(-########.#)Q6$FROMD,D0,G2,G1,G
   : MAT REDIM M$(4)62
   : $PACK(F=K0$)M$()FROML8$,A,A0,B,B3,A1,A4$,A2,A3,A4,A5,B(),A3$,D4,D3,C1,C3,
     C2,D2,B5,B4,B2,C5,Q6$,D1,C0,A1$,A0$,B0,B1,K5$
   : DATA SAVE DC #2,M$()
   : GOSUB 4770
   : $PACK(F=K0$)M$()FROMK3,K1$,K1,K2,K9,K9$,I9,C0$,K(),K2$()
5030 DATA SAVE DC #2,M$()
   : GOSUB '218(K3$,2,F7$,0)
   : GOSUB '219(K3$,2,S2,F7$,0)
   : RETURN
5100 SELECT CO 005(80),PRINT 005(80)
   : K4=4
   : IF B1(1,1)=2THEN 5800
   : GOSUB '180
   : P$()="JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"
   : K2$(1)="Y"
   : K2$(2)="3"
   : D5=.5
   : B1(1,1)=2
   : B1(2,1)=.6
   : B1(1,2)=5
   : B1(2,2)=.5
   : B1(1,3)=10
   : B1(2,3)=.4
   : B1(1,4)=100
   : B1(2,4)=.3
   : B1(1,5)=9E99
   : B1(2,5)=.2
   : GOSUB 4210
   : ON Q9GOTO 5600,5300,6320
5300 GOSUB 4660
   : GOSUB 4290
5320 GOSUB '100("0","3",1,0,"ENTER ITEM NUMBER TO CORRECT (0=END)",1)
   : GOSUB 4620
   : ON Q9+1GOTO 5410,5370
   : ON Q9-1GOSUB 4660,4290
   : GOTO 5320
5370 GOSUB 4210
   : ON Q9GOTO 5600,5320,6320
5410 PRINT HEX(010A);"MOUNT DISK CONTAINING FILE ";K3$;" IN DISK DRIVE ";F7$
   : GOSUB '254
   : E7$="1"
   : LIMITS T#2,K3$,H6,H7,B8,R
   : ERRORGOTO 4420
5460 E7$=" "
   : IF R=2THEN 5520
5480 PRINT AT(3,0,80);HEX(07);"FILE ";K3$;" IS NOT A SIMULATOR FILE"
   : K3$=" "
   : GOSUB 4660
   : GOTO 5320
5520 GOSUB '217(K3$,2,S2,0,1," ",F7$,0)
   : GOSUB '91
   : IF J0<>0THEN 5320
   : GOSUB 4800
   : IF K0$="BAD"THEN 5480
   : GOTO 6250
5600 I1$="M"
   : GOSUB 7070
   : MAT B=CON
   : A3$="S"
   : C1,B5,B4=1
   : D4=8
   : D3,C2=4
   : C3=28
   : C5=.95
   : D5=.5
   : D=100
   : D0,G2=20
   : B1,C0,D1,G,G1,I9=0
   : A0$,A1$=HEX(00)
   : B0=150
   : C0$="UNITS"
   : GOSUB 7120
   : GOTO 6250
5800 $UNPACK(F=HEX(610461046104510451045303500260046004A001A001))A6$()TO D,D0,
     G2,G1,G,D1,C0,B0,B1,A1$,A0$
   : PRINT AT(1,0,)
   : K4$=K3$
   : GOSUB 4580
   : IF Q6$="N"THEN 6200
   : PRINT AT(5,16,64);"1. SAVE DATA - YES"
   : GOSUB 4660
   : GOSUB 4290
5880 GOSUB '100("0","3",1,0,"ENTER ITEM NUMBER TO CORRECT (0=END)",1)
   : GOSUB 4620
   : ON Q9+1GOTO 5960,5930
   : ON Q9-1GOSUB 4660,4290
   : GOTO 5880
5930 GOSUB 4580
   : IF Q6$="N"THEN 6200
   : ELSE GOTO 5880
5960 PRINT HEX(010A);"MOUNT DISK ";
   : IF K2$="SIMULATOR"AND K3$=K4$THEN PRINT "CONTAINING";
   : ELSE PRINT "TO CONTAIN";
   : PRINT " FILE ";K3$;" IN DISK DRIVE ";F7$
   : GOSUB '254
   : E7$="2"
   : LIMITS T#2,K3$,H6,H7,B8,R
   : ERRORGOTO 4420
6030 E7$=" "
   : R1=K4
   : IF R=0OR R=-2THEN 6150
   : IF R=2THEN 6110
   : PRINT AT(3,0,80);HEX(07);"FILE ";K3$;" IS NOT A SIMULATOR FILE"
6080 K3$=" "
   : GOSUB 4660
   : GOTO 5880
6110 R1=0
   : IF K2$="SIMULATOR"AND K3$=K4$THEN 6150
   : PRINT AT(3,0,80);HEX(07);"FILE ";K3$;" ALREADY EXISTS ON DISK"
   : GOTO 6080
6150 GOSUB '217(K3$,2,S2,R1,4," ",F7$,0)
   : GOSUB '91
   : IF J0<>0THEN 5880
   : GOSUB 4950
   : K2$="SIMULATOR"
6200 PRINT AT(1,0,)
   : GOSUB '100("Y,N","NnYyY ",1,1,"DO YOU WISH TO MODIFY THE DATA AND RE-RUN
      (Y OR N)",2)
   : GOSUB 4620
   : IF Q6$="N"THEN GOSUB '31
6250 Q6$="PRNTAVAL"
   : LOAD DC TQ6$10,3617BEG 6270
   : ERRORGOTO 4530
6270 COM CLEAR V7$()
   : Q6$="FCST122A"
   : LOAD TQ6$4000,7999BEG 4000
   : ERRORGOTO 4530
6320 GOSUB '230(1,14,2,1,S$(2),1," ",STR(M$(),1,3),STR(M$(),4,3))
   : GOSUB '91
   : IF J0>0THEN PRINT AT(3,LEN(J$(J0))+1);"- INVENTORY FILE"
   : IF J0<>0THEN 6400
   : GOSUB '230(2,14,4,1,S$(4),1," ",STR(M$(),7,3),STR(M$(),10,3))
   : IF J0>0THEN PRINT AT(3,LEN(J$(J0))+1);"- PROFILE FILE"
   : GOSUB '91
   : IF J0=0THEN 6450
6400 PRINT HEX(010A);"PROGRAM WILL BE TERMINATED";TAB(64)
   : GOSUB '254
6420 GOSUB '239(1)
   : GOSUB '239(2)
   : GOSUB '31
6450 PRINT AT(1,0,640)
6460 GOSUB '100(" ",HEX(7F),Q0,0,"ENTER PRODUCT NUMBER",2)
   : IF Q6$=HEX(1F)THEN 6420
   : GOSUB '96(2)
   : F1$=Q6$
   : PRINT AT(5,20);"READING INVENTORY AND PROFILE RECORDS"
   : GOSUB '232(1,0,F1$)
   : GOSUB '91
   : IF J0>0THEN PRINT AT(3,LEN(J$(J0))+1);"- PRODUCT # ";F1$
   : IF J0=3THEN F1$=" "
   : IF J0=3OR J0=7THEN 6460
   : IF J0<>0THEN 6400
   : GOSUB '78(2)
   : GOSUB '232(2,0,G1$)
6590 GOSUB '91
   : IF J0>0THEN PRINT AT(3,LEN(J$(J0))+1);"- PROFILE ID ";G1$
   : IF J0=3THEN G1$=" "
   : IF J0=3OR J0=7THEN 6460
   : IF J0<>0THEN 6400
   : GOSUB '79(4)
   : GOSUB '239(1)
   : GOSUB '239(2)
   : GOSUB 7070
   : B0=E-E3
   : B1=E1
   : D4=E5
   : C0$=F3$
   : K5$=F2$
   : IF A3$<>"M"THEN 6750
   : D3=E4
6750 K1=INT(.8*C3)
   : K8=0
6770 K8=K8+1
   : IF K1>=B1(1,K8)THEN 6770
   : K2=INT(K1*B1(2,K8)+.5)
   : GOSUB 7120
   : GOTO 6250
6830 DEFFN'180
   : P=12
   : P$="D"
   : P(1)=31
   : P(2)=28
   : P(3)=31
   : P(4)=30
   : P(5)=31
   : P(6)=30
   : P(7)=31
   : P(8)=31
   : P(9)=30
   : P(10)=31
   : P(11)=30
   : P(12)=31
   : P(13)=00
   : P1=0
   : FOR P6=1TO P
   : PACK(####)P6$(P6)FROMP1
   : P1=P1+P(P6)
   : NEXT P6
   : PACK(####)P6$(P+1)FROMP1
   : RETURN
7070 Q9=POS("LMH"=I1$)
   : A4$=STR(D4$(1),Q9)
   : UNPACK(##.##)STR(D4$(1),20*Q9-16)TO A,A0,A1,A2,A3,A4,A5,B3,B,B2
   : RETURN
7120 K1$,K9$=Q1$
   : MAT K=ZER
   : K3,K9=P
   : CONVERT STR(Q1$,7,2)TO Q9
   : CONVERT Q9+1-INT(Q9/99)*100TO STR(K9$,3,2),(##)
   : I9=0
   : RETURN
9050 DEFFN'31
   : COM CLEAR I
   : LOAD TM$
9999 DEFFN'29"Q$=";HEX(22);"FCSG120A";HEX(22);":SCRATCHTQ$:SAVET$()Q$";HEX(0D)