Play and Learn 2

home *** CD-ROM | disk | FTP | other *** search

/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCMISC / EDPAK_4 / MAIN.BAS (.txt) < prev next >

Wrap

GW-BASIC | 1994-02-04 | 49.1 KB | 1,829 lines

1 GOSUB 65000 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 65000 ' metrocom-ny introduction 65010 CLS 65020 A$=STRING$(80,205) 65030 PRINT A$ 65040 PRINT TAB(13)"Serving The Metropolitan New York Business Community" 65050 COLOR 23,0,0 65060 PRINT :PRINT TAB(22)"M-E-T-R-O-C-O-M-! N-E-W Y-O-R-K-!" 65070 COLOR 7,0,0 65080 PRINT:PRINT TAB(26)"DATA LINE (516) 486-3196" 65090 PRINT A$ 65100 PRINT :PRINT :PRINT :PRINT :PRINT 65110 PRINT TAB(26)"Press ANY KEY To Continue!" 65120 A$=INKEY$:IF A$="" THEN 65120 65130 CLS 65140 KEY OFF 'Omit if not IBM Computer 65150 RETURN