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
)