1  REM  ****  HP BASIC PROGRAM LIBRARY  *******************************
2  REM
3  REM         FSUBp: CTC MANUFACTURING PARTS CONTROL 
4  REM
5  PRINT 
6  REM
7  REM  ****  CONTRIBUTED PROGRAM  ************************************
10  DIM X$[20],A$[20],Y$[10]
20  Y$="0123456789"
30  P0=0
100  FILES FS1,FS2
150  PRINT "ENTER TODAY'S DATE (MDY)";
155  INPUT X
160  D1=INT(X/10^4)
165  IF D1>0 AND D1<13 THEN 170
166  PRINT '7'7'7'7"INVALID DATE"
167  GOTO 150
170  D2=INT((X-D1*10^4)/100)
175  IF D2<1 OR D2>31 THEN 166
180  D3=X-D1*10^4-D2*100
185  IF D3<72 OR D3>99 THEN 166
200  N=1
205  PRINT "BEGINNING SUBASSY";
210  INPUT X$
215  IF X$#"0" THEN 235
220  READ #N;P2
225  READ #N;P1
230  GOTO 1000
235  GOSUB 8100
240  IF G1 THEN 200
245  IF  END #N THEN 290
247  S1=1
250  READ #N;P2
255  IF SGN(P2)#-1 THEN 250
260  S1=2
265  READ #N;P1
270  IF Q1=P1 AND Q2=-P2 THEN 1000
275  IF Q1<P1 THEN 305
280  IF Q1>P1 OR Q2>-P2 THEN 247
285  GOTO 305
290  N=N+1
300  IF N<3 THEN 325
305  PRINT '7'7'7"SUBASSY NOT ON FILE"
310  READ #1,1
315  READ #2,1
320  GOTO 200
325  IF  END #N THEN 290
330  GOTO S1 OF 250,260
1000  IF  END #N THEN 1200
1002  P9=66
1003  GOSUB 8200
1005  PRINT TAB(16);
1010  X1=P1
1015  X2=-P2
1020  GOSUB 2100
1025  S1=1
1030  READ #N;P2
1035  IF SGN(P2)#-1 THEN 1070
1040  K=1
1045  GOSUB 9900
1050  P9=P9+1
1055  S1=2
1060  READ #N;P1
1065  GOTO 1005
1070  S1=3
1075  READ #N;P1
1080  Q=INT(P1/100)
1085  P1=P1-Q*100
1090  X1=P1
1095  X2=P2
1100  PRINT TAB(37);
1105  GOSUB 2100
1110  PRINT TAB(60);
1115  Z$="####"
1120  X$=" "
1125  Z[1]=Q
1130  GOSUB 9000
1135  PRINT 
1140  P9=P9+1
1145  IF P9<60 THEN 1025
1150  GOSUB 8200
1155  GOTO 1025
1200  N=N+1
1205  IF N>2 THEN 9999
1210  IF  END #N THEN 1200
1220  GOTO S1 OF 1030,1055,1075
2100  Z$="##-####-##"
2105  X$="0"
2110  Z[1]=X1
2115  Z[2]=INT(X2/100)
2120  Z[3]=X2-Z[2]*100
2130  GOSUB 9000
2140  RETURN 
8000  G1=Z=0
8010  FOR I1=1 TO LEN(A$)
8020  FOR I2=1 TO 10
8030  IF A$[I1,I1]=Y$[I2,I2] THEN 8070
8040  NEXT I2
8050  G1=1
8060  RETURN 
8070  Z=Z*10+I2-1
8080  NEXT I1
8090  RETURN 
8100  REM
8105  G1=0
8110  IF LEN(X$)=10 THEN 8125
8115  PRINT '7'7"INVALID DATA"
8117  G1=1
8120  RETURN 
8125  IF X$[3,3]#"-" THEN 8115
8130  IF X$[8,8]#"-" THEN 8115
8135  A$=X$[1,2]
8140  GOSUB 8000
8145  IF G1 OR Z<10 OR Z>19 THEN 8115
8150  Q1=Z
8155  A$[1,4]=X$[4,7]
8160  A$[5]=X$[9]
8165  GOSUB 8000
8170  IF G1 THEN 8115
8175  Q2=Z
8180  RETURN 
8200  K=66-P9+4
8205  GOSUB 9900
8210  Z$="DATE:  ##/##/##"
8215  X$=" "
8220  Z[1]=D1
8225  Z[2]=D2
8230  Z[3]=D3
8235  GOSUB 9000
8240  PRINT TAB(27)"M A N U F A C T U R I N G";TAB(71)"PAGE: ";
8245  Z[1]=P0=P0+1
8250  Z$="###"
8255  GOSUB 9000
8260  PRINT 
8265  PRINT TAB(23)"SUBASSEMBLIES WITH COMPONENT PARTS"
8270  K=2
8275  GOSUB 9900
8280  PRINT TAB(15)"SUBASSEMBLY";TAB(35)"COMPONENT PART";TAB(60)"USAGE"
8285  K=2
8290  GOSUB 9900
8295  P9=11
8300  RETURN 
9000  REM
9040  V=Z2=Z3=Z4=Z5=Z7=Z8=Z9=1
9050  DIM V$[72],Z$[72]
9070  Z0=Z9-1
9080  Z0=Z0+1
9090  IF Z0=LEN(Z$)+1 THEN 9650
9100  IF Z$[Z0,Z0]="#" THEN 9170
9110  IF Z$[Z0,Z0+1]=".#" THEN 9170
9120  IF Z$[Z0,Z0+1]="+#" THEN 9150
9130  V$[V,V]=Z$[Z0,Z0]
9131  V=V+1
9140  GOTO 9080
9150  Z4=0
9160  GOTO 9080
9170  Z=100
9180  Z6=Z[Z2]
9190  Z9=Z0-1
9200  Z9=Z9+1
9210  IF Z$[Z9,Z9]="." THEN 9240
9220  IF Z$[Z9,Z9]="#" THEN 9200
9230  GOTO 9280
9240  IF Z5#1 THEN 9280
9250  Z5=0
9260  Z=Z9
9270  GOTO 9200
9280  IF Z#100 THEN 9300
9290  Z=Z9
9300  IF Z4=1 THEN 9350
9310  IF Z6 >= 0 THEN 9340
9320  V$[V,V]="-"
9321  V=V+1
9330  GOTO 9350
9340  V$[V,V]=" "
9341  V=V+1
9350  IF Z=Z9 THEN 9380
9360  Z6=ABS(Z6)+5*10^(Z-Z9)
9370  GOTO 9390
9380  Z6=ABS(Z6)+.5
9390  Z7=10^(Z-Z0-1)
9400  Z4=10*Z7
9410  FOR Z1=Z-Z0 TO Z+1-Z9 STEP -1
9420  IF Z1#0 THEN 9460
9430  V$[V,V]="."
9431  V=V+1
9440  Z3=0
9450  GOTO 9610
9460  Z8=INT(Z6/Z7)
9470  IF Z6<Z4 THEN 9500
9480  V$[V,V]="#"
9481  V=V+1
9490  GOTO 9600
9500  Z6=Z6-Z8*Z7
9510  IF Z8=0 THEN 9530
9520  Z3=0
9530  IF Z3=0 THEN 9590
9540  IF Z1#1 THEN 9570
9550  V$[V,V]="0"
9551  V=V+1
9560  GOTO 9600
9570  V$[V,V]=X$
9571  V=V+1
9580  GOTO 9600
9590  V$[V,V]=Y$[Z8+1,Z8+1]
9591  V=V+1
9600  Z7=Z7/10
9610  NEXT Z1
9620  Z3=Z4=Z5=Z7=1
9630  Z2=Z2+1
9640  GOTO 9070
9650  PRINT V$;
9660  V$=""
9670  RETURN 
9900  FOR I=1 TO K
9910  PRINT 
9920  NEXT I
9930  RETURN 
9999  END 
