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 )