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
)