1  REM  ****  HP BASIC PROGRAM LIBRARY  *******************************
2  REM
3  REM         DELAd1: CTC MANUFACTURING PARTS CONTROL 
4  REM
5  REM         36210 REV  B  PART 5 OF 23  2/73 
6  REM
7  REM  ****  CONTRIBUTED PROGRAM  ************************************
10  H$='29'31'31'31'31
11  REM *MANUFACTURING--ADD,DELETE, OR CHANGE PT NO. ON MASTER FILE*
12  DIM P[13],R[13],S[30]
13  DIM A$[20],B$[20],C$[10],H$[5],P$[10],R$[10],T$[20],X$[20]
20  N9=13
50  DATA "G1","G2","G3","G4","G5","G6","G7","G8","G9"
100  FILES G1,INVSC1,TRANSF
110  GOSUB 9400
120  Z0=0
130  C$="0123456789"
200  PRINT H$"ENTER TODAY'S DATE (MDY)";
210  INPUT A$
220  GOSUB 9500
230  IF G1 THEN 200
300  PRINT H$"ENTER ONE: ADD, DELETE, OR CHANGE PT NO";
310  INPUT T$[1,2]
315  C1=0
320  IF T$[1,2]#"AD" THEN 350
330  GOSUB 4000
340  GOTO 300
350  IF T$[1,2]#"DE" THEN 380
360  GOSUB 3000
370  GOTO 300
380  IF T$[1,2]#"CH" THEN 410
385  C1=1
390  GOSUB 3500
400  GOTO 300
410  IF T$[1,1]="0" THEN 9999
440  GOSUB 9565
450  GOTO 300
900  REM****ROUTINE TO READ SCRTCH ONTO FILE N****
950  G1=1
3000  REM ****ROUTINE TO DELETE A PART NUMBER ****
3010  T=T1=0
3020  PRINT H$"DELETE PART NO";
3030  INPUT X$
3040  IF X$="0" THEN 300
3045  C1=0
3050  GOSUB 3800
3060  IF G1 THEN 3020
3160  IF  END #1 THEN 3400
3165  PRINT "W A I T !"
3167  GOSUB 5000
3170  READ #1;P$
3175  MAT  READ #1;P
3180  IF P[1]=0 THEN 3400
3185  GOSUB 3950
3205  IF P1=Q1 AND P2=Q2 THEN 3280
3210  IF Q1<P1 THEN 3400
3215  IF Q1>P1 THEN 3225
3220  IF Q2<P2 THEN 3400
3225  PRINT #2;P$[1,10]
3230  MAT  PRINT #2;P
3235  GOTO 3170
3280  R$=P$
3285  MAT R=P
3290  IF  END #1 THEN 3370
3295  READ #1;P$
3300  MAT  READ #1;P
3305  PRINT #2;P$[1,10]
3310  MAT  PRINT #2;P
3315  GOTO 3295
3370  PRINT #2;"          "
3372  MAT P=ZER
3374  MAT  PRINT #2;P
3375  MAT P=ZER
3378  G1=0
3379  GOSUB 9800
3380  IF C1 THEN 3385
3382  A$=""
3383  GOSUB 9200
3385  RETURN 
3400  PRINT '7'7'7'7"PART NO. NOT ON FILE"
3405  G1=1
3410  RETURN 
3500  REM****CHANGE PT NO.****
3520  PRINT H$"PART NO. TO BE CHANGED";
3530  INPUT X$
3540  IF X$="0" THEN 300
3545  C1=1
3550  GOSUB 3050
3560  IF G1 THEN 3520
3565  T=Q*10+Q1
3567  T1=Q2
3570  PRINT "NEW PART NO: ";
3580  INPUT X$
3590  GOSUB 3800
3595  IF G1 THEN 3570
3600  GOSUB 3700
3650  GOSUB 4469
3655  IF G1 THEN 3570
3690  A$=""
3692  GOSUB 9200
3695  RETURN 
3700  IF Q1<8 OR (Q1=8 AND Q2=0) THEN 3720
3710  R[1]=-((Q1-8)*10^6+Q2)
3715  RETURN 
3720  R[1]=Q1*10^6+Q2
3730  RETURN 
3800  IF LEN(X$)=10 THEN 3816
3805  GOSUB 9565
3810  G1=1
3815  RETURN 
3816  IF X$[3,3]#"-" THEN 3805
3817  IF X$[8,8]#"-" THEN 3805
3820  A$=X$[1,1]
3825  GOSUB 8000
3830  IF G1 OR Z=0 THEN 3805
3835  Q=Z
3840  A$=X$[2,2]
3845  GOSUB 8000
3850  IF G1 THEN 3805
3855  Q1=Z
3860  A$[1,4]=X$[4,7]
3865  A$[5]=X$[9]
3870  GOSUB 8000
3875  IF G1 THEN 3805
3880  Q2=Z
3885  RESTORE 50
3890  FOR I=1 TO Q
3895  READ A$
3900  NEXT I
3905  IF Q#2 THEN 3925
3910  IF Q1=0 AND Q2<35000. THEN 3935
3915  A$[3]="A"
3925  IF Q#4 AND Q#7 THEN 3935
3930  IF Q1 >= 2 THEN 3915
3935  ASSIGN A$,1,W5
3940  IF Q#1 AND Q#8 AND Q#9 THEN 3945
3941  ASSIGN "INVSC3",2,W5
3942  V7=50
3943  RETURN 
3945  ASSIGN "INVSC1",2,W5
3946  V7=200
3947  RETURN 
3950  P1=INT(ABS(P[1])/10^6)
3955  P2=ABS(P[1])-P1*10^6
3960  IF SGN(P[1])>-1 THEN 3970
3965  P1=P1+8
3970  RETURN 
4000  REM****ROUTINE TO ADD A PART NO. TO THE FILE****
4010  T=T1=0
4015  PRINT H$"ADD PART NO";
4017  MAT R=ZER
4018  MAT S=ZER
4020  INPUT X$
4025  IF X$="0" THEN 300
4027  C1=0
4030  GOSUB 3800
4035  IF G1 THEN 4015
4040  GOSUB 3700
4090  PRINT "PART DESCRIPTION: ";
4095  INPUT X$
4100  IF LEN(X$)<11 THEN 4115
4105  GOSUB 9565
4110  GOTO 4090
4115  R$=X$
4120  PRINT "STANDARD COST";
4122  INPUT X$
4124  L=LEN(X$)
4125  IF L>3 AND L<9 THEN 4130
4126  GOSUB 9565
4128  GOTO 4120
4130  IF X$[L-2,L-2]#"." THEN 4126
4132  A$=X$[1,L-3]
4134  GOSUB 8000
4136  IF G1 THEN 4126
4138  X=Z
4140  A$=X$[L-1]
4142  GOSUB 8000
4144  IF G1 THEN 4126
4146  R[2]=X+Z*.01
4195  X$="ON ORDER: "
4200  FOR I=3 TO 4
4205  PRINT X$;
4210  INPUT A$
4215  GOSUB 8000
4220  IF  NOT G1 THEN 4235
4225  GOSUB 9565
4230  GOTO 4205
4235  R[I]=Z
4240  X$="ON HAND: "
4245  NEXT I
4250  PRINT "LEAD TIME: ";
4255  INPUT A$
4260  GOSUB 8000
4265  IF  NOT G1 AND Z<100 THEN 4280
4270  GOSUB 9565
4275  GOTO 4250
4280  S[22]=Z
4285  PRINT 
4290  PRINT "USAGE"
4295  DATA "3300/3000","2200-350","3360-100","3300-200","2200-000"
4296  DATA "2200-300","2200-200","","",""
4297  DATA "3360-200","3300-300","VT06","2200-112","2200-400","2200-401"
4298  DATA "2200-402","2200-420","2200PS","2200-404",""
4300  RESTORE 4295
4310  FOR I=1 TO 21
4320  READ B$
4330  IF B$="" THEN 4431
4400  PRINT B$;
4405  INPUT A$
4410  GOSUB 8000
4412  IF G1 THEN 4420
4415  IF I>10 THEN 4425
4417  IF Z<1000 THEN 4430
4420  GOSUB 9565
4422  GOTO 4300
4425  IF Z>99 THEN 4420
4430  S[I]=Z
4431  NEXT I
4432  J=1
4433  FOR I=5 TO 9
4434  R[I]=S[J]*1000+S[J+1]
4435  J=J+2
4436  NEXT I
4437  FOR I=10 TO N9
4438  R[I]=S[J]*10^4+S[J+1]*100+S[J+2]
4439  J=J+3
4440  NEXT I
4465  PRINT 
4466  PRINT "IS THE ABOVE ALL RIGHT";
4467  INPUT X$
4468  IF X$[1,1]="N" THEN 4015
4469  PRINT "W A I T !"
4470  GOSUB 5000
4475  IF  END #1 THEN 4680
4480  IF  END #2 THEN 4680
4485  READ #1;P$
4490  MAT  READ #1;P
4495  IF P[1]=0 THEN 4520
4500  GOSUB 3950
4505  IF P1=Q1 AND P2=Q2 THEN 4670
4510  IF Q1<P1 THEN 4520
4515  IF Q1>P1 OR Q2>P2 THEN 4540
4520  PRINT #2;R$[1,10]
4525  MAT  PRINT #2;R
4530  GOTO 4560
4540  PRINT #2;P$[1,10]
4545  MAT  PRINT #2;P
4550  GOTO 4485
4560  IF  END #1 THEN 4697
4562  IF  END #2 THEN 4574
4564  PRINT #2;P$[1,10]
4566  MAT  PRINT #2;P
4568  READ #1;P$
4570  MAT  READ #1;P
4572  GOTO 4564
4574  IF P[1]#0 THEN 4680
4590  GOSUB 9800
4600  G1=0
4605  IF C1 THEN 4620
4610  A$=""
4615  GOSUB 9200
4620  RETURN 
4670  PRINT '7'7'7'7"PART# ALREADY ON FILE"
4672  G1=1
4675  RETURN 
4680  PRINT '7'7"FILE";Q;"FULL"
4685  GOTO 4672
4697  PRINT '7'7"ERR"
4698  STOP 
5000  FOR I=1 TO V7
5010  PRINT #2,I; END 
5020  NEXT I
5030  READ #2,1
5040  RETURN 
8000  Z=G1=0
8010  FOR I1=1 TO LEN(A$)
8020  FOR I2=1 TO 10
8030  IF A$[I1,I1]=C$[I2,I2] THEN 8070
8040  NEXT I2
8050  G1=1
8060  RETURN 
8070  Z=Z*10+I2-1
8080  NEXT I1
8090  RETURN 
9200  REM *PRINT ON T-FILE*
9210  IF  END #3 THEN 9310
9220  PRINT #3;Q*10+Q1,Q2,R$,T$[1,2],Z0,T,T1,A$,D, END 
9230  RETURN 
9240  L=TYP(3)
9310  PRINT '7'7'7"TRANSACTION FILE FULL--CALL OPERATOR"
9320  PRINT "LAST TRANSACTION NOT RECORDED ON TRANSACTION FILE"
9330  STOP 
9400  REM *READ T-FILE TO END*
9420  L=TYP(3)
9425  GOTO L OF 9430,9435,9440
9430  READ #3;X
9432  GOTO 9420
9435  READ #3;T$
9436  GOTO 9420
9440  RETURN 
9500  REM****CHECK DATE****
9505  IF LEN(A$)<5 THEN 9565
9510  IF LEN(A$)>6 THEN 9565
9515  GOSUB 8000
9520  IF G1 THEN 9565
9525  M=INT(Z/10^4)
9527  IF M<1 OR M>12 THEN 9565
9530  D=INT((Z-M*10^4)/100)
9532  IF D<1 OR D>31 THEN 9565
9535  Y=Z-M*10^4-D*100
9550  IF Y<72 THEN 9565
9555  G1=0
9557  D=M*10^4+D*100+Y
9560  RETURN 
9565  PRINT '7'7'7'7'7'7"DATA OUT OF BOUNDS"'7'7
9566  PRINT '26'26'31;
9580  RETURN 
9800  REM****ROUTINE TO READ SCRTCH ONTO FILE N****
9805  READ #1,1
9810  READ #2,1
9815  IF  END #2 THEN 9850
9820  READ #2;P$
9825  MAT  READ #2;P
9830  PRINT #1;P$[1,10]
9835  MAT  PRINT #1;P
9840  GOTO 9820
9850  RETURN 
9999  END 
