image of READY prompt

Wang2200.org

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
     )