Listing of file='FCST127A' on disk='vmedia/701-2663.wvd.zip'
# Sector 216, program filename = 'FCST127A' 0010 REM FCST127A, RELEASE 1-0, (07/24/79), THIS PROGRAM IS A COPYRIGHT PRODUC T OF WANG LABORATORIES., UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED, REORDER SIMULATOR EXECUTION 4000 DIM A$1,A0$1,A1$1,A2$1,A6$1,B$1,B0$1,C2$4,C3$4,C4$4,C2$4,P7$4,P8$4,P9$4 : DIM P7$(1)2 : DIM C6$8,H6$4,H7$4,K6$4,K7$4,K8$2,O6$6,O7$20,O8$8,O9$8 : DIM O6$(20)6,O7$(20)4,O9$(1)2,Q9 4020 DEFFNR(X)=ROUND((X,0) : GOTO 6660 4050 DEFFN'181(P9$) : CONVERT STR(P9$,1,2)TO P9 : UNPACK(####)STR(P6$(P9),1,2)TO P9 : IF P$="D"THEN 4080 : P9=P9+(VAL(STR(P9$,3,1))-49)*7+VAL(STR(P9$,4,1))-48 : RETURN 4080 CONVERT STR(P9$,3,2)TO P6 : P9=P9+P6 : RETURN 4100 DEFFN'182(P9) : P9=P9-INT((P9-1)/P1)*P1 : PACK(####)P9$FROMP9 : MAT SEARCHP6$()<1,P*2+2>,>=STR(P9$,1,2)TO P7$()STEP 2 : P6=(VAL(STR(P7$(1),2))-1)/2 : UNPACK(####)STR(P6$(P6),1,2)TO P7 : CONVERT P6TO P9$,(##) : P7=P9-P7 : IF P$="D"THEN 4185 : P6=INT((P7+6)/7) : CONVERT P6TO STR(P9$,3,1),(#) : CONVERT P7-(P6-1)*7TO STR(P9$,4,1),(#) : RETURN 4185 CONVERT P7TO STR(P9$,3,2),(##) : RETURN 4200 DEFFN'183(P7$,P8) : GOSUB '181(P7$) : GOSUB '182(P9+P8) : P8$=P9$ : RETURN 4230 DEFFN'184(P7$,P8$) : GOSUB '181(P7$) : P8=P9 : GOSUB '181(P8$) : P8=P9-P8 : P8=P8+P1*(1-SGN(P8+.5))*.5 : RETURN 4295 DEFFN'170(F9,C3$,C4$) : GOSUB '184(C3$,C4$) : F6=P8+1 4320 DEFFN'171(F9,C3$,F6) : F8,E8,G6=0 : GOSUB '181(C3$) : CONVERT STR(C3$,1,2)TO F7 : UNPACK(####)P6$(F7+1)TO E6 : IF F9<0THEN 4405 : IF A4$<>"F"THEN 4405 : G6=D1 : IF ABS(D1)<B2THEN 4405 : G6=B2*SGN(D1) : GOTO 4405 4395 E6=E6+P(F7) 4405 E7=E6-P9+1 : F6=F6-E7 : IF F6>0THEN 4430 : E6=E6+F6 : E7=E7+F6 4430 P9=P9+E7 : E7=E7/P(F7) : E8=E8+E7 : IF G6>=0THEN 4510 : IF G6*(F9+E8)>=-1THEN 4510 : P9=E8 : E8=-1/G6-F9 : E7=E7-(P9-E8) : IF F6<=0THEN 4510 : E6=E6+F6 : F6=0 4490 IF E6<=P1THEN 4510 : E6=E6-P1 : GOTO 4490 4510 F8=F8+B(F7)*E7 : IF F6<=0THEN 4555 : F7=F7+1 : IF F7<=PTHEN 4395 : P9,F7=1 : E6=0 : GOTO 4395 4555 GOSUB '182(E6+1) : C3$=P9$ : F6=D*F8*(1+G6*F9+.5*G6*E8) : IF F6>0THEN 4590 : F6=0 4590 F7=D0*F8^D5 : RETURN 4615 DEFFN'175 : B$=" " : B9=0 : IF B0$="N"THEN 4650 : IF B0>0THEN 4680 4650 IF C1<=0THEN 4680 : GOSUB '183(C2$,-C1*7) : GOSUB '171(0,P8$,C1*7) : B9=.5*F8*D 4680 B0$="Y" : IF B0>0THEN 4705 : B0$="N" 4705 IF A3$="S"THEN 4770 : IF A3$="F"THEN 4770 : IF A3$="W"THEN 4990 : IF A3$="M"THEN 5090 : B$="I" : RETURN 4770 GOSUB '171(0,C2$,C1*3.5+C3) : B6=F6 : C6=F7 : GOSUB '171(0,C2$,C3) : B7=F6 : GOSUB '171(E8,C3$,C2*7) : B7=B7+F6 : IF A3$="S"THEN 4875 : IF B4>0THEN 4850 : B4=1 4850 C7=F6+.5*B4 : IF C7>B4THEN 4900 : C7=B4 : GOTO 4900 4875 C7=F6 : IF C7=0THEN 4900 : IF C7>B5THEN 4900 : C7=B5 4900 GOSUB '177 : C6=C6*C8 : IF C6>D2THEN 4935 : C6=D2 4935 B6=B6+C6 : B7=B7+C6 4955 IF B7>B6THEN 4965 : B7=B6+1 4965 GOSUB '176 : RETURN 4990 GOSUB '171(0,C2$,(C1+D3)*7) : B6=F6 : C6=D3+C1-.143*C3 : IF C6>=0THEN 5025 : B$="L" 5025 C6=(C6/(C1+D3))*B6 : IF D2<C6THEN 5045 : B6=B6+D2-C6 5045 GOSUB '183(C2$,C3) : GOSUB '171(C3/30,P8$,C2*7) : B7=B6+F6 : GOTO 4955 5090 B6=D3 : B7=D4 : GOTO 4955 5125 DEFFN'177 : IF C7*C6=0THEN 5185 : C7=C7/C6*(1-C5) : IF C7>=.5THEN 5185 : PACK(.####)C6$FROMC7 : MAT SEARCHC6$(),>STR(C6$,1,2)TO P7$()STEP 2 : C9=(VAL(STR(P7$(1),2))+1)/2 : IF C9>1THEN 5200 5185 C8=0 : RETURN 5200 UNPACK(.####)C6$(C9-1)TO D6 : UNPACK(.####)C6$(C9)TO D8 : UNPACK(#.#)C7$(C9-1)TO D7 : UNPACK(#.#)C7$(C9)TO D9 : C8=(D9-D7)/(D8-D6)*(C7-D6)+D7 : RETURN 5245 DEFFN'176 : B8=0 : IF B0+B1>B6THEN 5325 : B8=B7-B0-B1 : IF A3$="F"THEN 5305 : IF B8>B5THEN 5320 : B8=B5 : GOTO 5320 5305 IF B4>=B8THEN 5320 : B$="M" 5320 B8=-INT(-B8/B4)*B4 5325 RETURN 5345 DEFFN'192 : B$="S" : IF C0=CTHEN 5880 : B$="Z" : IF B(C)=0THEN 5875 : A$,B$,B1$=" " : ROTATE(A0$,1) : AND (A0$,FE) : ROTATE(A1$,1) : AND (A1$,FE) : ROTATE(A2$,1) : AND (A2$,FE) : A8=(C4-D*B(C))*(1+.3*B(C))/(B(C)+.3) : A9=ABS(A8) : IF C0<1THEN 5900 : A6=C-C0 : IF A6>0THEN 5490 : A6=A6+P 5490 IF A6=1THEN 5505 : B$="M" 5505 % LOGIC TO CHECK FOR SEASONAL ITEM IN LAST MONTH WOULD GO HERE 5520 A6=D*A3 : IF G2<A6THEN 5540 : A6=G2 5540 IF A9<B*A6THEN 5595 : A6=0 : XOR (A1$,01) : A6$=HEX(02) : AND (A6$,A1$) : IF A6$=HEX(02)THEN 5595 : B$="D" : RETURN 5595 G1=.9*G1+.1*A8 : G2=.9*G2+.1*A9 : A6=A : IF G2=0THEN 5670 : A6=ABS(G1)/G2 : IF A6<B3THEN 5645 : XOR (A2$,01) 5645 IF A0=0THEN 5655 : A6=A6*A0 5655 IF A6>ATHEN 5670 : A6=A 5670 A8=D : D=(1-A6)*D+A6*C4/B(C) : A8=D-A8 : D0=(1-A2)*D0+A2*A9 : IF D0>D*A3THEN 5725 : D0=D*A3 : B1$="L" 5725 IF D0<D*A4THEN 5750 : D0=D*A4 : B1$="H" 5750 IF A4$="N"THEN 5785 : IF D<>0THEN 5775 : D1=0 : GOTO 5785 5775 D1=(1-A1)*D1+A1*A8/D 5785 G=(1-A6)*G+A6*A8 : IF G>0THEN 5815 : XOR (A0$,01) 5815 A6$=HEX(0F) : AND (A6$,A0$) : IF A6$>HEX(0C)THEN 5845 : IF A6$=HEX(07)THEN 5845 : IF A6$<>HEX(0B)THEN 5875 5845 A$="D" : IF D0<D*A5THEN 5875 : D0=D*A5 : B1$="D" 5875 C0=C 5880 RETURN 5900 A0$,A1$,A2$=HEX(00) : A6,A8=0 : IF A4$="N"THEN 5930 : D1=0 5930 G=0 : IF ABS(C0)+C4=0THEN 5880 : D=(ABS(C0)*D+C4/B(C))/ABS(C0-1) 5955 A8=A8+1 : IF D>=B1(1,A8)THEN 5955 : D0=D*B1(2,A8) : G2=D0 : G1=0 : C0=C0-1 : IF C0=-3THEN 5875 : RETURN 6030 DEFFN'35(O8$) : O9$=HEX(8040201008040201) : INIT(O8$)O8$ : O7$=HEX(3180314031203110310831043102310130002020) : AND (O9$,O8$) : $TRAN(O9$,O7$)R : RETURN 6075 DEFFN'33(STR(O6$,3),O7) : B1=B1+O7 : STR(O6$,1,2)=K8$ : IF C2$<STR(O6$,3,4)THEN 6115 : CONVERT STR(O6$,1,2)TO O8 : CONVERT O8+1TO STR(O6$,1,2),(##) 6115 MAT SEARCHO6$(),>O6$TO O9$()STEP 6 : IF O9$(1)=HEX(0000)THEN 6185 : IF O6$(20)<HEX(FF)THEN 6185 : O8=(VAL(STR(O9$(1),2))+5)/6 : IF O8=20THEN 6165 : O6=O8*6-5 : MAT COPY -O6$()<O6,115-O6>TO -O6$()<O6+6,115-O6> : O6=O8*4-3 : MAT COPY -O7$()<O6,77-O6>TO -O7$()<O6+4,77-O6> 6165 O6$(O8)=O6$ : PACK(########)O7$(O8)FROMO7 : RETURN 6185 GOSUB 6620 : PRINT AT(1,0,);"THE ON ORDER QUEUE HAS OVERFLOWED" : GOSUB '254 : IF Q6$=HEX(1F)THEN GOSUB '31 : GOTO 7360 6220 DEFFN'34(STR(O9$,3)) : O6$=" " : O9=0 : STR(O9$,1,2)=K8$ 6245 IF O6$(1)>O9$THEN RETURN : UNPACK(########)O7$(1)TO O7 : O9=O9+O7 : B1=B1-O7 : MAT COPY O7$()<5,76>TO O7$()<1,76> : IF O6$<>" "THEN 6290 : O6$=O6$(1) 6290 MAT COPY O6$()<7,114>TO O6$()<1,114> : INIT(FF)O6$(20) : GOTO 6245 6315 DEFFN'37(H6$,H7$) : GOSUB '184(H6$,H7$) : H8=P8+1 : H9=FNR(K(K5)/P(C)*H8) : H6=1 : GOSUB '34(H7$) : IF O6$=" "THEN 6390 : GOSUB '184(H6$,STR(O6$,3,4)) : H6=P8/H8 6390 H8=FNR(H9*H6) : H7=H9-H8 : H6=0 : B0=B0-H8 : IF B0>0THEN 6430 : H6=ABS(B0) : B0=0 6430 B0=B0+O9-H7 : IF B0>0THEN 6455 : H6=H6-B0 : B0=0 6455 H9=H9-H6 : C4=C4+H9 : N6=N6+H9 : N7=N7+H6 : N8=N8+O9 : I5=I5+H6 : RETURN 6500 G8=3 : G9=G9+1 : PRINT HEX(0C);"REORDER SIMULATOR";TAB(37-LEN(K5$)/2);K5$ : PRINT TAB(70);"PAGE";G9 : RETURN 6535 PRINT " " : PRINT TAB(A7);" RD OH RCV OO OP OUTL RO MADE LO ST RC" : G8=G8+2 : RETURN 6565 DEFFN'36(G6) : IF G8<55THEN RETURN : GOSUB 6500 : IF G6=1THEN 6535 : RETURN 6600 SELECT PRINT <I0$>(96) : RETURN 6620 SELECT PRINT 005(80) : RETURN 6660 C2$=K1$ : STR(C2$,3)=STR(K1$,4) : IF P$="D"THEN 6680 : STR(C2$,4)=STR(K1$,6) 6680 K8$=STR(K1$,LEN(K1$)-1) : CONVERT STR(C2$,1,2)TO C : K5=1 : I5,C4,I6,I7,I8,K4,N6,N7,N7=0 : UNPACK(####)P6$(C)TO P9 : GOSUB '182(P9+1) : K6$=P9$ : INIT(FF)O6$() : IF B1=0THEN 7145 : G6=INT(C3/55)+1 : C7=FNR(B1/G6) : B1=0 : FOR K=1TO G6 : GOSUB '183(C2$,K/(G6+1)*K1) : GOSUB '33(P8$,C7) : NEXT K : GOTO 7145 6800 GOSUB '32 : IF STR(C2$,1,2)=STR(K7$,1,2)THEN 7145 : UNPACK(####)P6$(C+1)TO P9 : GOSUB '182(P9) : K7$=P9$ : IF STR(K7$,1,2)<>STR(K6$,1,2)THEN 6850 : GOSUB '37(K6$,K7$) 6850 G7=D*B(C) : C4=C4+I5*(1-M6) : GOSUB '192 : C4=C4-I5*(1-M6) : GOSUB '35(A0$) : G6$=O9$ : GOSUB '35(A1$) : GOSUB '36(0) : PRINT " " : PRINT " " : PRINT "CPN CPF DD TRND% VTRND VTH DFH MSD" 6930 PRINTUSING "### #######.# #######.# -###.# -######.# ######## ###### ## -######.#",P$(C),G7,D,ROUND((D1*100,1),ROUND((G,0),G6$,O9$,ROUND((G1, 0) : G8=G8+4 : GOSUB '36(0) : IF K2$(1)="Y"THEN PRINT " " : GOSUB '35(A2$) : PRINT " RC MADE LOST SF SFF DIF VSR TSH MAD" 6970 PRINTUSING " # -####### -####### ######.# # # #.### ###### ## -######.#",B$,C4,I5,D0,B1$,A$,A6,O9$,G2 : I5=0 : PRINT " " : G8=G8+3 : IF K2$(1)="N"THEN 7035 : GOSUB '254 : IF Q6$=HEX(1F)THEN GOSUB '31 : PRINT AT(1,0,);HEX(0A0A0A) : G8=3 7035 K5=K5+1 : IF K5>K3THEN 7355 : C=C+1 : IF C<=PTHEN 7085 : C=1 : CONVERT K8$TO O8 : CONVERT O8+1TO K8$,(##) 7085 C4=0 : GOSUB '183(K7$,1) : K6$,K7$=P8$ : IF G8<53THEN 7125 : GOSUB 6500 7125 GOSUB 6535 : GOTO 6800 7145 GOSUB '37(K6$,C2$) : IF K2$(1)="Y"THEN 7175 : GOSUB 6620 : PRINT AT(3,0);"REVIEW PERIOD NO.";K4+1;"SIMULATION PERIOD NO.";K5;TAB(64) : GOSUB 6600 7175 GOSUB '175 : GOSUB '176 : B6=FNR(B6) : B7=FNR(B7) : B8=FNR(B8) : IF B8=0THEN 7235 : K6=.5-RND(B8) : K6=FNR(K1+K2*1.25*K6*(.14822401/(.29670819-K6*K6)+.0014532591/(.2505217-K 6*K6)+2.0489)) : IF K6<1THEN K6=1 : GOSUB '183(C2$,K6) : GOSUB '33(P8$,B8) 7235 GOSUB '36(1) : PRINT TAB(A7); : PRINTUSING "#### ###### ###### ###### ###### ####### ###### ###### ##### #",C2$,B0,N8,B1,B6,B7,B8,N6,N7,B$ : G8=G8+1 : K4=K4+1 : I6=I6+B0 : I7=I7+N6 : I8=I8+N7 : N6,N7,N8=0 : K7$=C2$ : GOSUB '183(C2$,1) : K6$=P8$ : GOSUB '183(C2$,C1*7) : C2$=P8$ : GOTO 6800 7355 GOSUB '36(0) 7360 PRINT HEX(0A0A0A) : IF I7+I8>0THEN Q9=ROUND((100*I7/(I7+I8),1) : ELSE Q9=0 : PRINT "AVERAGE INVENTORY =";FNR(I6/K4);TAB(32);"LEVEL OF SERVICE =";Q9;" %" : PRINT "SALES MADE =";I7;TAB(32);"SALES LOST =";I8 : GOSUB 6620 : IF K2$(1)="N"THEN 7400 : GOSUB '254 : IF Q6$=HEX(1F)THEN GOSUB '31 7400 COM CLEAR C6$() : LOAD TM5$4000,9999 7415 DEFFN'32 : Q6$=" " : KEYIN Q6$,7430,7435 7430 RETURN 7435 IF Q6$=HEX(1F)OR Q6$=HEX(7E)THEN GOSUB '31 : RETURN 7455 DEFFN'254 : KEYIN Q6$,7455,7455 : SELECT PRINT 005 : PRINT AT(2,0);TAB(80);AT(2,0); : Q6$=" " : INPUT "KEY RETURN(EXEC) TO RESUME",Q6$ : PRINT AT(1,0);TAB(80),TAB(80),TAB(80) : RETURN 7460 DEFFN'29"Q$=";HEX(22);"FCST127A";HEX(22);":SCRATCH TQ$:SAVET$()Q$";HEX(0D )