Shareware Overload/ShartewareOverload.cdr/database/steel14.zip/CINPUT.BAS

BASIC Source File | 1980-01-01 | 27KB | 844 lines

4 DEFINT A-W,Y-Z
5 DIM F$(17),FLDN$(17,30),FTY(17,30),FL(17,30),IOPT(30)
6 DIM PROMPT$(30),IFN(30),IFLD(30),IRNFLD(30),NOS(30),ADDFLD(30,6)
7 DIM SUBX(30),SUBY(30),MULX(30),MULY(30),TBLOPT(30),TN(30)
8 DIM TBLFLD(30),XKEY(30),YKEY(30),CMOPT(30),MAXMIN(30,6)
9 DIM KC(30),CFLD(30)
13 DIM L(17),NREC(17)
16 DIM KY(17,30),KEYLIST(17,30)
21 DIM TX(10,10)
35 DIM K$(80)
50 DIM X(6,30)
70 CH = 29
75 PRINT "MEMORY FREE ",FRE(0)
80 GOSUB 52000
100 GOSUB 50000
200 GOTO 10000
500 REM ******* CLS
510 CLS
520 RETURN
10000 REM ********  CUSTOM INPUT PROGRAM  *********
10120 GOSUB 500
10130 HLD = 0
10140 PRINT "********  CUSTOM INPUT PROGRAM INITIAL MENU  *********"
10145 PRINT ""
10150 PRINT "       0 - EXIT THE PROGRAM "
10155 PRINT ""
10160 PRINT "       1 - ENTER A NEW INPUT DESCRIPTION "
10165 PRINT ""
10180 PRINT "       2 - READ CUSTOM INPUT DESCRIPTION"
10185 PRINT ""
10200 PRINT "       3 - PRINT CUSTOM INPUT DESCRIPTION ON PAPER  "
10210 PRINT ""
10220 PRINT "*********  ENTER THE NUMBER THEN PRESS RETURN  ********"
10240 GOSUB 60000
10242 IF DT# <0 OR DT#> 3  GOTO 10240
10250 T = DT#
10255 IF T = 0 GOTO 51000
10260 ON T GOTO 10280,10360,10460
10280 GOSUB 10540
10300 GOSUB 10780
10320 GOSUB 14500
10340 GOTO 10120
10360 REM *****
10380 GOSUB 10540
10400 GOSUB 15600
10420 GOSUB 16420
10440 GOTO 10120
10460 GOSUB 10540
10480 GOSUB 15600
10500 GOSUB 17760
10520 GOTO 10120
10540 GOSUB 500
10560 PRINT "**********  WHICH FILE DO YOU WANT  ************"
10580 PRINT ""
10600 FOR A = 1 TO MAXF
10620 PRINT A;" - "; F$(A)
10640 NEXT A
10660 PRINT ""
10680 PRINT "********  ENTER THE NUMBER THEN RETURN  ********"
10690 MAX = 2
10700 GOSUB 62030
10710 AH$ = A$
10720 A = VAL(A$)
10730 IF A = 0 THEN A = 1
10735 IF A = 1 THEN AH$ = "1"
10740 IF A<1 OR A> MAXF GOTO 10700
10760 RETURN
10780 FOR N = 1 TO NREC(A)
10800 GOSUB 500
10820 GOSUB 10900
10840 GOSUB 11380
10860 NEXT N
10880 RETURN
10900 GOSUB 500
10920 PRINT "FIELD # ";N;" ";FLDN$(A,N)
10940 IF FTY(A,N) = 1 THEN PRINT "  STRING WITH MAXIMUM LENGTH ";FL(A,N)
10960 IF FTY(A,N) = 2 THEN PRINT "  INTEGER"
10980 IF FTY(A,N) = 3 THEN PRINT "  SINGLE PRECISION "
11000 IF FTY(A,N) = 4 THEN PRINT "  DOUBLE PRECISION "
11020 IF FTY(A,N) = 5 THEN PRINT "  DOLLARS AND CENTS AMOUNT"
11040 PRINT "---------------------------------------------------------"
11060 PRINT "******  WHAT TYPE OF INPUT DO YOU WANT FOR THIS FIELD  ******"
11080 PRINT " 1 - OPERATOR ENTRY "
11100 PRINT " 2 - GET FROM ANOTHER FILE"
11120 PRINT " 3 - ADD SEVERAL PREVIOUS FIELDS     ****  NUMBERS ONLY  ****"
11140 PRINT " 4 - SUBTRACT TWO PREVIOUS FIELDS          ''  ''  ''  ''    "
11160 PRINT " 5 - MULTIPLY TWO PREVIOUS FIELDS"
11180 PRINT " 6 - COMPUTE USING TAX TABLE "
11200 PRINT " 7 - CONSTANT"
11220 PRINT " 8 - MAXIMUM OF PREVIOUS FIELDS"
11240 PRINT " 9 - MINIMUM OF PREVIOUS FIELDS"
11260 PRINT "10 - MULTIPLY BY A CONSTANT "
11280 PRINT "11 - ADD A CONSTANT"
11300 PRINT "12 - SUBTRACT A CONSTANT FROM A PREVIOUS FIELD"
11310 PRINT "13 - DIVIDE PREVIOUS FIELDS "
11320 PRINT "**********  ENTER THE NUMBER THEN PRESS RETURN  *************"
11340 GOSUB 60000
11342 IF DT# <1 GOTO 11340
11344 IF FTY(A,N) = 1 AND DT# > 2 GOTO 11340
11350 IOPT(N) = DT#
11360 ON IOPT(N) GOTO 11560,11640,12080,12320,12500,12680,14300,13820,14060,14300,14300,14300,12320
11370 RETURN
11380 PRINT "**********  IS THE DATA YOU JUST ENTERED CORRECT  ***********"
11400 PRINT "                1 - CORRECT"
11420 PRINT "                2 - NOT CORRECT"
11440 PRINT "************  ENTER THE NUMBER THEN PRESS RETURN  ***********"
11460 GOSUB 60000
11462 IF DT# <1 OR DT#> 2 GOTO 11460
11470 D = DT#
11480 IF D = 2 GOTO 10900
11500 RETURN
11520 GOTO 11380
11540 GOTO 10320
11560 REM ***** OPERATOR ENTRY *****
11580 PRINT "********************  OPERATOR ENTRY  ******************"
11590 PRINT "The prompt will be displayed when the input is requested"
11600 PRINT "*********  ENTER THE PROMPT THEN PRESS RETURN  *********"
11605 MAX = 75
11610 GOSUB 62030
11615 PROMPT$(N) = A$
11620 RETURN
11640 REM ******  GET FROM ANOTHER FILE  ******
11660 PRINT "***************  GET FROM ANOTHER FILE  ***************"
11680 FOR F = 1 TO MAXF
11700 PRINT F;" - ";F$(F)
11720 NEXT F
11740 PRINT "******  WHICH FILE DO YOU WANT TO GET ENTRY FROM  ******"
11750 PRINT "Must be the same file for all fields "
11760 PRINT "*********  ENTER THE NUMBER THEN PRESS RETURN  *********"
11780 GOSUB 60000
11782 IF DT# <1 OR DT#> MAXF GOTO 11780
11784 IF HLD > 0 AND DT# >< HLD GOTO 11780
11785 IFN(N) = DT#
11787 HLD = DT#
11800 B = IFN(N)
11820 FOR T = 1 TO NREC(B)
11840 PRINT T;" - ";FLDN$(B,T)
11860 NEXT T
11880 PRINT "******  WHICH FIELD DO YOU WANT TO GET ENTRY FROM  ******"
11900 PRINT "*********  ENTER THE NUMBER THEN PRESS RETURN  **********"
11920 GOSUB 60000
11922 IF DT# <1 OR DT#> NREC(B)  GOTO 11920
11930 IFLD(N) = DT#
11940 FOR T = 1 TO NREC(A)
11960 PRINT T;" - ";FLDN$(A,T)
11980 NEXT T
12000 PRINT "**********  RECORD NUMBER EQUALS WHICH FIELD  ***********"
12020 PRINT "*******  ENTER THE FIELD NUMBER THEN PRESS RETURN  ******"
12040 GOSUB 60000
12042 IF DT# <1 OR DT#> NREC(B) GOTO 12040
12050 IRNFLD(N) = DT#
12060 RETURN
12080 REM ***** ADD PREVIOUS FIELDS *****
12090 X(5,N) = DT#
12100 PRINT "*************  ADD PREVIOUS FIELDS  ************"
12120 PRINT "*****  HOW MANY FIELDS DO YOU WANT TO ADD  *****"
12140 PRINT "*****  ENTER THE NUMBER THEN PRESS RETURN  *****"
12145 GOSUB 60000
12147 IF DT# <1 OR DT#> NREC(A) GOTO 12145
12150 NOS(N) = DT#
12160 FOR T = 1 TO NREC(A)
12180 PRINT T;" - ";FLDN$(A,T)
12200 NEXT T
12220 FOR J = 1 TO NOS(N)
12240 PRINT "*****  ENTER THE ";J;"th FIELD TO BE ADDED  *****"
12260 GOSUB 60000
12262 IF DT# <1 OR DT#> NREC(A)  GOTO 12260
12264 IF FTY(A,DT#) = 1 GOTO 12260
12270 ADDFLD(N,J) = DT#
12280 NEXT J
12300 RETURN
12320 REM ***** SUBTRACT FIELDS *****
12340 IF IOPT(N) = 4 THEN PRINT "********  SUBTRACT FIELD X  - FIELD  Y  *****"
12350 IF IOPT(N) = 13 THEN PRINT "*******  DIVIDE FIELD X BY FIELD Y  ********"
12360 FOR T = 1 TO NREC(A)
12380 PRINT T;" - ";FLDN$(A,T)
12400 NEXT T
12440 PRINT "*****  ENTER FIELD X THEN PRESS RETURN  *****"
12445 GOSUB 60000
12447 IF DT# <1 OR DT#> NREC(A) GOTO 12445
12448 IF FTY(A,DT#) = 1 GOTO 12445
12450 SUBX(N) = DT#
12460 PRINT "*****  ENTER FIELD Y THEN PRESS RETURN  *****"
12462 GOSUB 60000
12464 IF DT# <1 OR DT#> NREC(A) GOTO 12462
12465 SUBY(N) = DT#
12467 IF FTY(A,DT#) = 1 GOTO 12462
12480 RETURN
12500 REM ***** MULTIPY FIELDS *****
12520 PRINT "************  MULTIPLY FIELDS  *************"
12540 FOR T = 1 TO NREC(A)
12560 PRINT T;" - ";FLDN$(A,T)
12580 NEXT T
12600 PRINT "**********  FIELD X TIMES FIELD Y  **********"
12620 PRINT "*****  ENTER FIELD X THEN PRESS RETURN  *****"
12625 GOSUB 60000
12627 IF DT# <1 OR DT#> NREC(A)  GOTO 12625
12628 IF FTY(A,DT#) = 1 GOTO 12625
12630 MULX(N) = DT#
12640 PRINT "*****  ENTER FIELD Y THEN PRESS RETURN  *****"
12645 GOSUB 60000
12647 IF DT# <1 OR DT#> NREC(A)  GOTO 12645
12648 IF FTY(A,DT#) = 1 GOTO 12645
12650 MULY(N) = DT#
12660 RETURN
12680 REM *********  TAX COMPUTE  *********
12700 GOSUB 500
12720 PRINT "*****************  IS THE TAX TABLE  *****************"
12740 PRINT "                    1 - CONSTANT "
12760 PRINT "                    2 - VARIABLE "
12780 PRINT "*********  ENTER THE NUMBER THEN PRESS RETURN  ********"
12782 IF DT# <1 OR DT#> 2 GOTO 12800
12800 GOSUB 60000
12802 IF DT# <1 OR DT#> 2 GOTO 12800
12810 X(1,N) = DT#
12820 ON X(1,N) GOSUB 13240,13380
12840 GOSUB 500
12860 PRINT "*****************  IS THE PAY PERIOD  *****************"
12880 PRINT "                    1 - CONSTANT "
12900 PRINT "                    2 - VARIABLE "
12920 PRINT "********  ENTER THE NUMBER THEN PRESS RETURN  *********"
12940 GOSUB 60000
12942 IF DT# <1 OR DT#> 2 GOTO 12940
12950 X(3,N) = DT#
12960 ON X(3,N) GOSUB 13540,13660
12980 PRINT "*******  WHICH FIELD IS SINGLE / MARRIED FIELD  ********"
13000 FOR T = 1 TO N
13020 PRINT T;"-";FLDN$(A,T)
13040 NEXT T
13060 PRINT "**********  ENTER THE NUMBER THEN PRESS RETURN  *********"
13080 GOSUB 60000
13082 IF DT# <1 OR DT#> NREC(A) GOTO 13080
13084 IF FTY(A,DT#) = 1 GOTO 13080
13090 X(5,N) = DT#
13100 PRINT "***************  WHICH FIELD IS THE PAY  ****************"
13120 FOR T = 1 TO N
13140 PRINT T;"-";FLDN$(A,T)
13160 NEXT T
13180 PRINT "**********  ENTER THE NUMBER THEN PRESS RETURN  *********"
13200 GOSUB 60000
13202 IF DT# <1 OR DT#> NREC(A) GOTO 13200
13204 IF FTY(A,DT#) = 1 GOTO 13200
13210 X(6,N) = DT#
13220 RETURN
13240 REM *******  TAX TABLE = CONSTANT
13260 PRINT "***************  ENTER THE TABLE NUMBER  ****************"
13280 PRINT ""
13300 PRINT "**********  ENTER THE NUMBER THEN PRESS RETURN  *********"
13320 PRINT ""
13340 GOSUB 60000
13350 X(2,N) = DT#
13360 RETURN
13380 REM *******  TAX TABLE VARIABLE
13400 PRINT "*********  WHICH FIELD CONTAINS THE TABLE NUMBER  *******"
13420 FOR T = 1 TO N
13440 PRINT T;"-";FLDN$(A,T)
13460 NEXT T
13480 PRINT "***********  ENTER THE NUMBER THEN PRESS RETURN  ********"
13500 GOSUB 60000
13502 IF DT# <1 OR DT#> NREC(A) GOTO 13500
13510 X(2,N) = DT#
13520 RETURN
13540 REM *******  PAY PERIOD CONSTANT
13560 PRINT "*************  ENTER THE PAY PERIOD CONSTANT  ***********"
13580 PRINT ""
13600 PRINT "**********  ENTER THE CONSTANT THEN PRESS RETURN  *******"
13620 GOSUB 60000
13630 X(4,N) = DT#
13640 RETURN
13660 REM *******  PAY PERIOD VARIABLE
13680 PRINT "******  WHICH FIELD CONTAINS THE PAY PERIOD NUMBER  *****"
13700 FOR T = 1 TO N
13720 PRINT T;"-";FLDN$(A,T)
13740 NEXT T
13760 PRINT "**********  ENTER THE NUMBER THEN PRESS RETURN  *********"
13780 GOSUB 60000
13782 IF DT# <1 OR DT#> NREC(A) GOTO 13780
13783 IF DT# = 1 GOTO 13780
13790 X(4,N) = DT#
13800 RETURN
13820 REM ************  MAXIMUM  **************
13840 PRINT "***************  MAXIMUM OF ITEMS  ****************"
13860 PRINT "*****  HOW MANY ITEMS DO YOU WANT TO COMPARE  *****"
13880 GOSUB 60000
13890 NOS(N) = DT#
13900 FOR T = 1 TO NREC(A)
13920 PRINT T;" - ";FLDN$(A,T)
13940 NEXT T
13960 FOR J = 1 TO NOS(N)
13980 PRINT "******  ENTER THE ";J;"th ITEM TO BE COMPARED  *****"
14000 GOSUB 60000
14002 IF DT# <1 OR DT#> NREC(A) GOTO 14000
14004 IF FTY(A,DT#) = 1 GOTO 14000
14010 MAXMIN(N,J) = DT#
14020 NEXT J
14040 RETURN
14060 REM ************  MINIMUM  **************
14080 PRINT "**************  MINIMUM OF ITEMS  ****************"
14100 PRINT "*****  HOW MANY ITEMS DO YOU WANT TO COMPARE *****"
14120 GOSUB 60000
14130 NOS(N) = DT#
14140 FOR T = 1 TO NREC(A)
14160 PRINT T;" - ";FLDN$(A,T)
14180 NEXT T
14200 FOR J = 1 TO NOS(N)
14220 PRINT "*****  ENTER THE ";J;"th ITEM TO BE COMPARED  *****"
14240 GOSUB 60000
14242 IF DT# <1 OR DT#> NREC(A) GOTO 14240
14244 IF FTY(A,DT#) = 1 GOTO 14240
14250 MAXMIN(N,J) = DT#
14260 NEXT J
14280 RETURN
14300 REM ***********  CONSTANT  ************
14320 PRINT "**************  ENTER CONSTANT  ****************"
14340 GOSUB 60180
14350 KC(N) = DT#
14360 IF IOPT(N) = 7 THEN RETURN
14380 FOR T = 1 TO NREC(A)
14400 PRINT T;" - ";FLDN$(A,T)
14420 NEXT T
14440 PRINT "*********  WHAT FIELD IS OPERATED ON  **********"
14460 GOSUB 60000
14462 IF DT# <1 OR DT#> NREC(A) GOTO 14460
14464 IF FTY(A,DT#) = 1 GOTO 14460
14470 CFLD(N) = DT#
14480 RETURN
14500 REM **********  OPEN IPUTD  **********
14520 GOSUB 500
14540 PRINT "*************  WRITING DATA ON FILE  ***************"
14560 N$ = "IPUTD" + AH$
14580 OPEN "O",#1,N$
14600 WRITE #1,NREC(A)
14620 FOR N = 1 TO NREC(A)
14640 WRITE #1,IOPT(N)
14660 ON IOPT(N) GOTO 14680,14740,14800,14940,15000,15060,15260,15140,15140,15260,15260,15260,14940
14680 REM *****  OPERATOR ENTRY  *****
14700 WRITE #1,PROMPT$(N)
14720 GOTO 15300
14740 REM *****  GET FROM ANOTHER FILE  *****
14760 WRITE #1,IFN(N),IFLD(N),IRNFLD(N)
14780 GOTO 15300
14800 REM *****  ADD PREVIOUS FIELDS  ******
14820 WRITE #1,NOS(N)
14840 FOR T = 1 TO NOS(N)
14860 Q = ADDFLD(N,T)
14880 WRITE #1,ADDFLD(N,T)
14900 NEXT T
14920 GOTO 15300
14940 REM *****  SUBTRACT PREVIOUS FIELDS  ******
14960 WRITE #1, SUBX(N),SUBY(N)
14980 GOTO 15300
15000 REM *****  MULTIPLY FIELDS  *****
15020 WRITE #1, MULX(N),MULY(N)
15040 GOTO 15300
15060 REM *****  TAX  TABLE  *****
15080 WRITE #1,X(1,N),X(2,N),X(3,N),X(4,N),X(5,N),X(6,N)
15100 GOTO 15300
15120 WRITE #1,CMOPT(N)
15140 REM *****  MAXIMUM  ******
15160 WRITE #1,NOS(N)
15180 FOR T = 1 TO NOS(N)
15200 WRITE #1,MAXMIN(N,T)
15220 NEXT T
15240 GOTO 15300
15260 REM *****  CONSTANT  *****
15280 WRITE #1,KC(N),CFLD(N)
15300 NEXT N
15320 CLOSE #1
15340 RETURN
15600 REM **********  OPEN IPUTD  **********
15620 GOSUB 500
15640 PRINT "*************  READING DATA FROM FILE  ***************"
15660 N$ = "IPUTD" + A$
15680 OPEN "I",#1,N$
15700 INPUT #1,NREC(A)
15720 FOR N = 1 TO NREC(A)
15740 INPUT #1,IOPT(N)
15760 ON IOPT(N) GOTO 15780,15840,15900,16020,16080,16140,16320,16200,16200,16320,16320,16320,16020
15780 REM *****  OPERATOR ENTRY  *****
15800 INPUT #1,PROMPT$(N)
15820 GOTO 16360
15840 REM *****  GET FROM ANOTHER FILE  *****
15860 INPUT #1,IFN(N),IFLD(N),IRNFLD(N)
15880 GOTO 16360
15900 REM *****  ADD PREVIOUS FIELDS  ******
15920 INPUT #1,NOS(N)
15940 FOR T = 1 TO NOS(N)
15960 INPUT #1,ADDFLD(N,T)
15980 NEXT T
16000 GOTO 16360
16020 REM *****  SUBTRACT PREVIOUS FIELDS  ******
16040 INPUT #1, SUBX(N),SUBY(N)
16060 GOTO 16360
16080 REM *****  MULTIPLY FIELDS  *****
16100 INPUT #1, MULX(N),MULY(N)
16120 GOTO 16360
16140 REM *****  GET FROM A TABLE  *****
16160 INPUT #1,X(1,N),X(2,N),X(3,N),X(4,N),X(5,N),X(6,N)
16180 GOTO 16360
16200 REM *****  MAXIMUM  ******
16220 INPUT #1,NOS(N)
16240 FOR T = 1 TO NOS(N)
16260 INPUT #1,MAXMIN(N,T)
16280 NEXT T
16300 GOTO 16360
16320 REM *****  CONSTANT  *****
16340 INPUT #1,KC(N),CFLD(N)
16360 NEXT N
16380 CLOSE #1
16400 RETURN
16420 REM **********  PRINT IPUTD  **********
16460 GOSUB 500
16480 PRINT N$
16500 FOR N = 1 TO NREC(A)
16520 PRINT "**********  ";N;" ";FLDN$(A,N);"  ************"
16540 PRINT " INPUT OPTION ";IOPT(N);" ";
16560 ON IOPT(N) GOTO 16580,16660,16800,16920,17020,17120,17620,17480,17480,17620,17620,17620,16920
16563 PRINT ""
16565 GOTO 17680
16580 REM *****  OPERATOR ENTRY  *****
16600 PRINT "OPERATOR ENTRY"
16620 PRINT "PROMPT ";PROMPT$(N)
16640 GOTO 17680
16660 REM *****  GET FROM ANOTHER FILE  *****
16680 PRINT "GET FROM ANOTHER FILE  "
16690 PRINT "FROM FILE:  FROM FIELD:            SOURCE RECORD NUMBER IS THIS FIELDS VALUE:"
16700 Q=IFN(N)
16720 W = IFLD(N)
16740 Z = IRNFLD(N)
16760 PRINT F$(Q),TAB(15) FLDN$(Q,W),TAB(38) FLDN$(A,Z)
16780 GOTO 17680
16800 REM *****  ADD PREVIOUS FIELDS  ******
16820 PRINT "ADD PREVIOUS FIELDS  #OF ADDS : ";NOS(N)
16840 FOR T = 1 TO NOS(N)
16860 PRINT "ADD THIS FIELD ";ADDFLD(N,T);FLDN$(A,Q)
16880 NEXT T
16900 GOTO 17680
16920 REM *****  SUBTRACT PREVIOUS FIELDS  ******
16940 Q = SUBX(N)
16960 W = SUBY(N)
16980 IF IOPT(N) = 4 THEN PRINT "SUBTRACT ";SUBX(N);FLDN$(A,Q);SUBY(N);FLDN$(A,W)
16990 IF IOPT(N) = 13 THEN PRINT "DIVIDE ";SUBX(N);FLDN$(A,Q);SUBY(N);FLDN$(A,W)
17000 GOTO 17680
17020 REM *****  MULTIPLY FIELDS  *****
17040 Q = MULX(N)
17060 W = MULY(N)
17080 PRINT "MULTIPLY "; MULX(N);FLDN$(A,Q);MULY(N);FLDN$(A,W)
17100 GOTO 17680
17120 REM *****  GET FROM A TABLE  *****
17140 ON X(1,N) GOSUB 17340,17280
17160 ON X(3,N) GOSUB 17440,17380
17180 Y = X(5,N)
17200 PRINT "SINGLE MARRIED FIELD NUMBER =";X(5,N);FLDN$(A,Y)
17220 Y = X(6,N)
17240 PRINT "PAY FIELD NUMBER = "X(6,N);FLDN$(A,Y)
17260 GOTO 17680
17280 Y = X(2,N)
17300 PRINT " TAX TABLE VARIES NUMBER = FIELD ";FLDN$(A,Y)
17320 RETURN
17340 PRINT "TAX TABLE CONSTANT NUMBER =";X(2,N)
17360 RETURN
17380 Y = X(4,N)
17400 PRINT "PAY PERIOD VARIES  NUMBER = FIELD ";FLDN$(A,Y)
17420 RETURN
17440 PRINT "PAY PERIOD CONSTANT  NUMBER = ";X(4,N)
17460 RETURN
17480 REM *****  MAXIMUM  ******
17500 PRINT "MAX OR MIN  NUMBER OF ITMS";NOS(N)
17520 FOR T = 1 TO NOS(N)
17540 Q = MAXMIN(N,T)
17560 PRINT "COMPARE : ";MAXMIN(N,T);FLDN$(A,Q)
17580 NEXT T
17600 GOTO 17680
17620 REM *****  CONSTANT  *****
17640 Q = CFLD(N)
17660 PRINT "CONSTANT";KC(N);CFLD(N);FLDN$(A,Q)
17680 NEXT N
17700 PRINT "*******  PRESS ANY KEY TO CONTINUE  *******"
17720 IF INKEY$ = "" GOTO 17720
17740 RETURN
17760 REM **********  LPRINT IPUTD  **********
17800 GOSUB 500
17820 LPRINT N$
17840 FOR N = 1 TO NREC(A)
17860 LPRINT "**********  ";N;" ";FLDN$(A,N);"  ************"
17880 LPRINT " INPUT OPTION ";IOPT(N);" ";
17900 ON IOPT(N) GOTO 17920,18000,18140,18260,18360,18460,18960,18820,18820,18960,18960,18960,18260
17905 LPRINT ""
17910 GOTO 19020
17920 REM *****  OPERATOR ENTRY  *****
17940 LPRINT "OPERATOR ENTRY"
17960 LPRINT "PROMPT ";PROMPT$(N)
17980 GOTO 19020
18000 REM *****  GET FROM ANOTHER FILE  *****
18020 LPRINT "GET FROM ANOTHER FILE "
18030 LPRINT "FROM FILE:   FROM FIELD            SOURCE RECORD NUMBER IS THIS FIELDS VALUE:"
18040 Q=IFN(N)
18060 W = IFLD(N)
18080 Z = IRNFLD(N)
18100 LPRINT F$(Q),TAB(15) FLDN$(Q,W),TAB(39) FLDN$(A,Z)
18120 GOTO 19020
18140 REM *****  ADD PREVIOUS FIELDS  ******
18160 LPRINT "ADD PREVIOUS FIELDS  #OF ADDS : ";NOS(N)
18180 FOR T = 1 TO NOS(N)
18200 LPRINT "ADD THIS FIELD ";ADDFLD(N,T);FLDN$(A,Q)
18220 NEXT T
18240 GOTO 19020
18260 REM *****  SUBTRACT PREVIOUS FIELDS  ******
18280 Q = SUBX(N)
18300 W = SUBY(N)
18320 IF IOPT(N) = 13 THEN  LPRINT "DIVIDE ";SUBX(N);FLDN$(A,Q);SUBY(N);FLDN$(A,W)
18330 IF IOPT(N) = 4 THEN LPRINT "SUBTRACT ";SUBX(N);FLDN$(A,Q);SUBY(N);FLDN$(A,W)
18340 GOTO 19020
18360 REM *****  MULTIPLY FIELDS  *****
18380 Q = MULX(N)
18400 W = MULY(N)
18420 LPRINT "MULTIPLY "; MULX(N);FLDN$(A,Q);MULY(N);FLDN$(A,W)
18440 GOTO 19020
18460 REM *****  GET FROM A TABLE  *****
18480 ON X(1,N) GOSUB 18680,18620
18500 ON X(3,N) GOSUB 18780,18720
18520 Y = X(5,N)
18540 LPRINT "SINGLE MARRIED FIELD NUMBER =";X(5,N);FLDN$(A,Y)
18560 Y = X(6,N)
18580 LPRINT "PAY FIELD NUMBER = "X(6,N);FLDN$(A,Y)
18600 GOTO 19020
18620 Y = X(2,N)
18640 LPRINT " TAX TABLE VARIES NUMBER = FIELD ";FLDN$(A,Y)
18660 RETURN
18680 LPRINT "TAX TABLE CONSTANT NUMBER =";X(2,N)
18700 RETURN
18720 Y = X(4,N)
18740 LPRINT "PAY PERIOD VARIES  NUMBER = FIELD ";FLDN$(A,Y)
18760 RETURN
18780 LPRINT "PAY PERIOD CONSTANT  NUMBER = ";X(4,N)
18800 RETURN
18820 REM *****  MAXIMUM  ******
18840 LPRINT "MAX OR MIN  NUMBER OF ITMS";NOS(N)
18860 FOR T = 1 TO NOS(N)
18880 Q = MAXMIN(N,T)
18900 LPRINT "COMPARE : ";MAXMIN(N,T);FLDN$(A,Q)
18920 NEXT T
18940 GOTO 19020
18960 REM *****  CONSTANT  *****
18980 Q = CFLD(N)
19000 LPRINT "CONSTANT";KC(N);CFLD(N);FLDN$(A,Q)
19020 NEXT N
19040 RETURN
23780 REM *************  READ SUBROUTINE  *************
23800 OPEN "I",#1,"FFILE"
23820 INPUT #1,MAXF
23840 FOR A = 1 TO MAXF
23860 INPUT #1,A,F$(A),NREC(A),L(A)
23880 FOR N = 1 TO NREC(A)
23900 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N)
23920 IF FTY(A,N) = 2 THEN INPUT #1,KY(A,N),KEYLIST(A,N)
23940 NEXT N
23960 NEXT A
23980 CLOSE #1
24000 RETURN
50000 REM **********  INTRO
50010 GOSUB 500
50100 PRINT "               I N P U T    P R O G R A M    3.0   "
50105 PRINT ""
50110 PRINT "      Copyright 1984 by Potomac Pacific Engineering Inc."
50120 PRINT ""
50130 PRINT "This program is licensed FREE to all users with some restrictions"
50165 PRINT "        See the manual for more information on the license."
50167 PRINT ""
50920 GOSUB 23780
50950 PRINT "******************  PRESS ANY KEY TO CONTINUE  *****************";
50960 IF INKEY$ = "" GOTO 50960
50970 RETURN
51000 REM ***** EXIT TO SYSTEM
51100 GOSUB 500
51110 CLOSE
51120 PRINT " -BYE, Have a nice day"
51130 END
52000 REM ***** INTRO 1
52010 GOSUB 500
52100 PRINT "           Put the DATA DISK in the default disk drive  "
52110 PRINT ""
52120 PRINT "          *****  THEN PRESS ANY KEY TO CONTINUE  *****"
52130 PRINT ""
52140 PRINT "      The  CUSTOM  programs only use the PROGRAM DATA DISK"
52150 PRINT "Keep it in the default disk drive at all times during this program."
52200 IF INKEY$ = "" GOTO 52200
52210 RETURN
60000 REM *******  INTEGER LESS THEN 100 CHECK  ********
60010 MAX = 2
60020 ACT$ = "1234567890=<>^"
60030 IF NE = 0 THEN ACT$ = "1234567890"
60040 PRINT ">__<";
60045 GOTO 60240
60050 REM
60060 REM *******  INTEGER *******
60070 MAX = 8
60080 ACT$ = "1234567890-+,=<>^"
60090 IF NE = 0 THEN ACT$ = "1234567890-+,"
60100 PRINT ">________<";
60110 GOTO 60240
60120 REM *******  SINGLE PRECISION  *******
60130 MAX = 10
60140 ACT$ = "1234567890-+,.%$=<>^"
60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60160 PRINT ">__________<";
60170 GOTO 60240
60180 REM *******  DOUBLE PRECISION  *******
60190 MAX = 20
60200 ACT$ = "1234567890-+,.%$=<>^"
60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60220 PRINT ">____________________<";
60230 GOTO 60240
60240 REM ********** NUMBER CHECK **********
60250 A$ = ""
60260 K$(20) = " "
60270 KTMAX = 0
60280 FOR T9 = 1 TO MAX
60290 K$(T9) = " "
60300 NEXT T9
60310 DIG$ = "1234567890."
60320 DOTFLG = 0
60330 T2 = MAX + 1
60340 FOR T6 = 1 TO T2
60350 PRINT CHR$(CH);
60360 NEXT T6
60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370
60380 KT = 0
60390 REM ***********  CHECK ALFANUMERIC INPUT FOR LENGTH  ***********
60400 KT = KT + 1
60410 REM
60420 W$ = INKEY$
60430 IF W$ = "" GOTO 60420
60440 C = ASC(W$)
60450 IF C = 0 THEN GOSUB 61900
60460 IF C = 13 GOTO 60580
60470 IF C = 17 OR C = 8 GOTO 61150
60480 IF C = 19 GOTO 60670
60490 IF C = 4 GOTO 60720
60500 IF C = 6 GOTO 60780
60510 IF C = 1 GOTO 60960
60520 IF KT > MAX GOTO 60410
60530 IF INSTR(ACT$,W$) = 0 GOTO 61230
60540 K$(KT) = W$
60550 PRINT K$(KT);
60560 IF KT > KTMAX THEN KTMAX = KT
60570 GOTO 60400
60580 REM **********  RETURN  **********
60590 FOR T9 = 1 TO KTMAX
60600 A$ = A$ + K$(T9)
60610 NEXT T9
60620 IF KTMAX = 0 THEN PRINT "1"
60630 IF KTMAX = 0 THEN DT# = 1
60640 IF KTMAX = 0 THEN RETURN
60650 PRINT ""
60660 GOTO 61260
60670 REM ********* MOVE CURSE BACK ********
60680 IF KT = 1 GOTO 60410
60690 KT = KT - 1
60700 PRINT CHR$(CH);
60710 GOTO 60410
60720 REM ********* MOVE CURSER FORWARD *********
60730 IF KT >= MAX GOTO 60410
60740 IF KT > (KTMAX + 1) GOTO 60410
60750 PRINT K$(KT);
60760 KT = KT + 1
60770 GOTO 60410
60780 REM ********** INSERT ***********
60790 IF KT > KTMAX GOTO 60410
60800 X9 = MAX
60810 WHILE X9 > KT
60820 X9 = X9 - 1
60830 K$(X9 + 1) = K$(X9)
60840 WEND
60850 K$(KT) = " "
60860 KTMAX = KTMAX + 1
60870 IF KTMAX > MAX THEN KTMAX = MAX
60880 FOR T9 = KT TO KTMAX
60890 PRINT K$(T9);
60900 NEXT T9
60910 T6 = (KTMAX - KT) + 1
60920 FOR T7 = 1 TO T6
60930 PRINT CHR$(CH);
60940 NEXT T7
60950 GOTO 60410
60960 REM ********** DELETE ***********
60970 IF KT > KTMAX GOTO 60410
60980 IF KTMAX = 1 GOTO 60410
60990 K$(MAX + 1) = ""
61000 X9 = KT
61010 WHILE X9 <= MAX
61020 K$(X9) = K$(X9 + 1)
61030 X9 = X9 + 1
61040 WEND
61050 KTMAX = KTMAX - 1
61060 FOR T9 = KT TO KTMAX
61070 PRINT K$(T9);
61080 NEXT T9
61090 PRINT "_";
61100 T7 = (KTMAX - KT) + 2
61110 FOR T8 = 1 TO T7
61120 PRINT CHR$(CH);
61130 NEXT T8
61140 GOTO 60410
61150 REM ********* BACKSPACE ********
61160 IF KT = 1 GOTO 60410
61170 KT = KT - 1
61180 PRINT CHR$(CH);
61190 K$(KT) = " "
61200 PRINT "_";
61210 PRINT CHR$(CH);
61220 GOTO 60410
61230 REM *******  INPUT NOT ACCEPTABLE  ********
61240 PRINT CHR$(7);
61250 GOTO 60420
61260 REM ********* CLEAR STRINGS ********
61270 MAX = LEN(A$)
61280 D2$ = ""
61290 D1$ = ""
61300 DFLG = 0
61310 FOR Q93 = 1 TO MAX
61320 R$ = MID$(A$,Q93,1)
61330 IF INSTR(DIG$,R$) = 0 GOTO 61400
61340 IF R$ = "." OR DFLG = 1 GOTO 61380
61350 IF DFLG = 1 GOTO 61380
61360 D2$ = D2$ + R$
61370 GOTO 61400
61380 D1$ = D1$ + R$
61390 DFLG = 1
61400 NEXT Q93
61410 DA# = VAL(D2$)
61420 D1# = VAL(D1$)
61430 DT# = DA# + D1#
61440 IF K$(1) = "-" THEN DT# =  -DT#
61450 RETURN
61900 REM ****** CHECK FOR ASC0
61910 S4$ = INKEY$
61920 C2 =  ASC(S4$)
61930 IF C2 = 83 THEN C = 1
61940 IF C2 = 82 THEN C = 6
61950 IF C2 = 75 THEN C = 19
61960 IF C2 = 77 THEN C = 4
61970 RETURN
62000 REM **********  ALPHANUMERIC CHECK  **************
62010 MAX = FL(A,Q)
62020 GOTO 62040
62030 REM ********  MAX SET IN PROGRAM  ********
62040 A$ = ""
62050 PRINT ">";
62060 FOR N9 = 1 TO MAX
62070 K$(N9) = ""
62080 PRINT "_";
62090 NEXT N9
62100 PRINT "<";
62110 T2 = MAX + 1
62120 FOR T4 = 1 TO T2
62130 PRINT CHR$(CH);
62140 NEXT T4
62150 KT = 0
62160 KTMAX = 1
62170 REM ***********  CHECK ALFANUMERIC INPUT FOR LENGTH  ***********
62180 KT = KT + 1
62190 PRINT TAB(KT+1)"";
62200 K$ = INKEY$
62210 IF K$ = "" GOTO 62200
62220 C = ASC(K$)
62230 IF C = 0 THEN GOSUB 61900
62240 IF C = 13 GOTO 62350
62250 IF C = 17 OR C = 8 GOTO 62920
62260 IF C = 19 GOTO 62450
62270 IF C = 4  GOTO 62500
62280 IF C = 6 GOTO 62560
62290 IF C = 1 GOTO 62730
62300 IF KT > MAX GOTO 62190
62310 K$(KT) = K$
62320 PRINT K$(KT);
62330 IF KT > KTMAX THEN KTMAX = KT
62340 GOTO 62180
62350 REM **********  RETURN  **********
62360 FOR T9 = 1 TO MAX
62370 A$ = A$ + K$(T9)
62420 NEXT T9
62430 PRINT ""
62440 RETURN
62450 REM ********* MOVE CURSE BACK ********
62460 IF KT = 1 GOTO 62190
62470 KT = KT - 1
62480 PRINT CHR$(CH);
62490 GOTO 62190
62500 REM ********* MOVE CURSER FORWARD *********
62510 IF KT >= MAX GOTO 62190
62520 IF KT >  KTMAX  GOTO 62190
62530 PRINT K$(KT);
62540 KT = KT + 1
62550 GOTO 62190
62560 REM ********** INSERT ***********
62570 X9 = MAX
62580 WHILE X9 > KT
62590 X9 = X9 - 1
62600 K$(X9 + 1) = K$(X9)
62610 WEND
62620 K$(KT) = " "
62630 KTMAX = KTMAX + 1
62640 IF KTMAX > MAX THEN KTMAX = MAX
62650 FOR T9 = KT TO KTMAX
62660 PRINT K$(T9);
62670 NEXT T9
62680 T6 = (KTMAX - KT) +1
62690 FOR T7 = 1 TO T6
62700 PRINT CHR$(CH);
62710 NEXT T7
62720 GOTO 62190
62730 REM ********** DELETE ***********
62740 IF KT > KTMAX GOTO 62200
62750 IF KTMAX = 1 GOTO 62190
62760 K$(MAX + 1) = ""
62770 X9 = KT
62780 WHILE X9 <= KTMAX
62790 K$(X9) = K$(X9 + 1)
62800 X9 = X9 + 1
62810 WEND
62820 KTMAX = KTMAX - 1
62830 FOR T9 = KT TO KTMAX
62840 PRINT K$(T9);
62850 NEXT T9
62860 PRINT "_";
62870 T7 = (KTMAX - KT) + 2
62880 FOR T6 = 1 TO T7
62890 PRINT CHR$(CH);
62900 NEXT T6
62910 GOTO 62190
62920 REM ********* BACKSPACE ********
62930 IF KT = 1 GOTO 62190
62940 K$(KT) = " "
62950 KT = KT - 1
62960 K$(KT) = " "
62970 PRINT CHR$(CH);
62980 PRINT "_";
62990 PRINT CHR$(CH);
63000 GOTO 62190
 " "
62950 KT = KT - 1
62960 K$(KT) = " "
62970 PRINT CHR$(CH);