2  H$='29'31'13'26'30
4  Y$="0123456789"
10  DIM P[13],Q[13],R[13],L[9],M[16],F[32]
11  DIM P$[10],Q$[10],R$[10],A$[20],X$[20]
100  FILES G1,MSCR
160  READ N9
162  DATA 13
170  MAT  READ L
174  DATA 50,200,200,200,200,200,200,50,50
180  MAT  READ M
185  DATA 6,12,18,25,31,37,43,50,56,62,68,75,81,87,93,0
190  DATA "G1","G2","G3","G4","G5","G6","G7","G8","G9"
200  READ #2,1
205  PRINT H$[1,2]"CLEAR, ENTER, MODIFY OR PRINT DATA (C/E/M/P)";
210  INPUT A$
215  IF A$="END" THEN 9999
217  IF A$[1,1]="C" THEN 300
220  IF A$[1,1]="E" THEN 1000
225  IF A$[1,1]="M" THEN 1200
230  IF A$[1,1]="P" THEN 2000
235  GOSUB 9565
240  GOTO 205
300  PRINT '7'7"ARE YOU SURE YOU WANT THE SCRATCH FILE CLEARED (Y/N)";
301  INPUT A$
302  IF A$[1,1]#"Y" THEN 200
305  FOR I=1 TO 100
310  PRINT #2,I; END 
315  NEXT I
320  PRINT '7"SCRATCH FILE CLEAR"
330  GOTO 200
1000  I1=0
1005  IF  END #2 THEN 1035
1010  READ #2;X,X
1020  I1=I1+1
1030  GOTO 1010
1035  IF I1<1600 THEN 1055
1045  PRINT '7'7'7"DATA FILE HAS 1600 PTS ON IT"
1050  STOP 
1055  PRINT 
1057  PRINT "PART NO.";
1060  INPUT X$
1061  IF X$="END" THEN 200
1062  GOSUB 7110
1065  IF G1 THEN 1057
1090  PRINT "QUANTITY";
1095  INPUT A$
1100  GOSUB 8000
1105  IF  NOT G1 AND Z<10^4 THEN 1125
1110  GOSUB 9565
1120  GOTO 1090
1125  PRINT #2;Q2,(Q*10+Q1)*10^4+Z
1130  IF TYP(-2)=3 THEN 1045
1135  PRINT #2; END 
1140  GOTO 1055
1200  PRINT H$[1,2]"ENTER ITEM#";
1205  INPUT A$
1207  IF A$="END" THEN 200
1210  GOSUB 8000
1215  IF  NOT G1 AND Z <= 1600 THEN 1230
1220  GOSUB 9565
1225  GOTO 1200
1230  X1=Z/16
1240  L0=INT(X1)
1245  L1=INT((X1-L0)*100)
1250  IF L1=0 THEN 1260
1255  L0=L0+1
1260  FOR L2=1 TO 16
1265  IF L1=M[L2] THEN 1285
1270  NEXT L2
1275  PRINT '7'7"ERR1"
1280  STOP 
1285  L1=L2*2-1
1286  READ #2,L0
1287  IF  END #2 THEN 1300
1290  FOR I1=1 TO 32
1295  READ #2;F[I1]
1296  NEXT I1
1300  I1=I1-1
1301  IF L1<I1 THEN 1305
1302  PRINT '7'7"ITEM# NOT IN USE";H$[3,5];
1303  GOTO 1200
1305  Q1=INT(F[L1+1]/10^4)
1306  L2=F[L1+1]-Q1*10^4
1307  Q=INT(Q1/10)
1308  Q1=Q1-Q*10
1310  PRINT "1. PART NO = ";
1315  Q2=F[L1]
1320  GOSUB 2400
1325  PRINT 
1335  PRINT "2. QUANTITY =";L2
1340  PRINT "3. DELETE"
1345  PRINT 
1350  PRINT "MOD#";
1355  INPUT A$
1360  IF A$="END" THEN 1200
1362  GOSUB 8000
1363  IF G1 THEN 1365
1364  GOTO Z OF 1375,1450,1495
1365  GOSUB 9565
1370  GOTO 1350
1375  PRINT "NEW PART NO";
1380  GOSUB 7100
1390  IF  NOT G1 THEN 1420
1400  PRINT H$[4,4];H$[2,2];
1405  GOTO 1350
1420  F[L1]=Q2
1425  F[L1+1]=(Q*10+Q1)*10^4+L2
1430  READ #2,L0
1432  FOR I=1 TO I1
1435  PRINT #2;F[I]
1440  NEXT I
1442  PRINT H$[3,5];
1445  IF I1=32 THEN 1400
1446  PRINT #2; END 
1447  GOTO 1400
1450  PRINT "NEW QTY";
1455  INPUT A$
1460  GOSUB 8000
1465  IF  NOT G1 AND Z<10^4 THEN 1485
1470  GOSUB 9565
1475  GOTO 1450
1485  L2=Z
1490  GOTO 1420
1495  PRINT "DELETE PART NO";
1500  INPUT A$
1505  IF A$[1,1]#"Y" THEN 1400
1510  Q=Q1=Q2=L2=0
1515  GOTO 1420
2000  P4=T2=T3=0
2001  PRINT "(1) TOP OF FORM OR (2) ABDICK";
2002  INPUT P5
2003  PRINT "CURRENT DATE";
2004  INPUT X
2005  D1=INT(X/10^4)
2006  D2=INT((X-D1*10^4)/100)
2007  D3=X-D1*10^4-D2*100
2010  P9=66
2012  GOSUB 8100
2020  IF  END #2 THEN 2195
2025  READ #2;Q2,L0
2026  T1=T1+1
2027  R[2]=Q=Q1=L1=0
2028  R$=""
2029  IF Q2=0 AND L0=0 THEN 2040
2030  Q1=INT(L0/10^4)
2031  L1=L0-Q1*10^4
2032  Q=INT(Q1/10)
2033  Q1=Q1-Q*10
2035  GOSUB 6000
2040  Z$="####:  "
2041  X$=" "
2042  Z[1]=T1
2043  GOSUB 9000
2045  GOSUB 2400
2047  PRINT "  ";R$;TAB(35);
2050  Z$="#####"
2052  X$=" "
2055  Z[1]=L1
2060  GOSUB 9000
2065  PRINT TAB(49);
2070  Z[1]=R[2]
2100  Z$="$#####.##    "
2110  GOSUB 9000
2115  T0=R[2]*L1*100
2120  X=INT(T0/100)
2125  X1=T0-X*100
2127  IF X1 <= 99 THEN 2130
2128  X=X+1
2129  X1=0
2130  GOSUB 2300
2135  T2=T2+X
2140  T3=T3+X1
2145  IF T3<100 THEN 2160
2150  T3=T3-100
2155  T2=T2+1
2160  K=1
2165  GOSUB 9900
2170  P9=P9+2
2175  IF P9<60 THEN 2025
2180  GOSUB 8100
2190  GOTO 2025
2195  PRINT TAB(18);"TOTAL";
2200  X=T2
2210  X1=T3
2220  GOSUB 2300
2230  END 
2300  PRINT TAB(69);
2305  Z$="$#######."
2310  X$=" "
2315  Z[1]=X
2320  GOSUB 9000
2325  Z$="##"
2330  X$="0"
2335  Z[1]=X1
2340  GOSUB 9000
2350  RETURN 
2400  Z$="##-####-##"
2405  X$="0"
2415  Z[1]=Q*10+Q1
2420  Z[2]=INT(Q2/100)
2425  Z[3]=Q2-Z[2]*100
2430  GOSUB 9000
2440  RETURN 
6000  REM
6005  G1=0
6010  RESTORE 190
6015  FOR I=1 TO Q
6020  READ A$
6025  NEXT I
6030  IF Q#2 THEN 6055
6035  IF Q1=0 AND Q2<35000. THEN 6065
6040  A$[3]="A"
6050  GOTO 6065
6055  IF Q#4 AND Q#7 THEN 6065
6060  IF Q1 >= 2 THEN 6040
6065  ASSIGN A$,1,W5
6070  N1=0
6075  N2=L[Q]
6080  IF N2-N1<2 THEN 6165
6082  R1=N1+INT((N2-N1)/2)
6085  READ #1,R1;P$
6090  MAT  READ #1;P
6095  X=P[1]
6100  GOSUB 6400
6102  P1=X1
6103  P2=X2
6105  READ #1;Q$
6110  MAT  READ #1;Q
6115  X=Q[1]
6120  GOSUB 6400
6125  S1=X1
6130  S2=X2
6135  IF P[1]=0 THEN 6205
6140  IF P1=Q1 AND P2=Q2 THEN 6185
6145  IF P1<Q1 THEN 6155
6150  IF P1>Q1 OR P2>Q2 THEN 6205
6155  IF Q[1]=0 THEN 6165
6160  IF S1=Q1 AND S2=Q2 THEN 6195
6162  IF S1>Q1 THEN 6165
6163  IF S1<Q1 OR S2<Q2 THEN 6215
6165  PRINT '7'7'7'7'7"PART NO. NOT ON FILE";H$[3,5];
6170  G1=1
6180  RETURN 
6185  F1=1
6187  R$=P$
6188  MAT R=P
6190  RETURN 
6195  F1=2
6197  R$=Q$
6198  MAT R=Q
6200  RETURN 
6205  N2=R1
6210  GOTO 6080
6215  N1=R1
6220  GOTO 6080
6400  X1=INT(ABS(X)/10^6)
6405  X2=ABS(X)-X1*10^6
6410  IF SGN(X)>-1 THEN 6430
6420  X1=X1+8
6430  RETURN 
7000  PRINT 
7010  RETURN 
7100  INPUT X$
7110  G1=0
7115  IF LEN(X$)=10 THEN 7135
7120  GOSUB 9565
7130  RETURN 
7135  IF X$[3,3]#"-" THEN 7120
7140  IF X$[8,8]#"-" THEN 7120
7145  A$=X$[1,1]
7150  GOSUB 8000
7155  IF G1 OR Z=0 THEN 7120
7160  Q=Z
7161  A$=X$[2,2]
7162  GOSUB 8000
7163  IF G1 THEN 7120
7164  Q1=Z
7165  A$[1,4]=X$[4,7]
7170  A$[5]=X$[9]
7175  GOSUB 8000
7180  IF G1 THEN 7120
7185  Q2=Z
7190  GOSUB 6000
7195  RETURN 
8000  G1=Z=0
8010  FOR I0=1 TO LEN(A$)
8020  FOR I2=1 TO 10
8030  IF A$[I0,I0]=Y$[I2,I2] THEN 8070
8040  NEXT I2
8050  G1=1
8060  RETURN 
8070  Z=Z*10+I2-1
8080  NEXT I0
8090  RETURN 
8100  GOTO P5 OF 8105,8120
8105  PRINT '12'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18;
8110  GOTO 8130
8120  K=66-P9
8125  GOSUB 9910
8130  K=4
8135  GOSUB 9910
8140  PRINT "DATE: ";
8145  Z$="##/##/##"
8150  X$=" "
8155  Z[1]=D1
8160  Z[2]=D2
8165  Z[3]=D3
8170  GOSUB 9000
8175  PRINT TAB(25)"T R A N S F E R  O F  $ A M O U N T S";TAB(71)"PAGE: ";
8180  Z$="###"
8185  P4=P4+1
8190  Z[1]=P4
8195  GOSUB 9000
8200  GOSUB 7000
8210  PRINT TAB(40)"RAW PARTS";
8215  K=2
8220  GOSUB 9900
8225  PRINT TAB(7)"PART NO.   DESCRIPTION   QUANTITY";TAB(50)"STD COST";
8230  PRINT TAB(71)" EXT COST";
8235  K=2
8240  GOSUB 9900
8245  P9=11
8250  RETURN 
9000  REM
9005  V=Z2=Z3=Z4=Z5=Z7=Z8=Z9=1
9010  DIM V$[72],Z$[72]
9020  Z0=Z9-1
9025  Z0=Z0+1
9030  IF Z0=LEN(Z$)+1 THEN 9350
9035  IF Z$[Z0,Z0]="#" THEN 9075
9040  IF Z$[Z0,Z0+1]=".#" THEN 9075
9045  IF Z$[Z0,Z0+1]="+#" THEN 9065
9050  V$[V,V]=Z$[Z0,Z0]
9055  V=V+1
9060  GOTO 9025
9065  Z4=0
9070  GOTO 9025
9075  Z=100
9080  Z6=Z[Z2]
9085  Z9=Z0-1
9090  Z9=Z9+1
9095  IF Z$[Z9,Z9]="." THEN 9110
9100  IF Z$[Z9,Z9]="#" THEN 9090
9105  GOTO 9130
9110  IF Z5#1 THEN 9130
9115  Z5=0
9120  Z=Z9
9125  GOTO 9090
9130  IF Z#100 THEN 9140
9135  Z=Z9
9140  IF Z4=1 THEN 9175
9145  IF Z6 >= 0 THEN 9165
9150  V$[V,V]="-"
9155  V=V+1
9160  GOTO 9175
9165  V$[V,V]=" "
9170  V=V+1
9175  IF Z=Z9 THEN 9190
9180  Z6=ABS(Z6)+5*10^(Z-Z9)
9185  GOTO 9195
9190  Z6=ABS(Z6)+.5
9195  Z7=10^(Z-Z0-1)
9200  Z4=10*Z7
9205  FOR Z1=Z-Z0 TO Z+1-Z9 STEP -1
9210  IF Z1#0 THEN 9235
9215  V$[V,V]="."
9220  V=V+1
9225  Z3=0
9230  GOTO 9330
9235  Z8=INT(Z6/Z7)
9240  IF Z6<Z4 THEN 9260
9245  V$[V,V]="#"
9250  V=V+1
9255  GOTO 9325
9260  Z6=Z6-Z8*Z7
9265  IF Z8=0 THEN 9275
9270  Z3=0
9275  IF Z3=0 THEN 9315
9280  IF Z1#1 THEN 9300
9285  V$[V,V]="0"
9290  V=V+1
9295  GOTO 9325
9300  V$[V,V]=X$
9305  V=V+1
9310  GOTO 9325
9315  V$[V,V]=Y$[Z8+1,Z8+1]
9320  V=V+1
9325  Z7=Z7/10
9330  NEXT Z1
9335  Z3=Z4=Z5=Z7=1
9340  Z2=Z2+1
9345  GOTO 9020
9350  PRINT V$;
9355  V$=""
9360  RETURN 
9565  PRINT '7'7"INVALID DATA";H$[3,5];
9567  G1=1
9570  RETURN 
9900  GOSUB 7000
9910  FOR I=1 TO K
9920  PRINT 
9930  NEXT I
9940  RETURN 
9999  END 
