image of READY prompt

Wang2200.org

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

# Sector 49, program filename = 'FCSG010A'
0010 REM FCSG010A, RELEASE 1-0, (01/02/79), THIS PROGRAM IS A COPYRIGHT PRODUC
     T OF WANG LABORATORIES., UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED,
     DESEASONALIZED DEMAND ADJUSTMENT
0170 DIM B6$8,B7$8,B8$20,I6$1,B1(2,5),B1$1,C6$1,F7$Q7,F6$Q2,D6$8,D7$8,A$1,A4$1
     ,G7$37
4000 %############ -## #.##  ####### ####### #######.# #######.# -#######.# -#
     ######.# -#######.# -###.# ######## ######## ########  #  #
4010 GOTO 5920
4050 DEFFN'192
   : B$="S"
   : IF C0=CTHEN 5120
   : B$="Z"
   : IF B(C)=0THEN 5110
   : 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 5160
   : A6=C-C0
   : IF A6>0THEN 4340
   : A6=A6+P
4340 IF A6=1THEN 4370
   : B$="M"
4370 % LOGIC TO CHECK FOR SEASONAL ITEM IN LAST MONTH WOULD GO HERE
4400 A6=D*A3
   : IF G2<A6THEN 4440
   : A6=G2
4440 IF A9<B*A6THEN 4550
   : A6=0
   : XOR (A1$,01)
   : A6$=HEX(02)
   : AND (A6$,A1$)
   : IF A6$=HEX(02)THEN 4550
   : B$="D"
   : RETURN
4550 G1=.9*G1+.1*A8
   : G2=.9*G2+.1*A9
   : A6=A
   : IF G2=0THEN 4700
   : A6=ABS(G1)/G2
   : IF A6<B3THEN 4650
   : XOR (A2$,01)
4650 IF A0=0THEN 4670
   : A6=A6*A0
4670 IF A6>ATHEN 4700
   : A6=A
4700 A8=D
   : D=(1-A6)*D+A6*C4/B(C)
   : A8=D-A8
   : D0=(1-A2)*D0+A2*A9
   : IF D0>D*A3THEN 4810
   : D0=D*A3
   : B1$="L"
4810 IF D0<D*A4THEN 4860
   : D0=D*A4
   : B1$="H"
4860 IF A4$="N"THEN 4930
   : IF D<>0THEN 4910
   : D1=0
   : GOTO 4930
4910 D1=(1-A1)*D1+A1*A8/D
4930 G=(1-A6)*G+A6*A8
   : IF G>=0THEN 4990
   : XOR (A0$,01)
4990 A6$=HEX(0F)
   : AND (A6$,A0$)
   : IF A6$>HEX(0C)THEN 5050
   : IF A6$=HEX(07)THEN 5050
   : IF A6$<>HEX(0B)THEN 5110
5050 A$="D"
   : IF D0<D*A5THEN 5110
   : D0=D*A5
   : B1$="D"
5110 C0=C
5120 RETURN
5160 A0$,A1$,A2$=HEX(00)
   : A6,A8=0
   : IF A4$="N"THEN 5220
   : D1=0
5220 G=0
   : IF ABS(C0)+C4=0THEN 5120
   : D=(ABS(C0)*D+C4/B(C))/ABS(C0-1)
5270 A8=A8+1
   : IF D>=B1(1,A8)THEN 5270
   : D0=D*B1(2,A8)
   : G2=D0
   : G1=0
   : C0=C0-1
   : IF C0=-3THEN 5110
   : RETURN
5400 DEFFN'35(B7$)
   : B6$=HEX(8040201008040201)
   : INIT(B7$)B7$
   : B8$=HEX(3180314031203110310831043102310130002020)
   : AND (B6$,B7$)
   : $TRAN(B6$,B8$)R
   : RETURN
5490 DEFFN'90
   : IF I6$="3"THEN RETURN
   : Q6$=" "
   : KEYIN Q6$,5506,5506
5506 IF Q6$="P"THEN GOSUB '254
   : IF Q6$=HEX(1F)THEN GOSUB '31
   : SELECT PRINT <I0$>(132)
   : IF L<L0THEN 5700
   : PRINT HEX(0C0A0E);TAB(3);N2$
   : P1=P1+1
   : PRINT HEX(0A);"CURRENT PERIOD # =";C;TAB(25);
   : IF I6$="1"THEN 5610
   : PRINT "(ERRORS)";
5610 PRINT TAB(46);"DESEASONALIZED DEMAND ADJUSTMENT REPORT";TAB(110);Q1$;TAB(
     122);"PAGE";P1
   : PRINT HEX(0A);G7$
   : PRINT HEX(0A)
   : L=5
   : PRINT "            LAST  CUR     CURR    CURR                         MEA
     N        MEAN                        VAR    DEMAND    TRACK  D"
5660 PRINT "PRODUCT     PER  BASE     MADE    LOST    DESEAS    SAFETY   ABSOL
     UTE     SIGNED       VAR   TREND    TREND   FILTER   SIGNAL  I  R"
5670 PRINT "NUMBER      PROC  IND    SALES   SALES    DEMAND    FACTOR      DE
     V         DEV       TREND    %       HIST    HIST     HIST   F  C"
   : PRINT HEX(0A)
   : L=9
5700 RETURN
5720 DEFFN'31
   : IF I6$<>"3"THEN 5780
   : IF E6=0THEN 5780
   : PRINT AT(9,0,);"TOTAL # OF PRODUCTS WITH MISSING PROFILES = ";E6
   : GOSUB '254
5780 SELECT PRINT 005(80)
   : PRINT AT(1,20,);"** TERMINATING PROGRAM **"
   : LOAD TM$
5820 IF I6$<>"3"THEN 5840
   : RETURN
5840 GOSUB '90
   : PRINT HEX(0A);I5;"PRODUCTS IN UPDATE"
   : L=L+2
   : RETURN
5920 SELECT @PARTS0$
5930 SELECT PRINT 005(80),CO 005(80),LIST 005(80)
   : P=12
   : E6=0
   : P1=0
   : C6$="A"
   : DATA 2,5,10,100,9E99,.6,.5,.4,.3,.2
   : RESTORE
   : MAT READ B1
   : CONVERT STR(Q1$,1,2)TO C
   : CONVERT STR(Q1$,4,2)TO Q9
   : IF Q9>15THEN 6110
   : C=C+11-12*SGN(C-1)
6110 Q9=C
   : PRINT AT(1,0,)
   : CONVERT PTO Q6$,(##)
   : GOSUB '100("1",Q6$,2,0,"ENTER PERIOD WHEN SALES OCCURRED",0)
   : IF Q6$=HEX(1F)THEN GOSUB '31
   : C=Q9
   : PRINT AT(5,10,800);"1. EACH PRODUCT IN UPDATE"
   : PRINT AT(6,10);"2. ERRORS ONLY"
   : PRINT AT(7,10);"3. NO HARDCOPY PRINTOUT"
   : Q6$="1"
6230 GOSUB '100("1","3",1,0,"ENTER NUMBER OF DESIRED REPORT TYPE",3)
   : IF Q6$=HEX(1F)THEN GOSUB '31
   : I6$=Q6$
   : IF I6$="3"THEN $CLOSE#15
   : IF I6$="3"THEN 6310
   : GOSUB '93(" ")
   : IF I0$=" "THEN 6230
6310 L=L0
   : PRINT AT(5,10,);"CURRENT PERIOD NUMBER = ";C
   : PRINT AT(6,10);"REPORT TYPE = ";
   : B8$="EACH UPDATED PRODUCT"
   : IF I6$="1"THEN 6400
   : B8$="ERRORS ONLY"
   : IF I6$="2"THEN 6400
   : B8$="NO PRINTOUT"
6400 PRINT B8$
   : Q6$=C6$
   : GOSUB '100("A,R,I,0","AaRrIi",1,1,"ENTER UPDATE TYPE (A=ALL R=RANGE I=IND
     IVIDUAL 0=END)",3)
   : IF Q6$=HEX(1F)THEN GOSUB '31
   : IF Q6$="0"THEN GOSUB '31
   : C6$=Q6$
   : G7$="ALL"
   : IF C6$="A"THEN 6710
   : G7$="INDIVIDUAL"
   : IF C6$="I"THEN 6710
6520 GOSUB '100(" ",HEX(7F),VAL(Q0$(2)),0,"ENTER STARTING PRODUCT ID (OR END)"
     ,2)
   : IF Q6$=HEX(1F)THEN GOSUB '31
   : IF Q6$="END"OR Q6$="end"THEN GOSUB '31
   : GOSUB '96(2)
   : F1$=Q6$
   : GOSUB '100(" ",HEX(7F),VAL(Q0$(2)),0,"ENTER ENDING PRODUCT ID (OR END)",2
     )
   : IF Q6$=HEX(1F)THEN GOSUB '31
   : IF Q6$="END"OR Q6$="end"THEN F6$="END"
   : IF F6$="END"THEN 6660
6610 GOSUB '96(2)
   : F6$=Q6$
   : IF F1$<=F6$THEN 6660
   : PRINT HEX(010A0A0A);"Starting ID must be lower than Ending ID"
   : GOTO 6520
6660 G7$="RANGE = ############ TO"
   : IF F1$=" "THEN STR(G7$,9,12)="  BEGINNING "
   : ELSE STR(G7$,9,12)=F1$
   : STR(G7$,26,12)=F6$
   : IF F6$="END"THEN INIT("^")F6$
6710 PRINT AT(7,10);"UPDATE TYPE - ";G7$
   : Q6$="Y"
   : GOSUB '100("Y,N","YyNn",1,1,"IS DATA OK (Y OR N)",3)
   : IF Q6$=HEX(1F)THEN GOSUB '31
   : IF Q6$="N"THEN 5930
   : I5=0
   : IF C6$="I"THEN 6830
   : PRINT AT(1,0,)
   : PRINT AT(9,25,);"PERFORMING DEMAND ADJUSTMENTS"
   : GOTO 6880
6830 PRINT AT(10,0);
   : PRINT "            LAST  CUR     CURR    CURR                      D"
   : PRINT "PRODUCT     PER  BASE     MADE    LOST    DESEAS    SAFETY  I  R"
   : PRINT "NUMBER      PROC  IND    SALES   SALES    DEMAND    FACTOR  F  C"
6880 GOSUB '90
   : IF C6$="I"THEN 6940
   : IF C6$="A"THEN 7170
   : IF C6$="R"THEN 7040
6940 GOSUB '100(" ",HEX(7F),VAL(Q0$(2)),0,"ENTER PRODUCT NUMBER (OR END)",2)
   : IF Q6$=HEX(1F)THEN GOSUB '31
   : IF Q6$<>"END"AND Q6$<>"end"THEN 7010
   : GOSUB 5820
   : SELECT PRINT 005(80)
   : P1,C6=0
   : GOTO 6310
7010 GOSUB '96(2)
   : F1$=Q6$
7040 GOSUB '232(1,0,F1$)
   : IF Q$=" "THEN 7240
   : IF C6$="I"THEN 7080
   : IF Q$="N"THEN 8270
7080 GOSUB '91
   : IF J0>0THEN PRINT AT(3,LEN(J$(J0))+1);"- Product ID ";F1$
   : IF C6$="I"THEN 6940
   : IF J0=7THEN 7130
   : IF J0<>0AND C6$="R"THEN GOSUB '31
7130 GOSUB '92
   : IF C6$="R"THEN 7040
   : GOTO 6940
7170 GOSUB '235(1,0)
   : IF Q$=" "THEN 7240
   : GOSUB '91
   : IF J0<>7THEN GOSUB '31
   : GOSUB '92
   : GOTO 7170
7240 GOSUB '78(2)
   : I5=I5+1
   : B$,A$=" "
   : GOSUB '90
   : IF F7$=G1$THEN 7570
7310 GOSUB '232(2,0,G1$)
   : F7$=" "
   : IF Q$=" "THEN 7540
   : IF I6$="3"THEN 7400
   : IF Q$<>"N"THEN 7400
   : PRINT "PRODUCT ID ";F1$;TAB(12+VAL(Q0$(2)));"  *** PROFILE ID ";G1$;" NOT
      FOUND ***"
   : L=L+1
   : IF C6$="I"THEN 7400
   : GOTO 7490
7400 SELECT PRINT 005(80)
   : GOSUB '91
   : IF J0>0THEN PRINT AT(3,LEN(J$(J0))+1);"- Profile ID ";G1$
   : IF C6$="I"THEN 6940
   : IF J0=3THEN 7490
   : IF J0<>7THEN GOSUB '31
   : GOSUB '92
   : GOTO 7310
7490 E6=E6+1
   : GOTO 8270
7510 B(C)=10
   : GOTO 7970
7540 F7$=G1$
   : GOSUB '79(4)
7570 IF C0=CTHEN 7820
   : A9=1
   : IF C0<>0THEN 7700
   : A9=1+G4-SGN(G4)
   : IF H>0THEN 7700
   : IF I6$="3"THEN 8210
   : GOSUB '90
   : PRINT F1$;TAB(1+VAL(Q0$(2)));"   ***** CANNOT BE PROCESSED - NEW PRODUCT
     WITH ZERO SALES *****"
   : L=L+1
   : GOTO 7970
7700 C4=(H+D3(1))/A9
   : Q9=1
   : IF I1$="L"THEN 7770
   : Q9=2
   : IF I1$="M"THEN 7770
   : Q9=3
7770 UNPACK(##.##)STR(D4$(1),4+(Q9-1)*20)TO A,A0,A1,A2,A3,A4,A5,B3,B,B2
   : A4$=STR(D4$(1),Q9)
   : C6=C0
7820 GOSUB '192
   : IF B$="S"THEN 7970
   : IF B$="Z"THEN 7970
7870 DEFFNR(Z)=SGN(Z)*INT(10*ABS(Z)+.5)*.1
   : D=FNR(D)
   : D0=FNR(D0)
   : G2=FNR(G2)
   : G=FNR(G)
   : G1=FNR(G1)
   : D1=SGN(D1)*INT(1000*ABS(D1)+.5)*.001
   : DBACKSPACE #2,1S
   : GOSUB '68(2)
7970 IF I6$="1"THEN 8020
   : IF I6$="3"THEN 8210
   : IF B$="D"THEN 8020
   : IF A$=" "THEN 8210
8020 GOSUB '90
   : IF C0<1THEN 8140
   : GOSUB '35(A0$)
   : D6$=B6$
   : GOSUB '35(A1$)
   : D7$=B6$
   : GOSUB '35(A2$)
   : PRINTUSING 4000,F1$,C0,B(C),H,D3(1),D,D0,G2,G1,G,D1*100,D6$,D7$,B6$,A$,B$
   : L=L+1
   : GOTO 8210
8140 PRINTUSING 4000,F1$,C0,B(C),H,D3(1),D,D0,G2;
   : IF C0+C6<>-1THEN 8180
   : IF G4=0THEN 8180
   : PRINT " (MADE + LOST SALES) REPRESENT";G4*100;"% OF MONTH";
8180 PRINT
   : L=L+1
8210 IF C6$<>"I"THEN 8270
   : SELECT PRINT 005(80)
   : PRINT AT(13,0);
   : PRINTUSING 4000,F1$,C0,B(C),H,D3(1),D,D0;
   : PRINT "  ";A$;" ";B$
8270 IF C6$="I"THEN 6940
8280 GOSUB '237(1,0)
   : IF Q$="E"THEN 8380
   : IF Q$=" "THEN 8360
   : GOSUB '91
   : IF J0>0THEN PRINT AT(3,LEN(J$(J0))+1);"- Product ID ";T7$
   : GOSUB '92
   : IF J0<>7THEN GOSUB '31
   : GOTO 8280
8360 IF C6$<>"R"THEN 7240
   : IF T7$<=F6$THEN 7240
8380 GOSUB 5820
   : IF C6$="A"THEN GOSUB '31
   : SELECT PRINT 005(80)
   : P1,C6=0
   : GOTO 6310
9998 DEFFN'29"Q$=";HEX(22);"FCSG010A";HEX(22);":SCRATCH TQ$:SAVET$()Q$";HEX(0D
     )