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 )