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)