Listing of file='FCSG110A' on disk='vmedia/701-2661A.wvd.zip'
# Sector 156, program filename = 'FCSG110A'
0010 REM FCSG110A, RELEASE 1-0, (12/20/78), THIS PROGRAM IS A COPYRIGHT PRODUC
T OF WANG LABORATORIES., UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED,
PROFILE MAINTENANCE
0170 COM M1$1,L5$9,P,P$1,M$8,P$(13)3
: DIM F7$3,F8$3,B6$4,B6$(1)2,F9$7,E6$1,E7$4,E8$16,D6$8,D6$(10)3,A0$10,E9$64
,D8$1,B7$21,K1$(52)5
: GOTO 4000
4000 %### - #.##
4005 %##### ####
4010 GOTO 5935
4035 PRINT AT(3,0,80);"Re-enter";HEX(07)
: RETURN
4055 PRINT AT(3,0);"Data may not be all zero";HEX(07)
: RETURN
4075 A6$=" "
: IF STR(L4$(1),3,2)<=STR(L4$(2),3,2)THEN 4100
4085 PRINT AT(3,0);"Indices Date must be >= ";L4$(1);HEX(07)
: A6$="E"
: RETURN
4100 IF STR(L4$(1),3,2)=STR(L4$(2),3,2)AND STR(L4$(1),1,2)>STR(L4$(2),1,2)THEN
4085
: CONVERT STR(L4$(1),1,2)TO B6
: IF L2<=(P*4)-(B6-1)THEN RETURN
: A6$="E"
: PRINT AT(3,0);"Number of Periods of Sales Data must be <= ";P*4-(B6-1);HE
X(07)
: RETURN
4145 B$=" "
: B8=1
: B6=0
: CONVERT STR(L4$(1),1,2)TO B9
: FOR I=1TO L2
: IF L(B8,B9)>B6THEN B6=L(B8,B9)
: B9=B9+1
: IF B9<=PTHEN 4195
: B9=1
: B8=B8+1
4195 NEXT I
: IF B6=0THEN 4220
: IF INT(LGT(B6/C9)+1)<=4THEN 4220
: PRINT AT(3,0);"Scale must be >= ";L1/(10^(4-(INT(LGT(B6))+1)));" to save
Sales Data";HEX(07)
: B$="E"
4220 RETURN
4235 D8$="Y"
: GOSUB '100("Y,N","YyNn",1,1,"DO YOU WISH TO RE-SCALE DATA (Y/N)",2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="Y"THEN 4265
: B$=" "
: RETURN
4265 C9=C9/L1
: GOSUB 4145
: IF B$="E"THEN RETURN
: FOR C6=1TO 4
: FOR C7=1TO P
: L(C6,C7)=ROUND((L(C6,C7)/C9,0)
: NEXT C7
: NEXT C6
: C9=L1*C9
: RETURN
4340 CONVERT STR(L4$(1),1,2)TO B6
: FOR B7=1TO 4
: FOR C7=1TO P
: IF (B7-1)*P+C7<B6OR (B7-1)*P+C7>(L2+B6)-1THEN L(B7,C7)=0
: NEXT C7
: NEXT B7
: RETURN
4385 Q6$="ENTER PROFILE ID FOR"
: STR(Q6$,LEN(Q6$)+2)=D6$
: STR(Q6$,LEN(Q6$)+2)="(0=CANCEL"
: STR(Q6$,LEN(Q6$)+2)=D6$
: STR(Q6$,LEN(Q6$)+1)=")"
: GOSUB '100("0",HEX(7F),VAL(Q0$(7)),0,Q6$,2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$<>"0"THEN 4440
: E6$=" "
: RETURN CLEAR
4435 GOTO 5995
4440 GOSUB '96(7)
: G1$=Q6$
: GOSUB '232(1,1,G1$)
: IF E6$<>"C"THEN 4490
: IF Q$=" "THEN 4480
: IF Q$="N"THEN RETURN
: IF Q$<>"B"THEN 4490
4480 PRINT AT(3,0,80);"Profile ID ";G1$;" already exists";HEX(07)
: GOTO 4385
4490 GOSUB '91
: IF J0=0THEN RETURN
: PRINT AT(3,LEN(J$(J0))+1);"- Profile ID ";G1$
: GOTO 4385
4520 PRINT AT(4,17,);"* * PROFILE INFORMATION * *"
: GOSUB 4545
: RETURN
4545 PRINT HEX(010A0A0A0A0A0A0A);"1. - PROFILE ID - ";G1$;TAB(80)
: RETURN
4565 D7=2
: IF E6$="C"OR L2$=" "THEN 4585
4575 D7=3
: Q6$=L2$
4585 GOSUB '100(" ",HEX(7F),20,0,"ENTER DESCRIPTION",D7)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$<>L2$THEN D8$="Y"
: L2$=Q6$
4605 PRINT AT(8,0,80);"2. - DESCRIPTION - ";L2$
: RETURN
4625 IF A5$="B"THEN 4640
: A5$="B"
: GOTO 4650
4640 A5$="S"
4650 F9$="INDICES"
: IF A5$="B"THEN 4665
: F9$="SALES"
4665 PRINT AT(9,0,80);"3. - TYPE OF ENTRY - ";F9$
: IF A5$="S"THEN 4725
: PRINT TAB(80)
: PRINT TAB(80)
: PRINT TAB(80)
: PRINT TAB(80)
: IF E6$="U"THEN RETURN
: L1,L2=0
: L4$(1)=" "
: RETURN
4725 IF E6$="C"THEN 4770
: IF L2=0THEN 4770
: GOSUB 4890
: GOSUB 5160
: GOSUB 5330
: GOSUB 5255
: RETURN
4770 C5$="S"
: D8$="Y"
: GOSUB 4815
: GOSUB 5095
: GOSUB 5280
: GOSUB 5200
: RETURN
4815 D7=1
: IF E6$="C"OR L4$(1)=" "THEN 4840
4825 D7=-1
: CONVERT L4$(1)TO Q9
: Q6$=L4$(1)
4840 GOSUB '100("0100","1399",4,0,"ENTER STARTING PERIOD/YEAR OF DATA (PPYY)",
D7)
: IF Q6$=HEX(1F)THEN GOSUB '31
: CONVERT Q9TO Q6$,(####)
: IF Q6$<>L4$(1)THEN D8$="Y"
: IF Q6$<>L4$(1)THEN L5=0
: CONVERT Q9TO L4$(1),(####)
: C5$="S"
4890 CONVERT STR(L4$(1),1,2)TO F7
: IF INT((F7-1)/P)=0THEN 4910
: PRINT AT(3,0,80);"Improper Date Format";HEX(07)
: GOTO 4840
4910 PRINT AT(10,0);"4. - STARTING PERIOD/YEAR OF DATA - ";L4$(1)
: IF E6$="C"THEN RETURN
: IF L2=0THEN RETURN
: IF E7$=" "THEN RETURN
: CONVERT STR(L4$(1),3,2)TO B6
: CONVERT STR(E7$,3,2)TO B7
: IF B6<=B7THEN RETURN
: Q6$="DO YOU WISH TO DELETE SALES DATA UP TO YEAR "
: CONVERT B6-1TO B6$,(##)
: STR(Q6$,45)=B6$
: STR(Q6$,LEN(Q6$)+1)=" (Y/N)"
4980 GOSUB '100("Y,N","YyNn",1,1,Q6$,2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="N"THEN RETURN
: B6=B6-B7
: IF B6<4THEN 5030
: MAT L=ZER
: RETURN
5030 FOR D6=1TO 4-B6
: FOR D7=1TO P
: L(D6,D7)=L(D6+B6,D7)
: NEXT D7
: NEXT D6
: FOR D6=5-B6TO 4
: FOR D7=1TO P
: L(D6,D7)=0
: NEXT D7
: RETURN
5095 IF E6$="U"AND L4$(2)<>" "THEN 5115
: CONVERT L4$(1)TO Q9
: Q6$=L4$(1)
: GOTO 5125
5115 CONVERT L4$(2)TO Q9
: Q6$=L4$(2)
5125 GOSUB '100("0100","1399",4,0,"ENTER STARTING PERIOD/YEAR OF DATA USED FOR
INDICES (PPYY)",-1)
: IF Q6$=HEX(1F)THEN GOSUB '31
: CONVERT Q9TO Q6$,(####)
: IF Q6$<>L4$(2)THEN D8$="Y"
: IF Q6$<>L4$(2)THEN L5=0
: CONVERT Q9TO L4$(2),(####)
5160 CONVERT STR(L4$(2),1,2)TO Q9
: IF INT((Q9-1)/P)=0THEN 5180
: PRINT AT(3,0);"Improper Date Format";HEX(07)
: GOTO 5125
5180 PRINT AT(11,0);"5. - STARTING PERIOD/YEAR OF DATA USED FOR INDICES - ";L4
$(2)
: RETURN
5200 IF E6$="C"OR L1=0THEN Q9=1
: ELSE Q9=L1
: GOSUB '100("1","1000000000",10,0,"ENTER SCALE (1,10,100,1000,...)",0)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF LGT(Q9)=INT(LGT(Q9))THEN 5230
: PRINT AT(3,0);"Re-enter";HEX(07)
: GOTO 5200
5230 C9=Q9
: IF E6$="C"OR L1=0THEN 5250
: IF C9<>L1OR B$="E"THEN GOSUB 4235
: IF B$="E"THEN 5260
5250 L1=C9
5255 PRINT AT(13,0,80);"7. - SCALE -";L1
5260 RETURN
5280 CONVERT (P*4-(F7-1))TO B6$,(##)
: D7=1
: IF E6$="C"OR L2=0THEN 5305
: D7=0
: Q9=L2
5305 GOSUB '100("1",B6$,2,0,"ENTER NUMBER OF PERIODS OF SALES DATA",D7)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q9<>L2THEN D8$="Y"
: L2=Q9
: C5$="S"
5330 PRINT AT(12,0);"6. - NUMBER OF PERIODS OF DATA - ";L2
: RETURN
5350 PRINT HEX(010A);"ENTER INDEX FOR ";P$(B6)
: B7$=" "
: D7=0
: Q9=B(B6)
5375 GOSUB '100("0","9.99",1,2,B7$,D7)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q9=B(B6)THEN 5405
: L5=0
: D8$="Y"
: C5$="B"
5405 B(B6)=Q9
5415 B7=INT((B6-1)/4)
: PRINT AT(6+B6-4*B7,16*B7,0);
: PRINTUSING 4000,P$(B6),B(B6)
: RETURN
5450 Q9=L(B8,B9)
: D7=0
: PRINT HEX(010A);"ENTER ";K1$(I);" SALES"
: B7$=" "
5475 GOSUB '100("0","9999",4,0,B7$,D7)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q9<>L(B8,B9)THEN L5=0
: IF Q9<>L(B8,B9)THEN D8$="Y"
: L(B8,B9)=Q9
5505 D7=INT((I-1)/P)
: PRINT AT(6+I-P*D7,D8*D7,0);
: PRINTUSING 4005,K1$(I),L(B8,B9);
: PRINT HEX(0D);
: RETURN
5540 DEFFN'31
: PRINT AT(1,25,);"** TERMINATING PROGRAM **"
: LOAD TM$
5570 DEFFN'195
: GOSUB '197
: MAT B=ZER
: L5=0
: FOR B6=1TO P
: FOR C7=D7TO C8
: IF (C7-1)*P+B6<C6OR (C7-1)*P+B6>C6+INT((L2-(C6-Q9))/P)*P-1THEN 5625
: B(B6)=B(B6)+L(C7,B6)
: L5=L5+1
5625 NEXT C7
: NEXT B6
: GOSUB '196
: RETURN
5655 DEFFN'196
: A6$="E"
: D7=0
: FOR B6=1TO P
: D7=D7+B(B6)
: NEXT B6
: IF D7=0THEN RETURN
: A6$=" "
: IF ABS(D7-P)<.005*PTHEN 5825
: MAT B=(P/D7)*B
: D7=0
: FOR B6=1TO P
: IF B(B6)<9.995THEN 5735
: D7=B6
5735 NEXT B6
: IF D7=0THEN 5800
: D6=.5*(B(D7)-9.99)
: B7=D7-1-P*(SGN(D7-1)-1)
: B6=D7+1+P*(SGN(P-D7)-1)
: B(B6)=B(B6)+D6
: B(B7)=B(B7)+D6
: B(D7)=9.99
5800 MAT B=(100)*B
: FOR B6=1TO P
: B(B6)=INT(B(B6)+.5)
: NEXT B6
: MAT B=(.01)*B
5825 C5$="E"
: RETURN
5845 DEFFN'197
: CONVERT STR(L4$(2),1,2)TO Q9
: IF STR(L4$(1),3,2)=STR(L4$(2),3,2)THEN 5890
: CONVERT STR(L4$(1),3,2)TO B6
: CONVERT STR(L4$(2),3,2)TO C7
: D7=C7-B6+1
: GOTO 5895
5890 D7=1
5895 C6=Q9+(D7-1)*P
: CONVERT STR(L4$(1),1,2)TO Q9
: RETURN
5935 SELECT PRINT 005(80),CO 005,P
: SELECT @PARTS0$
: PRINT AT(1,0,)
: F6=1
: P=12
: P$="D"
: MAT REDIM P$(1)36
: P$(1)="JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"
: MAT REDIM P$(12)3
5995 PRINT AT(1,0,)
: PRINT AT(5,16);"1. ADD A PROFILE"
: PRINT AT(6,16);"2. UPDATE A PROFILE"
: PRINT AT(7,16);"3. DELETE A PROFILE"
: PRINT AT(9,16);"THE FOLLOWING OPTIONS WILL TERMINATE PROFILE MAINTENANCE"
: PRINT AT(11,16);"4. PRINT ALL PROFILES"
: PRINT AT(12,16);"5. PRINT ONLY PROFILES NOT YET PRINTED"
6030 PRINT AT(13,16);"6. NO PRINTOUT - RETURN TO MENU"
: D7=0
: IF E6$="C"THEN Q9=1
: ELSE Q9=2
: IF E6$="D"THEN Q9=3
: IF E6$=" "THEN Q9=0
6055 IF Q9=0THEN D7=1
: GOSUB '100("1","6",1,0,"ENTER NUMBER OF DESIRED OPTION",D7)
: IF Q6$=HEX(1F)OR Q9=6THEN GOSUB '31
: IF Q9>3THEN 7465
: E6$="U"
: D6$="UPDATE"
: IF Q9=2THEN 6140
: E6$="D"
: D6$="DELETION"
: IF Q9=3THEN 6145
: E6$="C"
: D6$="ADD"
: IF F6>0THEN 6145
: PRINT AT(3,0,80);"No more space";HEX(07)
: GOTO 6055
6140 D8$="N"
6145 GOSUB 4385
: IF E6$="C"THEN 6380
: GOSUB '79(2)
: E7$=L4$(1)
: DBACKSPACE #2,1S
: GOSUB 4520
: GOSUB 4605
: Q6$="Y"
: IF A5$="S"THEN 6215
: Q6$="N"
6215 GOSUB 4650
: IF E6$="U"THEN 6470
: GOSUB '100("Y,N","YyNn",1,1,"DO YOU WISH TO DELETE THE PROFILE BELOW (Y/N
)",2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="Y"THEN 6270
: GOSUB '238(1)
: GOTO 5995
6270 GOSUB '231(1,0,G1$)
: IF Q$=" "THEN 6310
: GOSUB '91
: IF J0>0THEN PRINT AT(3,LEN(J$(J0))+3);"Profile ID ";G1$
: GOSUB '92
: IF J0<>7THEN GOSUB '31
: GOTO 5995
6310 FOR B7=1TO 10
: IF D6$(B7)<>" "THEN 6330
: D6$(B7)=T4$
: B7=10
6330 NEXT B7
: STR(M$(1),1)=HEX(FF)
: DATA SAVE DC #2,M$()
: F6=1
: GOTO 5995
6380 GOSUB 4520
: MAT L=ZER
: MAT B=ZER
: L2$,L4$()=" "
: L1,L2=0
: GOSUB 4565
: GOSUB '100("Y,N","YyNn",1,1,"DO YOU WISH TO ENTER SALES DATA (Y/N)",2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: A5$,C5$="B"
: IF Q6$="N"THEN 6450
: A5$="S"
6450 GOSUB 4650
6470 B6$="3"
: IF A5$="B"THEN 6505
: B6$="7"
: GOSUB '197
: CONVERT STR(L4$(1),1,2)TO B6
: IF (L2+B6)-C6<PTHEN PRINT AT(3,0);"Indices cannot be Generated with <";P;
"Periods of Data"
6505 Q9=0
: GOSUB '100("0",B6$,1,0,"ENTER ITEM NUMBER IN ERROR (0=END)",0)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q9>0THEN 6545
: IF A5$="B"THEN 6545
: GOSUB 4075
: IF A6$="E"THEN 6505
6545 ON Q9+1GOTO 6625,6575
: D8$="Y"
: ON Q9-1GOSUB 4575,4625,4825,5115,5280,5200
: IF B$="E"THEN 6505
: GOTO 6470
6575 IF E6$="C"THEN 6595
: PRINT HEX(010A0A0A);"Profile ID may not be changed"
: GOTO 6470
6595 D6$="ADD"
: GOSUB 4385
: GOSUB 4545
: GOTO 6470
6625 IF A5$="S"THEN 6895
: PRINT AT(1,0,)
: PRINT AT(5,(8-.5*LEN(G1$)),);"* * BASE INDICES FOR PROFILE ";G1$;" * *"
: B7$="ENTER INDEX FOR"
: D7=1
: FOR B6=1TO P
: IF E6$="U"THEN 6675
: STR(B7$,17,3)=P$(B6)
: GOSUB 5375
: GOTO 6680
6675 GOSUB 5415
6680 NEXT B6
6690 Q6$="0"
: GOSUB '100(" "," ",3,0,"ENTER NAME OF PERIOD IN ERROR (0=ALL OK 1=CHANGE
ALL)",3)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="0"THEN 6795
: C5$=A5$
: IF Q6$="1"THEN 6765
: MAT SEARCHP$()<1,P*3>,=Q6$TO B6$()STEP 3
: IF B6$(1)<>HEX(0000)THEN 6745
: GOSUB 4035
: GOTO 6690
6745 B6=1+(VAL(STR(B6$(1),2))-1)/3
: GOSUB 5350
: GOTO 6690
6765 FOR B6=1TO P
: GOSUB 5350
: NEXT B6
: GOTO 6690
6795 IF C5$<>"B"THEN 7265
: GOSUB '196
: IF A6$=" "THEN 6835
: GOSUB 4055
: GOTO 6690
6835 FOR B6=1TO P
: GOSUB 5415
: NEXT B6
: Q6$="Y"
: GOSUB '100("Y,N","YyNn",1,1,"ARE NORMALIZED INDICES OK (Y/N)",3)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="N"THEN 6690
: GOTO 7265
6895 CONVERT STR(L4$(1),3,2)TO B7
: C8=INT(L2/P)+SGN(MOD(L2,P))
: IF INT(L2/P)=L2/PAND STR(L4$(1),1,2)<>"01"THEN C8=C8+1
: B8=1
: B6$=STR(L4$(1),3,2)
: CONVERT STR(L4$(1),1,2)TO B9
: PRINT AT(1,0,)
: PRINT AT(5,10,);"* * SALES DATA FOR PROFILE ";G1$;" * *"
: D8=32
: Q9=INT((L2-1)/P)
: IF Q9<2THEN 6960
: D8=INT(52/Q9)
6960 B7$="ENTER SALES FOR"
: FOR I=1TO L2
: K1$(I)=P$(B9)
: STR(K1$(I),4,2)=B6$
: IF E6$="U"THEN 7005
: D7=1
: STR(B7$,17,5)=K1$(I)
: GOSUB 5475
: GOTO 7010
7005 GOSUB 5505
7010 B9=B9+1
: IF B9<=PTHEN 7035
: B9=1
: B8=B8+1
: CONVERT B7+B8-1TO B6$,(##)
7035 NEXT I
7045 Q6$="0"
: GOSUB '100(" "," ",5,0,"ENTER NAME OF PERIOD TO CORRECT (1=ALL 0=END)",3
)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="0"THEN 7195
: C5$=A5$
: IF Q6$="1"THEN 7140
: MAT SEARCHK1$()<1,5*L2>,=Q6$TO B6$()STEP 5
: IF B6$(1)<>HEX(0000)THEN 7100
: GOSUB 4035
: GOTO 7045
7100 I=1+(VAL(STR(B6$(1),2))-1)/5
: MAT SEARCHP$()<1,3*P>,=STR(K1$(I),1,3)TO B6$()STEP 3
: B9=1+(VAL(STR(B6$(1),2))-1)/3
: CONVERT STR(K1$(I),4,2)TO B8
: B8=B8-B7+1
: GOSUB 5450
: GOTO 7045
7140 B8=1
: CONVERT STR(L4$(1),1,2)TO B9
: FOR I=1TO L2
: GOSUB 5450
: B9=B9+1
: IF B9<=PTHEN 7180
: B9=1
: B8=B8+1
7180 NEXT I
: GOTO 7045
7195 IF A5$<>"S"THEN 7265
: CONVERT STR(L4$(1),1,2)TO B6
: IF (L2+B6)-C6<PTHEN 7265
: Q6$="Y"
: GOSUB '100("Y,N","YyNn",1,1,"DO YOU WISH TO GENERATE INDICES (Y/N)",3)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="N"THEN 7265
: D8$="Y"
: GOSUB '195
: IF A6$=" "THEN 7275
: GOSUB 4055
: GOTO 7045
7265 IF A5$="B"THEN 7275
: IF E6$="C"THEN MAT B=CON
7275 IF D8$="N"THEN 7445
: IF E6$<>"C"THEN 7415
: IF D6$(1)=" "THEN 7375
: B7=11
7300 B7=B7-1
: IF D6$(B7)=" "THEN 7300
: T8$="1"
: T4$=D6$(B7)
: GOSUB '234(1,1,G1$,0)
: GOSUB '91
: IF J0>0THEN PRINT AT(3,LEN(J$(J0))+3);"Profile ID ";G1$
: GOTO 7350
7345 GOSUB '92
7350 IF J0=5THEN 7405
: IF J0<>0THEN GOSUB '31
: D6$(B7)=" "
: GOTO 7415
7375 GOSUB '233(1,1,G1$,0)
: GOSUB '91
: IF J0=0THEN 7415
: IF J0>0THEN PRINT AT(3,LEN(J$(J0))+3);"Profile ID ";G1$
: GOSUB '92
: IF J0<>5THEN GOSUB '31
7405 F6=0
: GOTO 5995
7415 IF A5$="B"THEN 7435
: IF A5$="S"THEN GOSUB 4340
7435 GOSUB '69(2)
7445 GOSUB '238(1)
: GOTO 5995
7465 M1$="P"
: IF Q9=5THEN 7485
: M1$="A"
7485 GOSUB '93(" ")
: IF I0$=" "THEN 5995
: Q6$=M5$
: STR(Q6$,7,1)="4"
: LOAD TQ6$4000
9990 DEFFN'29"Q$=";HEX(22);"FCSG110A";HEX(22);":SCRATCH TQ$:SAVET$()Q$";HEX(0D
)