Listing of file='FCST110A' on disk='vmedia/701-2663.wvd.zip'
# Sector 268, program filename = 'FCST110A'
0010 REM FCST110A, MVP RELEASE 1-0, (02/02/79), THIS PROGRAM IS A COPYRIGHT P
RODUCT OF WANG LABORATORIES., UNAUTHORIZED REPRODUCTION OR USE IS PROHIBI
TED, PROFILE MAINTENANCE
0375 COM M1$1,L5$9,F6$8,F7$3,I0$
: DIM G1$10,B(13),C5$1,L2$20,L4$(2)4,L(4,13),M$(4)62,A5$1,L$20,J$(8)
: DIM Q$1,R1$8,R4$,R9$8,R9$(16),Q$(2)64,Q6$64,Q7$64
: DIM F8$3,B6$4,B6$(1)2,F9$7,E6$1,E7$4,E8$16,D6$8,E9$64,D8$1,A8$3,B7$21,K1$
(52)5,Q0$2
0410 %### - #.##
0415 %##### ####
0420 GOTO 5850
0495 IF E6$="U"THEN 515
: DSKIP #2,END
: F6=F6-1
: GOTO 545
0515 IF D8$="N"THEN 570
: IF C5$<>"P"THEN 535
: C5$="E"
0535 DBACKSPACE #2,1S
0545 $PACK(F=L$)M$()FROMG1$,C5$,A5$,B(),L2$,L4$(),L1,L2,L5,L()
: DATA SAVE DC #2,M$()
: IF E6$="U"THEN 570
: GOSUB '218(F6$,2,F7$,0)
0570 DBACKSPACE #2,BEG
: RETURN
0595 J0=3
: DBACKSPACE #2,BEG
0605 DATA LOAD DC #2,M$()
: ERRORGOTO 667
0610 IF END THEN 655
: IF STR(M$(1),1,10)<>G1$THEN 605
: $UNPACK(F=L$)M$()TO G1$,C5$,A5$,B(),L2$,L4$(),L1,L2,L5,L()
: ERRORGOTO 667
0630 E7$=L4$(1)
: J0=0
: RETURN
0655 PRINT AT(3,0,80);"PROFILE ";G1$;" IS NOT IN FILE ";F6$
: RETURN
0667 RETURN CLEAR
0668 RETURN CLEAR
0669 GOTO 6205
0680 DATA LOAD DC #2,M$()
: IF END THEN 710
: DBACKSPACE #2,2S
: DATA SAVE DC #2,M$()
: DSKIP #2,1
: GOTO 680
0710 DBACKSPACE #2,1S
: GOSUB '218(F6$,2,F7$,0)
: DBACKSPACE #2,BEG
: F6=F6+1
: RETURN
0745 PRINT HEX(010A);"ENTER TODAY'S DATE (PP/";
: IF P$="W"THEN 770
: PRINT "DD";
: C9=7
: GOTO 780
0770 PRINT "W/D";
: C9=8
0780 Q5=2
: PRINT "/YY)";
: IF L5$=" "THEN 805
: Q6$=L5$
: Q5=3
0805 GOSUB '100(" "," ",C9+1,0," ",Q5)
: L5$=Q6$
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF NUM(Q6$)=0THEN 1080
: IF POS(Q6$="/")-1<>NUM(Q6$)THEN 1080
: CONVERT STR(Q6$,1,NUM(Q6$))TO B6
: IF INT((B6-1)/P)<>0THEN 1080
: STR(Q6$,1)=STR(Q6$,POS(Q6$="/")+1)
: IF NUM(Q6$)=0THEN 1080
: IF POS(Q6$="/")-1<>NUM(Q6$)THEN 1080
: CONVERT STR(Q6$,1,NUM(Q6$))TO B7
: B9=B7
: IF P$="D"THEN 960
0910 STR(Q6$,1)=STR(Q6$,POS(Q6$="/")+1)
: IF NUM(Q6$)=0THEN 1080
: IF POS(Q6$="/")-1<>NUM(Q6$)THEN 1080
: CONVERT STR(Q6$,1,NUM(Q6$))TO B8
: IF INT((B8-1)/7)<>0THEN 1080
: B9=(B7-1)*7+B8
0960 IF INT((B9-1)/P(B6))<>0THEN 1080
: STR(Q6$,1)=STR(Q6$,POS(Q6$="/")+1)
: IF NUM(Q6$)<>64THEN 1080
: CONVERT Q6$TO B9
: IF B9>99THEN 1080
: L5$=" / ///"
: IF P$="W"THEN 1035
: CONVERT B7TO STR(L5$,4,2),(##)
: GOTO 1050
1035 CONVERT B7TO STR(L5$,4,1),(#)
: CONVERT B8TO STR(L5$,6,1),(#)
1050 CONVERT B6TO STR(L5$,1,2),(##)
: CONVERT B9TO STR(L5$,C9,2),(##)
: PRINT AT(5,0);
: PRINT "1. - DATE - ";L5$
: RETURN
1080 PRINT AT(3,0,80);"IMPROPER DATE FORMAT"
: GOTO 745
1100 Q6$=F6$
: GOSUB '100(" ","^",8,0,"ENTER NAME OF PROFILE FILE",3)
: F6$=Q6$
: IF Q6$=HEX(1F)THEN GOSUB '31
: PRINT AT(6,0);
: PRINT "2. - PROFILE FILE NAME - ";F6$;TAB(64)
: RETURN
1155 Q6$=F7$
: GOSUB '100(" "," ",3,0,"ENTER DESIRED DISK ADDRESS",3)
: IF Q6$=HEX(1F)THEN GOSUB '31
: F7$=Q6$
: GOSUB '205(F7$)
: IF Q$=" "THEN 1215
: PRINT AT(3,0,80);"INVALID ADDRESS"
: F7$=" "
: GOTO 1155
1215 SELECT #2<F7$>
: PRINT AT(7,0);
: PRINT "3. - DISK ADDRESS - ";F7$
: RETURN
1250 B6$=F8$
: Q6$="Y"
: GOSUB '100("Y,N","YyNn",1,1,"DOES FILE ALREADY EXIST (Y OR N)",3)
: IF Q6$=HEX(1F)THEN GOSUB '31
: F8$="OLD"
: IF Q6$="Y"THEN 1305
: F8$="NEW"
1305 PRINT AT(8,0);
: PRINT "4. - STATUS OF FILE - ";F8$
: IF F8$="NEW"AND B6$<>"NEW"THEN 1327
: IF F8$="OLD"THEN PRINT TAB(64)
: RETURN
1327 F6=0
1335 Q9=F6
: Q5=1
: IF F6=0THEN 1355
: Q5=-1
1355 GOSUB '100("1","9999",4,0,"ENTER NUMBER OF PROFILES IN FILE",Q5)
: IF Q6$=HEX(1F)THEN GOSUB '31
: F6=Q9
: PRINT AT(9,0);
: PRINT "5. - NO. OF PROFILES IN FILE - ";F6;TAB(64)
: RETURN
2185 PRINT AT(3,0,80);"DISK ERROR";ERR;"HAS OCCURRED"
: GOSUB '254
: GOTO 5850
2200 ON ERRORA8$,Q6$GOTO 2205
2205 PRINT AT(3,0,80);"ERROR ";A8$;" OCCURRED ON LINE ";Q6$;TAB(64)
: GOSUB '254
: GOTO 5850
2265 GOSUB '91
: IF J0=0THEN RETURN
: PRINT AT(1,0,80);J$(J0);":THE PROGRAM WILL BE TERMINATED"
: GOSUB '254
: GOSUB '31
4035 GOSUB 4060
: PRINT AT(3,0);HEX(07);"RE-ENTER"
: RETURN
4060 PRINT AT(3,0,80)
: RETURN
4080 PRINT AT(3,0);"DATA MAY NOT BE ALL ZERO"
: RETURN
4100 R$=" "
: IF STR(L4$(1),3,2)<=STR(L4$(2),3,2)THEN 4125
4110 PRINT AT(3,0);"INDICES DATE MUST BE >= ";L4$(1)
: R$="E"
: RETURN
4125 IF STR(L4$(1),3,2)=STR(L4$(2),3,2)AND STR(L4$(1),1,2)>STR(L4$(2),1,2)THEN
4110
: CONVERT STR(L4$(1),1,2)TO B6
: IF L2<=P*4-(B6-1)THEN RETURN
: R$="E"
: PRINT AT(3,0);"NUMBER OF MONTHS OF SALES DATA MUST BE <= ";P*4-(B6-1)
: RETURN
4170 DEFFN'197
: CONVERT STR(L4$(2),1,2)TO Q9
: IF STR(L4$(1),3,2)=STR(L4$(2),3,2)THEN 4215
: CONVERT STR(L4$(1),3,2)TO B6
: CONVERT STR(L4$(2),3,2)TO C7
: D7=C7-B6+1
: GOTO 4220
4215 D7=1
4220 C6=Q9+(D7-1)*P
: CONVERT STR(L4$(1),1,2)TO Q9
: RETURN
4240 S$=" "
: 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 4290
: B9=1
: B8=B8+1
4290 NEXT I
: IF B6=0THEN 4315
: IF INT(LGT(B6/C9)+1)<=4THEN 4315
: PRINT AT(3,0);"SCALE MUST BE >= ";L1/(10^(4-(INT(LGT(B6))+1)));" TO SAVE
SALES DATA"
: S$="E"
4315 RETURN
4330 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 4360
: L1=C9
: S$=" "
: RETURN
4360 C9=C9/L1
: GOSUB 4240
: IF S$="E"THEN RETURN
: FOR C6=1TO 4
: FOR C7=1TO P
: L(C6,C7)=ROUND((L(C6,C7)/C9,0)
: NEXT C7
: NEXT C6
: L1=L1*C9
: RETURN
4430 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
4475 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),10,0,Q6$,2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$<>"0"THEN 4530
: E6$=" "
: RETURN CLEAR
4525 GOTO 6240
4530 G1$=Q6$
: IF E6$="C"THEN RETURN
: GOSUB 595
: IF J0=3THEN 4475
4565 PRINT HEX(030A0A0A0A0A);TAB(17);"* * PROFILE INFORMATION * *"
: GOSUB 4590
: RETURN
4590 PRINT HEX(010A0A0A0A0A0A0A);"1. - PROFILE ID - ";G1$;TAB(80)
: RETURN
4610 D7=2
: IF E6$="C"OR L2$=" "THEN 4630
4620 D7=3
: Q6$=L2$
4630 GOSUB '100(" ","^",20,0,"ENTER DESCRIPTION",D7)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$<>L2$THEN D8$="Y"
: L2$=Q6$
: PRINT AT(8,0);
4655 PRINT "2. - DESCRIPTION - ";L2$;TAB(80)
: RETURN
4675 IF A5$="B"THEN 4690
: A5$="B"
: GOTO 4700
4690 A5$="S"
4700 F9$="INDICES"
: IF A5$="B"THEN 4715
: F9$="SALES"
4715 PRINT AT(9,0);
: PRINT "3. - TYPE OF ENTRY - ";F9$;TAB(80)
: IF A5$="S"THEN 4780
: PRINT TAB(80)
: PRINT TAB(80)
: PRINT TAB(80)
: PRINT TAB(80)
: IF E6$="U"THEN RETURN
: L1,L2=0
: L4$(1)=" "
: RETURN
4780 IF E6$="C"THEN 4825
: IF L2=0THEN 4825
: GOSUB 4930
: GOSUB 5165
: GOSUB 5340
: GOSUB 5265
: RETURN
4825 C5$="S"
: D8$="Y"
: GOSUB 4870
: GOSUB 5115
: GOSUB 5290
: GOSUB 5205
: RETURN
4870 D7=1
: IF E6$="C"OR L4$(1)=" "THEN 4895
4880 D7=-1
: CONVERT L4$(1)TO Q9
: Q6$=L4$(1)
4895 GOSUB '100("0100","1399",4,0,"ENTER STARTING PERIOD/YEAR OF DATA (PPYY)",
D7)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$<>L4$(1)THEN D8$="Y"
: CONVERT Q9TO L4$(1),(####)
: C5$="S"
4930 CONVERT STR(L4$(1),1,2)TO F7
: IF INT((F7-1)/P)=0THEN 4955
: GOSUB 4060
: PRINT "IMPROPER DATE FORMAT"
: GOTO 4895
4955 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 OR N)"
5025 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 5075
: MAT L=ZER
: RETURN
5075 FOR D6=1TO 4-B6
: FOR D7=1TO P
: L(D6,D7)=L(D6+B6,D7)
: NEXT D7
: NEXT D6
: RETURN
5115 IF E6$="U"AND L4$(2)<>" "THEN 5135
: CONVERT L4$(1)TO Q9
: Q6$=L4$(1)
: GOTO 5145
5135 CONVERT L4$(2)TO Q9
: Q6$=L4$(2)
5145 GOSUB '100("0100","1399",4,0,"ENTER STARTING PERIOD/YEAR OF DATA USED FOR
INDICES (PPYY)",-1)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$<>L4$(2)THEN D8$="Y"
: CONVERT Q9TO L4$(2),(####)
5165 CONVERT STR(L4$(2),1,2)TO Q9
: IF INT((Q9-1)/P)=0THEN 5185
: PRINT AT(3,0);"IMPROPER DATE FORMAT"
: GOTO 5145
5185 PRINT AT(11,0);"5. - STARTING PERIOD/YEAR OF DATA USED FOR INDICES - ";L4
$(2)
: RETURN
5205 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 5235
: GOSUB 4035
: GOTO 5205
5235 IF E6$="C"OR L1=0THEN 5255
: C9=Q9
: IF C9<>L1OR S$="E"THEN GOSUB 4330
: IF S$="E"THEN 5270
5255 IF E6$="C"OR L1=0THEN L1=Q9
: PRINT AT(13,0);
5265 PRINT "7. - SCALE -";L1;TAB(80)
5270 RETURN
5290 CONVERT (P*4-(F7-1))TO B6$,(##)
: D7=1
: IF E6$="C"OR L2=0THEN 5315
: D7=0
: Q9=L2
5315 GOSUB '100("1",B6$,2,0,"ENTER NUMBER OF MONTHS OF SALES DATA",D7)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q9<>L2THEN D8$="Y"
: L2=Q9
: C5$="S"
5340 PRINT AT(12,0);
: PRINT "6. - NUMBER OF MONTHS OF DATA - ";L2
: RETURN
5365 PRINT HEX(010A);"ENTER INDEX FOR ";P$(B6)
: B7$=" "
: D7=0
: Q9=B(B6)
5390 GOSUB '100("0","9.99",1,2,B7$,D7)
: IF Q6$=HEX(1F)THEN GOSUB '31
: B(B6)=Q9
5410 B7=INT((B6-1)/4)
: PRINT AT(6+B6-4*B7,16*B7);
: PRINTUSING 410,P$(B6),B(B6)
: RETURN
5445 Q9=L(B8,B9)
: D7=0
: PRINT HEX(010A);"ENTER ";K1$(I);" SALES FOR PROFILE ";G1$
: B7$=" "
5470 GOSUB '100("0","9999",4,0,B7$,D7)
: IF Q6$=HEX(1F)THEN GOSUB '31
: L(B8,B9)=Q9
5490 D7=INT((I-1)/P)
: PRINT AT(3+I-P*D7,D8*D7);
: PRINTUSING 415,K1$(I),L(B8,B9);
: PRINT HEX(0D);
: RETURN
5525 DEFFN'31
: PRINT AT(1,0,80);TAB(20);"** TERMINATING PROGRAM **"
: GOSUB '219(F6$,2,1,F7$,0)
: COM CLEAR M1$
: LOAD DC T#0,M$
5560 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 5610
: B(B6)=B(B6)+L(C7,B6)
: L5=L5+1
5610 NEXT C7
: NEXT B6
: GOSUB '196
: RETURN
5640 DEFFN'196
: R$="E"
: D7=0
: FOR B6=1TO P
: D7=D7+B(B6)
: NEXT B6
: IF D7=0THEN RETURN
: R$=" "
: C5$="E"
: IF ABS(D7-P)<.005*PTHEN RETURN
: MAT B=(P/D7)*B
: D7=0
: FOR B6=1TO P
: IF B(B6)<9.995THEN 5725
: D7=B6
5725 NEXT B6
: IF D7=0THEN 5790
: 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
5790 MAT B=(100)*B
: FOR B6=1TO P
: B(B6)=INT(B(B6)+.5)
: NEXT B6
: MAT B=(.01)*B
: RETURN
5850 SELECT PRINT 005(64),CO 005,P
: IF M$<>" "THEN 5875
: M$="START"
5875 L$=HEX(A00AA001A0015202A014A0046005600160015003)
: Q0$=" 1"
: PRINT HEX(03)
: GOSUB 745
: GOSUB 1100
: GOSUB 1155
: GOSUB 1250
5925 B6$="4"
: IF F8$="OLD"THEN 5940
: B6$="5"
5940 GOSUB '100("0",B6$,1,0,"ENTER ITEM NUMBER IN ERROR (0=END)",1)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q9=0THEN 5970
: ON Q9GOSUB 745,1100,1155,1250,1335
: GOTO 5925
5970 Q6$="TO CONTAIN"
: IF F8$="NEW"THEN 5985
: Q6$="CONTAINING"
5985 PRINT HEX(010A);"MOUNT DISK ";Q6$;" FILE ";F6$;" IN UNIT ";F7$
5990 KEYIN Q6$,5990,5990
: INPUT "KEY RETURN(EXEC) TO RESUME",Q6$
: LIMITS T#2,F6$,B6,B7,B8,R
: ERRORGOTO 2185
6010 IF F8$="OLD"THEN 6145
: IF R=0THEN 6040
: PRINT AT(3,0,80);"FILE NAME ALREADY EXISTS"
: GOTO 5925
6040 DATA LOAD BA T#2,(0,R)R9$()
: B6$=STR(R9$(1),3,1)
: B7$=STR(R9$(1),5,1)
: AND (B6$,7F)
: AND (B7$,7F)
: B6=256*(VAL(B7$)-VAL(B6$))+VAL(STR(R9$(1),6,1))-VAL(STR(R9$(1),4,1))
: IF B6>F6+1THEN 6115
: IF B6>1THEN PRINT AT(3,0,80);"YOUR DISK ONLY HAS ROOM FOR";B6-2;"PROFILES
"
: ELSE PRINT AT(3,0,80);"YOUR DISK IS FULL"
: GOTO 5925
6115 GOSUB '217(F6$,2,1,F6+2,4," ",F7$,0)
6120 GOSUB 2265
: GOSUB '218(F6$,2,F7$,0)
: DBACKSPACE #2,BEG
: GOTO 6240
6145 IF R=2THEN 6165
: PRINT AT(3,0,80);"FILE IS NOT ACTIVE ON DISK"
: GOTO 5925
6165 F6=B7-B6-B8+1
: IF B7-B6<2THEN 6205
: IF B8>2THEN 6220
: F6=B7-B6-1
: IF B8<2THEN 6205
: GOSUB '217(F6$,2,1,0,4," ",F7$,0)
: GOTO 6120
6205 PRINT AT(3,0,80);"FILE ";F6$;" IS NOT A PROFILE FILE"
: GOTO 5925
6220 GOSUB '217(F6$,2,1,0,4," ",F7$,0)
: GOSUB 2265
6240 PRINT HEX(03)
: 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"
6275 PRINT AT(13,16);"6. NO PRINTOUT - RETURN TO MENU"
: IF E6$="C"THEN Q9=1
: ELSE Q9=2
: IF E6$="D"THEN Q9=3
: IF E6$=" "THEN Q9=0
6295 IF Q9=0THEN Q6$=" "
: IF Q9=0THEN D7=1
: ELSE D7=0
: GOSUB '100("1","6",1,0,"ENTER NUMBER OF DESIRED OPTION",D7)
: IF Q6$=HEX(1F)OR Q9=6THEN GOSUB '31
: IF Q9>3THEN 7390
: E6$="U"
: D6$="UPDATE"
: IF Q9=2THEN 6390
: E6$="D"
: D6$="DELETION"
: IF Q9=3THEN 6390
: E6$="C"
: D6$="ADD"
: IF F6>0THEN 6390
: GOSUB 4060
: PRINT "NO MORE SPACE"
: GOTO 6295
6390 GOSUB 4475
: IF E6$="C"THEN 6505
: GOSUB 4565
: GOSUB 4655
: Q6$="Y"
: IF A5$="S"THEN 6440
: Q6$="N"
6440 GOSUB 4700
: IF E6$="U"THEN 6595
: GOSUB '100("Y,N","YyNn",1,1,"DO YOU WISH TO DELETE THE PROFILE BELOW (Y O
R N)",2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="N"THEN 6240
: GOSUB 680
: GOTO 6240
6505 GOSUB 4565
: MAT L=ZER
: MAT B=ZER
: L2$,L4$()=" "
: L1,L2=0
: GOSUB 4610
: GOSUB '100("Y,N","YyNn",1,1,"DO YOU WISH TO ENTER SALES DATA (Y OR N)",2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: A5$,C5$="B"
: IF Q6$="N"THEN 6575
: A5$="S"
6575 GOSUB 4700
6595 B6$="3"
: IF A5$="B"THEN 6630
: 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;
"MONTHS OF DATA"
6630 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 6670
: IF A5$="B"THEN 6670
: GOSUB 4100
: IF R$="E"THEN 6630
6670 ON Q9+1GOTO 6750,6700
: D8$="Y"
: ON Q9-1GOSUB 4620,4675,4880,5135,5290,5205
: IF S$="E"THEN 6630
: GOTO 6595
6700 IF E6$="C"THEN 6720
: PRINT HEX(010A0A0A);"PROFILE ID MAY NOT BE CHANGED"
: GOTO 6595
6720 D6$="ADD"
: GOSUB 4475
: GOSUB 4590
: GOTO 6595
6750 IF A5$="S"THEN 6965
: PRINT HEX(030A0A0A0A0A);TAB(8-.5*LEN(G1$));"* * BASE INDICES FOR ";G1$;"
* *"
: B7$="ENTER INDEX FOR"
: D7=1
: FOR B6=1TO P
: IF E6$="U"THEN 6795
: STR(B7$,17,3)=P$(B6)
: GOSUB 5390
: GOTO 6800
6795 GOSUB 5410
6800 NEXT B6
6810 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 6920
: D8$="Y"
: C5$=A5$
: IF Q6$="1"THEN 6890
: MAT SEARCHP$()<1,P*3>,=Q6$TO B6$()STEP 3
: IF B6$(1)<>HEX(0000)THEN 6870
: GOSUB 4035
: GOTO 6810
6870 B6=1+(VAL(STR(B6$(1),2))-1)/3
: GOSUB 5365
: GOTO 6810
6890 FOR B6=1TO P
: GOSUB 5365
: NEXT B6
: GOTO 6810
6920 IF C5$<>"B"THEN 7330
: GOSUB '196
: IF R$=" "THEN 7330
: GOSUB 4080
: GOTO 6810
6965 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 HEX(03)
: D8=32
: Q9=INT((L2-1)/P)
: IF Q9<2THEN 7025
: D8=INT(52/Q9)
7025 B7$="ENTER SALES FOR"
: FOR I=1TO L2
: K1$(I)=P$(B9)
: STR(K1$(I),4,2)=B6$
: IF E6$="U"THEN 7070
: D7=1
: STR(B7$,17,5)=K1$(I)
: GOSUB 5470
: GOTO 7075
7070 GOSUB 5490
7075 B9=B9+1
: IF B9<=PTHEN 7100
: B9=1
: B8=B8+1
: CONVERT B7+B8-1TO B6$,(##)
7100 NEXT I
7110 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 7265
: D8$="Y"
: C5$=A5$
: IF Q6$="1"THEN 7210
: MAT SEARCHK1$()<1,5*L2>,=Q6$TO B6$()STEP 5
: IF B6$(1)<>HEX(0000)THEN 7170
: GOSUB 4035
: GOTO 7110
7170 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 5445
: GOTO 7110
7210 B8=1
: CONVERT STR(L4$(1),1,2)TO B9
: FOR I=1TO L2
: GOSUB 5445
: B9=B9+1
: IF B9<=PTHEN 7250
: B9=1
: B8=B8+1
7250 NEXT I
: GOTO 7110
7265 IF A5$<>"S"THEN 7330
: CONVERT STR(L4$(1),1,2)TO B6
: IF (L2+B6)-C6<PTHEN 7330
: 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 7330
: GOSUB '195
: IF R$=" "THEN 7345
: GOSUB 4080
: GOTO 7110
7330 L5=0
: IF A5$="B"THEN 7345
: IF E6$="C"THEN MAT B=CON
7345 IF D8$="N"THEN 6240
: IF A5$="S"THEN GOSUB 4430
: C5$="E"
: GOSUB 495
: GOTO 6240
7390 M1$="P"
: IF Q9=5THEN 7410
: M1$="A"
7410 GOSUB '93(" ")
: IF I0$=" "THEN 6240
: PRINT HEX(030A0A0A0A0A0A);TAB(13);"* * LOADING PROFILE PRINT ROUTINE *
*"
: LOAD DC T#0,"FCST114A"
7455 DEFFN'100(Q$(1),Q$(2),Q3,Q4,Q7$,Q5)
: Q6=Q9
: SELECT PRINT 005(80)
: IF Q7$<>" "THEN PRINT HEX(010A);Q7$;TAB(80)
7460 KEYIN Q7$,7460,7460
7465 Q7$=" "
: Q7=Q3+Q4+2+17*(1-ABS(SGN(Q3+Q4)))
: IF Q5>1THEN Q7=Q3+64*(1-ABS(SGN(Q3)))
: PRINT AT(2,0,80);
: IF Q5>-1AND Q5<3THEN 7470
: STR(Q6$,Q7+1)=" "
: LINPUT -STR(Q6$,,Q7)
: GOTO 7480
7470 Q6$=ALL(8B)
: IF Q5>1THEN 7475
: STR(Q6$,Q3+1,1)="."
: STR(Q6$,Q7)=" "
: Q7$="Default = "&Q6$&"-"
: $TRAN(Q7$,HEX(238B))R
: PRINT AT(2,Q7+3);
: IF Q5=0THEN PRINTUSING Q7$,Q9;
: PRINT HEX(0D)
: Q7$=Q6$
7475 LINPUT ?STR(Q6$,,Q7)
: IF Q5=0AND Q6$=Q7$THEN Q7=0
: IF Q5=1AND Q6$=Q7$THEN Q6$="0"
7480 $TRAN(Q6$,HEX(208B))R
: IF Q7$=HEX(0F)THEN 7465
: IF Q6$=HEX(1F)THEN 7505
: IF Q5>1THEN 7510
: $TRAN(STR(Q6$,POS(Q6$=".")+1)," .")R
: $TRAN(Q7$,HEX(238B))R
: MAT COPY -Q7$<1,16>TO -Q7$<2,17>
: STR(Q7$,,1)="-"
: IF Q7=0THEN CONVERT Q9TO Q6$,(Q7$)
: CONVERT Q$(1)TO Q7
: ERRORQ7=0
7485 CONVERT Q$(2)TO Q8
: ERRORQ8=0
7490 CONVERT Q6$TO Q9
: ERRORGOTO 7520
7495 IF Q3+Q4=0THEN 7500
: IF ABS(Q9)>=10^ABS(Q3)OR INT(Q9*10^Q4)<>Q9*10^Q4THEN 7520
7500 IF Q7=0AND Q8=0THEN 7505
: IF Q9<Q7OR Q9>Q8THEN 7520
7505 PRINT AT(1,0,240)
: RETURN
7510 IF Q$()=" "THEN 7505
: IF Q4=0AND Q$(1)<=Q6$AND Q$(2)>=Q6$THEN 7505
: Q7$=HEX(07)
: IF Q4=0THEN 7515
: IF Q4=1THEN $TRAN(STR(Q6$,,Q3),Q$(2))R
: Q7=LEN(Q$(1))
: MAT SEARCHSTR(Q$(1),,Q7),=STR(Q6$,,Q3)TO STR(Q7$,,2)STEP Q3+1
: Q9=INT((VAL(Q7$,2)+Q3)/(Q3+1))
: IF Q9>0THEN 7505
: Q7$=" - "&STR(Q$(1),,Q7)&HEX(07)
7515 PRINT AT(3,0,80);"Re-enter.";Q7$
: GOTO 7465
7520 Q7$=HEX(07)
: IF Q$()=" "THEN 7515
: PRINT AT(3,0,80);Q7$;"Re-enter, ";Q7;"<= X <=";Q8
: Q9=Q6
: GOTO 7465
7525 DEFFN'31
: Q6$=HEX(1F)
: RETURN
7530 DEFFN'15
: Q7$=HEX(0F)
: RETURN
7535 DEFFN'4
: IF Q5>1THEN Q6$="END"
: ELSE Q6$="0"
: RETURN
7540 DEFFN'121(U9$)
: U9=0
: MAT COPY -STR(U9$,,LEN(U9$))TO -U9$
: IF STR(U9$,7,1)="/"THEN STR(U9$,,7)=STR(U9$,2,6)&"0"
: IF STR(U9$,4,1)="/"THEN STR(U9$,,4)=STR(U9$,2,3)&"0"
: IF STR(U9$,,1)=" "THEN STR(U9$,,1)="0"
: IF VER(U9$,"##/##/##")<>8THEN 7550
: CONVERT STR(U9$,,2)TO Q6
: CONVERT STR(U9$,7,2)TO Q8
: IF Q6<1OR Q6>12OR Q8=0THEN 7550
7545 Q6$=HEX(001F1C1F1E1F1E1F1F1E1F1E1F)
: IF MOD(Q8,4)=0THEN STR(Q6$,3,1)=HEX(1D)
: CONVERT STR(U9$,4,2)TO Q7
: IF Q7<1OR Q7>VAL(STR(Q6$,Q6+1,1))THEN 7550
: ADD(STR(Q6$,,Q6),STR(Q6$,2,Q6))
: U9=Q8*1E3+VAL(Q6$)+INT(Q6/9)*256-VAL(STR(Q6$,Q6+1,1))+Q7
: RETURN
7550 Q6$="E"
: RETURN
7555 DEFFN'123(Q9)
: U9$=" "
: IF Q9<=0THEN 7550
: Q9=INT(Q9)
: Q7=INT(365.25*(INT(Q9/1E3)-1))+MOD(Q9,1E3)
: Q9=INT(Q7/365.25)
: Q9=Q9-1+SGN(Q7-INT(365.25*Q9))
: U9=Q9*1E3+(Q7-INT(365.25*Q9))+1E3
: Q9=INT(U9/1E3)
: Q6$=HEX(001F3B5A7897B5D4F311304E6D)
: IF MOD(Q9,4)=0THEN STR(Q6$,3)=ADDALL(HEX(01))
: FOR Q6=1TO 12
7560 IF VAL(STR(Q6$,Q6+1,1))+INT(Q6/9)*256>=U9-Q9*1E3THEN 7565
: NEXT Q6
7565 Q7=U9-Q9*1E3-VAL(STR(Q6$,Q6))-INT(Q6/10)*256
: CONVERT Q6*1E6+Q7*1E3+Q9TO U9$,(########)
: U9$=XOR HEX(00001F00001F0000)
: RETURN
7595 DEFFN'93(Q7$)
: Q6$="215"
: GOSUB '100("215,216,204",Q7$,3,2,"ENTER PRINTER ADDRESS",3)
: Q7$=Q6$
: UNPACK(##)STR(@I0$,Q9,1)TO Q8
: CONVERT Q8TO Q6$,(##)
: Q6$="PRINTER BEING USED BY STATION "&Q6$
: SELECT #15<Q7$>
: $OPEN 7675,#15
: ERRORQ6$="PRINTER NOT ATTACHED TO SYSTEM"&HEX(07)
: GOTO 7675
7655 PACK(##)Q6$FROMS2
: STR(@I0$,Q9,1)=Q6$
: IF Q$(2)=" "THEN Q6$="MOUNT PAPER INTO PRINTER"
: ELSE Q6$=Q$(2)
: I0$=Q7$
7675 PRINT AT(1,0);Q6$
: IF I0$="204"THEN PRINT AT(3,0);HEX(07);"MAKE SURE THAT TERMINAL PRINTER I
S ON, AND SELECTED"
7685 GOSUB '254
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF I0$=" "THEN RETURN
: $GIO#15(010102001212400040004000,Q6$)
: PRINT AT(3,0,80)
: IF STR(Q6$,8,1)=HEX(00)THEN RETURN
: PRINT AT(3,0);"PRINTER NOT READY, TURN PRINTER ON"
: GOTO 7685
7750 DEFFN'217(R9$,R9,R8,R1,Q9,Q6$,R4$,R2)
: $OPEN #R9
: LIMITS T#R9,R9$,Q6,Q7,Q8,R
: Q$="D"
: IF ABS(R)=1THEN 7800
: IF R1<=0THEN 7765
: IF R=2THEN 7800
: Q9=4
: Q$="S"
: IF R=0THEN 7755
: IF Q7-Q6+1<R1THEN 7800
: DATA SAVE DC OPEN T#R9,R9$,R9$
: GOTO 7770
7755 DATA SAVE DC OPEN T#R9,R1,R9$
: ERRORGOTO 7800
7760 LIMITS T#R9,Q6,Q7,Q8
: GOTO 7770
7765 IF R<2THEN 7800
7770 GOSUB 7820
: Q$="M"
: IF STR(R9$(1),4,4)<>HEX(FD4D5558)AND R1=-2THEN 7800
: IF STR(R9$(1),4,4)=HEX(FD4D5558)THEN 7775
: STR(R9$(1),4,4)=HEX(FD4D5558)
: R9$(2)=Q6$
: STR(R9$(),33)=" "
7775 Q$="P"
: IF Q6$<>R9$(2)THEN 7800
: Q$="A"
: Q6$=STR(R9$(),33,48)
: IF STR(Q6$,R8,1)=" "XOR R1<>-1THEN 7800
: STR(Q6$,R8,1)=" "
: ON Q9-1GOTO 7780,7785,7795
: R1$=" 1 2 3"
: GOTO 7790
7780 R1$=" 1 2"
: GOTO 7790
7785 R1$=" 1 3"
7790 $TRAN(Q6$,R1$)R
7795 IF Q6$<>" "THEN 7800
: CONVERT Q9TO STR(R9$(),32+R8,1),(#)
: GOSUB 7825
: DATA LOAD DC OPEN T#R9,R9$
: Q$=" "
7800 IF R2=0THEN $CLOSE#R9
: RETURN
7805 DEFFN'218(R9$,R9,R4$,R2)
: $OPEN #R9
: LIMITS T#R9,Q6,Q7,Q8
: Q6=Q8-Q6+2
: R9$()=HEX(A0)
: DATA SAVE BA T#R9,(Q8)R9$()
: GOSUB 7820
: STR(R9$(),2,2)=BIN(Q6,2)
: GOSUB 7825
: DATA LOAD DC OPEN T#R9,R9$
: DSKIP #R9,END
: GOTO 7800
7810 DEFFN'219(R9$,R9,R8,R4$,R2)
: $OPEN #R9
: LIMITS T#R9,R9$,Q6,Q7,Q8
: GOSUB 7820
: STR(R9$(),32+R8,1)=" "
: GOSUB 7825
: DATA SAVE DC CLOSE#R9
: GOTO 7800
7815 DEFFN'215(R4$,Q4)
: MAT SEARCH"310B10320B20330B30350B50360B60370B70",=STR(R4$,,3)TO STR(R4$,4
,2)STEP 3
: ON (VAL(STR(R4$,4),2)+2)/3SELECT #15/310;#15/B10;#15/320;#15/B20;#15/330;
#15/B30;#15/350;#15/B50;#15/360;#15/B60;#15/370;#15/B70
: ELSE RETURN
: IF Q4=0THEN $CLOSE#15
: ELSE $OPEN #15
: RETURN
7820 DATA LOAD BA T#R9,(Q7,Q8)R9$()
: RETURN
7825 DATA SAVE BA T#R9,(Q7,Q8)R9$()
: RETURN
7840 DEFFN'91
: $TRAN(Q$,"0 1E2X3N4D5S6A7B8P")R
: CONVERT Q$TO J0
: IF J0<1OR J$(J0)=" "THEN 7870
: PRINT AT(3,0,80);HEX(07);J$(J0)
7870 J$()="END OF FILE IMPROPER CALL RECORD NOT FOUNDDUPLICATE KEY NO
MORE SPACE ACCESS CONFLICT RECORD BUSY INVALID PASSWORD"
: RETURN
7905 DEFFN'205(R1$)
: Q$=" "
: MAT SEARCH"310320330350360370B10B20B30B50B60B70D10D11D12D13D14D15D20D21D2
2D23D24D25D30D31D32D33D34D35D50D51D52D53D54D55D60D61D62D63D64D65D70D71D72
D73D74D75",=R1$TO R1$STEP 3
: IF STR(R1$,,2)=HEX(0000)THEN Q$="I"
: RETURN
7940 DEFFN'254
: KEYIN Q6$,7940,7940
: 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
9990 DEFFN'29"Q$=";HEX(22);"FCST110A";HEX(22);":SCRATCH TQ$:SAVET$()Q$";HEX(0D
)