1  REM  ****  HP BASIC PROGRAM LIBRARY  *******************************
2  REM
3  REM         OBSPRT : CTC MANUFACTURING PARTS cONTROL
4  REM
5  REM         36210 REV  B  PART 12 OF 23   2/73 
6  REM
7  REM  ****  CONTRIBUTED PROGRAM  ************************************
10  REM *MANUFACTURING--PRINTS OBSOLETES*
11  DIM P$[10],P[13],Z$[20],X$[1],A$[10]
50  DATA "G1","G2","G3","G4","G5","G6","G7","G8","G9"
100  FILES G1
150  P9=13
155  T9=0
160  PRINT '29'31"ENTER TODAY'S DATE (MDY)";
165  INPUT X
170  D1=INT(X/10^4)
175  IF D1>0 AND D1<13 THEN 190
180  PRINT '7'7"INVALID DATE"
185  GOTO 160
190  D2=INT((X-D1*10^4)/100)
195  IF D2<1 OR D2>31 THEN 180
200  D3=X-D1*10^4-D2*100
205  IF D3<72 OR D3>99 THEN 180
210  K9=66
215  P0=0
220  GOSUB 8000
300  Q=1
305  Q3=0
310  READ A$
320  ASSIGN A$,1,W5
325  IF  END #1 THEN 2000
725  IF Z3=0 THEN 7315
1000  REM
1005  READ #1;P$
1010  MAT  READ #1;P
1015  IF P[1]=0 THEN 2000
1020  GOSUB 3000
1040  IF F9 THEN 1005
1050  REM
1065  Q1=INT(ABS(P[1])/10^6)
1067  Q2=ABS(P[1])-Q1*10^6
1070  IF SGN(P[1])>-1 THEN 1080
1075  Q1=Q1+8
1080  Z[1]=Q*10+Q1
1090  Z[2]=INT(Q2/100)
1100  Z[3]=Q2-Z[2]*100
1110  X$="0"
1120  Z$="##-####-##"
1125  PRINT TAB(35);
1130  GOSUB 7000
1200  K=8
1210  GOSUB 9950
1220  PRINT P$;
1230  K=21-LEN(P$)
1240  GOSUB 9950
1260  Z$="$#####.##"
1270  X$=" "
1280  Z[1]=P[2]
1290  GOSUB 7000
1300  K=7
1310  GOSUB 9950
1320  Z$="#######"
1330  Z[1]=P[4]
1340  GOSUB 7000
1341  K=5
1342  GOSUB 9950
1343  Z[1]=P[2]*P[4]
1344  T9=T9+Z[1]
1345  Z$="#####.##"
1346  GOSUB 7000
1355  PRINT 
1360  PRINT 
1370  K9=K9+2
1380  IF K9<60 THEN 1005
1390  GOSUB 8000
1400  GOTO 1005
2000  IF Q3 OR (Q#2 AND Q#4 AND Q#7) THEN 2004
2001  A$[3]="A"
2002  Q3=1
2003  GOTO 320
2004  Q=Q+1
2005  Q3=0
2006  IF Q<10 THEN 310
2011  PRINT 
2013  PRINT TAB(71)"";TAB(28);
2015  Z$="$#######.##"
2016  Z[1]=T9
2017  GOSUB 7000
2020  END 
3000  REM
3030  FOR I=5 TO P9-1
3040  IF P[I]#0 THEN 3080
3050  NEXT I
3055  IF INT(P[P9]/100)#0 THEN 3080
3060  F9=0
3070  RETURN 
3080  F9=1
3090  RETURN 
7000  REM
7005  V=Z2=Z3=Z4=Z5=Z7=Z8=Z9=1
7010  DIM V$[72],Y$[10]
7015  Y$="0123456789"
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  K=66-K9+4
8001  GOSUB 9900
8002  Z$="##/##/##"
8003  X$=" "
8004  Z[1]=D1
8005  Z[2]=D2
8006  Z[3]=D3
8007  PRINT "DATE: ";
8008  GOSUB 7000
8009  PRINT TAB(42)"C T C  O B S O L E T E  P A R T S";"";TAB(26)"PAGE: ";
8015  Z$="###"
8020  Z[1]=P0=P0+1
8025  GOSUB 7000
8030  K=3
8035  GOSUB 9900
8040  PRINT TAB(35);
8050  PRINT "PART NUMBER     PART DESCRIPTION     ";
8055  PRINT "STANDARD COST     ON HAND  CST ON HAND"
8060  K=2
8070  GOSUB 9900
8080  K9=10
8095  RETURN 
9900  REM***PRINT K BLANK LINES****
9910  FOR I=1 TO K
9920  PRINT 
9930  NEXT I
9940  RETURN 
9950  REM ****PRINT K SPACES****
9960  FOR I=1 TO K
9970  PRINT " ";
9980  NEXT I
9990  RETURN 
9999  END 
