image of READY prompt

Wang2200.org

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
     )