1  REM  ****  HP BASIC PROGRAM LIBRARY  *******************************
2  REM
3  REM         PRDCST : CTC MANUFACTURING PARTS CONTROL
4  REM
5  REM         36210 REV  B  PART 20 OF 23  2/73 
6  REM
7  REM  ****  CONTRIBUTED PROGRAM  ************************************
10  DIM P[13],U[30],W[30],Q[13],R[13],L[9],T[22,2]
11  DIM Y$[10],X$[20],D$[10],A$[20],P$[10],Q$[10],R$[10]
12  Y$="0123456789"
20  READ O,O1,O2,N9
25  DATA 21,7,9,13
34  REM
40  MAT  READ L
45  DATA 50,200,200,200,200,200,200,50,50
50  DATA "G1","G2","G3","G4","G5","G6","G7","G8","G9"
100  FILES G1,G0,FS1,FS2
105  READ #1;Q$
110  FOR I=1 TO O
120  READ #2;W[I]
130  NEXT I
140  READ #2;A1,A2,B1,B2,C1,C2,K5,K6,T1
150  PRINT "ENTER TODAY'S DATE (MDY)";
160  INPUT D
165  D1=INT(D/10^4)
167  IF D1>0 AND D1<13 THEN 175
170  PRINT '7'7"INVALID DATE"
172  GOTO 150
175  D2=INT((D-D1*10^4)/100)
177  IF D2<1 OR D2>31 THEN 170
180  D3=D-D1*10^4-D2*100
185  IF D3<72 OR D3>99 THEN 170
195  REM
197  MAT T=ZER
198  S6=S7=0
200  PRINT "COST BY PRODUCT OR SUBASSEMBLY (P/S)";
210  INPUT X$
220  IF X$[1,1]="P" THEN 1000
230  IF X$[1,1]="S" THEN 4000
240  PRINT '7'7"WHAT";
250  GOTO 210
1000  Q=1
1002  Q3=0
1003  READ A$
1004  ASSIGN A$,1,W5
1005  IF  END #1 THEN 2600
1010  READ #1;P$
1015  MAT  READ #1;P
1017  IF P[1]=0 THEN 2600
1020  REM ****BREAK UP Q INTO U****
1025  GOSUB 9700
1030  FOR I=1 TO O
1032  IF U[I]=99 THEN 1065
1035  X=(P[2]*U[I]*W[I])*100
1040  T[I,1]=T[I,1]+INT(X/100)
1045  T[I,2]=T[I,2]+(X-INT(X/100)*100)
1050  IF T[I,2]<100 THEN 1065
1055  T[I,1]=T[I,1]+1
1060  T[I,2]=T[I,2]-100
1065  NEXT I
2250  GOTO 1010
2600  IF Q3 OR (Q#2 AND Q#4 AND Q#7) THEN 2620
2605  A$[3]="A"
2610  Q3=1
2615  GOTO 1004
2620  Q=Q+1
2625  IF Q<10 THEN 1002
2660  K=4
2665  GOSUB 9900
2670  PRINT "B U I L D I N G  C O S T  B Y  P R O D U C T"
2671  PRINT TAB(10);D1;"/";D2;"/";D3
2675  K=2
2680  GOSUB 9900
2685  I=1
2690  PRINT "3300/3000";
2695  GOSUB 3000
2700  PRINT "2200-350";
2705  GOSUB 3000
2715  PRINT "3360-100";
2720  GOSUB 3000
2725  PRINT "3300-200";
2730  GOSUB 3000
2735  PRINT "2200-000";
2740  GOSUB 3000
2745  PRINT "2200-300";
2750  GOSUB 3000
2755  PRINT "2200-200";
2760  GOSUB 3000
2765  I=11
2770  PRINT "3360-200";
2775  GOSUB 3000
2780  PRINT "3300-300";
2785  GOSUB 3000
2790  PRINT "VT06";
2795  GOSUB 3000
2800  PRINT "2200-112";
2805  GOSUB 3000
2810  PRINT "2200-400";
2815  GOSUB 3000
2820  PRINT "2200-401";
2825  GOSUB 3000
2830  PRINT "2200-402";
2835  GOSUB 3000
2840  PRINT "2200-420";
2845  GOSUB 3000
2850  PRINT "2200PS";
2855  GOSUB 3000
2856  PRINT "2200-404";
2857  GOSUB 3000
2860  PRINT "TOTAL";
2865  X1=S6
2870  X2=S7
2875  GOSUB 3200
2880  END 
3000  REM
3015  X1=T[I,1]
3020  X2=T[I,2]
3025  GOSUB 3200
3030  S6=S6+X1
3035  S7=S7+X2
3040  IF S7<100 THEN 3060
3045  S6=S6+1
3050  S7=S7-100
3060  I=I+1
3065  PRINT 
3067  PRINT 
3070  RETURN 
3200  PRINT TAB(20);
3210  Z[1]=X1
3215  X$=" "
3220  Z$="$#######."
3225  GOSUB 7000
3230  Z[1]=X2
3235  X$="0"
3240  Z$="##"
3250  GOSUB 7000
3260  RETURN 
4000  K=4
4005  GOSUB 9900
4010  PRINT TAB(25)"COMPONENT PART  QTY  UNIT COST   QTY COST"
4015  PRINT 
4020  PRINT "SUB-ASSEMBLY";
4025  INPUT X$
4027  IF X$="0" THEN 9999
4030  IF LEN(X$)=10 THEN 4045
4035  PRINT '7'7"INVALID DATA"
4040  GOTO 4020
4045  IF X$[3,3]#"-" THEN 4035
4050  IF X$[8,8]#"-" THEN 4035
4055  A$=X$[1,2]
4060  GOSUB 8000
4065  IF G1 OR Z<10 OR Z>19 THEN 4035
4067  Q1=Z
4070  A$[1,4]=X$[4,7]
4075  A$[5]=X$[9]
4080  GOSUB 8000
4085  IF G1 THEN 4035
4090  Q2=Z
4095  T=0
4100  READ #3,1
4105  READ #4,1
4110  E1=3
4115  IF  END #E1 THEN 4240
4120  F1=1
4125  READ #E1;A
4130  IF SGN(A)#-1 THEN 4125
4135  F1=2
4140  READ #E1;N
4145  IF Q1=N AND Q2=-A THEN 4165
4150  IF Q1<N THEN 4242
4155  IF Q1>N OR Q2>-A THEN 4120
4160  GOTO 4242
4165  IF  END #E1 THEN 4246
4170  F1=1
4175  READ #E1;P2
4180  IF SGN(P2)=-1 THEN 4250
4185  F1=2
4190  READ #E1;P
4195  T7=INT(P/100)
4200  P1=P-T7*100
4205  P=INT(P1/10)
4210  P1=P1-P*10
4230  GOSUB 4300
4235  GOTO 4170
4240  E1=E1+1
4241  IF E1<5 THEN 4244
4242  PRINT "SUBASSEMBLY NOT ON FILE"
4243  GOTO 4015
4244  IF  END #E1 THEN 4240
4245  GOTO F1 OF 4125,4140
4246  E1=E1+1
4247  IF E1>4 THEN 4250
4248  IF  END #E1 THEN 4246
4249  GOTO F1 OF 4175,4190
4250  PRINT 
4255  PRINT "TOTAL COST OF SUB-ASSEMBLY  ";
4260  Z$="##-####-##"
4265  X$="0"
4270  Z[1]=Q1
4275  Z[2]=INT(Q2/100)
4280  Z[3]=Q2-Z[2]*100
4282  GOSUB 7000
4284  Z$="$#######.##"
4286  X$=" "
4288  Z[1]=T
4290  PRINT TAB(55);
4292  GOSUB 7000
4294  PRINT 
4296  GOTO 4015
4300  X$="0"
4305  Z$="##-####-##   "
4315  Z[1]=P*10+P1
4320  Z[2]=INT(P2/100)
4325  Z[3]=P2-Z[2]*100
4330  PRINT TAB(28);
4335  GOSUB 7000
4337  IF G1 THEN 4390
4338  T=T+R[2]*T7
4340  Z$="###  "
4342  X$=" "
4345  Z[1]=T7
4350  GOSUB 7000
4355  Z$="$#####.##  "
4360  Z[1]=R[2]
4365  GOSUB 7000
4370  Z[1]=R[2]*T7
4375  GOSUB 7000
4380  PRINT 
4390  RETURN 
6000  REM
6005  G1=0
6010  RESTORE 50
6015  FOR I=1 TO P
6020  READ A$
6025  NEXT I
6030  IF P#2 THEN 6055
6035  IF P1=0 AND P2<35000. THEN 6065
6040  A$[3]="A"
6050  GOTO 6065
6055  IF P#4 AND P#7 THEN 6065
6060  IF P1 >= 2 THEN 6040
6065  ASSIGN A$,1,W5
6070  N1=0
6075  N2=L[P]
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  U1=X1
6103  U2=X2
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 U1=P1 AND U2=P2 THEN 6185
6145  IF U1<P1 THEN 6155
6150  IF U1>P1 OR U2>P2 THEN 6205
6155  IF Q[1]=0 THEN 6165
6160  IF S1=P1 AND S2=P2 THEN 6195
6162  IF S1>P1 THEN 6165
6163  IF S1<P1 OR S2<P2 THEN 6215
6165  PRINT '7'7"PART NO NOT ON FILE"
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=1
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  REM
7005  V=Z2=Z3=Z4=Z5=Z7=Z8=Z9=1
7010  DIM V$[72],Z$[72]
7020  Z0=Z9-1
7025  Z0=Z0+1
7030  IF Z0=LEN(Z$)+1 THEN 7350
7035  IF Z$[Z0,Z0]="#" THEN 7075
7040  IF Z$[Z0,Z0+1]=".#" THEN 7075
7045  IF Z$[Z0,Z0+1]="+#" THEN 7065
7050  V$[V,V]=Z$[Z0,Z0]
7055  V=V+1
7060  GOTO 7025
7065  Z4=0
7070  GOTO 7025
7075  Z=100
7080  Z6=Z[Z2]
7085  Z9=Z0-1
7090  Z9=Z9+1
7095  IF Z$[Z9,Z9]="." THEN 7110
7100  IF Z$[Z9,Z9]="#" THEN 7090
7105  GOTO 7130
7110  IF Z5#1 THEN 7130
7115  Z5=0
7120  Z=Z9
7125  GOTO 7090
7130  IF Z#100 THEN 7140
7135  Z=Z9
7140  IF Z4=1 THEN 7175
7145  IF Z6 >= 0 THEN 7165
7150  V$[V,V]="-"
7155  V=V+1
7160  GOTO 7175
7165  V$[V,V]=" "
7170  V=V+1
7175  IF Z=Z9 THEN 7190
7180  Z6=ABS(Z6)+5*10^(Z-Z9)
7185  GOTO 7195
7190  Z6=ABS(Z6)+.5
7195  Z7=10^(Z-Z0-1)
7200  Z4=10*Z7
7205  FOR Z1=Z-Z0 TO Z+1-Z9 STEP -1
7210  IF Z1#0 THEN 7235
7215  V$[V,V]="."
7220  V=V+1
7225  Z3=0
7230  GOTO 7330
7235  Z8=INT(Z6/Z7)
7240  IF Z6<Z4 THEN 7260
7245  V$[V,V]="#"
7250  V=V+1
7255  GOTO 7325
7260  Z6=Z6-Z8*Z7
7265  IF Z8=0 THEN 7275
7270  Z3=0
7275  IF Z3=0 THEN 7315
7280  IF Z1#1 THEN 7300
7285  V$[V,V]="0"
7290  V=V+1
7295  GOTO 7325
7300  V$[V,V]=X$
7305  V=V+1
7310  GOTO 7325
7315  V$[V,V]=Y$[Z8+1,Z8+1]
7320  V=V+1
7325  Z7=Z7/10
7330  NEXT Z1
7335  Z3=Z4=Z5=Z7=1
7340  Z2=Z2+1
7345  GOTO 7020
7350  PRINT V$;
7355  V$=""
7360  RETURN 
8000  G1=Z=0
8010  FOR I1=1 TO LEN(A$)
8020  FOR I2=1 TO 10
8025  IF A$[I1,I1]=Y$[I2,I2] THEN 8070
8030  NEXT I2
8040  G1=1
8050  RETURN 
8070  Z=Z*10+I2-1
8080  NEXT I1
8090  RETURN 
9700  REM ****BREAD UP Q INTO U****
9710  J=1
9720  FOR I=5 TO 9
9730  U[J]=INT(P[I]/1000)
9740  U[J+1]=P[I]-U[J]*1000
9750  J=J+2
9760  NEXT I
9765  FOR I=10 TO N9
9770  U[J]=INT(P[I]/10^4)
9772  U[J+1]=INT((P[I]-U[J]*10^4)/100)
9774  U[J+2]=P[I]-U[J]*10^4-U[J+1]*100
9776  J=J+3
9778  NEXT I
9780  RETURN 
9900  REM ****SKP K LINES ON PRINTED OUTPUT****
9910  FOR I=1 TO K
9920  PRINT 
9930  NEXT I
9940  RETURN 
9950  REM ****SKIP K SPACES ON A LINE OF PRINTED OUTPUT****
9960  FOR I=1 TO K
9970  PRINT " ";
9980  NEXT I
9990  RETURN 
9999  END 
