1000 COM R1,R2,R3,R4,R$[72],N,C[30,4],A$[72] 1010 REM *** COFTAB - PROGRAM COFTA8 - 06/06/73 1012 REM *** RECODES THE DATA. 1013 REM *** TRANSFERS CONTROL TO COFTA1. 2000 FILES VARBLE,WORK1,WORK2 3000 FILES F1,F2,F3,F4,F5,F6,F7,F8,F9,F10 5000 DIM B$[72],T$[72],S$[72],D$[20],E$[1],U$[72],V$[72] 5010 DIM N$[72] 5020 DIM C$[50] 5030 D$=",;)(=NX 0123456789" 5040 N=0 5050 PRINT #2,1 5060 P2=0 5070 B1=0 5080 GOSUB 7230 5090 IF S1=4 THEN 5120 5100 PRINT "*****'(' EXPECTED AFTER ";A$[P1,P4] 5110 CHAIN "COFTA1" 5120 T$=A$[P1,P4] 5130 B$=T$ 5140 READ #1,1 5150 IF END #1 THEN 6430 5160 V$=A$ 5170 T2=P2 5180 READ #1;T1,A$ 5190 P2=0 5200 GOSUB 6450 5210 IF U$#T$ THEN 5180 5220 GOSUB 6580 5230 A$=V$ 5240 P2=T2 5250 N=N+1 5260 C[N,1]=U1 5270 C[N,2]=U2 5280 C[N,3]=0 5290 B1=0 5300 GOSUB 7230 5310 IF S1=5 THEN 5340 5320 PRINT "*****'=' EXPECTED AFTER "A$[P1,P4] 5330 GOTO 5110 5340 T$=A$[P1,P4] 5350 IF LEN(T$) <= C[N,2]-C[N,1]+1 THEN 5380 5360 PRINT "*****NEW FIELD LENGTH OF "B$" > OLD LENGTH" 5370 GOTO 5110 5380 C[N,3]=C[N,3]+1 5390 PRINT #2;T$ 5400 PRINT #3,1 5410 C1=0 5420 GOSUB 6840 5430 C1=C1+1 5440 PRINT #3;S$ 5450 GOTO S1 OF 5700,5460,5590 5460 GOSUB 5510 5470 GOSUB 7780 5480 IF S1#6 THEN 5300 5490 GOSUB 5740 5500 GOTO 5300 5510 READ #3,1 5520 PRINT #2;C1 5530 FOR I=1 TO C1 5540 READ #3;T$ 5550 PRINT #2;T$ 5560 NEXT I 5570 PRINT #2; END 5580 RETURN 5590 GOSUB 5510 5600 GOSUB 7780 5610 IF S1=6 THEN 5680 5620 B1=0 5630 GOSUB 7230 5640 IF S1=7 THEN 5780 5650 IF S1=1 THEN 5070 5660 PRINT "*****'CR' OR ',' OR '/' EXPECTED AFTER EQUATION FOR "B$ 5670 GOTO 5110 5680 GOSUB 5740 5690 GOTO 5070 5700 GOSUB 7780 5710 IF S1#6 THEN 5420 5720 GOSUB 5740 5730 GOTO 5420 5740 PRINT "CONTINUE"; 5750 INPUT A$ 5760 P2=0 5770 RETURN 5780 F=F1=4 5790 IF END #4 THEN 6250 5800 GOTO 5820 5810 IF END #F1 THEN 6170 5820 PRINT #3,1 5830 READ #F1,1 5840 READ #F1;A$ 5850 READ #2,1 5860 IF A$[1,3]="EOT" THEN 6300 5870 FOR I=1 TO N 5880 FOR J=1 TO C[I,3] 5890 READ #2;T$,T1 5900 FOR K=1 TO T1 5910 READ #2;S$ 5920 IF A$[C[I,1],C[I,2]]S$[C[I,4]+1] THEN 6110 5940 B$="" 5950 IF C[I,1]=1 THEN 5970 5960 B$=A$[1,C[I,1]-1] 5970 B$[LEN(B$)+1]=T$ 5980 IF C[I,2]=LEN(A$) THEN 6000 5990 B$[LEN(B$)+1]=A$[C[I,2]+1] 6000 FOR K1=K+1 TO T1 6010 READ #2;S$ 6020 NEXT K1 6030 FOR K1=J+1 TO C[I,3] 6040 READ #2;T$,T1 6050 FOR K2=1 TO T1 6060 READ #2;S$ 6070 NEXT K2 6080 NEXT K1 6090 A$=B$ 6100 GOTO 6140 6110 NEXT K 6120 NEXT J 6130 B$=A$ 6140 NEXT I 6150 PRINT #3;B$, END 6160 GOTO 5840 6170 IF END #3 THEN 6230 6180 IF END #F THEN 6270 6190 READ #3,1 6200 READ #3;A$ 6210 PRINT #F;A$ 6220 GOTO 6200 6230 F1=F1+1 6240 GOTO 5810 6250 PRINT #F,1 6260 GOTO 6170 6270 F=F+1 6280 PRINT #F,1 6290 GOTO 6210 6300 PRINT #3;A$ 6310 PRINT #F1,1 6320 READ #3,1;A$ 6330 IF END #F THEN 6380 6340 PRINT #F;A$ 6350 IF A$[1,3]="EOT" THEN 6400 6360 READ #3;A$ 6370 GOTO 6340 6380 F=F+1 6390 GOTO 6340 6400 PRINT #F; END 6420 GOTO 5110 6430 PRINT "*****"B$" IS NOT DEFINED AS A VARIABLE" 6440 GOTO 5110 6450 REM ***** ROUTINE FOR DECODING VAR STRING INTO VARIABLE LABEL 6460 B1=0 6470 GOSUB 7230 6480 IF S1=1 THEN 6530 6490 E1=0 6500 IF U7=2 THEN 6560 6510 PRINT "*****',' EXPECTED AFTER "A$[P1,P4] 6520 RETURN 6530 U$=A$[P1,P4] 6540 E1=1 6550 RETURN 6560 PRINT "*****SYNTAX ERROR IN "A$ 6570 RETURN 6580 REM ***** ROUTINE FOR UNPACKING COL.NOS. FROM VAR STRING 6590 B1=0 6600 GOSUB 7230 6610 IF S1#1 THEN 6510 6620 N$=A$[P1,P4] 6630 GOSUB 7870 6640 IF E1#0 THEN 6670 6650 IF U7=2 THEN 6560 6660 RETURN 6670 U1=N1 6680 B1=0 6690 GOSUB 7230 6700 IF S1=7 OR S1=1 THEN 6740 6710 IF U7=2 THEN 6560 6720 PRINT "*****'CR' OR ',' EXPECTED AFTER "A$[P1,P4] 6730 RETURN 6740 N$=A$[P1,P4] 6750 GOSUB 7870 6760 IF E1#0 THEN 6790 6770 IF U7=2 THEN 6560 6780 RETURN 6790 U2=N1 6800 C$="" 6810 IF P2 >= A9 THEN 6830 6820 C$=A$[P2+1] 6830 RETURN 6840 REM*****RECODING SPECS PROCESSOR 6850 GOSUB 7230 6860 IF S1>0 AND S1<4 THEN 6890 6870 PRINT "*****',' OR ';' OR ')' EXPECTED AFTER "A$[P1,P4] 6880 GOTO 5110 6890 T$=A$[P1,P4] 6900 T2=LEN(T$) 6910 FOR I=1 TO T2 6920 IF T$[I,I]="-" THEN 7000 6930 NEXT I 6940 S$=T$ 6950 S$[LEN(S$)+1]=T$ 6960 IF LEN(S$)/2 <= C[N,2]-C[N,1]+1 THEN 6980 6970 GOTO 5360 6980 C[N,4]=LEN(S$)/2 6990 RETURN 7000 IF I#1 THEN 7080 7010 S$="" 7020 T$=T$[2] 7030 T1=LEN(T$) 7040 FOR I=1 TO T1 7050 S$[I,I]='7 7060 NEXT I 7070 GOTO 6950 7080 IF T2#I THEN 7160 7090 T$=T$[LEN(T$)-1] 7100 T1=LEN(T$) 7110 S$=T$ 7120 FOR I=1 TO T1 7130 S$[T1+I]="^" 7140 NEXT I 7150 GOTO 6960 7160 S$=T$[1,I-1] 7170 T$=T$[I+1] 7180 IF LEN(T$)=LEN(S$) THEN 7210 7190 PRINT "*****"T$" AND "S$" NOT OF SAME LENGTHS" 7200 GOTO 5110 7210 S$[LEN(S$)+1]=T$ 7220 GOTO 6960 7230 REM ***** SCANNER 7240 A9=LEN(A$) 7250 P2=P1=P2+1 7260 IF P2 <= A9 THEN 7300 7270 P4=P2-1 7280 S1=7 7290 RETURN 7300 GOSUB 7710 7310 IF S1=7 THEN 7270 7320 A9=LEN(A$) 7330 IF A$[P2,P2]#" " THEN 7400 7340 GOTO B1+1 OF 7370,7350,7400 7350 S1=8 7360 GOTO 7690 7370 IF P2 >= A9 THEN 7270 7380 A$=A$[P2+1] 7390 GOTO 7320 7400 IF A$[P2,P2]#"'" THEN 7570 7410 IF P2A9 THEN 7420 7490 IF A$[P2,P2]#"'" THEN 7470 7500 IF P2 >= A9 THEN 7530 7510 A$[P2]=A$[P2+1] 7520 GOTO 7320 7530 P2=P2-1 7540 A$=A$[1,P2] 7550 P4=P2 7560 GOTO 7280 7570 E$=A$[P2,P2] 7580 IF B1#2 THEN 7620 7590 IF E$#D$[2,2] THEN 7650 7600 I2=2 7610 GOTO 7680 7620 FOR I2=1 TO 5 7630 IF E$=D$[I2,I2] THEN 7680 7640 NEXT I2 7650 P2=P2+1 7660 IF P2>A9 THEN 7270 7670 GOTO 7320 7680 S1=I2 7690 P4=P2-1 7700 RETURN 7710 REM ***** ROUTINE FOR SCANNING LEADING BLANKS 7720 S1=0 7730 IF A$[P2,P2]#" " THEN 7770 7740 P1=P2=P2+1 7750 IF P2 <= A9 THEN 7730 7760 S1=7 7770 RETURN 7780 REM ***** ROUTINE TO DETERMINE CONTINUATION OF RECODE 7790 T1=P1+1 7800 IF T1>A9 THEN 7860 7810 IF A$[T1,T1]="/" THEN 7850 7820 IF A$[T1,T1]#" " THEN 7860 7830 T1=T1+1 7840 GOTO 7800 7850 S1=6 7860 RETURN 7870 REM *****SUBROUTINE TO CONVERT STRING TO AN INTEGER (0-999) 7880 E1=1 7890 T1=LEN(N$) 7900 IF T1 <= 5 THEN 7940 7910 PRINT "*****"N$" IS AN ILLEGAL INTEGER" 7920 E1=0 7930 RETURN 7940 N1=0 7950 FOR I2=T1 TO 1 STEP -1 7960 E$=N$[I2,I2] 7970 FOR J2=11 TO 20 7980 IF E$=D$[J2,J2] THEN 8010 7990 NEXT J2 8000 GOTO 7910 8010 N1=N1+(J2-11)*10^(T1-I2) 8020 NEXT I2 8030 RETURN 8040 END