PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #370)
[PCjs Machine "ibm5150"]
Waiting for machine "ibm5150" to load....
Information about “FLASH CARDS 4 OF 4 (367, 368, 369)”
A menu-driven 7,500-Word Vocabulary Builder and Spelling Teacher for the
high school and college-level student. The flash card format has proved
to be an effective teaching mechanism for improving spelling and
vocabulary skills.
The dictionary does not include the 4,000 most basic words but, rather,
the 7,500 next most commonly-used words. BASIC source code is included.
While you're polishing your spelling, learn the parts of speech and the
definition of each word.
MAIN.BAS
2 PRINT FRE(0)
3 DEFDBL X
4 DEFINT A-W,Y-Z
5 DIM F$(15),FLDN$(15,28),FTY(15,28),FL(15,28),IOPT(28)
6 DIM PROMPT$(28),IFN(28),IFLD(28),IRNFLD(28),NOS(28),ADDFLD(28,6)
7 DIM SUBX(28),SUBY(28),MULX(28),MULY(28)
8 DIM XKEY(28),YKEY(28),CMOPT(28),MAXMIN(28,6)
9 DIM KC(28),CFLD(28)
10 DIM X$(28),Y$(28)
13 DIM L(15),NREC(15),Z$(28),KT(28)
14 DIM X(28),CK$(28),SN$(28)
16 DIM KEYLIST(15,28),L$(10,50),LEND(28),CL(28)
18 DIM SU%(28),S!(10)
20 DIM XL(40)
21 DIM TX(6,28)
25 DIM S#(28)
26 DIM MAX(10),Z%(10)
30 DIM GFLG(28)
35 DIM K$(80)
40 DIM FS(30),PP(30),MS(30),MIND#(30),MAXD#(30),TAX#(30),PCT!(30),OVR#(30)
42 DIM MAXK(10)
44 DIM SCRN(40),LE(28),CE(28),LEK(28),CEK(28),SW$(18)
46 DIM REALFLG(28)
50 DIM SUMF(28),SUM#(28)
52 DIM SHOW(30),MAXC#(30),MINC#(30)
54 DIM MAXC(28),MINC(28),MFLG(28)
61 CH = 29
62 GOSUB 50000
63 GOSUB 16800
65 GOSUB 27000
80 GOSUB 10000
90 GOSUB 29000
95 GOSUB 60000
100 REM
400 GOSUB 13000
402 IF KD < 5 THEN GOSUB 11000
403 ROPEN = 0
404 GOSUB 13000
406 TWOOPEN = 0
410 PRINT "****** INPUT AND OUTPUT OPTIONS -- WHAT FILE DO YOU WANT: *****"
420 PRINT ""
425 PRINT " 0 - *** EXIT THE PROGRAM ***"
430 FOR I = 1 TO MAXF
440 PRINT I;TAB(5) " - ";F$(I)
450 NEXT I
460 PRINT ""
470 PRINT "***** ENTER THE NUMBER OF THE FILE YOU WANT THEN PRESS RETURN *****"
475 GOSUB 14000
477 IF DT# < 0 OR DT#>MAXF GOTO 475
480 A = DT#
482 IF A = 0 GOTO 51000
483 GOSUB 13000
484 PRINT "FILE : "; F$(A)
485 GOSUB 2300
490 GOSUB 2500
491 CSCR = 2
492 IF SCRN(A) <> 0 THEN GOSUB 28000 ELSE RPT = 0
493 IF MFLG(A) = 2 THEN GOSUB 29070
494 GOSUB 40020
495 IF REALFLG(A) = 2 THEN GOSUB 60070
500 IF REALFLG(A) = 2 THEN GOSUB 60200
530 GOTO 3000
1905 MATCH = 1
2300 REM DISK SELECTION
2302 IF HDISK = 2 THEN GOSUB 13000
2303 IF HDISK = 2 THEN GOTO 2360
2304 PRINT ""
2305 PRINT "************ WHICH DISK DRIVE IS THE FILE ON **************"
2310 PRINT ""
2312 PRINT " 0 - BACK TO CHOICE OF FILES"
2315 PRINT " 1 - DISK DRIVE A"
2320 PRINT " 2 - DISK DRIVE B"
2325 PRINT " 3 - DISK DRIVE C"
2330 PRINT " 4 - DISK DRIVE D"
2335 PRINT ""
2340 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ************"
2345 GOSUB 14000
2347 IF DT# < 0 OR DT#>4 GOTO 2345
2350 T = DT#
2352 IF T = 0 THEN 100
2355 ON T GOTO 2360,2370,2380,2390
2360 T$ = F$(A)
2365 GOTO 2490
2370 T$ = "B:"+F$(A)
2375 GOTO 2490
2380 T$ = "C:"+F$(A)
2385 GOTO 2490
2390 T$ = "D:"+F$(A)
2490 RETURN
2500 REM OPEN FILE
2503 CLOSE #1
2505 OPEN "R",#1,T$,L(A)
2507 D = 0
2510 FOR T = 1 TO NREC(A)
2520 FIELD #1,D AS DY$,FL(A,T) AS X$(T)
2530 D = D + FL(A,T)
2540 NEXT T
2543 GOSUB 7800
2545 RETURN
2550 REM OPEN SECOND FILE
2553 CLOSE #2
2555 OPEN "R",#2,T$,L(B)
2557 D = 0
2560 FOR T = 1 TO NREC(B)
2565 FIELD #2,D AS DY$,FL(B,T) AS Y$(T)
2570 D = D + FL(B,T)
2575 NEXT T
2578 RETURN
2580 REM OPEN THIRD FILE
2581 CLOSE #3
2584 OPEN "R",#3,T$,L(C)
2586 D = 0
2588 FOR T = 1 TO NREC(C)
2590 FIELD #3,D AS DY$,FL(C,T) AS Z$(T)
2592 D = D + FL(C,T)
2594 NEXT T
2596 RETURN
3000 REM SECOND MENU
3010 GOSUB 13000
3011 SFLG = 0
3012 PRINT "FILE : ";F$(A);TAB(57)"MAXIMUM RECORD :";MRN
3015 CALFLG = 0
3020 PRINT "******************* WHAT DO YOU WANT TO DO WITH THE FILE *******************"
3030 PRINT ""
3035 PRINT " 0 - CHANGE FILES "
3040 PRINT " 1 - READ A SPECIFIC RECORD"
3050 PRINT " 2 - PRINT ON PAPER ALL OR SEVERAL SEQUENTIAL RECORDS"
3060 PRINT " 3 - SCAN SEVERAL RECORDS IN A FILE"
3070 PRINT " 4 - SEARCH A FILE"
3080 PRINT " 5 - NEW ENTRY"
3090 PRINT " 6 - SEARCH A SORTED FILE"
3202 PRINT " 7 - RECALCULATE ALL THE RECORDS IN THE FILE"
3207 PRINT ""
3210 PRINT "************* ENTER THE NUMBER OF THE OPTION THEN PRESS ENTER ***************"
3212 SPRT = 5
3215 GOSUB 14000
3218 IF DT# < 0 OR DT#>7 GOTO 3215
3220 N = DT#
3225 IF N = 0 THEN CLOSE
3227 IF N = 0 THEN GOTO 400
3230 ON N GOTO 8000,5000,4000,18000,3700,17000,47000
3600 GOTO 18000
3700 GOSUB 13000
3720 GOTO 7000
4000 REM SCAN ALL RECORDS
4005 GOSUB 13000
4007 GOSUB 7800
4008 GOSUB 4100
4009 GOSUB 13000
4010 PRINT "************ SCAN ALL SEQUENTIAL RECORDS SUBPROGRAM ************"
4011 PRINT ""
4012 PRINT " WHAT RECORD DO YOU WANT TO START AT ? "
4013 PRINT ""
4014 PRINT " Enter zero to return to file options "
4015 PRINT ""
4016 PRINT "*********** ENTER THE RECORD NUMBER THEN PRESS RETURN ***********"
4018 GOSUB 14100
4020 RN = DT#
4022 IF RN = 0 THEN GOTO 3010
4032 IF INKEY$ <> "" GOTO 4600
4035 IF RN > MRN GOTO 26000
4040 GET #1,RN
4050 GOSUB 4300
4060 RN = RN + 1
4070 GOTO 4032
4100 REM **** GET FIELDS TO DISPLAY
4110 FOR T = 1 TO NREC(A)
4120 GOSUB 13000
4124 PRINT "******************* SCAN SUBROUTINE **********************"
4126 PRINT ""
4130 PRINT "FIELD NUMBER : ";T;" - "; FLDN$(A,T)
4140 PRINT ""
4150 PRINT "***** DO YOU WANT THIS FIELD DISPLAYED WHILE SCANNING *****"
4160 PRINT ""
4170 PRINT " 1 - NO, Do not show this field "
4180 PRINT " 2 - YES, Show this field "
4190 PRINT ""
4200 PRINT "************ Enter the number then press return ***********"
4210 GOSUB 14000
4220 IF DT# < 1 OR DT# > 2 THEN 4210
4230 SHOW(T) = DT#
4240 NEXT T
4250 RETURN
4300 REM **** PRINT FIELDS
4305 PRINT "RECORD NUMBER ";RN
4310 FOR Q = 1 TO NREC(A)
4320 IF SHOW(Q) = 2 THEN GOSUB 12030
4330 NEXT Q
4340 RETURN
4600 REM
4604 PRINT "****************** PAUSE SUBROUTINE **********************"
4608 PRINT " 1 - CONTINUE SCANING "
4610 PRINT " 0 - BACK TO FILE OPTIONS "
4625 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ***********"
4628 GOSUB 14000
4635 IF DT# = 0 THEN GOTO 3010
4640 GOTO 4040
5000 REM
5005 GOSUB 13000
5010 PRINT "************ PRINT ON PAPER ALL SEQUENTIAL RECORDS *************"
5011 PRINT ""
5012 PRINT " WHAT RECORD DO YOU WANT TO START PRINTING AT ?"
5013 PRINT ""
5014 PRINT " Enter zero to return to file options "
5015 PRINT ""
5016 PRINT "*********** ENTER THE RECORD NUMBER THEN PRESS RETURN **********"
5018 GOSUB 14100
5020 RN = DT#
5021 IF RN = 0 GOTO 3010
5022 PRINT "************** DO YOU WANT THIS RECORD PRINTED IN **************"
5023 PRINT " 1 - EXPANDED FORM "
5024 PRINT " 2 - CONDENSED FORM "
5025 PRINT "************** ENTER THE NUMBER THEN PRESS RETURN **************"
5026 GOSUB 14000
5027 IF DT# < 1 OR DT#>2 GOTO 5026
5030 PFLG = DT#
5031 IF PFLG = 2 THEN GOSUB 12880
5032 IF PFLG = 2 THEN GOSUB 12900
5033 GOSUB 16000
5036 REM
5038 IF INKEY$ <> "" GOTO 5600
5039 IF RN > MRN GOTO 26000
5040 REM
5041 GET #1,RN
5050 IF PFLG = 1 THEN GOSUB 12200
5060 IF PFLG = 2 THEN GOSUB 12500
5510 RN = RN + 1
5520 GOTO 5036
5600 REM
5602 GOSUB 13000
5604 PRINT "****************** PAUSE SUBROUTINE **********************"
5606 PRINT ""
5608 PRINT " 1 - CONTINUE PRINTING "
5610 PRINT " 0 - BACK TO FILE OPTIONS"
5620 PRINT ""
5625 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ***********"
5628 GOSUB 14000
5630 IF DT# = 0 THEN GOTO 3010
5640 GOTO 5040
5725 REM
6000 REM
7000 REM
7010 GOSUB 13000
7012 PRINT ""
7014 PRINT "FILE NAME: ";F$(A)
7020 PRINT "******************** NEW RECORD ENTRY ********************"
7022 PRINT ""
7024 PRINT "******************* WHAT RECORD NUMBER ? *****************"
7030 PRINT ""
7031 GOSUB 7800
7032 PRINT "********** Enter zero to return to file options **********"
7033 PRINT ""
7034 PRINT "---- MAXIMUM RECORD NUMBER CURRENTLY = ";MRN
7035 PRINT "---- ENTER A NUMBER FROM 1 TO ";MRN +1
7036 PRINT ""
7038 PRINT "******** ENTER THE RECORD NUMBER THEN PRESS RETURN *******"
7040 GOSUB 14100
7042 IF DT# <0 OR DT# >(MRN +1) GOTO 7040
7045 RN = DT#
7046 GOSUB 13000
7048 IF RN = 0 GOTO 3010
7200 GOSUB 40000
7205 IF RN > MRN THEN MRN = RN
7210 GOTO 7010
7800 MRN = LOF(1)/ L(A)
7805 REM MRN = INT(MRN)
7810 RETURN
7900 REM ***** LOF
7910 MRN2 = LOF(3)/82
7920 RETURN
7950 REM ******* LOF
7960 MRNS = LOF(2)/L(B)
7970 RETURN
8000 REM
8010 GOSUB 13000
8020 PRINT "******************** READ A SINGLE RECORD *******************"
8030 PRINT ""
8040 PRINT "FILE NAME: ";F$(A)
8042 PRINT ""
8043 PRINT "MINIMUM RECORD NUMBER : 1 MAXIMIM RECORD NUMBER : ";MRN
8044 PRINT ""
8045 PRINT "******* ENTER THE NUMBER OF THE RECORD THEN PRESS RETURN ******"
8046 PRINT ""
8048 PRINT "*********** ENTER ZERO TO RETURN TO FILE OPTIONS ************"
8049 GOSUB 7800
8050 GOSUB 14100
8052 RN = DT#
8057 IF RN = 0 THEN GOTO 3010
8058 GOSUB 13000
8059 IF RN > MRN GOTO 26800
8060 GET #1,RN
8500 GOSUB 12000
8510 LI = 20
8515 GOSUB 13100
8520 PRINT "***************************** OPTIONS : ********************************"
8530 PRINT " 1 - READ THE NEXT RECORD 3 - CORRECT THIS RECORD 5 - SHOW SUBRECORDS "
8532 PRINT " 2 - PRINT THIS RECORD ON PAPER 4 - READ ANOTHER RECORD 0 - TO FILE OPTIONS "
8535 PRINT "****************** Enter the number then press return **********************"
8537 SPRT = 5
8540 GOSUB 14000
8542 IF DT# <0 OR DT# > 5 GOTO 8510
8550 B = DT#
8552 IF B = 3 THEN GOSUB 9000
8554 IF B = 3 THEN GOTO 8510
8555 IF SFLG > 0 AND B = 1 THEN GOTO 18380
8556 IF B = 1 THEN RN = RN + 1
8560 IF B = 5 AND RPT <> 2 THEN 8580
8562 ON B GOTO 8058,8600,9000,8000,20000
8564 REM
8570 GOTO 3010
8580 LI = 24
8585 GOSUB 13100
8590 PRINT TAB(10) "SUBRECORDS ARE NOT SET UP ON THIS FILE";
8595 GOTO 8510
8600 REM PRINT SINGLE RECORD
8610 GOSUB 16000
8680 GOSUB 12200
8920 GOTO 8000
9000 REM
9005 LI = 20
9007 GOSUB 13100
9010 PRINT "******************* CORRECT RECORD SUBROUTINE ******************* "
9020 PRINT " 0 - TO FILE OPTION -- DONE WITH CORRECTIONS "
9022 PRINT " 1 TO ";NREC(A);"THE FIELD YOU WANT TO CHANGE "
9025 PRINT "*************** ENTER THE NUMBER THEN PRESS RETURN ************** "
9028 SPRT = 5
9030 GOSUB 14000
9031 IF DT# <0 OR DT# >NREC(A) GOTO 9030
9033 T = DT#
9040 IF T = 0 THEN GOTO 3010
9045 D = T
9046 IF REALFLG(A) = 2 AND T = TGTRN THEN GOSUB 61300
9047 Q = T
9048 LI = 20
9049 GOSUB 13100
9050 PRINT "****** FIELD NUMBER: ";D;" FIELD NAME: ";FLDN$(A,D);" ****** "
9060 PRINT "*********** ENTER THE CORRECTION THEN PRESS RETURN ************** "
9062 PRINT " "
9063 PRINT " "
9064 PRINT " ";
9066 LI = 22
9068 GOSUB 13100
9070 ON FTY(A,D) GOTO 9100,9150,9200,9250,9250
9100 GOSUB 15000
9105 I$ = A$
9110 LSET X$(D) = I$
9120 GOTO 9290
9150 GOSUB 14100
9151 T2 = KEYLIST(A,D)
9152 T3 = MAXK(T2)
9153 REM IF KY(A,D) = 2 AND ( DT# < 1 OR DT# > T3) GOTO 9150
9154 IF MFLG(A) = 2 THEN GOSUB 29190
9155 I% = DT#
9157 I# = I%
9160 LSET X$(D) = MKI$(I%)
9165 X(D) = I%
9170 GOTO 9290
9200 GOSUB 14200
9203 IF MFLG(A) = 2 THEN GOSUB 29190
9205 I! = DT#
9207 I# = I!
9210 LSET X$(D) = MKS$(I!)
9220 GOTO 9290
9250 GOSUB 14300
9253 IF MFLG(A) = 2 THEN GOSUB 29190
9255 I# = DT#
9260 LSET X$(D) = MKD$(I#)
9290 PUT #1,RN
9291 N = D
9294 IF REALFLG(A) = 2 AND N = FLD1 THEN GOSUB 61000
9295 IF REALFLG(A) = 2 AND N = FLD2 THEN GOSUB 61200
9296 IF REALFLG(A) = 2 AND N = TGTRN THEN GOSUB 61400
9297 IF REALFLG(A) = 2 AND N = TGTRN THEN GOSUB 60300
9298 IF GFLG(Q) = 1 THEN GOSUB 46000 ELSE GOSUB 44500
9299 RETURN
10000 REM READ FFILE
10010 OPEN "I",#1,"FFILE"
10020 INPUT #1,MAXF
10030 FOR A = 1 TO MAXF
10040 INPUT #1,A,F$(A),NREC(A),L(A)
10050 FOR N = 1 TO NREC(A)
10060 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N)
10070 IF FTY(A,N) = 2 THEN INPUT #1,D,KEYLIST(A,N)
10075 IF D >< 2 THEN KEYLIST(A,N) = 0
10080 NEXT N
10090 NEXT A
10100 CLOSE #1
10110 RETURN
10900 REM PUT DISK IN DRIVE SUB
10905 IF HDISK = 2 THEN RETURN
10910 GOSUB 13000
10920 PRINT " ******** PUT PROGRAM DATA DISK IN THE DEFAULT DISK DRIVE *********"
10930 PRINT ""
10940 PRINT " THEN PRESS ANY KEY TO CONTINUE "
10950 PRINT ""
10960 PRINT " If the program data disk is already in the default disk drive then"
10965 PRINT " just press any key to continue."
10970 PRINT ""
10990 IF INKEY$ = "" GOTO 10990
10992 GOSUB 13000
10993 PRINT " READING INFORMATION, PLEASE WAIT "
10995 RETURN
11000 REM LOAD KEYLIST
11010 GOSUB 13000
11100 A = 10
11105 PRINT "FILE : KEYLIST "
11110 GOSUB 2300
11120 GOSUB 2500
11130 FOR T = 1 TO 10000
11140 IF T > MRN GOTO 11900
11150 GET #1,T
11160 T1 = CVI(X$(1))
11170 T2 = CVI(X$(2))
11180 L$(T1,T2) = X$(3)
11185 IF T2 > MAXK(T1) THEN MAXK(T1) = T2
11190 NEXT T
11900 KD = 5
11935 CLOSE #1
11937 PRINT FRE(0)
11940 RETURN
12000 REM ****** PRINT SUBROUTINE *****
12010 PRINT "************* FILE : ";F$(A);"- ";"RECORD NUMBER: ";RN;" *************"
12015 IF CSCR = 1 GOTO 34000
12020 FOR Q = 1 TO NREC(A)
12022 GOSUB 12025
12023 NEXT Q
12024 RETURN
12025 IF Q MOD 19 = 0 THEN GOSUB 12170
12030 PRINT Q; TAB(5) FLDN$(A,Q);
12040 ON FTY(A,Q) GOSUB 12050,12070,12100,12130,12142
12045 RETURN
12050 PRINT TAB(26) X$(Q)
12060 RETURN
12070 I%=CVI(X$(Q))
12072 X(N) = I%
12075 PRINT TAB(25) I%;
12080 IF KEYLIST(A,Q) = 0 THEN PRINT ""
12082 IF KEYLIST(A,Q) = 0 THEN GOTO 12150
12084 T1 = KEYLIST(A,Q)
12085 IF I% < 0 THEN I% = 0
12086 W$ = L$(T1,I%)
12090 PRINT TAB(30) "key: ";W$
12095 RETURN
12100 I!=CVS(X$(Q))
12110 PRINT TAB(25) I!
12120 RETURN
12130 I#=CVD(X$(Q))
12135 X(Q) = I#
12140 PRINT TAB(25) I#
12141 RETURN
12142 I#=CVD(X$(Q))
12144 PRINT TAB(26);
12146 PRINT USING "**$########.##";I#
12147 X(Q) = I#
12148 RETURN
12150 RETURN
12152 IF Q < 20 THEN RETURN
12153 PRINT""
12154 PRINT ""
12155 PRINT ""
12156 PRINT ""
12157 PRINT ""
12160 RETURN
12170 PRINT "*** MORE FIELDS, PRESS ANY KEY TO CONTINUE ***"
12180 IF INKEY$ = "" GOTO 12180
12190 RETURN
12200 REM * LINE PRINT
12210 LPRINT ""
12220 PRINT "RECORD NUMBER: ";RN
12230 LPRINT "RECORD NUMBER: ";RN;
12235 IF CSCR = 1 THEN GOTO 35000 ELSE LPRINT ""
12240 FOR Q = 1 TO NREC(A)
12260 LPRINT Q;TAB(5) FLDN$(A,Q);
12270 ON FTY(A,Q) GOTO 12280,12310,12350,12390,12425
12280 REM
12290 LPRINT TAB(26) X$(Q)
12300 GOTO 12480
12310 I%=CVI(X$(Q))
12314 LPRINT TAB(25) I%;
12318 IF KEYLIST(A,Q) = 0 THEN LPRINT ""
12320 IF KEYLIST(A,Q) = 0 THEN GOTO 12480
12322 T1 = KEYLIST(A,Q)
12324 W$ = L$(T1,I%)
12328 LPRINT TAB(30) "key: ";W$
12330 GOTO 12480
12340 GOTO 12480
12350 I!=CVS(X$(Q))
12370 LPRINT TAB(25) I!
12380 GOTO 12480
12390 I#=CVD(X$(Q))
12410 LPRINT TAB(25) I#
12420 GOTO 12480
12425 I#=CVD(X$(Q))
12450 LPRINT TAB(26);
12460 LPRINT USING "**$########.##";I#
12480 NEXT Q
12490 RETURN
12500 PRINT ""
12510 LPRINT ""
12530 LPRINT "RECORD # ";RN;" ";
12540 FOR Q = 1 TO NREC(A)
12547 IF LEND(Q)= 5 THEN LPRINT ""
12548 T2 = CL(Q)
12570 ON FTY(A,Q) GOTO 12590,12610,12730,12770,12810
12590 LPRINT TAB(T2) X$(Q);
12600 GOTO 12860
12610 I%=CVI(X$(Q))
12630 LPRINT TAB(T2)I%;
12660 IF KEYLIST(A,Q) = 0 THEN GOTO 12860
12670 T1 = KEYLIST(A,Q)
12680 W$ = L$(T1,I%)
12685 T1 = CL(Q) + 11
12700 LPRINT TAB(T1)"key: ";W$;
12720 GOTO 12860
12730 I!=CVS(X$(Q))
12750 LPRINT TAB(T2)I!;
12760 GOTO 12860
12770 I#=CVD(X$(Q))
12790 LPRINT TAB(T2)I#;
12800 GOTO 12860
12810 I#=CVD(X$(Q))
12840 LPRINT TAB(T2) "";
12850 LPRINT USING "**$########,.##";I#;
12860 NEXT Q
12870 RETURN
12880 PRINT " HOW MANY COLUMNS ARE THERE ON YOUR PRINTER "
12890 GOSUB 14100
12892 COLM = DT#
12895 RETURN
12900 REM ******* TAB CONTROL *******
12901 C = 15
12902 FOR T = 1 TO NREC(A)
12903 LEND(T) = 0
12905 CL(T)= C
12906 GOSUB 12910
12907 IF C > COLM THEN GOSUB 12970
12908 NEXT T
12909 RETURN
12910 ON FTY(A,T) GOTO 12920,12930,12940,12950,12950
12920 C = C + FL(A,T) + 1
12925 RETURN
12930 C = C + 7
12933 IF KEYLIST(A,T) > 0 THEN C = C + 30
12935 RETURN
12940 C = C + 9
12945 RETURN
12950 C = C + 16
12952 RETURN
12970 CL(T)= 1
12972 C =1
12974 LEND(T) = 5
12975 GOSUB 12910
12980 RETURN
13000 REM CLEAR SCREEN
13010 CLS
13020 RETURN
13050 REM LOCATE - TAB SET IN PROGRAM
13060 GOTO 13110
13100 REM LOCATE - TAB EQUALS ONE
13105 TB = 1
13110 LOCATE LI,TB
13120 RETURN
13600 REM CHECK FOR ASC0
13610 S4$ = INKEY$
13620 C2 = ASC(S4$)
13630 IF C2 = 83 THEN C = 1
13640 IF C2 = 82 THEN C = 6
13650 IF C2 = 75 THEN C = 19
13660 IF C2 = 77 THEN C = 4
13670 RETURN
14000 REM INTEGER LESS THEN 100 CHECK
14010 MAX = 2
14020 ACT$ = " 1234567890=<>^"
14023 IF NE = 0 THEN ACT$ = " 1234567890"
14025 PRINT ">__<";
14030 GOTO 14500
14100 REM INTEGER
14110 MAX = 8
14120 ACT$ = " 1234567890-+,=<>^"
14123 IF NE = 0 THEN ACT$ = " 1234567890-+,"
14125 PRINT ">________<";
14130 GOTO 14500
14200 REM SINGLE PRECISION
14210 MAX = 10
14220 ACT$ = " 1234567890-+,.%$=<>^"
14223 IF NE = 0 THEN ACT$ = " 1234567890+-,.%$"
14225 PRINT ">__________<";
14230 GOTO 14500
14300 REM DOUBLE PRECISION
14310 MAX = 20
14320 ACT$ = " 1234567890-+,.%$=<>^"
14323 IF NE = 0 THEN ACT$ = " 1234567890+-,.%$"
14325 PRINT ">____________________<";
14330 GOTO 14500
14500 REM NUMBER CHECK
14505 A$ = ""
14510 K$(20) = " "
14515 KTMAX = 0
14520 FOR T9 = 1 TO MAX
14525 K$(T9) = " "
14530 NEXT T9
14535 DIG$ = "1234567890."
14540 DOTFLG = 0
14541 T2 = MAX + 1
14542 FOR T6 = 1 TO T2
14544 PRINT CHR$(CH);
14546 NEXT T6
14550 IF INKEY$ = "" GOTO 14560 ELSE GOTO 14550
14560 KT = 0
14565 REM
14570 KT = KT + 1
14575 REM
14580 W$ = INKEY$
14585 IF W$ = "" GOTO 14580
14590 C = ASC(W$)
14593 IF C = 0 THEN GOSUB 13600
14595 IF C = 13 GOTO 14660
14600 IF C = 17 OR C = 8 GOTO 14860
14605 IF C = 19 GOTO 14690
14610 IF C = 4 GOTO 14710
14615 IF C = 6 GOTO 14730
14620 IF C = 1 GOTO 14790
14625 IF KT > MAX GOTO 14575
14630 IF INSTR(ACT$,W$) = 0 GOTO 14890
14635 K$(KT) = W$
14645 PRINT K$(KT);
14650 IF KT > KTMAX THEN KTMAX = KT
14655 GOTO 14570
14660 REM * RETURN
14670 FOR T9 = 1 TO KTMAX
14675 A$ = A$ + K$(T9)
14676 IF K$(T9) = "^" GOTO 15830
14677 IF K$(T9) = ">" GOTO 15950
14678 IF K$(T9) = "=" GOTO 15800
14679 IF K$(T9) = "<" GOTO 15900
14680 NEXT T9
14681 IF KTMAX = 0 THEN PRINT "1";
14682 IF KTMAX = 0 THEN DT# = 1
14684 IF SPRT >< 5 THEN PRINT ""
14685 SPRT = 0
14686 IF KTMAX = 0 THEN RETURN
14687 GOTO 14905
14689 GOTO 14905
14690 REM * MOVE CURSE BACK
14695 IF KT = 1 GOTO 14575
14700 KT = KT - 1
14703 PRINT CHR$(CH);
14705 GOTO 14575
14710 REM * MOVE CURSER FORWARD
14715 IF KT >= MAX GOTO 14575
14716 IF KT > (KTMAX + 1) GOTO 14575
14718 PRINT K$(KT);
14720 KT = KT + 1
14725 GOTO 14575
14730 REM * INSERT
14733 IF KT > KTMAX GOTO 14575
14735 X9 = MAX
14740 WHILE X9 > KT
14745 X9 = X9 - 1
14750 K$(X9 + 1) = K$(X9)
14755 WEND
14760 K$(KT) = " "
14767 KTMAX = KTMAX + 1
14769 IF KTMAX > MAX THEN KTMAX = MAX
14770 FOR T9 = KT TO KTMAX
14775 PRINT K$(T9);
14780 NEXT T9
14781 T6 = (KTMAX - KT) + 1
14782 FOR T7 = 1 TO T6
14783 PRINT CHR$(CH);
14784 NEXT T7
14785 GOTO 14575
14790 REM * DELETE
14793 IF KT > KTMAX GOTO 14575
14794 IF KTMAX = 1 GOTO 14575
14795 K$(MAX + 1) = ""
14800 X9 = KT
14805 WHILE X9 <= MAX
14810 K$(X9) = K$(X9 + 1)
14815 X9 = X9 + 1
14820 WEND
14830 KTMAX = KTMAX - 1
14835 FOR T9 = KT TO KTMAX
14840 PRINT K$(T9);
14845 NEXT T9
14850 PRINT "_";
14851 T7 = (KTMAX - KT) + 2
14852 FOR T8 = 1 TO T7
14853 PRINT CHR$(CH);
14854 NEXT T8
14855 GOTO 14575
14860 REM BACKSPACE
14865 IF KT = 1 GOTO 14575
14870 KT = KT - 1
14875 PRINT CHR$(CH);
14877 K$(KT) = " "
14880 PRINT "_";
14883 PRINT CHR$(CH);
14885 GOTO 14575
14890 REM INPUT NOT ACCEPTABLE
14895 PRINT CHR$(7);
14900 GOTO 14580
14905 REM * CLEAR STRINGS
14910 MAX = LEN(A$)
14915 D2$ = ""
14920 D1$ = ""
14925 DFLG = 0
14930 FOR Q93 = 1 TO MAX
14935 R$ = MID$(A$,Q93,1)
14940 IF INSTR(DIG$,R$) = 0 GOTO 14975
14945 IF R$ = "." OR DFLG = 1 GOTO 14965
14950 IF DFLG = 1 GOTO 14965
14955 D2$ = D2$ + R$
14960 GOTO 14975
14965 D1$ = D1$ + R$
14970 DFLG = 1
14975 NEXT Q93
14980 DA# = VAL(D2$)
14985 D1# = VAL(D1$)
14990 DT# = DA# + D1#
14995 IF K$(1) = "-" THEN DT# = -DT#
14997 RETURN
15000 REM * ALPHANUMERIC CHECK
15010 MAX = FL(A,Q)
15020 GOTO 15040
15030 REM * MAX SET IN PROGRAM
15040 A$ = ""
15050 PRINT ">";
15060 FOR N9 = 1 TO MAX
15065 K$(N9) = ""
15070 PRINT "_";
15080 NEXT N9
15090 PRINT "<";
15100 T2 = MAX + 1
15110 FOR T4 = 1 TO T2
15120 PRINT CHR$(CH);
15125 NEXT T4
15130 KT = 0
15135 KTMAX = 1
15140 REM * CHECK ALFANUMERIC INPUT FOR LENGTH
15150 KT = KT + 1
15160 PRINT TAB(KT+1)"";
15170 K$ = INKEY$
15180 IF K$ = "" GOTO 15170
15190 C = ASC(K$)
15195 IF C = 0 THEN GOSUB 13600
15200 IF C = 13 GOTO 15310
15210 IF C = 17 OR C = 8 GOTO 15710
15220 IF C = 19 GOTO 15370
15230 IF C = 4 GOTO 15410
15240 IF C = 6 GOTO 15450
15250 IF C = 1 GOTO 15570
15260 IF KT > MAX GOTO 15160
15270 K$(KT) = K$
15290 PRINT K$(KT);
15295 IF KT > KTMAX THEN KTMAX = KT
15300 GOTO 15150
15310 REM * RETURN
15320 FOR T9 = 1 TO MAX
15330 A$ = A$ + K$(T9)
15332 IF K$(T9) = "^" GOTO 15830
15333 IF K$(T9) = ">" GOTO 15950
15335 IF K$(T9) = "=" GOTO 15850
15338 IF K$(T9) = "<" GOTO 15900
15340 NEXT T9
15350 PRINT ""
15360 RETURN
15370 REM * MOVE CURSE BACK
15380 IF KT = 1 GOTO 15160
15385 KT = KT - 1
15390 PRINT CHR$(CH);
15400 GOTO 15160
15410 REM * MOVE CURSER FORWARD
15420 IF KT >= MAX GOTO 15160
15425 IF KT > KTMAX GOTO 15160
15427 PRINT K$(KT);
15430 KT = KT + 1
15440 GOTO 15160
15450 REM INSERT*
15460 X9 = MAX
15470 WHILE X9 > KT
15480 X9 = X9 - 1
15490 K$(X9 + 1) = K$(X9)
15500 WEND
15510 K$(KT) = " "
15520 KTMAX = KTMAX + 1
15525 IF KTMAX > MAX THEN KTMAX = MAX
15530 FOR T9 = KT TO KTMAX
15540 PRINT K$(T9);
15550 NEXT T9
15552 T6 = (KTMAX - KT) +1
15554 FOR T7 = 1 TO T6
15556 PRINT CHR$(CH);
15558 NEXT T7
15560 GOTO 15160
15570 REM *DELETE
15575 IF KT > KTMAX GOTO 15170
15578 IF KTMAX = 1 GOTO 15160
15580 K$(MAX + 1) = ""
15590 X9 = KT
15600 WHILE X9 <= KTMAX
15610 K$(X9) = K$(X9 + 1)
15620 X9 = X9 + 1
15630 WEND
15650 KTMAX = KTMAX - 1
15660 FOR T9 = KT TO KTMAX
15670 PRINT K$(T9);
15680 NEXT T9
15690 PRINT "_";
15692 T7 = (KTMAX - KT) + 2
15694 FOR T6 = 1 TO T7
15696 PRINT CHR$(CH);
15698 NEXT T6
15700 GOTO 15160
15710 REM * BACKSPACE
15720 IF KT = 1 GOTO 15160
15725 K$(KT) = " "
15730 KT = KT - 1
15735 K$(KT) = " "
15740 PRINT CHR$(CH);
15750 PRINT "_";
15755 PRINT CHR$(CH);
15760 GOTO 15160
15800 REM * SAME ENTRY AS LAST RECORD
15810 DT# = X(N)
15820 RETURN
15830 REM * SAME ENTRY AS LAST RECORD OVER ONE COLUMN
15835 DT# = X(N + 1)
15840 RETURN
15850 REM * SAME ENTRY AS LAST RECORD ALFANUMERIC
15860 A$ = CK$(N)
15870 RETURN
15900 REM RESTART DATA ENTRY*
15910 REFLG = 1
15915 IF NE = 0 GOTO 15340
15920 RETURN
15950 REM * ABORT NEW DATA ENTRY
15960 IF NE = 0 GOTO 15340
15970 ABORTFLG = 1
15980 RETURN
16000 GOSUB 13000
16010 PRINT "*********** MAKE SURE YOUR PRINTER IS ON **************"
16020 PRINT ""
16030 PRINT "******************** WITH PAPER ***********************"
16040 PRINT ""
16050 PRINT "********** PRESS ANY KEY TO START PRINTING ************"
16055 PRINT ""
16057 PRINT " ******* PRESS THE LETTER A TO ABORT *******"
16070 T$ = INKEY$
16073 IF T$ = "" GOTO 16070
16075 PRINT T$
16085 IF T$ = "A" OR T$ = "a" THEN GOTO 3010
16090 RETURN
16200 REM * PRINT OUT FIELDS
16205 T2 = 1
16210 FOR T = 1 TO NREC(A)
16220 PRINT TAB(T2) T;"-";FLDN$(A,T);
16230 IF T MOD 2 = 0 THEN PRINT ""
16235 IF T MOD 2 = 0 THEN T2 = -25
16237 T2 = T2 + 26
16340 NEXT T
16350 RETURN
16800 REM * HARD DISK OPTION
16810 GOSUB 13000
16820 PRINT "**************** ARE YOU USING A HARD DISK *******************"
16830 PRINT ""
16840 PRINT " 1 - NO , I AM USING FLOPPY DISKS"
16845 PRINT ""
16850 PRINT " 2 - YES, I AM USING A HARD DISK"
16852 PRINT " with all my files on the hard disk"
16854 PRINT " and the hard disk is the default drive"
16860 PRINT ""
16870 PRINT "************* ENTER THE NUMBER THEN PRESS RETURN *************"
16880 GOSUB 14000
16890 IF DT#<1 OR DT#>2 GOTO 16880
16900 HDISK = DT#
16910 RETURN
17000 REM
17005 RNB = 0
17010 GOSUB 13000
17020 PRINT "****************** SEARCH A SORTED FILE *******************"
17030 PRINT ""
17040 GOSUB 16200
17060 PRINT ""
17070 PRINT "*********** ENTER ZERO TO RETURN TO INITIAL MENU **********"
17080 PRINT ""
17090 PRINT "************ WHAT FIELD IS THIS FILE SORTED BY ************"
17100 GOSUB 14000
17101 IF DT# <0 OR DT# >NREC(A) GOTO 17100
17105 SF = DT#
17110 IF SF = 0 GOTO 3010
17120 PRINT "********* WHAT VALUE DO YOU WANT TO SEARCH FOR ? **********"
17130 PRINT FLDN$(A,SF);"="
17150 ON FTY(A,SF) GOTO 17160,17200,17250,17300,17300
17160 MAX = FL(A,SF)
17162 GOSUB 15030
17164 SV$ = A$
17166 LN = LEN(A$)
17170 GOTO 17350
17200 GOSUB 14100
17202 SV% = DT#
17205 SV$ = MKI$(SV%)
17210 GOTO 17350
17250 GOSUB 14200
17252 SV! = DT#
17255 SV$ = MKS$(SV!)
17260 GOTO 17350
17300 GOSUB 14300
17305 SV$ = MKD$(DT#)
17350 REM START SEARCH*
17360 RN = 8192
17365 I!= RN
17368 IF RN > MRN GOTO 17800
17370 GET #1,RN
17375 I!= I!/ 2
17376 IF FTY(A,SF) = 1 THEN XT$ = LEFT$(X$(SF),LN) ELSE XT$=X$(SF)
17377 IF I!< 1 THEN GOTO 17900
17378 IF XT$ = SV$ THEN RNB = RN
17380 IF XT$ < SV$ THEN GOTO 17500
17390 RN = RN - I!
17400 GOTO 17368
17500 RN = RN + I!
17510 GOTO 17368
17600 REM
17610 GOTO 8057
17800 REM ON ERROR ROUTINE
17801 I!= I!/ 2
17802 IF I!< 1 GOTO 17900
17805 RN = RN - I!
17810 GOTO 17368
17900 IF XT$ = SV$ THEN GOTO 17950
17902 IF RNB > 0 THEN RN = RNB
17904 IF RNB > 0 THEN GOTO 8057
17906 PRINT " RECORD NOT FOUND "
17910 GOTO 17000
17950 PRINT "RN = ";RN
17960 GOTO 8057
18000 REM
18005 SFLG = 1
18010 GOSUB 13000
18020 PRINT "********************* SEARCH FILE ***********************"
18030 PRINT ""
18040 GOSUB 16200
18060 PRINT ""
18070 PRINT "*********** ENTER ZERO TO RETURN TO INITIAL MENU **********"
18080 PRINT ""
18090 PRINT "************* WHICH FIELD DO YOU WANT TO SEARCH ***********"
18100 GOSUB 14000
18101 IF DT# <0 OR DT# >NREC(A) GOTO 18100
18105 SF = DT#
18110 IF SF = 0 GOTO 3010
18120 PRINT "********* WHAT VALUE DO YOU WANT TO SEARCH FOR ? **********"
18130 PRINT FLDN$(A,SF);"="
18150 ON FTY(A,SF) GOTO 18160,18200,18250,18300,18300
18160 MAX = FL(A,SF)
18162 GOSUB 15030
18164 SV$ = A$
18166 LN = LEN(A$)
18170 GOTO 18350
18200 GOSUB 14100
18202 SV% = DT#
18205 SV$ = MKI$(SV%)
18210 GOTO 18350
18250 GOSUB 14200
18252 SV! = DT#
18255 SV$ = MKS$(SV!)
18260 GOTO 18350
18300 GOSUB 14300
18305 SV$ = MKD$(DT#)
18350 REM * START SEARCH
18360 GOSUB 18800
18365 FOR RN = RNSS TO MRN
18370 GET #1,RN
18376 IF FTY(A,SF) = 1 THEN XT$ = LEFT$(X$(SF),LN) ELSE XT$=X$(SF)
18378 IF XT$ = SV$ THEN GOTO 8057
18380 NEXT RN
18390 GOTO 3010
18800 REM * GET STARTING AND ENDING FILE
18803 PRINT ""
18805 PRINT "MINIMUM RECORD NUMBER = 1 MAXIMUM RECORD NUMBER = ";MRN
18810 PRINT "****** WHICH RECORD NUMBER DO YOU WANT TO START THE SEARCH AT ******"
18820 GOSUB 14100
18830 IF DT#<1 OR DT#>MRN THEN 18820
18840 RNSS = DT#
18900 RETURN
20000 REM ***** GET UPPER LIMIT
20010 GOSUB 20050
20020 GOSUB 20400
20030 GOTO 21000
20050 RNU = RN
20060 TESTH$ = TEST$
20100 WHILE TEST$ = TESTH$
20110 RNU = RNU - 1
20115 IF RNU = 0 THEN GOTO 20140
20120 GET #1,RNU
20130 WEND
20140 RNU = RNU + 1
20200 REM * GET LOWER LIMIT
20250 RNL = RN
20290 GET #1,RNL
20300 WHILE TEST$ = TESTH$
20310 RNL = RNL + 1
20315 IF RNL > MRN THEN GOTO 20340
20320 GET #1,RNL
20330 WEND
20340 RNL = RNL - 1
20350 RETURN
20400 REM * SET SUMS TO ZERO
20410 FOR T = 1 TO 28
20420 SUM#(T) = 0
20430 NEXT T
20450 RETURN
21000 REM * PRINT REPIOTIOUS FIELDS
21050 OFFSET = -1
21100 FOR TH = RNU TO RNL
21105 OFFSET = OFFSET + 1
21110 GET #1,TH
21120 T2 = LSTE + 1
21130 FOR N = T2 TO NREC(A)
21140 GOSUB 34110
21150 NEXT N
21160 NEXT TH
21180 LI = 1
21182 TB = 47
21185 GOSUB 13050
21190 PRINT "RECORDS";RNU;" TO ";RNL;" *******"
21195 RN = RNL
21200 GOTO 8510
26000 REM
26100 EFLG = 1
26200 PRINT "********** END OF FILE ***********"
26202 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
26204 IF INKEY$ = "" GOTO 26204
26210 GOTO 3010
26500 REM
26600 PRINT "********** END OF FILE ***********"
26610 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
26620 IF INKEY$ = "" GOTO 26620
26635 EFLG = 1
26640 RETURN
26800 REM
26900 PRINT "****** RECORD NUMBER REQUESTED DOES NOT EXIST ******"
26910 GOTO 8020
27000 REM * READ SCREEN TEST
27005 GOSUB 10900
27010 OPEN "I",#1,"SCTEST"
27020 FOR T = 1 TO 40
27030 INPUT #1,SCRN(T)
27040 NEXT T
27050 CLOSE #1
27060 RETURN
27070 REM * READ SCREEN DESCRIPTION
27071 GOSUB 10900
27072 A$ = STR$(A)
27074 A$ = MID$(A$,2)
27076 A$ = "SCREEN" + A$
27080 OPEN "I",#2,A$
27090 FOR T = 1 TO 18
27100 INPUT #2,SW$(T)
27110 NEXT T
27120 FOR T = 1 TO NREC(A)
27130 INPUT #2,LE(T),CE(T)
27140 IF FTY(A,T) = 2 THEN INPUT #2,LEK(T),CEK(T)
27150 NEXT T
27160 INPUT #2,RPT
27170 IF RPT = 2 THEN GOSUB 27200
27180 CLOSE #2
27190 RETURN
27200 INPUT #2,LSTE
27210 T2 = LSTE + 1
27220 FOR T = T2 TO NREC(A)
27230 INPUT #2,SUMF(T)
27240 NEXT T
27245 H = 0
27250 FOR T = 1 TO LSTE
27260 H = FL(A,T) + H
27270 NEXT T
27280 FIELD #1,H AS TEST$
27300 RETURN
28000 REM
28100 GOSUB 13000
28110 PRINT "********** DO YOU WANT TO USE THE STANDARD OR YOUR CUSTOM SCREEN **********"
28115 PRINT ""
28120 PRINT " 1 - USE THE CUSTOM SCREEN"
28125 PRINT ""
28130 PRINT " 2 - USE THE STANDARD SCREEN"
28135 PRINT ""
28140 PRINT "******************* ENTER THE NUMBER THEN PRESS RETURN ********************"
28200 GOSUB 14000
28210 IF DT# < 1 OR DT# > 2 THEN 28200
28220 CSCR = DT#
28230 IF CSCR = 1 THEN GOSUB 27070
28300 RETURN
29000 REM * READ IDEX SUBROUTINE
29010 OPEN "I",#1,"IDEX"
29020 FOR T = 1 TO MAXF
29030 INPUT #1,D,D,D,MFLG(T)
29040 NEXT T
29050 CLOSE #1
29060 RETURN
29070 REM * READ MAX MIN DATA
29080 A$ = STR$(A)
29090 A$ = MID$(A$,2)
29100 A$ = "MAXMIN" + A$
29110 OPEN "I",#2,A$
29120 FOR T = 1 TO NREC(A)
29130 INPUT #2,MAXC#(T),MINC#(T)
29140 NEXT T
29150 CLOSE #2
29160 RETURN
29190 N = D
29200 REM * CHECK MAX LIMITS
29210 IF DT# < MINC#(N) OR DT# > MAXC#(N) THEN GOSUB 29300
29220 RETURN
29300 PRINT CHR$(7);
29310 PRINT CHR$(7);
29329 RETURN
30000 REM * PRINT OVERLAY
30005 GOSUB 20400
30010 OFFSET = 0
30100 FOR T = 1 TO 18
30110 PRINT SW$(T)
30120 NEXT T
30130 RETURN
31000 REM * PRINT FIELDS
31010 X(N) = I#
31100 IF LE(N) = 0 THEN RETURN
31110 LI = LE(N) + 1 + OFFSET
31115 TB = CE(N)
31120 GOSUB 13050
31130 ON FTY(A,N) GOSUB 32000,32100,32100,32100,32200
31140 IF KEYLIST(A,N) > 0 THEN GOSUB 33000
31145 IF SUMF(N) = 2 THEN GOSUB 39200
31150 RETURN
32000 REM STRINGS *
32010 PRINT I$
32020 RETURN
32100 PRINT I#
32110 RETURN
32200 REM *$$$$
32210 PRINT USING "**$########.##";I#
32220 RETURN
33000 REM * PRINT KEYS
33100 IF LEK(N) = 0 THEN RETURN
33110 LI = LEK(N) + 1 + OFFSET
33120 REM
33130 TB = CEK(N)
33140 GOSUB 13050
33150 T1 = KEYLIST(A,N)
33160 PRINT L$(T1,I#)
33170 RETURN
34000 REM * PRINT FIELDS
34050 GOSUB 30000
34100 FOR N = 1 TO NREC(A)
34102 GOSUB 34110
34104 NEXT N
34110 ON FTY(A,N) GOSUB 34200,34300,34500,34600,34600
34120 GOSUB 31000
34140 RETURN
34200 I$ = X$(N)
34250 RETURN
34300 I#=CVI(X$(N))
34310 X(N) = I#
34350 RETURN
34500 I#=CVS(X$(N))
34550 RETURN
34600 I#=CVD(X$(N))
34610 X(N) = I#
34650 RETURN
35000 REM * PRINT OVERLAY
35010 EFLG = 0
35030 IF RPT = 2 THEN LPRINT "AND SUBRECORDS" ELSE LPRINT ""
35050 GOSUB 20400
35100 FOR T = 1 TO 18
35110 LPRINT SW$(T);
35115 GOSUB 35200
35117 IF EFLG = 1 THEN RETURN
35120 NEXT T
35130 RETURN
35200 REM * LPRINT FIELDS
35210 FOR T2 = 1 TO NREC(A)
35220 IF LE(T2) = T THEN GOSUB 36000
35300 IF LEK(T2) = T THEN GOSUB 39000
35400 NEXT T2
35410 LPRINT ""
35500 RETURN
35600 REM * LPRINT REPEATING FIELDS
35650 GOSUB 20050
35655 T3 = LSTE + 1
35657 RN = RNL
35660 FOR TH = RNU TO RNL
35665 GET #1,TH
35670 FOR N = T3 TO NREC(A)
35675 T2 = N
35680 GOSUB 36100
35685 IF SUMF(N) = 2 THEN SUM#(N) = SUM#(N) + I#
35687 IF FTY(A,N) = 2 AND LEK(N) > 0 THEN GOSUB 39000
35690 NEXT N
35700 LPRINT ""
35710 NEXT TH
35750 REM * LPRINT SUMS
35755 EFLG = 1
35760 FOR N = LSTE TO NREC(A)
35770 IF SUMF(N) = 2 THEN GOSUB 35900
35780 NEXT N
35790 RETURN
35900 REM
35905 TB = CE(N)
35906 LPRINT TAB(TB);
35907 IF FTY(A,N) = 5 THEN GOTO 35950
35910 LPRINT TAB(TB) SUM#(N);
35920 RETURN
35950 LPRINT USING "**$########.##";SUM#(N);
35960 RETURN
36000 REM * LPRINT FIELDS
36050 N = T2
36060 IF RPT = 2 AND N > LSTE THEN GOTO 35600
36100 ON FTY(A,T2) GOSUB 34200,34300,34500,34600,34600
36200 GOTO 37000
37000 REM * PRINT FIELDS
37115 TB = CE(T2)
37125 LPRINT TAB(TB) "";
37130 ON FTY(A,T2) GOSUB 38010,38100,38100,38100,38200
37150 RETURN
38000 REM STRINGS *
38010 LPRINT I$;
38020 RETURN
38100 LPRINT I#;
38110 RETURN
38200 REM * $$$$
38210 LPRINT USING "**$########.##";I#;
38220 RETURN
39000 REM * PRINT KEYS
39010 ON FTY(A,T2) GOSUB 34200,34300,34500,34600,34600
39090 N = T2
39130 TB = CEK(T2)
39140 LPRINT TAB(TB) "";
39150 T1 = KEYLIST(A,T2)
39160 LPRINT L$(T1,I#);
39170 RETURN
39200 REM * PRINT TOTALS
39300 SUM#(N) = SUM#(N) + I#
39310 LI = 19
39320 GOSUB 13050
39330 IF FTY(A,N) = 5 THEN GOTO 39600
39400 PRINT SUM#(N);
39410 RETURN
39600 REM $$$$$
39610 PRINT USING "**$########.##";SUM#(N);
39620 RETURN
40000 REM * NEW INPUT
40002 ABORTFLG = 0
40008 IF REALFLG(A) = 2 THEN GOSUB 60200
40010 GOSUB 13000
40015 IF DATAIN = 1 GOTO 40500
40017 GOSUB 40020
40018 GOTO 40500
40020 REM READ INPUT DATA
40021 GOSUB 49000
40022 GOSUB 10900
40025 A$ = STR$(A)
40027 A$ = MID$(A$,2)
40030 N$ = "IPUTD"+A$
40040 OPEN "I",#2,N$
40050 INPUT #2,NREC(A)
40060 FOR N3= 1 TO NREC(A)
40062 N = N3
40070 INPUT #2,IOPT(N)
40080 ON IOPT(N) GOTO 40090,40120,40150,40210,40240,40270,40430,40370,40370,40430,40430,40430,40210
40085 GOTO 40450
40090 REM OPERATOR ENTRY*
40100 INPUT #2,PROMPT$(N)
40110 GOTO 40450
40120 REM GET FROM ANOTHER FILE*
40130 INPUT #2,IFN(N),IFLD(N),IRNFLD(N)
40132 GFLG(IFN(N)) = 1
40134 GFLG(IFLD(N)) = 1
40136 GFLG(IRNFLD(N)) = 1
40140 GOTO 40450
40150 REM ADD PREVIOUS FIELDS*
40160 INPUT #2,NOS(N)
40170 FOR T = 1 TO NOS(N)
40180 INPUT #2,ADDFLD(N,T)
40185 GFLG(ADDFLD(N,T)) = 1
40190 NEXT T
40200 GOTO 40450
40210 REM SUBTRACT PREVIOUS FIELDS*
40220 INPUT #2, SUBX(N),SUBY(N)
40222 GFLG(SUBX(N)) = 1
40224 GFLG(SUBY(N)) = 1
40230 GOTO 40450
40240 REM MULTIPLY FIELDS*
40250 INPUT #2, MULX(N),MULY(N)
40252 GFLG(MULX(N)) = 1
40254 GFLG(MULY(N)) = 1
40260 GOTO 40450
40270 REM GET FROM A TABLE*
40280 INPUT #2,TX(1,N),TX(2,N),TX(3,N),TX(4,N),TX(5,N),TX(6,N)
40282 GFLG(TX(2,N)) = 1
40283 GFLG(TX(4,N)) = 1
40284 GFLG(TX(5,N)) = 1
40285 GFLG(TX(6,N)) = 1
40290 TTBL = 5
40310 GOTO 40450
40370 REM MAXIMUM*
40380 INPUT #2,NOS(N)
40390 FOR T = 1 TO NOS(N)
40400 INPUT #2,MAXMIN(N,T)
40405 GFLG(MAXMIN(N,T)) = 1
40410 NEXT T
40420 GOTO 40450
40430 REM CONSTANT*
40440 INPUT #2,KC(N),CFLD(N)
40445 GFLG(CFLD(N)) = 1
40450 NEXT N3
40460 CLOSE #2
40470 DATAIN = 1
40480 RETURN
40500 REM OPEN SECOND FILE*
40505 IF TWOOPEN = 1 THEN 40637
40507 TWOOPEN = 1
40510 FOR T = 1 TO NREC(A)
40520 IF IOPT(T) = 2 GOTO 40600
40530 NEXT T
40540 GOTO 40640
40600 B = IFN(T)
40602 AHLD = A
40604 A = B
40610 PRINT F$(B), " SECOND FILE FOR CUSTOM INPUT "
40620 GOSUB 2300
40625 A = AHLD
40630 GOSUB 2550
40635 GOSUB 7950
40637 IF TAXIN = 1 THEN 41000
40638 TAXIN = 1
40640 FOR T = 1 TO NREC(A)
40650 IF IOPT(T) = 6 GOTO 40800
40660 NEXT T
40670 GOTO 41000
40800 GOSUB 45000
41000 REM CUSTOM INPUT ROUTINE*
41010 GOSUB 13000
41012 OFFSET = 0
41014 IF REALFLG(A) = 2 AND RN <= MRN THEN GOSUB 61300
41015 PRINT "***************** FILE NAME :";F$(A);" ";"RECORD NUMBER :";RN;" ****************"
41030 IF CSCR = 1 THEN GOSUB 30000
41080 LI = 25
41082 GOSUB 13100
41085 PRINT "[ = SAME AS LAST RECORD , < BACK UP , > ABORT THIS RECORD , ^ EQUALLAST OVER 1]";
41087 GOTO 41130
41092 LI = 20
41093 GOSUB 13100
41094 PRINT " "
41095 PRINT " "
41096 PRINT " "
41097 PRINT " "
41100 PRINT " ";
41110 LI = 20
41115 GOSUB 13100
41120 PRINT "ON FIELD NUMBER : ";N;" FIELD NAME : ";FLDN$(A,N);" : "
41125 RETURN
41130 N = 1
41133 WHILE N <= NREC(A)
41135 REFLG = 0
41137 IF N < 1 THEN N = 1
41140 ON IOPT(N) GOSUB 41200,41400,41600,41800,42000,42200,42600,42800,43000,43200,43400,43600,41800,53000,54000,55000,56000,57000,58000,59000
41150 GOSUB 43800
41155 N = N + 1
41160 WEND
41165 GOTO 44910
41170 REM * BACK UP FIELDS UNTIL IOPT = 1
41175 N = N - 1
41180 IF N < 1 THEN 41133
41185 IF IOPT(N) <> 1 THEN 41175
41190 GOTO 41133
41200 REM * OPERATOR ENTRY
41202 NE = 1
41205 GOSUB 41092
41210 PRINT PROMPT$(N)
41215 REFLG = 0
41220 IF FTY(A,N) = 1 GOTO 41300
41230 ON FTY(A,N) GOSUB 15000,14100,14200,14300,14300
41234 IF REFLG = 1 THEN GOTO 41170
41235 IF ABORTFLG = 1 GOTO 7000
41236 IF MFLG(A) = 2 AND FTY(A,N) <> 1 THEN GOSUB 29200
41237 T2 = KEYLIST(A,N)
41238 T3 = MAXK(T2)
41239 REM IF KY(A,N) = 2 AND (DT# < 1 OR DT# > T3) GOTO 41230
41240 I# = DT#
41245 NE = 0
41250 RETURN
41298 REFLG = 0
41300 Q = N
41302 GOSUB 15000
41303 IF ABORTFLG = 1 GOTO 7000
41304 I$ = A$
41306 NE = 0
41308 IF REFLG = 1 GOTO 41170
41310 RETURN
41400 REM GET FROM ANOTHER FILE*
41402 FLD = IFLD(N)
41404 T = IRNFLD(N)
41406 RN2= X(T)
41407 IF RN2 > MRNS THEN GOTO 48000
41408 GET #2,RN2
41409 B = IFN(N)
41420 ON FTY(B,FLD) GOTO 41422,41460,41500,41550,41550
41422 I$ = Y$(FLD)
41430 RETURN
41460 Y$ = Y$(FLD)
41465 I% = CVI(Y$)
41467 I# = I%
41470 RETURN
41500 I! = CVS(Y$(FLD))
41505 I# = I!
41510 RETURN
41550 I# = CVD(Y$(FLD))
41560 GOTO 43800
41600 REM ADD PREVIOUS FIELDS*
41605 I# = 0
41610 FOR T = 1 TO NOS(N)
41620 T2 = ADDFLD(N,T)
41630 I# = I# + X(T2)
41640 NEXT T
41650 RETURN
41800 REM SUBTRACT FIELDS
41810 T1 = SUBX(N)
41820 T2 = SUBY(N)
41830 IF IOPT(N) = 4 THEN I# = X(T1) - X(T2) ELSE I# = X(T1)/X(T2)
41840 RETURN
42000 REM MULTIPLY FIELDS
42010 T1 = MULX(N)
42020 T2 = MULY(N)
42030 I# = X(T1) * X(T2)
42040 RETURN
42200 REM GET FROM A TABLE
42210 ON TX(1,N) GOSUB 42400,42450
42220 ON TX(3,N) GOSUB 42500,42550
42230 Y = TX(5,N)
42240 MSS = X(Y)
42250 Y = TX(6,N)
42260 PAY# = X(Y)
42270 GOSUB 45500
42272 I# = TTAX#
42290 RETURN
42400 FSS = TX(2,N)
42410 RETURN
42450 Y = TX(2,N)
42460 FSS = X(Y)
42470 RETURN
42500 PPS = TX(4,N)
42510 RETURN
42550 Y = TX(4,N)
42560 PPS = X(Y)
42570 RETURN
42600 REM CONSTANT
42610 I# = KC(N)
42620 RETURN
42800 REM MAXIMUM
42802 T2 = MAXMIN(N,1)
42804 I# = X(T2)
42810 FOR T = 2 TO NOS(N)
42820 T2 = MAXMIN(N,T)
42830 IF X(T2) > I# THEN I# = X(T2)
42840 NEXT T
42850 RETURN
43000 REM MINIMUM*
43002 T2 = MAXMIN(N,1)
43004 I# = X(T2)
43010 FOR T = 2 TO NOS(N)
43020 T2 = MAXMIN(N,T)
43030 IF X(T2) < I# THEN I# = X(T2)
43040 NEXT T
43050 RETURN
43200 REM MULTIPLY BY A CONSTANT*
43210 T = CFLD(N)
43220 I# = KC(N) * X(T)
43230 RETURN
43400 REM ADD A CONSTANT*
43410 T = CFLD(N)
43420 I# = KC(N) + X(T)
43430 RETURN
43600 REM SUBTRACT A CONSTANT
43610 T = CFLD(N)
43620 I# = X(T) - KC(N)
43630 RETURN
43800 REM LSET
43810 ON FTY(A,N) GOTO 43900,44000,44100,44200,44200
43900 REM STRING*
43910 LSET X$(N) = I$
43920 CK$(N) = I$
43990 GOTO 44400
44000 REM INTEGER *
44020 LSET X$(N) = MKI$(I#)
44030 GOTO 44400
44100 REM SINGLE PRECISION*
44110 I! = I#
44120 LSET X$(N) = MKS$(I#)
44130 GOTO 44400
44200 REM DOUBLE PRECISION*
44210 LSET X$(N) = MKD$(I#)
44400 X(N) = I#
44410 IF CALFLG = 5 THEN RETURN
44500 IF CSCR = 1 THEN GOSUB 31000
44501 IF CSCR = 1 THEN GOTO 44900
44502 IF N < 19 THEN HT = N + 1
44503 IF N >= 19 THEN HT = N MOD 18 + 2
44504 LI = HT
44505 GOSUB 13100
44506 IF N <18 GOTO 44510
44507 PRINT " ";
44508 GOSUB 13100
44510 PRINT N;TAB(5) FLDN$(A,N);
44515 IF KEYLIST(A,N) > 0 GOTO 44800
44520 IF FTY(A,N) = 1 GOTO 44600
44525 IF FTY(A,N) = 5 GOTO 44700
44530 PRINT TAB(25) I#
44535 X(N) = I#
44540 GOTO 44900
44600 PRINT TAB(26) I$
44610 GOTO 44900
44700 PRINT TAB(26);
44710 PRINT USING "**$########.##";I#
44715 X(N) = I#
44720 GOTO 44900
44800 REM KEYLIST
44810 T1 = KEYLIST(A,N)
44820 W$ = L$(T1,I#)
44830 PRINT TAB(25) I#;
44835 X(N) = I#
44840 PRINT TAB(30) "key ";W$
44900 RETURN
44910 PUT #1,RN
44912 IF REALFLG(A) = 2 THEN GOSUB 60300
44913 IF REALFLG(A) = 2 AND RN <= MRN THEN GOSUB 61400
44915 IF RN > MRN THEN MRN = RN
44920 LI = 20
44925 GOSUB 13100
44930 PRINT "*********************** OPTIONS : ************************ "
44940 PRINT " 1 - ENTER NEXT RECORD 3 - CORRECT THIS RECORD "
44950 PRINT " 2 - ENTER ANOTHER RECORD 4 - ENTER A SUBRECORD "
44960 PRINT "*************** 0 - RETURN TO FILE OPTIONS ************** "
44962 SPRT = 5
44965 GOSUB 14000
44967 IF DT# <0 OR DT# >4 GOTO 44920
44970 TH = DT#
44975 IF TH = 2 THEN RETURN
44980 IF TH = 0 THEN GOTO 3010
44985 IF TH = 3 THEN GOSUB 9000
44987 IF TH = 3 THEN GOTO 44920
44988 IF TH = 4 AND RPT <> 2 THEN 44996
44989 IF TH = 4 THEN GOTO 52000
44990 RN = RN + 1
44995 GOTO 41000
44996 LI = 24
44997 GOSUB 13100
44998 PRINT TAB(10) "SUBRECORDS ARE NOT SET UP ON THIS FILE";
44999 GOTO 44920
45000 REM
45001 IF HDISK = 2 THEN GOTO 45010
45002 GOSUB 13000
45004 PRINT " PUT THE FLOPPY DISK WITH THE TAX SCHEDULE ON IT IN"
45005 PRINT " IN THE DEFAULT DISK DRIVE "
45006 PRINT ""
45007 PRINT " **** THEN PRESS ANY KEY TO CONTINUE **** "
45008 IF INKEY$ = "" THEN GOTO 45008
45010 OPEN "R",#3,"TAXSCH",82
45015 FIELD #3,40 AS D$,2 AS FD$,2 AS PP$,2 AS MS$,8 AS MIN$,8 AS MAX$,8 AS TX$,4 AS PCT$,8 AS OVR$
45018 GOSUB 7900
45020 FOR T7 = 1 TO 1000
45040 IF T7 > MRN2 GOTO 45160
45050 GET #3,T7
45070 FS(T7) = CVI(FD$)
45080 PP(T7) = CVI(PP$)
45090 MS(T7) = CVI(MS$)
45100 MIND#(T7) = CVD(MIN$)
45110 MAXD#(T7) = CVD(MAX$)
45120 TAX#(T7) = CVD(TX$)
45130 PCT!(T7) = CVS(PCT$)
45140 OVR#(T7) = CVD(OVR$)
45150 NEXT T7
45160 REM
45170 GOTO 45200
45200 REM
45210 TMAX = T7 - 1
45215 CLOSE #3
45218 TTBL = 5
45220 RETURN
45230 REM
45240 REM
45250 REM
45260 REM
45270 REM
45500 REM
45510 FOR T7 = 1 TO TMAX
45520 IF FS(T7) = FSS THEN GOTO 45530 ELSE GOTO 45610
45530 IF PP(T7) = PPS THEN GOTO 45540 ELSE GOTO 45610
45540 IF MS(T7) = MSS THEN GOTO 45550 ELSE GOTO 45610
45550 IF PAY# < MIND#(T7) GOTO 45610
45560 IF PAY# > MAXD#(T7) GOTO 45610
45570 PAYEX# = PAY# - OVR#(T7)
45580 TXE# = PAYEX# * PCT!(T7) / 100
45590 TTAX# = TAX#(T7) + TXE#
45600 GOTO 45680
45610 NEXT T7
45620 PRINT "++++++ PROPER TAX TABLE NOT FOUND ++++++"
45630 PRINT "CHECK : FEDERAL OR STATE NUMBER ";FSS
45640 PRINT " PAY PERIOD NUMBER ";PPS
45650 PRINT " MARRIED/SINGLE NUMBER ";MSS
45660 PRINT " PAY ";PAY
45670 PRINT "***** PRESS ANY KEY TO CONTINUE ******"
45672 IF INKEY$ = "" GOTO 45672
45674 GOTO 3010
45680 REM RETURNS TTAX*
45690 RETURN
46000 REM CROSS CHECK FIELD
46010 IF DATAIN >< 1 THEN GOSUB 40020
46020 REM
46030 REM
46100 GET #1,RN
46130 FOR N2= 1 TO NREC(A)
46133 N = N2
46135 REM
46140 ON IOPT(N) GOSUB 46200,46200,41600,41800,42000,46200,42600,42800,43000,43200,43400,43600,41800,53000,54000,55000,56000,57000,58000,59000
46145 REM
46150 GOSUB 43800
46160 NEXT N2
46162 PUT #1,RN
46165 RETURN
46200 ON FTY(A,N) GOTO 46220,46300,46400,46500,46500
46220 I$ = X$(N)
46230 RETURN
46300 I% = CVI(X$(N))
46310 I# = I%
46320 RETURN
46400 I! = CVS(X$(N))
46410 I# = I!
46420 RETURN
46500 I# = CVD(X$(N))
46510 RETURN
47000 REM
47050 CALFLG = 5
47100 GOSUB 13000
47110 PRINT "******* RECALCULATE THE FIELDS IN A FILE OPTION *******"
47120 PRINT ""
47130 PRINT " Use only if you know what you are doing "
47140 PRINT ""
47150 PRINT "MINIMUM RECORD NUMBER : 1 MAXIMUM RECORD NUMBER : ";MRN
47160 PRINT ""
47190 PRINT "*********** DO YOU WANT TO USE THIS OPTION ************"
47200 PRINT " 1 - NO, RETURN TO FILE OPTION"
47300 PRINT " 2 - YES, I WANT TO USE THIS OPTION "
47310 PRINT "********* Enter the number then Press Return **********"
47320 GOSUB 14000
47330 IF DT# < 1 OR DT# > 2 THEN 47320
47340 IF DT# = 1 THEN 3010
47400 FOR RN = 1 TO MRN
47430 GOSUB 46000 : PRINT "ON RECORD ";RN
47450 NEXT RN
47470 GOTO 3010
48000 REM
48100 REM
48110 PRINT " ++++++ ERROR +++++++"
48120 PRINT "RECORD NUMBER ";RN2;" IN FILE ";F$(B);" DOES NOT EXIST"
48140 PRINT "YOU PROBABLY ENTERED FIELD ";IRNFLD(N);" WRONG"
48160 PRINT "********* PRESS ANY KEY TO CONTINUE ********"
48170 IF INKEY$ = "" GOTO 48170
48180 GOTO 40000
49000 REM * SET GFLG TO ZERO
49100 FOR T = 1 TO 28
49110 GFLG(T) = 0
49120 NEXT T
49130 RETURN
50000 REM INTRO
50010 GOSUB 13000
50100 PRINT " M A I N 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 "
50140 PRINT "YOU MUST READ THE LICENSE CONDITIONS PRIOR TO USING THIS PROGRAM"
50165 PRINT " See the manual for more information on the license."
50167 PRINT ""
50950 PRINT "***************** PRESS ANY KEY TO CONTINUE ******************";
50960 IF INKEY$ = "" GOTO 50960
50970 RETURN
51000 REM ******* DONE
51100 CLOSE
51105 GOSUB 13000
51110 PRINT " -BYE, Have a nice day
51120 END
52000 REM * SUB RECORD INPUT
52010 LI = 1
52015 TB = 60
52020 GOSUB 13110
52030 PRINT "ON SUBRECORD ";(RN+1)
52100 OFFSET = OFFSET + 1
52110 RN = RN + 1
52115 IF REALFLG(A) = 2 AND RN <= MRN THEN GOSUB 61300
52120 T2 = LSTE + 1
52130 FOR N = T2 TO NREC(A)
52135 REFLG = 0
52140 ON IOPT(N) GOSUB 41200,41400,41600,41800,42000,42200,42600,42800,43000,43200,43400,43600,41800,53000,54000,55000,56000,57000,58000,59000
52150 GOSUB 43800
52160 NEXT N
52165 GOTO 44910
53000 REM SPACE FOR CUSTOM INPUT OPTION # 14
53990 RETURN
54000 REM SPACE FOR CUSTOM INPUT OPTION # 15
54990 RETURN
55000 REM SPACE FOR CUSTOM INPUT OPTION # 16
55990 RETURN
56000 REM SPACE FOR CUSTOM INPUT OPTION # 17
56990 RETURN
57000 REM SPACE FOR CUSTOM INPUT OPTION # 18
57990 RETURN
58000 REM SPACE FOR CUSTOM INPUT OPTION # 19
58990 RETURN
59000 REM SPACE FOR CUSTOM INPUT OPTION # 20
59990 RETURN
60000 REM *READ REALTIME OPTIONS
60010 OPEN "I",#1,"REALTIME"
60020 FOR T = 1 TO MAXF
60030 INPUT #1,REALFLG(T)
60040 NEXT T
60050 CLOSE #1
60060 RETURN
60070 REM * READ REALTIME DATA
60080 A$ = STR$(A)
60090 A$ = MID$(A$,2)
60100 A$ = "REAL" + A$
60110 OPEN "I",#3,A$
60120 INPUT #3,TFILE,FLD1,FLD2,TFLD1,TFLD2,TFLD3,TFLD4,ADSUB1,ADSUB2,ADSUB3,ADSUB4,TGTRN
60130 CLOSE #3
60140 RETURN
60200 REM * OPEN REALTIME FILE
60202 IF ROPEN = 5 THEN RETURN
60205 GOSUB 13000
60210 AHLD = A
60220 A = TFILE
60230 C = TFILE
60235 PRINT F$(C);" FILE FOR REALTIME TRANSFER "
60240 GOSUB 2300
60245 C = TFILE
60250 GOSUB 2580
60260 A = AHLD
60265 ROPEN = 5
60270 RETURN
60300 REM * PUT DATA ON REALTIME FILE
60310 IF REALFLG(A) >< 2 THEN RETURN
60330 REM *** CONTINUE
60340 IF ROPEN < 5 THEN GOSUB 60200
60400 T3 = X(TGTRN)
60410 GET #3,T3
60415 IF CTK = 5 THEN 60600
60420 T1# = CVD(Z$(TFLD1))
60430 T2# = X(FLD1)
60440 IF ADSUB1 = 2 THEN T2# = -1 * T2#
60450 LSET Z$(TFLD1) = MKD$(T1# + T2#)
60460 IF TFLD2 = 0 THEN 60600
60520 T1# = CVD(Z$(TFLD2))
60540 IF ADSUB2 = 2 THEN T2# = -1 * T2#
60550 LSET Z$(TFLD2) = MKD$(T1# + T2#)
60600 REM * SECOND TRANSFER
60605 IF CTK = 4 THEN 60900
60610 IF FLD2 = 0 THEN 60900
60620 T1# = CVD(Z$(TFLD3))
60630 T2# = X(FLD2)
60640 IF ADSUB3 = 2 THEN T2# = -1 * T2#
60650 LSET Z$(TFLD3) = MKD$(T1# + T2#)
60660 IF TFLD4 = 0 THEN 60900
60720 T1# = CVD(Z$(TFLD4))
60740 IF ADSUB4 = 2 THEN T2# = -1 * T2#
60750 LSET Z$(TFLD4) = MKD$(T1# + T2#)
60900 PUT #3,T3
60920 CTK = 1
60980 RETURN
61000 REM * CORECT DATA ON REALTIME FILE
61050 CTK = 4
61060 XHLD1 = X(N)
61100 X(N) = I# - X(N)
61120 GOSUB 60300
61130 X(N) = XHLD1
61140 RETURN
61200 XHLD1 = X(N)
61205 X(N) = I# - X(N)
61215 CTK = 5
61220 GOSUB 60300
61230 X(N) = XHLD1
61240 RETURN
61300 REM * CORRECT REALTIME FILE FOR OVERWRITE
61330 GET #1,RN
61340 X1# = CVD(X$(FLD1))
61345 IF FLD2 = 0 THEN 61355
61350 X2# = CVD(X$(FLD2))
61355 X3# = CVI(X$(TGTRN))
61360 RETURN
61400 REM ***
61410 XHLD1 = X(FLD1)
61415 IF FLD2 = 0 THEN 61425
61420 XHLD2 = X(FLD2)
61425 XHLD3 = X(TGTRN)
61430 X(FLD1) = -X1#
61440 X(FLD2) = -X2#
61445 X(TGTRN) = X3#
61450 GOSUB 60300
61460 X(FLD1) = XHLD1
61465 IF FLD2 = 0 THEN 61475
61470 X(FLD2) = XHLD2
61475 X(TGTRN) = XHLD3
61480 RETURN
Directory of PC-SIG Library Disk #0370
Volume in drive A has no label
Directory of A:\
CARDS 259200 1-31-84 12:38a
FLAG 128 1-31-84 12:19a
MAIN BAS 50304 1-01-80
SFLAG 128 1-31-84 12:19a
4 file(s) 309760 bytes
9216 bytes free