1  REM  ****      HP BASIC PROGRAM LIBRARY  ****************************
2  REM 
3  REM            INMAIN:  CTC PROJECTION PROGRAMS
4  REM
5  REM            36212  REV B  PART 1 OF 10   6/73
6  REM
7  REM  ****       CONTRIBUTED PROGRAM  ********************************
8  REM
9  H$=""
10  DIM F[64],P[16]
11  DIM A$[20],C$[10],S$[20]
12  MAT F=ZER
13  K=0
20  C$="0123456789"
21  MAT  READ P
22  DATA 2.2E+06,2.2002E+06,2.20022E+06,2.2003E+06,2.20035E+06,2.2004E+06,2.2005E+06
23  DATA 3.0001E+06,3.3001E+06,3.3002E+06,3.3003E+06,3.3601E+06,3.3602E+06,4.46E+06
24  DATA 5.5E+06,5.50036E+06
100  FILES IN1
200  PRINT H$[1,2]"CREATE,MODIFY,PRINT OR DISTROY INPUT FILE (C/M/P/D)";
205  INPUT A$
210  IF A$="END" THEN 9999
215  IF A$[1,1]="C" THEN 500
220  IF A$[1,1]="M" THEN 2000
225  IF A$[1,1]="D" THEN 300
230  IF A$[1,1]="P" THEN 3000
235  GOSUB 4240
240  GOTO 200
300  PRINT '7'7'7'7'7'7'7'7'7"ARE YOU SURE YOU WANT TO CLEAR THE INPUT FILE";
305  INPUT A$
310  IF A$[1,1]#"Y" THEN 200
315  MAT F=ZER
325  FOR I=1 TO 100
330  MAT  PRINT #1;F
340  NEXT I
355  PRINT "INPUT FILE IS ALL 0'S NOW"
360  END 
500  REM
545  GOSUB 5600
550  IF B1 THEN 200
560  PRINT "BEGINNING MONTH";
565  INPUT G3
570  IF G3>0 AND G3<49 THEN 1000
575  GOSUB 4240
580  GOTO 560
1000  FOR L1=L2 TO L3
1005  GOSUB 4300
1010  FOR P=1 TO 16
1011  GOSUB 4000
1012  MAT F=ZER
1015  GOSUB 4500
1020  PRINT H$[1,2];S$;"/";
1025  Z$="####-###"
1030  X$="0"
1035  Z[1]=P1
1040  Z[2]=P2
1045  GOSUB 9000
1050  PRINT 
1055  PRINT "MONTHS (MXX)"
1060  FOR G2=G3 TO 48
1065  Z$="M##"
1070  Z[1]=G2
1075  GOSUB 9000
1080  INPUT X
1085  IF X=-99 THEN 1110
1100  F[G2]=X
1105  NEXT G2
1110  PRINT "CONSTANTS (CXX)"
1115  FOR G2=49 TO 60
1120  Z$="C##"
1125  Z[1]=G2-48
1130  GOSUB 9000
1135  INPUT X
1140  IF X=-99 THEN 1165
1145  F[G2]=X
1160  NEXT G2
1165  PRINT "ADD ENTRY TO FILE";
1170  INPUT A$
1175  IF A$[1,1]#"Y" THEN 1012
1180  GOSUB 4050
1185  NEXT P
1190  NEXT L1
1195  GOTO 200
2000  PRINT H$[1,2]"SALES TYPE";
2005  INPUT S$
2010  IF S$="END" THEN 200
2015  GOSUB 4400
2020  IF B1 THEN 2000
2025  PRINT "PRODUCT";
2030  INPUT S$
2032  IF S$="END" THEN 2000
2035  GOSUB 4700
2040  IF B1 THEN 2025
2045  GOSUB 4000
2050  PRINT "MODIFY MONTHS OR CONSTANTS (M/C)";
2055  INPUT A$
2060  IF A$[1,1]="M" THEN 2080
2065  IF A$[1,1]="C" THEN 2200
2070  GOSUB 4240
2075  GOTO 2050
2080  FOR I=1 TO 12
2085  FOR J=1 TO 4
2090  PRINT TAB(15*(J-1));
2091  Z$="M##:"
2092  X$="0"
2093  Z[1]=J+4*(I-1)
2094  GOSUB 9000
2095  PRINT F[Z[1]];
2097  NEXT J
2100  PRINT 
2102  NEXT I
2105  PRINT 
2115  PRINT "MODIFY MONTH";
2120  INPUT A$
2121  IF A$="END" THEN 2000
2122  GOSUB 4200
2123  IF B1 THEN 2115
2125  IF Z>0 AND Z<49 THEN 2140
2130  GOSUB 4240
2135  GOTO 2115
2140  PRINT "NEW VALUE";
2145  INPUT F[Z]
2150  GOSUB 4050
2155  PRINT H$[6,8];
2160  GOTO 2115
2200  FOR I=1 TO 9
2205  Z$="C##:"
2206  X$="0"
2207  Z[1]=I
2208  GOSUB 9000
2209  PRINT F[I+48]
2210  NEXT I
2211  PRINT "C10 [N0]:";F[58]
2212  PRINT "C11 [R0]:";F[59]
2215  PRINT 
2225  PRINT "MODIFY CONSTANT";
2230  INPUT A$
2235  IF A$="END" THEN 2000
2240  GOSUB 4200
2245  IF B1 THEN 2225
2250  IF Z>0 AND Z<13 THEN 2265
2255  GOSUB 4240
2260  GOTO 2225
2265  PRINT "NEW VALUE";
2270  INPUT F[Z+48]
2275  GOSUB 4050
2280  PRINT H$[6,8];
2285  GOTO 2225
3000  PRINT "ENTER CURRENT DATE";
3005  INPUT D
3010  D1=INT(D/10^4)
3015  IF D1>0 AND D1<13 THEN 3030
3020  GOSUB 4240
3025  GOTO 3000
3030  D2=INT((D-D1*10^4)/100)
3035  IF D2<1 OR D2>31 THEN 3020
3040  D3=D-D1*10^4-D2*100
3045  IF D3<72 OR D3>79 THEN 3020
3046  PRINT "BEGINNING F.Y.";
3047  INPUT F1
3048  IF F1>70 AND F1<99 THEN 3052
3049  GOSUB 4240
3050  GOTO 3046
3052  P9=66
3053  GOSUB 5600
3054  IF B1 THEN 200
3055  FOR L1=L2 TO L3
3057  GOSUB 3500
3060  FOR P=1 TO 16
3065  GOSUB 4000
3070  GOSUB 4500
3075  Z$="####-###  "
3080  Z[1]=P1
3085  Z[2]=P2
3090  X$="0"
3095  GOSUB 9000
3097  F2=F1
3100  FOR L5=1 TO 4
3105  Z$="##-## "
3110  Z[1]=F2
3115  F2=F2+1
3120  Z[2]=F2
3125  PRINT TAB(10);
3130  GOSUB 9000
3135  FOR L6=1 TO 12
3140  Z$="#### "
3145  X$=" "
3150  Z[1]=F[L6+12*(L5-1)]
3155  GOSUB 9000
3157  NEXT L6
3160  IF L5#1 THEN 3190
3165  Z$=" ###### ###### ###### .### .### ## ###### .## .## ### .###"
3170  FOR I=49 TO 59
3175  Z[I-48]=F[I]
3180  NEXT I
3185  GOSUB 9000
3190  PRINT 
3195  NEXT L5
3200  PRINT 
3205  P9=P9+5
3210  IF P9<58 THEN 3220
3215  GOSUB 3500
3220  NEXT P
3225  NEXT L1
3230  END 
3500  K=66-P9+4
3505  GOSUB 9900
3510  GOSUB 4300
3515  X=INT((134-(LEN(S$)+19))/2)
3520  PRINT TAB(X)"S A L E  T Y P E:  ";S$
3525  X$=" "
3530  Z$="##/##/##"
3535  Z[1]=D1
3540  Z[2]=D2
3545  Z[3]=D3
3550  PRINT TAB(63);
3555  GOSUB 9000
3560  K=3
3565  GOSUB 9900
3570  PRINT "PRODUCT    F.Y.  M01  M02  M03  M04  M05  M06  M07  M08  ";
3575  PRINT "M09  M10  M11  M12      C1     C2     C3   C4   C5 C6";
3580  PRINT "     C7  C8  C9 C10  C11"
3585  K=2
3590  GOSUB 9900
3595  P9=11
3597  RETURN 
4000  R=32*(L1-1)+1
4010  R1=R+2*(P-1)
4020  READ #1,R1
4025  MAT  READ #1;F
4030  RETURN 
4050  READ #1,R1
4060  MAT  PRINT #1;F
4070  RETURN 
4200  B1=Z=0
4205  S6=1
4210  IF A$[1,1]#"-" THEN 4220
4215  S6=-1
4217  A$=A$[2]
4220  FOR I1=1 TO LEN(A$)
4225  FOR I2=1 TO 10
4230  IF A$[I1,I1]=C$[I2,I2] THEN 4255
4235  NEXT I2
4240  PRINT '7'7"INVALID DATA";H$[3,5];
4245  B1=1
4250  RETURN 
4255  Z=Z*10+I2-1
4260  NEXT I1
4265  Z=Z*S6
4270  RETURN 
4300  GOTO L1 OF 4305,4315,4325,4335,4345,4355
4305  S$="END USER"
4310  RETURN 
4315  S$="OEM"
4320  RETURN 
4325  S$="INTL"
4330  RETURN 
4335  S$="LEASE CO."
4340  RETURN 
4345  S$="CTC LEASES"
4350  RETURN 
4355  S$="INSTALLMENT"
4360  RETURN 
4400  B1=0
4402  L1=1
4405  IF S$="EU" THEN 4470
4410  L1=2
4415  IF S$="OEM" THEN 4470
4420  L1=3
4425  IF S$="INTL" THEN 4470
4430  L1=4
4435  IF S$="LSE CO" THEN 4470
4440  L1=5
4445  IF S$="CTC LSE" THEN 4470
4450  L1=6
4455  IF S$="INST" THEN 4470
4460  PRINT '7'7'7"INVALID SALE TYPE";H$[3,5];
4465  B1=1
4470  RETURN 
4500  P1=INT(P[P]/1000)
4510  P2=P[P]-P1*1000
4520  RETURN 
4700  B1=0
4705  IF LEN(S$)=8 THEN 4725
4710  PRINT '7'7"INVALID PRODUCT";H$[3,5];
4715  B1=1
4720  RETURN 
4725  IF S$[5,5]#"-" THEN 4710
4730  A$=S$[1,4]
4735  GOSUB 4200
4740  IF B1 THEN 4720
4745  P1=Z
4750  A$=S$[6,8]
4755  GOSUB 4200
4760  IF B1 THEN 4720
4765  P2=Z
4770  P3=P1*1000+P2
4775  FOR P=1 TO 16
4780  IF P[P]=P3 THEN 4720
4785  NEXT P
4790  GOTO 4710
5600  B1=0
5602  PRINT "BEGINNING SALE TYPE";
5605  INPUT S$
5610  IF S$#"END" THEN 5615
5612  B1=1
5614  RETURN 
5615  GOSUB 4400
5620  IF B1 THEN 5602
5625  L2=L1
5630  PRINT "ENDING SALE TYPE";
5635  INPUT S$
5640  GOSUB 4400
5645  IF B1 THEN 5630
5650  IF L1 >= L2 THEN 5670
5655  GOSUB 4240
5660  GOTO 5630
5670  L3=L1
5680  RETURN 
9000  REM
9003  LET Z2=Z3=Z4=Z5=Z7=Z8=Z9=1
9004  DIM Y$[10],Z$[72],Z[20]
9005  LET Y$="0123456789"
9006  LET Z0=Z9-1
9007  LET Z0=Z0+1
9008  IF Z0=LEN(Z$)+1 THEN 9059
9009  IF Z$[Z0,Z0]="#" THEN 9016
9010  IF Z$[Z0,Z0+1]=".#" THEN 9016
9011  IF Z$[Z0,Z0+1]="+#" THEN 9014
9012  PRINT Z$[Z0,Z0];
9013  GOTO 9007
9014  LET Z4=0
9015  GOTO 9007
9016  LET Z=100
9017  LET Z6=Z[Z2]
9018  LET Z9=Z0-1
9019  LET Z9=Z9+1
9020  IF Z$[Z9,Z9]="." THEN 9023
9021  IF Z$[Z9,Z9]="#" THEN 9019
9022  GOTO 9027
9023  IF Z5#1 THEN 9027
9024  LET Z5=0
9025  LET Z=Z9
9026  GOTO 9019
9027  IF Z#100 THEN 9029
9028  LET Z=Z9
9029  IF Z4=1 THEN 9034
9030  IF Z6 >= 0 THEN 9033
9031  PRINT "-";
9032  GOTO 9034
9033  PRINT " ";
9034  LET Z6=ABS(Z6)+10^(Z-Z9-1)
9035  FOR Z1=Z-Z0 TO Z+1-Z9 STEP -1
9036  IF Z$[Z-Z1,Z-Z1]#"." THEN 9041
9037  PRINT ".";
9038  LET Z3=0
9039  LET Z7=2
9040  GOTO 9055
9041  LET Z8=INT(Z6/(10^(Z1+Z7-2)))
9042  IF Z6<10^(Z-Z0) THEN 9045
9043  PRINT "#";
9044  GOTO 9055
9045  LET Z6=Z6-Z8*10^(Z1+Z7-2)
9046  IF Y$[Z8+1,Z8+1]="0" THEN 9048
9047  LET Z3=0
9048  IF Z3=0 THEN 9054
9049  IF Z1#1 THEN 9052
9050  PRINT "0";
9051  GOTO 9055
9052  PRINT X$;
9053  GOTO 9055
9054  PRINT Y$[Z8+1,Z8+1];
9055  NEXT Z1
9056  LET Z3=Z4=Z5=Z7=1
9057  LET Z2=Z2+1
9058  GOTO 9006
9059  RETURN 
9900  FOR I=1 TO K
9910  PRINT "     "
9920  NEXT I
9930  RETURN 
9999  END 
