PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #214)
[PCjs Machine "ibm5150"]
Waiting for machine "ibm5150" to load....
Information about “DATA BASE OF STEEL 1 OF 4 (215,267,268)”
This is the first volume of Potomac Engineering's database, spreadsheet
and expert system offerings, all grouped under the title "... of
Steel". The first two disks contain the Database Management System
which includes Accounting, Payroll, Inventory, and A/R Applications
Programmable, Relational. The documentation for the whole system is on
Disk No 215.
The Spreadsheet (No 267) includes 21 ways to calculate numbers or write
your own subroutine. It is written in BASIC for easy modification, and
a compiled version is available.
The Expert System (No 268) provides for inference engines, designing
your own expert systems, and intelligent search patterns. The entire
system is menu driven, so all the options are displayed on the screen.
Features:
~ Written in BASIC for easy modification
~ Compiled version provided (192k)
~ Sample checkbook application
~ Automatic recalculation
~ Bar charts
~ Full cursor control
~ Report generator
~ Customizable screens
~ ASCII output
~ Tax tables
~ Create subfiles
~ Sort on 3 fields
~ 3 files open simultaneously
~ Global field changes
~ Transfer data between files
~ Inference engine
~ Design expert systems
~ Assigns probability with rules
~ Intellignet search pattern with manual override
~ Detects contradictory evidence
~ Explanation of reasoning
System Requirements: Two disk drives (Hard disk recommended)
How to Start: Consult the README file for documentation and
directions. To run the BASIC programs follow the GETTING STARTED
instructions for your configuration.
Suggested Registration: $20.00
File Descriptions:
The First Disk Contains:
-------- --- Database of Steel - Source Code
SCAN BAS Database extract and select program
MAIN BAS Main database program
CHANGE BAS Global database change and replacement
FORM BAS Report format program
TRANSFER BAS Transfer data from one file to another
CFILE BAS Creates (defines) database file
SORT BAS Sorts database
CTRANSFE BAS Customizes transfers between files
CINPUT BAS Sets up new data entry for the file
CLIMITS BAS Sets range limts for numeric fields
CFORM BAS Creates print forms
TESTASCI BAS Reads file created from above and display it
ASCII BAS Convert from random access format to ASCII
CSCREEN BAS Sets up screen display for record
CREAL BAS Realtime transfers between files
READ ME Descriptions of files on disk
The Second Disk Contains:
READ ME Descriptions of files on disk
-------- --- Database of Steel - sample programs and files, doc
MASTER TXT Manual (WordStar format - 153K)
REMARKS4 BAS Program remarks
REMARKS3 BAS Program remarks
REMARKS2 BAS Program remarks
REMARKS1 BAS Program remarks
PRINTMAN BAS Procedure to print the manual
??? OBJ Part of Database of Steel
??? BAS Part of Database of Steel
??? Various data files for Database of Steel
The Third Disk Contains:
-------- --- Spreadsheet of Steel and Compiled Database Program
READ ME Description of files on this disk
REMARKST BAS Sort remarks
MAIN EXE Compiled database program
CHECK Sample spreadsheet
TAX Sample spreadsheet
SORTINT BAS Sort source for database
SORT BAS Sort source for database
SS EXE Compiled spreadsheet
SSREMARK BAS Spreadsheet remarks
SS BAS Spreadsheet source
SORTSTR BAS Sort source for database
The Fourth Disk Contains:
-------- --- Expert System of Steel
EXPERT BAS Source code for expert system
EXPERT EXE Compiled program for expert system
REM BAS Remarks for source program (33K)
READ ME Description of files on this disk
FORM EXE Compiled program for database
SCAN EXE Compiled program for database
TEMP BAS Part of expert system disk
CLS OBJ Part of expert system disk
??? Sample program for Database of Steel
ASCII.BAS
3 DEFDBL X
4 DEFINT A-W,Y-Z
5 DIM F$(15),FLDN$(15,30),FTY(15,30),FL(15,30)
10 DIM X$(30)
13 DIM L(15),NREC(15)
14 DIM X(20)
20 DIM XL(40)
35 DIM K$(80)
61 CH = 29: PRINT FRE(0)
70 NE = 0
75 GOSUB 50000
80 GOSUB 10000
400 GOSUB 13000
404 GOSUB 13000
410 PRINT "********** ASCII PROGRAM -- WHAT FILE DO YOU WANT: **********"
420 PRINT ""
425 PRINT " 0 - *** EXIT THE PROGRAM ***"
430 FOR I = 1 TO MAXF
440 PRINT I;" - ";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
495 GOSUB 8000
500 GOTO 6000
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 ""
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#
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 SUBROUTINE *******
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
6000 REM ***** CHANGE TO SEQUENTIAL ASCII FILE
6075 GOSUB 13000
6100 PRINT " This program converts the records you specify to "
6110 PRINT " to a sequential ASCII form"
6120 PRINT ""
6278 PRINT "******** WHAT RECORD DO YOU WANT TO START AT *********"
6281 PRINT ""
6282 PRINT " Enter Zero When you are done "
6283 PRINT ""
6284 PRINT "******** ENTER THE NUMBER THEN PRESS RETURN *********"
6287 GOSUB 14100
6288 IF DT# <0 OR DT# > MRN GOTO 6287
6290 RNS= DT#
6300 IF RNS = 0 THEN 51000
6375 PRINT ""
6378 PRINT "********* WHAT RECORD DO YOU WANT TO END AT *********"
6381 PRINT ""
6384 PRINT "******** ENTER THE NUMBER THEN PRESS RETURN *********"
6387 GOSUB 14100
6388 IF DT# <1 OR DT# > MRN GOTO 6387
6390 RNF= DT#
6396 REM GET RECORD
6399 FOR T = RNS TO RNF
6402 GET #1,T
6403 GOSUB 6417
6404 PRINT #2,""
6405 NEXT T
6406 GOSUB 13000
6407 PRINT "*** ANY MORE RECORDS TO CONVERT ***"
6410 GOTO 6100
6417 FOR Q = 1 TO NREC(A)
6435 ON FTY(A,Q) GOSUB 6507,6441,6453,6465,6465
6436 IF Q < NREC(A) THEN PRINT #2,CHR$(44);
6438 NEXT Q
6439 RETURN
6440 REM ************** CONVERT STRINGS TO DECIMALS ****************
6441 I%=CVI(X$(Q))
6447 PRINT #2,I%;
6450 RETURN
6453 I!=CVS(X$(Q))
6459 PRINT #2,I!;
6462 RETURN
6465 I#=CVD(X$(Q))
6468 PRINT #2,I#;
6471 RETURN
6507 I$ = X$(Q)
6508 PRINT #2,CHR$(34);I$;CHR$(34);
6510 RETURN
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(B)/L(B)
7970 RETURN
8000 REM ****** OPEN ASCII FILE
8100 OPEN "O",#2,"ASCIDATA"
8200 RETURN
9070 ON FTY(A,N) GOTO 9100,9150,9200,9250,9250
9100 REM
9110 LSET X$(N) = I$
9120 GOTO 9290
9150 REM
9160 LSET X$(N) = MKI$(I#)
9170 GOTO 9290
9200 REM
9210 LSET X$(N) = MKS$(I#)
9220 GOTO 9290
9250 REM
9260 LSET X$(N) = MKD$(I#)
9290 RETURN
10000 REM ************* READ SUBROUTINE *************
10004 GOSUB 10900
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,D
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
10995 RETURN
13000 REM ********* CLEAR SCREEN
13010 CLS
13020 RETURN
13100 REM ********* LOCATE
13110 LOCATE LI,1
13120 RETURN
13200 FOR T% = 1 TO 80
13210 PRINT CHR$(8);
13220 NEXT T%
13222 FOR T% = 1 TO 24
13223 PRINT CHR$(11);
13224 NEXT T%
13225 LI = LI - 1
13230 FOR T% = 1 TO LI
13240 PRINT CHR$(0)
13250 NEXT T%
13590 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 *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
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)
14680 NEXT T9
14681 IF KTMAX = 0 THEN PRINT "1"
14682 IF KTMAX = 0 THEN DT# = 1
14683 IF KTMAX = 0 THEN RETURN
14684 PRINT ""
14685 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
26000 REM ******* ON ERROR ROUTINE ************
26100 EFLG = 1
26200 PRINT "********** END OF FILE ***********"
26202 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
26204 IF INKEY$ = "" GOTO 26204
26500 REM ********* ON ERROR SUBROUTINE ***********
26600 PRINT "********** END OF FILE ***********"
26610 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
26620 IF INKEY$ = "" GOTO 26620
26635 EFLG = 1
26640 RETURN
26800 REM ********** ON ERROR GOTO **************
26900 PRINT "************ RECORD NOT FOUND *************"
41000 REM ***** WRITE SECOND FILE
41100 LSET Y$ = XT$
41200 PUT #2,RN2
41300 RN2 = RN2 + 1
41400 RETURN
50000 REM ********** INTRO
50010 GOSUB 13000
50100 PRINT " A S C I I P R O G R A M 3.0 "
50105 PRINT ""
50110 PRINT " Copyright 1984 by Potomac Pacific Engineering Inc."
50120 PRINT ""
50130 PRINT "This program is licensed FREE to all users with some restrictions"
50165 PRINT " See the manual for more information on the license."
50167 PRINT ""
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
CFILE.BAS
4 DEFINT A-W,Y-Z
5 DIM F$(15),FLDN$(17,40),FTY(17,40),FL(17,40)
13 DIM L(17),NREC(17)
16 DIM KY(17,40),KEYLIST(17,40)
35 DIM K$(80)
40 DIM SCRN(40),MFLG(40)
45 DIM REALFLG(40)
70 CH = 29
75 PRINT FRE(0)
80 GOSUB 52000
100 GOSUB 50000
200 GOTO 40000
500 REM ******* CLS
510 CLS
520 RETURN
8000 REM ***** FILE NAME ACCEPLABLE TEST ************
8010 TEST = 1
8100 FOR Q = 1 TO LEN(A$)
8110 K$(Q) = MID$(A$,Q,1)
8120 C = ASC(K$(Q))
8130 IF C < 48 OR C > 122 THEN TEST = 4
8140 IF Q = 1 AND ( C < 65 OR C > 122 ) THEN TEST = 4
8150 NEXT Q
8190 RETURN
23780 REM ************* READ SUBROUTINE *************
23800 OPEN "I",#1,"FFILE"
23820 INPUT #1,MAXF
23840 FOR A = 1 TO MAXF
23860 INPUT #1,A,F$(A),NREC(A),L(A)
23880 FOR N = 1 TO NREC(A)
23900 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N)
23920 IF FTY(A,N) = 2 THEN INPUT #1,KY(A,N),KEYLIST(A,N)
23940 NEXT N
23960 NEXT A
23980 CLOSE #1
24000 RETURN
25000 REM ************ WRITE SCREEN TEST *********
25100 OPEN "O",#1,"SCTEST"
25200 FOR T = 1 TO 40
25300 WRITE #1,SCRN(T)
25400 NEXT T
25500 CLOSE #1
25600 RETURN
26000 REM ************ READ SCREEN TEST *********
26100 OPEN "I",#1,"SCTEST"
26200 FOR T = 1 TO 40
26300 INPUT #1,SCRN(T)
26400 NEXT T
26500 CLOSE #1
26600 RETURN
27000 REM ********** READ IDEX SUBROUTINE
27010 OPEN "I",#1,"IDEX"
27020 FOR T = 1 TO MAXF
27030 INPUT #1,D,D,D,MFLG(T)
27040 NEXT T
27050 CLOSE #1
27060 RETURN
27070 REM ********** WRITE IDEX SUBROUTINE
27080 OPEN "O",#1,"IDEX"
27090 FOR T = 1 TO 30
27100 WRITE #1,D,D,D,MFLG(T)
27110 NEXT T
27120 CLOSE #1
27130 RETURN
40000 REM ******* FILE DESCRIPTION MENU *********
40060 GOSUB 500
40080 PRINT "**************** FILE DESCRIPTION MENU ******************"
40100 PRINT ""
40120 PRINT " 0 - EXIT TO OPERATING SYSTEM"
40125 PRINT ""
40140 PRINT " 1 - ENTER A FILE DESCRIPTION"
40145 PRINT ""
40160 PRINT " 2 - READ A SINGLE FILE DESCRIPTION"
40165 PRINT ""
40180 PRINT " 3 - READ ALL FILE DESCRIPTIONS"
40185 PRINT ""
40200 PRINT " 4 - PRINT ON PAPER ONE FILE DESCRIPTION "
40205 PRINT ""
40220 PRINT " 5 - PRINT ON PAPER ALL THE FILE DESCRIPTIONS"
40240 PRINT ""
40260 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN ************"
40280 GOSUB 60000
40282 IF DT# <0 OR DT# >5 GOTO 40280
40300 T = DT#
40310 IF T = 0 THEN 51000
40320 ON T GOTO 40620,40340,40540,40740,40960
40340 GOSUB 500
40360 PRINT "************ WHAT FILE DESCRIPTION DO YOU WANT TO READ **********"
40380 FOR T = 1 TO MAXF
40400 PRINT T;"-";F$(T)
40420 NEXT T
40440 PRINT "*************** ENTER THE NUMBER THEN PRESS RETURN **************"
40460 GOSUB 60000
40462 IF DT# <1 OR DT# >MAXF GOTO 40460
40480 A = DT#
40500 GOSUB 42680
40520 GOTO 40060
40540 FOR A = 1 TO MAXF
40560 GOSUB 42680
40580 NEXT A
40600 GOTO 40060
40620 GOSUB 41040
40640 GOSUB 45020
40660 GOSUB 42580
40680 GOSUB 43220
40700 GOSUB 44420
40720 GOTO 40060
40740 REM PRINT A SINGLE RECORD
40760 GOSUB 500
40780 PRINT "************ WHAT FILE DESCRIPTION DO YOU WANT PRINTED **********"
40800 FOR T = 1 TO MAXF
40820 PRINT T;"-";F$(T)
40840 NEXT T
40860 PRINT "*************** ENTER THE NUMBER THEN PRESS RETURN **************"
40880 GOSUB 60000
40882 IF DT# <1 OR DT# >MAXF GOTO 40880
40900 A = DT#
40920 GOSUB 43700
40940 GOTO 40060
40960 FOR A = 1 TO MAXF
40980 GOSUB 43700
41000 NEXT A
41020 GOTO 40060
41040 GOSUB 500
41060 PRINT "**************** NEW FILE DESCRIPTION ENTRY ******************"
41080 FOR T = 1 TO MAXF
41100 PRINT T;"-";F$(T)
41120 NEXT T
41140 T1 = MAXF + 1
41160 PRINT "***** YOU MAY RENAME AND REDEFINE ANY OF THE ABOVE FILES *****
41180 PRINT " ---- YOU WILL LOSE ALL STORED DATA IN A FILE YOU REDEFINE ---"
41200 PRINT " OR "
41220 PRINT "------- YOU MAY ENTER A NEW FILE WITH FILE NUMBER = ";T1;"------"
41240 PRINT ""
41260 PRINT "*********** ENTER THE FILE NUMBER THEN PRESS RETURN ***********"
41280 PRINT ""
41300 GOSUB 60000
41302 IF DT# <1 OR DT# >T1 GOTO 41300
41320 A = DT#
41340 GOTO 44200
41360 PRINT "***** ENTER THE FILE NAME -- 8 CHARACTERS OR LESS *****"
41380 PRINT "--------- LETTERS AND NUMBERS ONLY , NO SPACES --------"
41400 PRINT "----------- FIRST CHARACTER MUST BE A LETTER ----------"
41420 MAX = 8
41440 GOSUB 62030
41450 GOSUB 8000
41455 IF TEST = 4 GOTO 41440
41460 F$(A) = A$
41480 PRINT "******** ENTER THE NUMBER OF FIELDS IN THIS FILE *******"
41500 GOSUB 60000
41502 IF DT# <1 OR DT# >100 GOTO 41500
41520 NREC(A) = DT#
41540 FOR N = 1 TO NREC(A)
41560 GOSUB 41620
41580 NEXT N
41600 RETURN
41620 GOSUB 500
41640 PRINT "FIELD NUMBER ";N
41660 PRINT "******** ENTER THE NAME OF THIS FIELD **********"
41680 MAX = 20
41700 GOSUB 62030
41720 FLDN$(A,N) = A$
41740 PRINT "*************** IS THIS FILELD *****************"
41760 PRINT " 1 - A NUMBER "
41780 PRINT " 2 - A STRING "
41800 PRINT "****** ENTER THE NUMBER THEN PRESS RETURN ******"
41820 GOSUB 60000
41822 IF DT# <1 OR DT# >2 GOTO 41820
41840 T = DT#
41860 ON T GOTO 41880,42420
41880 REM
41900 PRINT "****************** IS THIS NUMBER AN *******************"
41920 PRINT " 1 - INTEGER "
41930 PRINT " ---- MAY BE DECLARE A KEY TO A LIST
41940 PRINT " ---- NO DECIMALS, A NUMBER FROM -32,768 TO +32,768"
41960 PRINT " 2 - SINGLE PRECISION"
41980 PRINT " ---- DECIMALS ALLOWED, ONLY SIX DIGITS ACCURACY"
42000 PRINT " 3 - DOUBLE PRECISION"
42020 PRINT " ---- DECIMALS ALLOWED, 15 DIGITS ACCURACY"
42040 PRINT " 4 - DOLLARS AND CENTS "
42060 PRINT " ---- USE FOR ALL DOLLAR AND CENTS AMOUNTS "
42080 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN **********"
42100 GOSUB 60000
42102 IF DT# <1 OR DT# >4 GOTO 42100
42120 T = DT#
42140 ON T GOTO 42160,42240,42300,42360
42160 FTY(A,N) = 2
42180 FL(A,N) = 2
42200 GOSUB 44720
42220 GOTO 42560
42240 FTY(A,N) = 3
42260 FL(A,N) = 4
42280 GOTO 42560
42300 FTY(A,N) = 4
42320 FL(A,N) = 8
42340 GOTO 42560
42360 FTY(A,N) = 5
42380 FL(A,N) = 8
42400 GOTO 42560
42420 FTY(A,N) = 1
42440 PRINT "************ WHAT IS THE MAXIMUM LENGTH OF THE STRING **********"
42460 PRINT " ----- ENTER A NUMBER FROM 1 TO 55 -----
42480 PRINT "*************** ENTER THE LENGTH THEN PRESS RETURN *************"
42500 GOSUB 60000
42502 IF DT# <1 OR DT# >55 GOTO 42500
42520 FL(A,N) = DT#
42560 RETURN
42580 L(A) = 0
42600 FOR N = 1 TO NREC(A)
42620 L(A) = L(A) + FL(A,N)
42640 NEXT N
42660 RETURN
42680 GOSUB 500
42690 GOSUB 42580
42700 PRINT "-------------------------------------------------------------------------------"
42720 PRINT "FILE NUMBER : ";A
42740 PRINT "FILE NAME : "; F$(A)
42760 PRINT "NUMBER OF FIELDS : ";NREC(A)
42780 PRINT "RECORD LENGTH : ";L(A)
42800 FOR N = 1 TO NREC(A)
42820 PRINT N ;TAB(5);FLDN$(A,N);
42840 ON FTY(A,N) GOTO 42860,42900,42980,43020,43060
42860 PRINT TAB(30) " STRING WITH MAXIMUM LENGTH ";FL(A,N)
42880 GOTO 43080
42900 PRINT TAB(30) " INTEGER ";
42920 IF KY(A,N) = 2 THEN PRINT "--- KEY FOR LIST # ";KEYLIST(A,N)
42940 IF KY(A,N) <> 2 THEN PRINT ""
42960 GOTO 43080
42980 PRINT TAB(30) " SINGLE PRECISION "
43000 GOTO 43080
43020 PRINT TAB(30) " DOUBLE PRECISION "
43040 GOTO 43080
43060 PRINT TAB(30) " DOLLARS AND CENTS "
43080 REM ***
43100 NEXT N
43120 PRINT "-------------------------------------------------------------------------------"
43140 PRINT "*************** PRESS ANY KEY TO CONTINUE ******************"
43160 PRINT ""
43180 IF INKEY$ = "" GOTO 43180
43200 RETURN
43220 REM ****** STORE FILES OM FILE FILE ******
43240 OPEN "O",#1,"FFILE"
43260 WRITE #1,MAXF
43280 FOR T = 1 TO MAXF
43300 WRITE #1,T,F$(T),NREC(T),L(T)
43320 FOR N = 1 TO NREC(T)
43340 WRITE #1,FLDN$(T,N),FTY(T,N),FL(T,N)
43360 IF FTY(T,N) = 2 THEN WRITE #1,KY(T,N),KEYLIST(T,N)
43380 NEXT N
43400 NEXT T
43420 CLOSE #1
43425 GOSUB 26000
43430 SCRN(A) = 0
43432 GOSUB 25000
43434 GOSUB 27000
43436 MFLG(A) = 0
43438 GOSUB 27070
43439 GOSUB 53000
43440 RETURN
43700 LPRINT "-------------------------------------------------------------------------------"
43720 LPRINT "FILE NUMBER : ";A
43740 LPRINT "FILE NAME : "; F$(A)
43760 LPRINT "NUMBER OF FIELDS : ";NREC(A)
43780 LPRINT "RECORD LENGTH : ";L(A)
43800 FOR N = 1 TO NREC(A)
43820 LPRINT N ;TAB(5);FLDN$(A,N);
43840 ON FTY(A,N) GOTO 43860,43900,43980,44020,44060
43860 LPRINT TAB(30) " STRING WITH MAXIMUM LENGTH ";FL(A,N)
43880 GOTO 44080
43900 LPRINT TAB(30) " INTEGER ";
43920 IF KY(A,N) = 2 THEN LPRINT "--- KEY FOR LIST # ";KEYLIST(A,N)
43940 IF KY(A,N) <> 2 THEN LPRINT ""
43960 GOTO 44080
43980 LPRINT TAB(30) " SINGLE PRECISION "
44000 GOTO 44080
44020 LPRINT TAB(30) " DOUBLE PRECISION "
44040 GOTO 44080
44060 LPRINT TAB(30) " DOLLAR AND CENTS AMOUNT "
44080 REM ***
44100 NEXT N
44120 PRINT ""
44140 RETURN
44160 END
44180 REM ************ CHECK FOR SKIPED FILES ***************
44200 IF A > MAXF+1 GOTO 44280
44220 IF A > MAXF THEN MAXF = A
44240 GOTO 41360
44260 PRINT ""
44280 PRINT ""
44300 PRINT "+++++++++++++++ MISTAKE ++++++++++++++++
44320 PRINT " YOU MAY NOT SKIP FILE NUMBERS"
44340 PRINT "THE HIGEST NUMBER FILE IS CURRENTLY ";MAXF
44360 PRINT "YOU MAY NUMBER YOUR FILE FROM 1 TO ";MAXF+1
44380 PRINT ""
44400 GOTO 41180
44420 REM ****** OPEN INITAL IPUT DATA FILE ******
44440 GOSUB 500
44460 PRINT "******** PUTING DATA ON INPUT DATA FILE ********"
44480 PRINT A
44500 T$ = STR$(A)
44520 T$ = MID$(T$,2)
44540 N$ = "IPUTD" + T$
44560 PRINT N$
44580 OPEN "O",#2,N$
44600 WRITE #2,NREC(A)
44620 FOR T = 1 TO NREC(A)
44640 WRITE #2,1," "
44660 NEXT T
44680 CLOSE #2
44700 RETURN
44720 REM ******** KEYLIST PROGRAM ***********
44740 GOSUB 500
44760 PRINT "FILE :";F$(A);" FIELD : ";N;"- ";FLDN$(A,N)
44780 PRINT ""
44800 PRINT "************ IS THIS FIELD A KEY TO A LIST ***********"
44820 PRINT ""
44840 PRINT " 1 - NOT A KEY "
44860 PRINT " 2 - IS A KEY "
44880 PRINT ""
44900 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN **********"
44910 GOSUB 60000
44912 IF DT# <1 OR DT# >2 GOTO 44910
44920 KY(A,N) = DT#
44940 IF KY(A,N) = 1 THEN RETURN
44960 PRINT "********* WHAT KEY LIST DOES THIS FIELD ACCESS ********"
44970 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN *********"
44980 GOSUB 60000
44982 IF DT# <1 OR DT# >10 GOTO 44980
44990 KEYLIST(A,N) = DT#
45000 RETURN
45020 REM ************ CHANGE **********
45040 GOSUB 42680
45080 PRINT "********** WHAT FIELD DO YOU WANT TO CHANGE ************"
45120 PRINT "*************** ENTER 0 FOR NO CHANGES *****************"
45140 GOSUB 60000
45142 IF DT# <0 OR DT# >NREC(A) GOTO 45140
45150 N = DT#
45160 IF N = 0 THEN RETURN
45180 GOSUB 41620
45200 GOTO 45020
50000 REM ********** INTRO
50010 GOSUB 500
50100 PRINT " F I L E D E S C R I P T I O N P R O G R A M 2.0 "
50105 PRINT ""
50110 PRINT " Copyright 1984 by Potomac Pacific Engineering Inc."
50120 PRINT ""
50130 PRINT "This program is licensed FREE to all users with some restrictions"
50165 PRINT " See the manual for more information on the license."
50167 PRINT ""
50920 GOSUB 23780
50950 PRINT "****************** PRESS ANY KEY TO CONTINUE *****************";
50960 IF INKEY$ = "" GOTO 50960
50970 RETURN
51000 REM ***** EXIT TO SYSTEM
51100 GOSUB 500
51110 CLOSE
51120 PRINT " -BYE, Have a nice day"
51130 END
52000 REM ***** INTRO 1
52010 GOSUB 500
52100 PRINT " Put the DATA DISK in the default disk drive "
52110 PRINT ""
52120 PRINT " ***** THEN PRESS ANY KEY TO CONTINUE *****"
52130 PRINT ""
52140 PRINT " The CUSTOM programs only use the PROGRAM DATA DISK"
52150 PRINT "Keep it in the default disk drive at all times during this program."
52200 IF INKEY$ = "" GOTO 52200
52210 RETURN
53000 REM ********** READ IDEX SUBROUTINE
53010 OPEN "I",#1,"REALTIME"
53020 FOR T = 1 TO MAXF
53030 INPUT #1,REALFLG(T)
53040 NEXT T
53050 CLOSE #1
53060 REALFLG(A) = 0
53070 REM ********** WRITE IDEX SUBROUTINE
53080 OPEN "O",#1,"REALTIME"
53090 FOR T = 1 TO 30
53100 WRITE #1,REALFLG(T)
53110 NEXT T
53120 CLOSE #1
53130 RETURN
60000 REM ******* INTEGER LESS THEN 100 CHECK ********
60010 MAX = 2
60020 ACT$ = "1234567890=<>^"
60030 IF NE = 0 THEN ACT$ = "1234567890"
60040 PRINT ">__<";
60050 GOTO 60240
60060 REM ******* INTEGER *******
60070 MAX = 8
60080 ACT$ = "1234567890-+,=<>^"
60090 IF NE = 0 THEN ACT$ = "1234567890-+,"
60100 PRINT ">________<";
60110 GOTO 60240
60120 REM ******* SINGLE PRECISION *******
60130 MAX = 10
60140 ACT$ = "1234567890-+,.%$=<>^"
60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60160 PRINT ">__________<";
60170 GOTO 60240
60180 REM ******* DOUBLE PRECISION *******
60190 MAX = 20
60200 ACT$ = "1234567890-+,.%$=<>^"
60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60220 PRINT ">____________________<";
60230 GOTO 60240
60240 REM ********** NUMBER CHECK **********
60250 A$ = ""
60260 K$(20) = " "
60270 KTMAX = 0
60280 FOR T9 = 1 TO MAX
60290 K$(T9) = " "
60300 NEXT T9
60310 DIG$ = "1234567890."
60320 DOTFLG = 0
60330 T2 = MAX + 1
60340 FOR T6 = 1 TO T2
60350 PRINT CHR$(CH);
60360 NEXT T6
60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370
60380 KT = 0
60390 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
60400 KT = KT + 1
60410 REM
60420 W$ = INKEY$
60430 IF W$ = "" GOTO 60420
60440 C = ASC(W$)
60450 IF C = 0 THEN GOSUB 61900
60460 IF C = 13 GOTO 60580
60470 IF C = 17 OR C = 8 GOTO 61150
60480 IF C = 19 GOTO 60670
60490 IF C = 4 GOTO 60720
60500 IF C = 6 GOTO 60780
60510 IF C = 1 GOTO 60960
60520 IF KT > MAX GOTO 60410
60530 IF INSTR(ACT$,W$) = 0 GOTO 61230
60540 K$(KT) = W$
60550 PRINT K$(KT);
60560 IF KT > KTMAX THEN KTMAX = KT
60570 GOTO 60400
60580 REM ********** RETURN **********
60590 FOR T9 = 1 TO KTMAX
60600 A$ = A$ + K$(T9)
60610 NEXT T9
60620 IF KTMAX = 0 THEN PRINT "1"
60630 IF KTMAX = 0 THEN DT# = 1
60640 IF KTMAX = 0 THEN RETURN
60650 PRINT ""
60660 GOTO 61260
60670 REM ********* MOVE CURSE BACK ********
60680 IF KT = 1 GOTO 60410
60690 KT = KT - 1
60700 PRINT CHR$(CH);
60710 GOTO 60410
60720 REM ********* MOVE CURSER FORWARD *********
60730 IF KT >= MAX GOTO 60410
60740 IF KT > (KTMAX + 1) GOTO 60410
60750 PRINT K$(KT);
60760 KT = KT + 1
60770 GOTO 60410
60780 REM ********** INSERT ***********
60790 IF KT > KTMAX GOTO 60410
60800 X9 = MAX
60810 WHILE X9 > KT
60820 X9 = X9 - 1
60830 K$(X9 + 1) = K$(X9)
60840 WEND
60850 K$(KT) = " "
60860 KTMAX = KTMAX + 1
60870 IF KTMAX > MAX THEN KTMAX = MAX
60880 FOR T9 = KT TO KTMAX
60890 PRINT K$(T9);
60900 NEXT T9
60910 T6 = (KTMAX - KT) + 1
60920 FOR T7 = 1 TO T6
60930 PRINT CHR$(CH);
60940 NEXT T7
60950 GOTO 60410
60960 REM ********** DELETE ***********
60970 IF KT > KTMAX GOTO 60410
60980 IF KTMAX = 1 GOTO 60410
60990 K$(MAX + 1) = ""
61000 X9 = KT
61010 WHILE X9 <= MAX
61020 K$(X9) = K$(X9 + 1)
61030 X9 = X9 + 1
61040 WEND
61050 KTMAX = KTMAX - 1
61060 FOR T9 = KT TO KTMAX
61070 PRINT K$(T9);
61080 NEXT T9
61090 PRINT "_";
61100 T7 = (KTMAX - KT) + 2
61110 FOR T8 = 1 TO T7
61120 PRINT CHR$(CH);
61130 NEXT T8
61140 GOTO 60410
61150 REM ********* BACKSPACE ********
61160 IF KT = 1 GOTO 60410
61170 KT = KT - 1
61180 PRINT CHR$(CH);
61190 K$(KT) = " "
61200 PRINT "_";
61210 PRINT CHR$(CH);
61220 GOTO 60410
61230 REM ******* INPUT NOT ACCEPTABLE ********
61240 PRINT CHR$(7);
61250 GOTO 60420
61260 REM ********* CLEAR STRINGS ********
61270 MAX = LEN(A$)
61280 D2$ = ""
61290 D1$ = ""
61300 DFLG = 0
61310 FOR Q93 = 1 TO MAX
61320 R$ = MID$(A$,Q93,1)
61330 IF INSTR(DIG$,R$) = 0 GOTO 61400
61340 IF R$ = "." OR DFLG = 1 GOTO 61380
61350 IF DFLG = 1 GOTO 61380
61360 D2$ = D2$ + R$
61370 GOTO 61400
61380 D1$ = D1$ + R$
61390 DFLG = 1
61400 NEXT Q93
61410 DA# = VAL(D2$)
61420 D1# = VAL(D1$)
61430 DT# = DA# + D1#
61440 IF K$(1) = "-" THEN DT# = -DT#
61450 RETURN
61900 REM ****** CHECK FOR ASC0
61910 S4$ = INKEY$
61920 C2 = ASC(S4$)
61930 IF C2 = 83 THEN C = 1
61940 IF C2 = 82 THEN C = 6
61950 IF C2 = 75 THEN C = 19
61960 IF C2 = 77 THEN C = 4
61970 RETURN
62000 REM ********** ALPHANUMERIC CHECK **************
62010 MAX = FL(A,Q)
62020 GOTO 62040
62030 REM ******** MAX SET IN PROGRAM ********
62040 A$ = ""
62050 PRINT ">";
62060 FOR N9 = 1 TO MAX
62070 K$(N9) = ""
62080 PRINT "_";
62090 NEXT N9
62100 PRINT "<";
62110 T2 = MAX + 1
62120 FOR T4 = 1 TO T2
62130 PRINT CHR$(CH);
62140 NEXT T4
62150 KT = 0
62160 KTMAX = 1
62170 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
62180 KT = KT + 1
62190 PRINT TAB(KT+1)"";
62200 K$ = INKEY$
62210 IF K$ = "" GOTO 62200
62220 C = ASC(K$)
62230 IF C = 0 THEN GOSUB 61900
62240 IF C = 13 GOTO 62350
62250 IF C = 17 OR C = 8 GOTO 62920
62260 IF C = 19 GOTO 62450
62270 IF C = 4 GOTO 62500
62280 IF C = 6 GOTO 62560
62290 IF C = 1 GOTO 62730
62300 IF KT > MAX GOTO 62190
62310 K$(KT) = K$
62320 PRINT K$(KT);
62330 IF KT > KTMAX THEN KTMAX = KT
62340 GOTO 62180
62350 REM ********** RETURN **********
62360 FOR T9 = 1 TO MAX
62370 A$ = A$ + K$(T9)
62420 NEXT T9
62430 PRINT ""
62440 RETURN
62450 REM ********* MOVE CURSE BACK ********
62460 IF KT = 1 GOTO 62190
62470 KT = KT - 1
62480 PRINT CHR$(CH);
62490 GOTO 62190
62500 REM ********* MOVE CURSER FORWARD *********
62510 IF KT >= MAX GOTO 62190
62520 IF KT > KTMAX GOTO 62190
62530 PRINT K$(KT);
62540 KT = KT + 1
62550 GOTO 62190
62560 REM ********** INSERT ***********
62570 X9 = MAX
62580 WHILE X9 > KT
62590 X9 = X9 - 1
62600 K$(X9 + 1) = K$(X9)
62610 WEND
62620 K$(KT) = " "
62630 KTMAX = KTMAX + 1
62640 IF KTMAX > MAX THEN KTMAX = MAX
62650 FOR T9 = KT TO KTMAX
62660 PRINT K$(T9);
62670 NEXT T9
62680 T6 = (KTMAX - KT) +1
62690 FOR T7 = 1 TO T6
62700 PRINT CHR$(CH);
62710 NEXT T7
62720 GOTO 62190
62730 REM ********** DELETE ***********
62740 IF KT > KTMAX GOTO 62200
62750 IF KTMAX = 1 GOTO 62190
62760 K$(MAX + 1) = ""
62770 X9 = KT
62780 WHILE X9 <= KTMAX
62790 K$(X9) = K$(X9 + 1)
62800 X9 = X9 + 1
62810 WEND
62820 KTMAX = KTMAX - 1
62830 FOR T9 = KT TO KTMAX
62840 PRINT K$(T9);
62850 NEXT T9
62860 PRINT "_";
62870 T7 = (KTMAX - KT) + 2
62880 FOR T6 = 1 TO T7
62890 PRINT CHR$(CH);
62900 NEXT T6
62910 GOTO 62190
62920 REM ********* BACKSPACE ********
62930 IF KT = 1 GOTO 62190
62940 K$(KT) = " "
62950 KT = KT - 1
62960 K$(KT) = " "
62970 PRINT CHR$(CH);
62980 PRINT "_";
62990 PRINT CHR$(CH);
63000 GOTO 62190
CFORM.BAS
4 DEFINT A-W,Y-Z
5 DIM F$(17),FLDN$(17,30),FTY(17,30),FL(17,30),IOPT(30)
13 DIM L(17),NREC(17)
16 DIM KY(17,30),KEYLIST(17,30)
18 DIM FORM$(10)
19 DIM EN(80),CE(80,10),TE(80,10),L$(80,10),EFN(80,10)
35 DIM K$(80)
70 CH = 29
74 PRINT FRE(0)
80 GOSUB 52000
100 GOSUB 50000
200 GOTO 1000
500 REM ******* CLS
510 CLS
520 RETURN
1000 GOSUB 5920
1220 GOSUB 500
1240 PRINT "******* FORM DESCRIPTIONS INITIAL MENU *********"
1245 PRINT ""
1250 PRINT " 0 - EXIT "
1255 PRINT ""
1260 PRINT " 1 - ENTER A NEW FORM DESCRIPTION"
1265 PRINT ""
1280 PRINT " 2 - READ A READ A FORM DESCRIPTION"
1300 PRINT " WITH - CORECTIONS"
1320 PRINT " - PRINT ON PAPER "
1325 PRINT ""
1340 PRINT "****** ENTER THE NUMBER THEN PRESS RETURN ******"
1360 PRINT ""
1380 GOSUB 60000
1382 IF DT# <0 OR DT#> 2 GOTO 1380
1390 T = DT#
1395 IF T = 0 GOTO 51000
1400 ON T GOTO 1420,1500
1420 REM ********** REM NEW CUSTOM INPUT **********
1440 GOSUB 1900
1460 GOSUB 3560
1480 GOTO 1220
1500 REM ********** READ A OUTPUT DESCRIPTION *********
1520 PRINT "******** WHAT FORM DO YOU WANT TO SEE ********"
1540 GOSUB 6060
1560 PRINT "******** WHAT FORM DO YOU WANT TO SEE ********"
1565 GOSUB 60000
1567 IF DT# <1 OR DT# >MAXFORM GOTO 1565
1570 T = DT#
1580 N$ = FORM$(T)
1600 GOSUB 3960
1620 GOSUB 4340
1640 PRINT " PRESS ANY KEY TO CONTINUE "
1660 IF INKEY$ = "" GOTO 1660
1680 PRINT "****************** OPTIONS : ****************"
1700 PRINT " 0 - RETURN TO INITIAL MENU"
1720 PRINT " 1 - MAKE CORRECTIONS"
1740 PRINT " 2 - PRINT ON PAPER "
1760 PRINT "***** ENTER THE NUMBER THEN PRESS RETURN *****"
1780 GOSUB 60000
1782 IF DT# <0 OR DT#> 2 GOTO 1780
1790 T1 = DT#
1800 IF T1 = 0 GOTO 1220
1820 IF T1 = 1 GOTO 5300
1840 GOSUB 4820
1860 GOTO 1220
1880 GOTO 1220
1900 GOSUB 500
1920 GOSUB 6160
1940 PRINT "********************** CUSTOM OUTPUT ROUTINE *******************"
1960 PRINT ""
1980 PRINT "********* HOW MANY LINES DO YOU WANT ON YOUR OUTPUT FORM ******"
2000 GOSUB 60050
2002 IF DT# <1 OR DT#> 100 GOTO 2000
2010 LN = DT#
2020 GOSUB 500
2040 PRINT "YOU WANT ";LN;" LINES ON YOUR OUTPUT FORM "
2060 PRINT "*************** IS THAT CORRECT **************"
2080 PRINT " 1 - CORRECT "
2100 PRINT " 2 - NOT CORRECT"
2110 PRINT "***** ENTER THE NUMBER THEN PRESS RETURN *****"
2120 GOSUB 60000
2122 IF DT# <1 OR DT#> 2 GOTO 2120
2130 T = DT#
2140 IF T = 2 GOTO 1900
2160 GOSUB 500
2180 PRINT "********** WHICH FILE DO YOU WANT TO USE IN THIS FROM **********"
2200 PRINT ""
2220 FOR T = 1 TO MAXF
2240 PRINT T;"-";F$(T)
2260 NEXT T
2280 PRINT ""
2300 PRINT "************* ENTER THE NUMBER THEN PRESS RETURN ***************"
2305 GOSUB 60000
2307 IF DT# <1 OR DT#> MAXF GOTO 2305
2310 MF = DT#
2320 GOSUB 500
2340 N$ = FORM$(TH)
2360 REM ****** BEGIN LINE LOOP ******
2380 FOR L = 1 TO LN
2400 GOSUB 2460
2420 NEXT L
2440 RETURN
2460 GOSUB 500
2480 PRINT "********** LINE NUMBER";L;"**********"
2500 PRINT ""
2520 PRINT "HOW MANY ENTRIES ON THIS LINE ?"
2540 GOSUB 60000
2542 IF DT# <1 OR DT#> 10 GOTO 2540
2550 EN(L) = DT#
2660 REM ******* BEGIN ENTRY LOOP ********
2680 FOR E = 1 TO EN(L)
2700 GOSUB 2760
2720 NEXT E
2740 RETURN
2760 GOSUB 500
2780 PRINT "*********** LINE ";L;" ENTRY ";E;" ***********"
2800 PRINT ""
2820 PRINT "WHAT COLUMN TO YOU WANT THIS ENTRY TO START AT ?
2840 GOSUB 60050
2842 IF DT# <1 OR DT#> 250 GOTO 2840
2850 CE(L,E) = DT#
2860 PRINT "********** WHAT TYPE IS THE ENTRY ************"
2880 PRINT " 1 - STRING CONSTANT"
2900 PRINT " 2 - GET FROM MAIN FILE"
2920 PRINT " 3 - STRING CORESPONDING TO A KEY FROM A FILE "
2940 PRINT " 4 - BLANK"
2950 PRINT "***** ENTER THE NUMBER THEN PRESS RETURN *****"
2960 GOSUB 60000
2962 IF DT# <1 OR DT#> 4 GOTO 2960
2965 IF DT# = 4 THEN DT# = 5
2970 TE(L,E) = DT#
2980 ON TE(L,E) GOTO 3000,3080,3300,3520,3520
3000 REM ***** STRING CONSTANT *****
3020 PRINT "****** ENTER THE CONSTANT THEN PRESS RETURN ******"
3030 MAX = 70
3040 GOSUB 62030
3050 L$(L,E) = A$
3060 GOTO 3520
3080 REM ***** GET FROM MAIN FILE *****
3100 GOSUB 500
3120 PRINT "**************** GET FROM MAIN FILE ****************"
3140 PRINT " FILE NAME ";F$(MF)
3160 PRINT " RECORD NUMBER AUTOMATICALLY INCREMENTS FOR EACH FORM "
3180 PRINT "*** WHAT FIELD DO YOU WANT TO GET THE ENTRY FROM ***"
3200 FOR T = 1 TO NREC(MF)
3220 PRINT T;"-";FLDN$(MF,T)
3240 NEXT T
3260 PRINT "***** ENTER THE FIELD NUMBER THEN PRESS RETURN *****"
3265 GOSUB 60000
3267 IF DT# <1 OR DT#> NREC(MF) GOTO 3265
3270 EFN(L,E) = DT#
3280 GOTO 3520
3300 REM ******** PRINT KEY CORRESPONDING TO A KEY
3320 PRINT "****** PRINT KEY CORESPONDING TO FILE ENTRY ********"
3340 PRINT " FILE NAME ";F$(MF)
3360 PRINT " RECORD NUMBER AUTOMATICALLY INCREMENTS FOR EACH FORM "
3380 PRINT "**** WHAT FIELD DO YOU WANT TO BASE THE KEY ON *****"
3400 FOR T = 1 TO NREC(MF)
3420 PRINT T;"-";FLDN$(MF,T)
3440 NEXT T
3460 PRINT "***** ENTER THE FIELD NUMBER THEN PRESS RETURN *****"
3465 GOSUB 60000
3467 IF DT# <1 OR DT#> NREC(MF) GOTO 3465
3468 IF KY(MF,DT#) <> 2 GOTO 3465
3470 EFN(L,E) = DT#
3480 GOTO 3520
3520 RETURN
3540 RETURN
3560 REM ********** WRITE DATA ON FILE ***********
3580 PRINT " FILE NAME ";N$
3600 OPEN "O",#1,N$
3620 WRITE #1,LN,MF,SFO
3640 IF SFO = 1 THEN WRITE #1,TMF,TSF,SF
3660 FOR T1 = 1 TO LN
3680 WRITE #1,EN(T1)
3700 FOR T2 = 1 TO EN(T1)
3720 WRITE #1,CE(T1,T2),TE(T1,T2)
3740 ON TE(T1,T2) GOTO 3760,3800,3840,3880,3880
3760 WRITE #1,L$(T1,T2)
3780 GOTO 3880
3800 WRITE #1,EFN(T1,T2)
3820 GOTO 3880
3840 WRITE #1,EFN(T1,T2)
3860 GOTO 3880
3880 NEXT T2
3900 NEXT T1
3920 CLOSE
3940 RETURN
3960 REM ********** READ DATA ON FILE ***********
3980 OPEN "I",#1,N$
4000 INPUT #1,LN,MF,SFO
4020 IF SFO = 1 THEN INPUT #1,TMF,TSF,SF
4040 FOR T1 = 1 TO LN
4060 INPUT #1,EN(T1)
4080 FOR T2 = 1 TO EN(T1)
4100 INPUT #1,CE(T1,T2),TE(T1,T2)
4120 ON TE(T1,T2) GOTO 4140,4180,4220,4260,4260
4140 INPUT #1,L$(T1,T2)
4160 GOTO 4260
4180 INPUT #1,EFN(T1,T2)
4200 GOTO 4260
4220 INPUT #1,EFN(T1,T2)
4240 GOTO 4260
4260 NEXT T2
4280 NEXT T1
4300 CLOSE
4320 RETURN
4340 REM ********** PRINT DATA ON PAPER *********
4360 PRINT "CUSTOM OUTPUT FILE NAME ";N$
4380 PRINT "NUMBER OF LINES ";LN
4400 PRINT "MAIN FILE ";F$(MF)
4420 IF SFO = 2 THEN GOTO 4440
4440 FOR T1 = 1 TO LN
4460 PRINT "***** LINE NUMBER ";T1;"NUMBER OF ENTRIES";EN(T1)
4480 FOR T2 = 1 TO EN(T1)
4500 PRINT "ENTRY # ";T2;"COLUMN NUMBER ";CE(T1,T2)
4520 ON TE(T1,T2) GOTO 4540,4580,4640,4700,4740
4540 PRINT " STRING CONSTANT : ";L$(T1,T2)
4560 GOTO 4760
4580 T3 = EFN(T1,T2)
4600 PRINT " GET FROM MAIN FILE - FIELD = ";FLDN$(MF,T3)
4620 GOTO 4760
4640 T3 = EFN(T1,T2)
4660 PRINT " PRINT VALUE CORESPONDING TO A KEY ";FLDN$(MF,T3)
4680 GOTO 4760
4700 PRINT " GET FROM SECONDARY FILE - FORMAT SAME AS LAST LINE"
4720 GOTO 4760
4740 PRINT " LINE BLANK "
4760 NEXT T2
4780 NEXT T1
4800 RETURN
4820 REM ********** PRINT DATA ON PAPER *********
4840 LPRINT "CUSTOM OUTPUT FILE NAME ";N$
4860 LPRINT "NUMBER OF LINES ";LN
4880 LPRINT "MAIN FILE ";F$(MF)
4920 FOR T1 = 1 TO LN
4940 LPRINT "LINE NUMBER ";T1;"NUMBER OF ENTRIES";EN(T1)
4960 FOR T2 = 1 TO EN(T1)
4980 LPRINT "ENTRY # ";T2;"COLUMN NUMBER ";CE(T1,T2)
5000 ON TE(T1,T2) GOTO 5020,5060,5120,5180,5220
5020 LPRINT " STRING CONSTANT : ";L$(T1,T2)
5040 GOTO 5240
5060 T3 = EFN(T1,T2)
5080 LPRINT " GET FROM MAIN FILE - FIELD = ";FLDN$(MF,T3)
5100 GOTO 5240
5120 T3 = EFN(T1,T2)
5140 LPRINT " VALUE CORESPONDING TO KEY = ";FLDN$(MF,T3)
5160 GOTO 5240
5180 LPRINT " GET FROM SECONDARY FILE - FORMAT SAME AS LAST LINE"
5200 GOTO 5240
5220 LPRINT " LINE BLANK "
5240 NEXT T2
5260 NEXT T1
5280 RETURN
5300 REM ********** CORRECT RECORD ROUTINE ***********
5320 GOSUB 500
5340 PRINT "****************** OPTIONS : ******************"
5360 PRINT " 1 - RETURN TO INITIAL MENU"
5380 PRINT " 2 - CHANGE A SINGLE ENTRY"
5400 PRINT " 3 - CHANGE AN ENTIRE LINE"
5420 PRINT "***** ENTER THE NUMBER THEN PRESS RETURN *****"
5440 GOSUB 60000
5442 IF DT# <1 OR DT#> 3 GOTO 5440
5450 TC = DT#
5460 IF TC = 1 THEN GOSUB 3560
5480 IF TC = 1 GOTO 1220
5500 IF TC = 2 GOTO 5600
5520 PRINT "WHAT LINE DO YOU WANT TO CHANGE ?"
5540 GOSUB 60000
5550 L = DT#
5560 GOSUB 2460
5580 GOTO 5300
5600 REM ******* CHANGE A SINGLE ENTRY *******
5620 PRINT "WHAT LINE IS THE ENTRY ON THAT YOU WANT TO CHANGE ?"
5640 GOSUB 60050
5642 IF DT# <1 OR DT#> 100 GOTO 5640
5650 L = DT#
5660 PRINT "WHAT IS THE ENTRY NUMBER THAT YOU WANT TO CHANGE ? "
5680 GOSUB 60000
5682 IF DT# <1 OR DT#> 10 GOTO 5680
5690 E = DT#
5700 GOSUB 2760
5720 GOTO 5300
5740 REM ******* LIST OF FORM FILE ********
5760 OPEN "O",#1,"FORMLIST"
5780 WRITE #1,MAXFORM
5800 FOR T = 1 TO MAXFORM
5820 WRITE #1,FORM$(T)
5840 NEXT T
5860 CLOSE #1
5880 RETURN
5900 REM ********* INPUT LIST OF FORMS FROM DISK *********
5920 OPEN "I",#1,"FORMLIST"
5940 INPUT #1,MAXFORM
5960 FOR T = 1 TO MAXFORM
5980 INPUT #1,FORM$(T)
6000 NEXT T
6020 CLOSE #1
6040 RETURN
6060 REM ******* PRINT FORM LIST *******
6080 FOR T = 1 TO MAXFORM
6100 PRINT T;"-";FORM$(T)
6120 NEXT T
6140 RETURN
6160 GOSUB 500
6180 PRINT "************** WHAT FORM DO YOU WANT ***************"
6200 GOSUB 6060
6220 PRINT ""
6240 PRINT " YOU MAY REDEFINE ANY OF THE ABOVE FORMS "
6260 PRINT " OR"
6280 PRINT " YOU MAY DEFINE A NEW FORM "
6300 PRINT ""
6320 PRINT "********* ENTER A NUMBER FROM 1 TO ";MAXFORM + 1;"*********"
6340 GOSUB 60000
6342 IF DT# <1 OR DT#> (MAXFORM + 1) GOTO 6340
6350 T = DT#
6360 TH = T
6380 IF T > MAXFORM + 1 THEN GOTO 6160
6400 GOSUB 6500
6420 IF T = MAXFORM + 1 THEN MAXFORM = T
6440 GOSUB 500
6460 PRINT "FORM NAME : ";N$
6480 RETURN
6500 PRINT "******* WHAT IS THE NAME OF YOUR FORM *******"
6510 PRINT "First Character must be a letter."
6515 PRINT "No spaces between characters."
6520 PRINT ""
6540 PRINT "***** ENTER THE NAME THEN PRESS RETURN ******"
6550 MAX = 8
6560 GOSUB 62030
6562 GOSUB 8000
6564 IF TEST = 4 GOTO 6560
6570 FORM$(T) = A$
6580 N$ = FORM$(T)
6600 GOSUB 5740
6620 RETURN
8000 REM ***** FILE NAME ACCEPLABLE TEST ************
8010 TEST = 1
8100 FOR Q = 1 TO LEN(A$)
8110 K$(Q) = MID$(A$,Q,1)
8120 C = ASC(K$(Q))
8130 IF C < 48 OR C > 122 THEN TEST = 4
8140 IF Q = 1 AND ( C < 65 OR C > 122 ) THEN TEST = 4
8150 NEXT Q
8190 RETURN
23780 REM ************* READ SUBROUTINE *************
23800 OPEN "I",#1,"FFILE"
23820 INPUT #1,MAXF
23840 FOR A = 1 TO MAXF
23860 INPUT #1,A,F$(A),NREC(A),L(A)
23880 FOR N = 1 TO NREC(A)
23900 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N)
23920 IF FTY(A,N) = 2 THEN INPUT #1,KY(A,N),KEYLIST(A,N)
23940 NEXT N
23960 NEXT A
23980 CLOSE #1
24000 RETURN
50000 REM ********** INTRO
50010 GOSUB 500
50100 PRINT " F O R M D E S C R I P T I O 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 "
50165 PRINT " See the manual for more information on the license."
50167 PRINT ""
50920 GOSUB 23780
50950 PRINT "****************** PRESS ANY KEY TO CONTINUE *******************";
50960 IF INKEY$ = "" GOTO 50960
50970 RETURN
51000 REM ***** EXIT TO SYSTEM
51100 GOSUB 500
51110 CLOSE
51120 PRINT " -BYE, Have a nice day"
51130 END
52000 REM ***** INTRO 1
52010 GOSUB 500
52100 PRINT " Put the DATA DISK in the default disk drive "
52110 PRINT ""
52120 PRINT " ***** THEN PRESS ANY KEY TO CONTINUE *****"
52130 PRINT ""
52140 PRINT " The CUSTOM programs only use the PROGRAM DATA DISK"
52150 PRINT "Keep it in the default disk drive at all times during this program."
52200 IF INKEY$ = "" GOTO 52200
52210 RETURN
60000 REM ******* INTEGER LESS THEN 100 CHECK ********
60010 MAX = 2
60020 ACT$ = "1234567890=<>^"
60030 IF NE = 0 THEN ACT$ = "1234567890"
60040 PRINT ">__<";
60045 GOTO 60240
60050 REM
60060 REM ******* INTEGER *******
60070 MAX = 8
60080 ACT$ = "1234567890-+,=<>^"
60090 IF NE = 0 THEN ACT$ = "1234567890-+,"
60100 PRINT ">________<";
60110 GOTO 60240
60120 REM ******* SINGLE PRECISION *******
60130 MAX = 10
60140 ACT$ = "1234567890-+,.%$=<>^"
60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60160 PRINT ">__________<";
60170 GOTO 60240
60180 REM ******* DOUBLE PRECISION *******
60190 MAX = 20
60200 ACT$ = "1234567890-+,.%$=<>^"
60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60220 PRINT ">____________________<";
60230 GOTO 60240
60240 REM ********** NUMBER CHECK **********
60250 A$ = ""
60260 K$(20) = " "
60270 KTMAX = 0
60280 FOR T9 = 1 TO MAX
60290 K$(T9) = " "
60300 NEXT T9
60310 DIG$ = "1234567890."
60320 DOTFLG = 0
60330 T2 = MAX + 1
60340 FOR T6 = 1 TO T2
60350 PRINT CHR$(CH);
60360 NEXT T6
60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370
60380 KT = 0
60390 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
60400 KT = KT + 1
60410 REM
60420 W$ = INKEY$
60430 IF W$ = "" GOTO 60420
60440 C = ASC(W$)
60450 IF C = 0 THEN GOSUB 61900
60460 IF C = 13 GOTO 60580
60470 IF C = 17 OR C = 8 GOTO 61150
60480 IF C = 19 GOTO 60670
60490 IF C = 4 GOTO 60720
60500 IF C = 6 GOTO 60780
60510 IF C = 1 GOTO 60960
60520 IF KT > MAX GOTO 60410
60530 IF INSTR(ACT$,W$) = 0 GOTO 61230
60540 K$(KT) = W$
60550 PRINT K$(KT);
60560 IF KT > KTMAX THEN KTMAX = KT
60570 GOTO 60400
60580 REM ********** RETURN **********
60590 FOR T9 = 1 TO KTMAX
60600 A$ = A$ + K$(T9)
60610 NEXT T9
60620 IF KTMAX = 0 THEN PRINT "1"
60630 IF KTMAX = 0 THEN DT# = 1
60640 IF KTMAX = 0 THEN RETURN
60650 PRINT ""
60660 GOTO 61260
60670 REM ********* MOVE CURSE BACK ********
60680 IF KT = 1 GOTO 60410
60690 KT = KT - 1
60700 PRINT CHR$(CH);
60710 GOTO 60410
60720 REM ********* MOVE CURSER FORWARD *********
60730 IF KT >= MAX GOTO 60410
60740 IF KT > (KTMAX + 1) GOTO 60410
60750 PRINT K$(KT);
60760 KT = KT + 1
60770 GOTO 60410
60780 REM ********** INSERT ***********
60790 IF KT > KTMAX GOTO 60410
60800 X9 = MAX
60810 WHILE X9 > KT
60820 X9 = X9 - 1
60830 K$(X9 + 1) = K$(X9)
60840 WEND
60850 K$(KT) = " "
60860 KTMAX = KTMAX + 1
60870 IF KTMAX > MAX THEN KTMAX = MAX
60880 FOR T9 = KT TO KTMAX
60890 PRINT K$(T9);
60900 NEXT T9
60910 T6 = (KTMAX - KT) + 1
60920 FOR T7 = 1 TO T6
60930 PRINT CHR$(CH);
60940 NEXT T7
60950 GOTO 60410
60960 REM ********** DELETE ***********
60970 IF KT > KTMAX GOTO 60410
60980 IF KTMAX = 1 GOTO 60410
60990 K$(MAX + 1) = ""
61000 X9 = KT
61010 WHILE X9 <= MAX
61020 K$(X9) = K$(X9 + 1)
61030 X9 = X9 + 1
61040 WEND
61050 KTMAX = KTMAX - 1
61060 FOR T9 = KT TO KTMAX
61070 PRINT K$(T9);
61080 NEXT T9
61090 PRINT "_";
61100 T7 = (KTMAX - KT) + 2
61110 FOR T8 = 1 TO T7
61120 PRINT CHR$(CH);
61130 NEXT T8
61140 GOTO 60410
61150 REM ********* BACKSPACE ********
61160 IF KT = 1 GOTO 60410
61170 KT = KT - 1
61180 PRINT CHR$(CH);
61190 K$(KT) = " "
61200 PRINT "_";
61210 PRINT CHR$(CH);
61220 GOTO 60410
61230 REM ******* INPUT NOT ACCEPTABLE ********
61240 PRINT CHR$(7);
61250 GOTO 60420
61260 REM ********* CLEAR STRINGS ********
61270 MAX = LEN(A$)
61280 D2$ = ""
61290 D1$ = ""
61300 DFLG = 0
61310 FOR Q93 = 1 TO MAX
61320 R$ = MID$(A$,Q93,1)
61330 IF INSTR(DIG$,R$) = 0 GOTO 61400
61340 IF R$ = "." OR DFLG = 1 GOTO 61380
61350 IF DFLG = 1 GOTO 61380
61360 D2$ = D2$ + R$
61370 GOTO 61400
61380 D1$ = D1$ + R$
61390 DFLG = 1
61400 NEXT Q93
61410 DA# = VAL(D2$)
61420 D1# = VAL(D1$)
61430 DT# = DA# + D1#
61440 IF K$(1) = "-" THEN DT# = -DT#
61450 RETURN
61900 REM ****** CHECK FOR ASC0
61910 S4$ = INKEY$
61920 C2 = ASC(S4$)
61930 IF C2 = 83 THEN C = 1
61940 IF C2 = 82 THEN C = 6
61950 IF C2 = 75 THEN C = 19
61960 IF C2 = 77 THEN C = 4
61970 RETURN
62000 REM ********** ALPHANUMERIC CHECK **************
62010 MAX = FL(A,Q)
62020 GOTO 62040
62030 REM ******** MAX SET IN PROGRAM ********
62040 A$ = ""
62050 PRINT ">";
62060 FOR N9 = 1 TO MAX
62070 K$(N9) = ""
62080 PRINT "_";
62090 NEXT N9
62100 PRINT "<";
62110 T2 = MAX + 1
62120 FOR T4 = 1 TO T2
62130 PRINT CHR$(CH);
62140 NEXT T4
62150 KT = 0
62160 KTMAX = 1
62170 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
62180 KT = KT + 1
62190 PRINT TAB(KT+1)"";
62200 K$ = INKEY$
62210 IF K$ = "" GOTO 62200
62220 C = ASC(K$)
62230 IF C = 0 THEN GOSUB 61900
62240 IF C = 13 GOTO 62350
62250 IF C = 17 OR C = 8 GOTO 62920
62260 IF C = 19 GOTO 62450
62270 IF C = 4 GOTO 62500
62280 IF C = 6 GOTO 62560
62290 IF C = 1 GOTO 62730
62300 IF KT > MAX GOTO 62190
62310 K$(KT) = K$
62320 PRINT K$(KT);
62330 IF KT > KTMAX THEN KTMAX = KT
62340 GOTO 62180
62350 REM ********** RETURN **********
62360 FOR T9 = 1 TO MAX
62370 A$ = A$ + K$(T9)
62420 NEXT T9
62430 PRINT ""
62440 RETURN
62450 REM ********* MOVE CURSE BACK ********
62460 IF KT = 1 GOTO 62190
62470 KT = KT - 1
62480 PRINT CHR$(CH);
62490 GOTO 62190
62500 REM ********* MOVE CURSER FORWARD *********
62510 IF KT >= MAX GOTO 62190
62520 IF KT > KTMAX GOTO 62190
62530 PRINT K$(KT);
62540 KT = KT + 1
62550 GOTO 62190
62560 REM ********** INSERT ***********
62570 X9 = MAX
62580 WHILE X9 > KT
62590 X9 = X9 - 1
62600 K$(X9 + 1) = K$(X9)
62610 WEND
62620 K$(KT) = " "
62630 KTMAX = KTMAX + 1
62640 IF KTMAX > MAX THEN KTMAX = MAX
62650 FOR T9 = KT TO KTMAX
62660 PRINT K$(T9);
62670 NEXT T9
62680 T6 = (KTMAX - KT) +1
62690 FOR T7 = 1 TO T6
62700 PRINT CHR$(CH);
62710 NEXT T7
62720 GOTO 62190
62730 REM ********** DELETE ***********
62740 IF KT > KTMAX GOTO 62200
62750 IF KTMAX = 1 GOTO 62190
62760 K$(MAX + 1) = ""
62770 X9 = KT
62780 WHILE X9 <= KTMAX
62790 K$(X9) = K$(X9 + 1)
62800 X9 = X9 + 1
62810 WEND
62820 KTMAX = KTMAX - 1
62830 FOR T9 = KT TO KTMAX
62840 PRINT K$(T9);
62850 NEXT T9
62860 PRINT "_";
62870 T7 = (KTMAX - KT) + 2
62880 FOR T6 = 1 TO T7
62890 PRINT CHR$(CH);
62900 NEXT T6
62910 GOTO 62190
62920 REM ********* BACKSPACE ********
62930 IF KT = 1 GOTO 62190
62940 K$(KT) = " "
62950 KT = KT - 1
62960 K$(KT) = " "
62970 PRINT CHR$(CH);
62980 PRINT "_";
62990 PRINT CHR$(CH);
63000 GOTO 62190
CHANGE.BAS
3 DEFDBL X
4 DEFINT A-W,Y-Z
5 DIM F$(15),FLDN$(15,30),FTY(15,30),FL(15,30)
10 DIM X$(30),Y$(30)
13 DIM L(15),NREC(15),Z$(30),EGL(30),KT(30),I#(30,5),I$(30,5),ORN(30)
14 DIM X(30),CK$(30),SN$(30),SFN(30)
16 DIM KY(15,30),KEYLIST(15,30),L$(10,100),LEND(30),CL(30)
17 DIM ORNFLG(30),FTA(30),ATF(30),BTF(30),IMAX(30)
18 DIM SU%(40),S!(30),SUM#(40)
20 DIM XL(40),TC(30)
22 DIM ORFLG(30),D(30),TFN(30),KTSUM(10),SUMFN(10)
25 DIM S#(30)
26 DIM MAX(10),Z%(10),SU#(30),D#(10),EFN(10,30)
35 DIM K$(80)
40 DIM CNST#(30),CNST$(30),FFLD(30)
42 DIM MAXK(10),MAXSAF(3)
61 CH = 29: PRINT FRE(0)
70 NE = 0
75 GOSUB 50000
77 GOSUB 60000
80 GOSUB 10000
90 GOSUB 11000
400 GOSUB 13000
402 IF KD < 5 THEN GOSUB 11000
404 GOSUB 13000
410 PRINT "********** CHANGE PROGRAM -- WHAT FILE DO YOU WANT: **********"
420 PRINT ""
425 PRINT " 0 - *** EXIT THE PROGRAM ***"
430 FOR I = 1 TO MAXF
440 PRINT I;" - ";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
500 GOTO 6000
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 ""
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#
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 SUBROUTINE *******
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(A)
2565 FIELD #2,L AS Y$
2578 RETURN
2580 REM ******* OPEN THIRD FILE *******
2582 PRINT C,F$(C),L(C)
2584 OPEN "R",#2,F$(C),L(C)
2586 D = 0
2588 FOR T = 1 TO NREC(C)
2590 FIELD #2,D AS DY$,FL(C,T) AS Z$(T)
2592 D = D + FL(C,T)
2594 NEXT T
2596 RETURN
3010 GOTO 400
6000 REM ********** LOOP THROUGH FIELDS ************
6001 EFLG = 0:GOSUB 10700
6002 GOSUB 10200
6003 FOR Q = 1 TO NREC(A)
6006 GOSUB 6045
6009 NEXT Q
6010 REM ********* ADD OPTIONS *******
6011 GOSUB 20000
6012 REM ********** GET STARTING RECORD **********
6015 GOSUB 6375
6018 REM ********** GET RECORDS ***********
6021 RN = RN - 1
6024 RN = RN + 1
6027 GOSUB 6090
6029 IF MATCH = 0 THEN PRINT "RECORD NUMBER ";RN ;" CONDITIONS NOT MET"
6030 IF MATCH = 0 GOTO 6024
6036 REM ******** PRINT ON PAPER ********
6039 GOSUB 30000
6040 IF PRTOPT = 1 THEN GOSUB 12200
6041 IF PRTOPT <> 1 THEN GOSUB 12000
6042 GOTO 6024
6045 REM *********** LOOP THROUGH FIELDS ************
6048 GOSUB 6129
6050 IF EGL(Q) = 1 THEN RETURN
6051 IF FTY(A,Q) = 1 THEN GOTO 6069
6057 REM ****** NUMBERS ********
6060 ON EGL(Q) GOSUB 6045,6201,6234,6234,6201
6063 GOTO 6075
6066 REM ****** STRINGS *******
6069 ON EGL(Q) GOSUB 6366,6246,6279,6279,6246
6072 REM ********** OR ROUTINE ******
6075 GOSUB 6288
6078 IF DT# = 2 THEN GOSUB 6324
6087 RETURN
6090 REM ************** GET RECORDS *****************
6093 GOSUB 6396
6096 FOR Q = 1 TO NREC(A)
6099 REM *********** CONVERT STRINGS TO DECIMALS *********
6102 GOSUB 6435
6105 IF TEST = 1 THEN GOTO 6123
6108 IF TEST = 0 THEN GOSUB 6561
6111 REM ******* OR CHECK RESULTS *********
6114 IF TEST = 1 THEN GOTO 6123
6117 MATCH = 0
6120 RETURN
6123 NEXT Q
6124 MATCH = 1
6126 RETURN
6129 GOSUB 13000
6138 PRINT "FIELD NUMBER: ";Q;"FIELD NAME: ";FLDN$(A,Q)
6141 K = 0
6147 PRINT "****************** CHOSE A RELATIONSHIP *******************"
6153 PRINT " 0 - RETURN TO FILE OPTIONS "
6156 PRINT " 1 - ANY VALUE IS ACCEPTABLE"
6159 PRINT " 2 - ";FLDN$(A,Q);" EQUAL TO X"
6162 PRINT " 3 - ";FLDN$(A,Q);" GREATER THEN X"
6165 PRINT " 4 - ";FLDN$(A,Q);" LESS THEN X"
6166 PRINT " 5 - ";FLDN$(A,Q);" BETWEEN X AND Y"
6171 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ***********"
6177 REM ******* EGL MEANS EQUAL GREATER OR LESS THEN *****
6180 GOSUB 14000
6181 IF DT# < 0 OR DT#>5 GOTO 6180
6183 EGL(Q) = DT#
6189 IF EGL(Q) = 0 GOTO 3010
6192 RETURN
6195 IF FTY(A,Q)=1 THEN GOTO 6243
6198 ON EGL(Q) GOTO 6366,6201,6234,6234,6201
6201 PRINT "********** ENTER THE VALUE OF X THEN PRESS RETURN **********"
6204 K = K + 1
6207 KT(Q)=K
6209 GOSUB 14300
6210 I#(Q,K) = DT#
6211 IF EGL(Q) = 5 AND K = 2 THEN RETURN
6212 IF EGL(Q) = 5 THEN PRINT "********** ENTER THE VALUE OF Y THEN PRESS RETURN **********"
6213 IF EGL(Q) = 5 GOTO 6204
6215 PRINT "*************** MUTIPLE VALUES OF X ? *****************"
6216 PRINT " 1 - MORE VALUES OF X "
6219 PRINT " 2 - NO MORE VALUES OF X "
6222 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN **********"
6225 GOSUB 14000
6226 IF DT# <1 OR DT# > 2 GOTO 6225
6228 IF DT# = 1 GOTO 6201
6231 RETURN
6234 PRINT "******* ENTER THE VALUE OF X THEN PRESS RETURN ********"
6235 GOSUB 14300
6237 I#(Q,1) = DT#
6240 RETURN
6243 ON EGL(Q) GOTO 6366,6246,6279,6279
6246 PRINT "******* ENTER THE VALUE OF X THEN PRESS RETURN *******"
6249 K = K + 1
6252 KT(Q)=K
6253 MAX = 30
6254 GOSUB 15030
6255 I$(Q,K) = A$
6256 IF EGL(Q) = 5 AND K = 2 THEN RETURN
6257 IF EGL(Q) = 5 THEN PRINT "******* ENTER THE VALUE OF Y THEN PRESS RETURN *******"
6258 IF EGL(Q) = 5 THEN GOTO 6249
6260 PRINT "*************** MUTIPLE VALUES OF X ? *****************"
6261 PRINT " 1 - MORE VALUES OF X "
6264 PRINT " 2 - NO MORE VALUES OF X "
6267 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN **********"
6270 GOSUB 14000
6271 IF DT# <1 OR DT# >2 GOTO 6270
6273 IF DT# = 1 GOTO 6246
6276 RETURN
6279 PRINT "******* ENTER THE VALUE OF X THEN PRESS RETURN *******"
6280 MAX = 30
6281 GOSUB 15030
6282 I$(Q,1) = A$
6285 RETURN
6288 REM ************** OR / AND ROUTINE **************
6290 IF Q = NREC(A) THEN RETURN
6291 PRINT ""
6294 PRINT "***** DO YOU WANT THIS CONDITON ORed WITH ANOTHER CONDITION ****"
6297 PRINT " 1 - NO, THIS CONDITION MUST BE MEET "
6300 PRINT " 2 - YES, CHECK ANOTHER FIELD TO SEE IF IT MEETS IT'S CONDITION"
6303 PRINT " - Use only on the lower number field of the 2 you want to or"
6306 PRINT "************* ENTER THE NUMBER THEN PRESS RETURN ***************"
6309 GOSUB 14000
6310 IF DT# <1 OR DT# >2 GOTO 6309
6315 ORN(Q) = 0
6318 RETURN
6321 IF A$ ="1" GOTO 6366
6324 GOSUB 13000
6327 PRINT "-------------------- OR OPTION --------------------------"
6333 PRINT "************** WHAT FIELD DO YOU WANT ? ******************"
6336 PRINT "FIELD NUMBER: ";Q;"FIELD NAME: ";FLDN$(A,Q)
6339 PRINT "******************** ORed WITH ***************************"
6345 FOR N = (Q+1) TO NREC(A)
6348 PRINT "FIELD NUMBER: ";N;"FIELD NAME: ";FLDN$(A,N)
6351 NEXT N
6357 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ***********"
6360 GOSUB 14000
6361 IF DT# <(Q+1) OR DT# > NREC(A) GOTO 6360
6363 ORN(Q) = DT#
6366 RETURN
6372 F4 = 23
6375 GOSUB 13000
6378 PRINT "******** WHAT RECORD DO YOU WANT TO START AT *********"
6381 PRINT ""
6384 PRINT "******** ENTER THE NUMBER THEN PRESS RETURN *********"
6387 GOSUB 14100
6388 IF DT# <1 OR DT# > 20000 GOTO 6387
6390 RN = DT#
6393 RETURN
6396 REM GET RECORD
6399 IF INKEY$ <> "" THEN GOSUB 6576
6402 IF RN > MRN THEN GOSUB 26500
6403 IF EFLG = 1 GOTO 400
6405 GET #1,RN
6417 FOR J = 1 TO NREC(A)
6420 ORFLG(J) = 0
6423 NEXT J
6426 RETURN
6429 Q = Q + 1
6432 REM
6435 ON FTY(A,Q) GOTO 6507,6441,6453,6465,6465
6438 REM ************** CONVERT STRINGS TO DECIMALS ****************
6441 I%=CVI(X$(Q))
6444 I# = I%
6447 S#(Q) = I#
6450 GOTO 6471
6453 I!=CVS(X$(Q))
6456 I# = I!
6459 S#(Q) = I#
6462 GOTO 6471
6465 I#=CVD(X$(Q))
6468 S#(Q) = I#
6471 IF ORFLG(Q) = 1 GOTO 6546
6474 REM ************** CHECK NUMBERS FOR RELATIONS ***************
6477 ON EGL(Q) GOTO 6546,6480,6492,6498,6502
6480 FOR K = 1 TO KT(Q)
6483 IF I#=I#(Q,K) GOTO 6546
6486 NEXT K
6489 GOTO 6561
6492 IF I#>I#(Q,1) GOTO 6546
6495 GOTO 6561
6498 IF I# < I#(Q,1) GOTO 6546
6501 GOTO 6561
6502 IF I# > I#(Q,1) AND I# < I#(Q,2) GOTO 6546
6503 GOTO 6561
6504 REM **************CHECK STRINGS FOR RELATIONS **************
6507 ON EGL(Q) GOTO 6546,6510,6534,6540,6544
6510 FOR K = 1 TO KT(Q)
6513 Y$ = I$(Q,K)
6516 Y = LEN(Y$)
6519 X$ = X$(Q)
6522 X$ = LEFT$(X$,Y)
6525 IF X$=I$(Q,K) GOTO 6546
6528 NEXT K
6531 GOTO 6561
6534 IF X$(Q) > I$(Q,1) GOTO 6546
6537 GOTO 6561
6540 IF X$(Q) < I$(Q,1) GOTO 6546
6543 GOTO 6561
6544 IF X$(Q) > I$(Q,1) AND X$(Q) < I$(Q,2) GOTO 6546
6545 GOTO 6561
6546 P = ORN(Q)
6549 IF P = 0 GOTO 6555
6552 ORFLG(P) = 1
6555 TEST = 1
6558 RETURN
6561 TEST = 0
6567 IF ORN(Q) <> O THEN TEST = 1 ELSE TEST = 2
6573 RETURN
6576 REM ******** PAUSE SUBROUTINE ********
6579 PRINT "****************** PAUSE SUBROUTINE **********************"
6582 PRINT " 1 - CONTINUE SCANNING"
6585 PRINT " 0 - STOP SCANNING "
6588 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ***********"
6591 GOSUB 14000
6593 IF DT# <0 OR DT# >1 GOTO 6588
6597 IF DT# = 0 THEN GOTO 400
6600 RETURN
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(B)/L(B)
7970 RETURN
9070 ON FTY(A,N) GOTO 9100,9150,9200,9250,9250
9100 REM
9110 LSET X$(N) = I$
9120 GOTO 9290
9150 REM
9160 LSET X$(N) = MKI$(I#)
9170 GOTO 9290
9200 REM
9210 LSET X$(N) = MKS$(I#)
9220 GOTO 9290
9250 REM
9260 LSET X$(N) = MKD$(I#)
9290 RETURN
10000 REM ************* READ SUBROUTINE *************
10004 GOSUB 10900
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,KY(A,N),KEYLIST(A,N)
10080 NEXT N
10090 NEXT A
10100 CLOSE #1
10110 RETURN
10200 REM ******* SELECTIVE SCAN CONTINUED ********
10210 GOSUB 13000
10220 PRINT "***************** CHANGE PROGRAM *****************"
10230 PRINT ""
10240 PRINT "******** WHAT DO YOU WANT DONE WITH THE RESULTS *********"
10250 PRINT ""
10260 PRINT " 1 - SHOWN ON THE MONITOR (TV) ONLY "
10370 PRINT " 2 - PRINT ON PAPER AND SHOWN ON THE MONITOR "
10400 PRINT ""
10500 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ***********"
10510 GOSUB 14000
10512 IF DT# <1 OR DT# >2 GOTO 10510
10520 IF DT# = 2 THEN PRTOPT = 1 ELSE PRTOPT = 0
10530 RETURN
10700 REM ****** SELECTIVE SCAN INTRO
10705 GOSUB 13000
10710 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
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
11940 RETURN
12000 REM ****** PRINT SUBROUTINE *****
12010 PRINT "************* FILE : ";F$(A);"- ";"RECORD NUMBER: ";RN;" *************"
12020 FOR Q = 1 TO NREC(A)
12025 REM IF Q MOD 20 = 0 THEN GOSUB 12170
12030 PRINT Q; TAB(5) FLDN$(A,Q);
12040 ON FTY(A,Q) GOTO 12050,12070,12100,12130,12142
12050 PRINT TAB(26) X$(Q)
12060 GOTO 12150
12070 I%=CVI(X$(Q))
12075 PRINT TAB(25) I%;
12080 IF KY(A,Q) <> 2 THEN PRINT ""
12082 IF KY(A,Q) <> 2 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 GOTO 12150
12100 I!=CVS(X$(Q))
12110 PRINT TAB(25) I!
12120 GOTO 12150
12130 I#=CVD(X$(Q))
12140 PRINT TAB(25) I#
12141 GOTO 12150
12142 I#=CVD(X$(Q))
12144 PRINT TAB(26);
12146 PRINT USING "**$########.##";I#
12150 NEXT Q
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 PRINT ""
12210 LPRINT ""
12220 PRINT "RECORD NUMBER: ";RN
12230 LPRINT "RECORD NUMBER: ";RN
12240 FOR Q = 1 TO NREC(A)
12250 PRINT Q;TAB(5) FLDN$(A,Q);
12260 LPRINT Q;TAB(5) FLDN$(A,Q);
12270 ON FTY(A,Q) GOTO 12280,12310,12350,12390,12425
12280 PRINT TAB(26) X$(Q)
12290 LPRINT TAB(26) X$(Q)
12300 GOTO 12480
12310 I%=CVI(X$(Q))
12312 PRINT TAB(25) I%;
12314 LPRINT TAB(25) I%;
12316 IF KY(A,Q) <> 2 THEN PRINT ""
12318 IF KY(A,Q) <> 2 THEN LPRINT ""
12320 IF KY(A,Q) <> 2 THEN GOTO 12480
12322 T1 = KEYLIST(A,Q)
12324 W$ = L$(T1,I%)
12326 PRINT TAB(30) "key: ";W$
12328 LPRINT TAB(30) "key: ";W$
12330 GOTO 12480
12340 GOTO 12480
12350 I!=CVS(X$(Q))
12360 PRINT TAB(25) I!
12370 LPRINT TAB(25) I!
12380 GOTO 12480
12390 I#=CVD(X$(Q))
12400 PRINT TAB(25) I#
12410 LPRINT TAB(25) I#
12420 GOTO 12480
12425 I#=CVD(X$(Q))
12430 PRINT TAB(26);
12440 PRINT USING "**$########.##";I#
12450 LPRINT TAB(26);
12460 LPRINT USING "**$########.##";I#
12480 NEXT Q
12490 RETURN
12500 PRINT ""
12510 LPRINT ""
12520 PRINT "RECORD # ";RN;" ";
12530 LPRINT "RECORD # ";RN;" ";
12540 FOR Q = 1 TO NREC(A)
12545 IF LEND(Q)= 5 THEN PRINT ""
12547 IF LEND(Q)= 5 THEN LPRINT ""
12548 T2 = CL(Q) + 6
12550 PRINT TAB(CL(Q))"<";Q;">";
12560 LPRINT TAB(CL(Q))"<";Q;">";
12570 ON FTY(A,Q) GOTO 12580,12610,12730,12770,12810
12580 PRINT TAB(T2) X$(Q);
12590 LPRINT TAB(T2) X$(Q);
12600 GOTO 12860
12610 I%=CVI(X$(Q))
12620 PRINT TAB(T2)I%;
12630 LPRINT TAB(T2)I%;
12660 IF KY(A,Q) <> 2 THEN GOTO 12860
12670 T1 = KEYLIST(A,Q)
12680 W$ = L$(T1,I%)
12685 T1 = CL(Q) + 11
12690 PRINT TAB(T1)"key: ";W$;
12700 LPRINT TAB(T1)"key: ";W$;
12720 GOTO 12860
12730 I!=CVS(X$(Q))
12740 PRINT TAB(T2)I!;
12750 LPRINT TAB(T2)I!;
12760 GOTO 12860
12770 I#=CVD(X$(Q))
12780 PRINT TAB(T2)I#;
12790 LPRINT TAB(T2)I#;
12800 GOTO 12860
12810 I#=CVD(X$(Q))
12820 PRINT TAB(T2) "";
12830 PRINT USING "**$########,.##";I#;
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:PRINT T;CL(T); " RETURNED FROM 12910 "
12907 IF C > COLM THEN GOSUB 12970
12908 PRINT T;CL(T): NEXT T
12909 RETURN
12910 ON FTY(A,T) GOTO 12920,12930,12940,12950,12950
12920 C = C + FL(A,T) + 5
12925 RETURN
12930 C = C + 11
12933 IF KY(A,T) = 2 THEN C = C + 30
12935 RETURN
12940 C = C + 13
12945 RETURN
12950 C = C + 18
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
13100 REM ********* LOCATE
13110 LOCATE LI,1
13120 RETURN
13200 FOR T% = 1 TO 80
13210 PRINT CHR$(8);
13220 NEXT T%
13222 FOR T% = 1 TO 24
13223 PRINT CHR$(11);
13224 NEXT T%
13225 LI = LI - 1
13230 FOR T% = 1 TO LI
13240 PRINT CHR$(0)
13250 NEXT T%
13590 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 *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
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
14683 IF KTMAX = 0 THEN RETURN
14684 PRINT ""
14685 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" 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 3 = 0 THEN PRINT ""
16235 IF T MOD 3 = 0 THEN T2 = -25
16237 T2 = T2 + 26
16340 NEXT T
16350 RETURN
20000 REM **** TYPE OF CHANGE *******
20050 GOSUB 40000
20100 FOR N = 1 TO NREC(A)
20200 GOSUB 13000
20205 PRINT "FIELD NUMBER :";N;" FIELD NAME :";FLDN$(A,N)
20210 PRINT "******** WHAT TYPE OF CHANGE DO YOU WANT ********"
20220 PRINT " 1 - NO CHANGE "
20230 PRINT " 2 - REPLACE "
20240 PRINT " 3 - ADD A CONSTANT TO THIS FIELDS VALUE"
20250 PRINT " 4 - MULTIPLY THE CURRENT VALUE BY A CONSTANT"
20260 PRINT " 5 - ADD A CONSTANT TO A DIFFERENT NUMBER FIELD"
20270 PRINT " 6 - MULTIPLY A DIFFERENT FIELD BY A CONSTANT"
20280 PRINT "******** ENTER THE VALUE THEN PRESS RETURN ********"
20300 GOSUB 14000
20310 IF DT# < 1 OR DT# >6 GOTO 20300
20320 TC(N) = DT#
20400 ON TC(N) GOSUB 21000,21500,22000,22500,23000,23500
20410 NEXT N
21000 REM ****** NO CHANGE
21010 RETURN
21500 REM REPLACE ******
21505 PRINT " ENTER THE VALUE YOU WANT THE FIELD TO HAVE "
21510 IF FTY(A,N) = 1 GOTO 21700
21520 GOSUB 14200
21530 CNST#(N) = DT#
21540 RETURN
21700 REM ***** STRING
21710 INPUT CNST$(N)
21720 RETURN
22000 REM ******* ADD A CONSTANT
22100 PRINT " ENTER THE NUMBER YOU WANT TO ADD TO THE CURRENT VALUE "
22110 GOSUB 14200
22120 CNST#(N) = DT#
22130 RETURN
22500 REM ******* MULTIPLY A CONSTAT BY A CONSTANT
22600 PRINT " ENTER THE NUMBER YOU WANT TO MULTIPLY THE CURRENT VALUE BY"
22610 GOSUB 14200
22620 CNST#(N) = DT#
22630 RETURN
23000 REM ******* ADD A CONSTANT TO A DIFFERENT FIELD
23100 PRINT "WHICH FIELD DO YOU WANT TO ADD THE CONSTANT TO "
23110 FOR T = 1 TO NREC(A)
23120 PRINT T;"-";FLDN$(A,T)
23130 NEXT T
23200 GOSUB 14000
23210 FFLD(N) = DT#
23300 PRINT "ENTER THE VALUE YOU WANT TO ADD TO THIS FIELD "
23310 GOSUB 14200
23320 CNST#(N) = DT#
23400 RETURN
23500 REM ******* MULTIPLY A DIFFERENT FIELD BY A CONSTANT
23600 PRINT "WHICH FIELD DO YOU WANT TO MULTIPLY THE CONSTANT BY"
23610 FOR T = 1 TO NREC(A)
23620 PRINT T;"-";FLDN$(A,T)
23630 NEXT T
23700 GOSUB 14000
23710 FFLD(N) = DT#
23800 PRINT "ENTER THE VALUE YOU WANT TO MULTIPLY THIS FIELD BY"
23810 GOSUB 14200
23820 CNST#(N) = DT#
23900 RETURN
26000 REM ******* ON ERROR ROUTINE ************
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 ********* ON ERROR SUBROUTINE ***********
26600 PRINT "********** END OF FILE ***********"
26610 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
26620 IF INKEY$ = "" GOTO 26620
26635 EFLG = 1
26640 RETURN
26800 REM ********** ON ERROR GOTO **************
26900 PRINT "************ RECORD NOT FOUND *************"
30000 REM CHANGE FIELDS ********
30100 FOR N = 1 TO NREC(A)
30200 ON TC(N) GOSUB 30900,31000,32000,33000,34000,35000
30300 IF TC(N) = 1 GOTO 30800
30400 GOSUB 9070
30800 NEXT N
30810 PUT #1,RN
30815 IF SECF = 2 THEN GOSUB 41000
30820 RETURN
30900 REM ****** NO CHANGE
30910 RETURN
31000 REM ****** REPLACE
31100 IF FTY(A,N) = 1 GOTO 31700
31200 I# = CNST#(N)
31300 RETURN
31700 I$ = CNST$(N)
31710 RETURN
32000 REM ****** ADD A CONSTAT TO THIS FIELDS VALUE
32100 I# = CNST#(N) + S#(N)
32110 RETURN
33000 REM ****** MULTIPLY A CONSTANT TO THIS FIELD
33200 I# = CNST#(N) * S#(N)
33300 RETURN
34000 REM ****** ADD A CONSTANT TO DIFFERENT FIELD
34100 T = FFLD(N)
34200 I# = CNST#(N) + S#(T)
34300 RETURN
35000 REM ****** MULTIPLY A CONSTANT TO A DIFFERENT NUMBER FIELD
35100 T = FFLD(N)
35200 I# = CNST#(N) * S#(T)
35300 RETURN
40000 REM ***** CREATE SECOND FILE
40100 GOSUB 13000
40110 PRINT "**** DO YOU WANT TO CREATE A SECOND FILE WITH THE SECECTED RECORDS ****"
40120 PRINT " 1 - NO"
40130 PRINT " 2 - YES"
40140 PRINT "********************** ENTER THE NUMBER THEN PRESS RETURN **************"
40150 GOSUB 14000
40160 IF DT#<1 OR DT#>2 THEN 40150
40170 SECF = DT#
40175 IF SECF = 2 THEN GOSUB 40200
40180 RETURN
40200 REM ****** OPEN SECOND FILE
40210 FIELD #1,L(A) AS X1$
40220 PRINT "FILE TO TRANSFER DATA TO"
40230 PRINT "THE DISK DRIVE MUST BE DIFFERENT FROM THE SOURCE DRIVE "
40240 GOSUB 2300
40250 GOSUB 2550
40255 RN2 = 1
40260 RETURN
41000 REM ***** WRITE SECOND FILE
41100 LSET Y$ = XT$
41200 PUT #2,RN2
41300 RN2 = RN2 + 1
41400 RETURN
50000 REM ********** INTRO
50010 GOSUB 13000
50100 PRINT " C H A N G E 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 several restrictions "
50150 PRINT " - See the manual for more information on the license "
50160 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
60000 REM INTRO 2
61000 GOSUB 13000
61100 PRINT " This program will change the value of all the records in you file"
61110 PRINT " that meet the conditions you specify. "
61120 PRINT ""
61130 PRINT "**** ALWAYS MAKE A BACK UP COPY BEFORE YOU USE THIS PROGRAM ****"
61800 PRINT ""
61805 PRINT " Press any key to continue"
61810 IF INKEY$ = "" THEN 61810
61820 RETURN
CINPUT.BAS
4 DEFINT A-W,Y-Z
5 DIM F$(17),FLDN$(17,30),FTY(17,30),FL(17,30),IOPT(30)
6 DIM PROMPT$(30),IFN(30),IFLD(30),IRNFLD(30),NOS(30),ADDFLD(30,6)
7 DIM SUBX(30),SUBY(30),MULX(30),MULY(30),TBLOPT(30),TN(30)
8 DIM TBLFLD(30),XKEY(30),YKEY(30),CMOPT(30),MAXMIN(30,6)
9 DIM KC(30),CFLD(30)
13 DIM L(17),NREC(17)
16 DIM KY(17,30),KEYLIST(17,30)
21 DIM TX(10,10)
35 DIM K$(80)
50 DIM X(6,30)
70 CH = 29
75 PRINT "MEMORY FREE ",FRE(0)
80 GOSUB 52000
100 GOSUB 50000
200 GOTO 10000
500 REM ******* CLS
510 CLS
520 RETURN
10000 REM ******** CUSTOM INPUT PROGRAM *********
10120 GOSUB 500
10130 HLD = 0
10140 PRINT "******** CUSTOM INPUT PROGRAM INITIAL MENU *********"
10145 PRINT ""
10150 PRINT " 0 - EXIT THE PROGRAM "
10155 PRINT ""
10160 PRINT " 1 - ENTER A NEW INPUT DESCRIPTION "
10165 PRINT ""
10180 PRINT " 2 - READ CUSTOM INPUT DESCRIPTION"
10185 PRINT ""
10200 PRINT " 3 - PRINT CUSTOM INPUT DESCRIPTION ON PAPER "
10210 PRINT ""
10220 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN ********"
10240 GOSUB 60000
10242 IF DT# <0 OR DT#> 3 GOTO 10240
10250 T = DT#
10255 IF T = 0 GOTO 51000
10260 ON T GOTO 10280,10360,10460
10280 GOSUB 10540
10300 GOSUB 10780
10320 GOSUB 14500
10340 GOTO 10120
10360 REM *****
10380 GOSUB 10540
10400 GOSUB 15600
10420 GOSUB 16420
10440 GOTO 10120
10460 GOSUB 10540
10480 GOSUB 15600
10500 GOSUB 17760
10520 GOTO 10120
10540 GOSUB 500
10560 PRINT "********** WHICH FILE DO YOU WANT ************"
10580 PRINT ""
10600 FOR A = 1 TO MAXF
10620 PRINT A;" - "; F$(A)
10640 NEXT A
10660 PRINT ""
10680 PRINT "******** ENTER THE NUMBER THEN RETURN ********"
10690 MAX = 2
10700 GOSUB 62030
10710 AH$ = A$
10720 A = VAL(A$)
10730 IF A = 0 THEN A = 1
10735 IF A = 1 THEN AH$ = "1"
10740 IF A<1 OR A> MAXF GOTO 10700
10760 RETURN
10780 FOR N = 1 TO NREC(A)
10800 GOSUB 500
10820 GOSUB 10900
10840 GOSUB 11380
10860 NEXT N
10880 RETURN
10900 GOSUB 500
10920 PRINT "FIELD # ";N;" ";FLDN$(A,N)
10940 IF FTY(A,N) = 1 THEN PRINT " STRING WITH MAXIMUM LENGTH ";FL(A,N)
10960 IF FTY(A,N) = 2 THEN PRINT " INTEGER"
10980 IF FTY(A,N) = 3 THEN PRINT " SINGLE PRECISION "
11000 IF FTY(A,N) = 4 THEN PRINT " DOUBLE PRECISION "
11020 IF FTY(A,N) = 5 THEN PRINT " DOLLARS AND CENTS AMOUNT"
11040 PRINT "---------------------------------------------------------"
11060 PRINT "****** WHAT TYPE OF INPUT DO YOU WANT FOR THIS FIELD ******"
11080 PRINT " 1 - OPERATOR ENTRY "
11100 PRINT " 2 - GET FROM ANOTHER FILE"
11120 PRINT " 3 - ADD SEVERAL PREVIOUS FIELDS **** NUMBERS ONLY ****"
11140 PRINT " 4 - SUBTRACT TWO PREVIOUS FIELDS '' '' '' '' "
11160 PRINT " 5 - MULTIPLY TWO PREVIOUS FIELDS"
11180 PRINT " 6 - COMPUTE USING TAX TABLE "
11200 PRINT " 7 - CONSTANT"
11220 PRINT " 8 - MAXIMUM OF PREVIOUS FIELDS"
11240 PRINT " 9 - MINIMUM OF PREVIOUS FIELDS"
11260 PRINT "10 - MULTIPLY BY A CONSTANT "
11280 PRINT "11 - ADD A CONSTANT"
11300 PRINT "12 - SUBTRACT A CONSTANT FROM A PREVIOUS FIELD"
11310 PRINT "13 - DIVIDE PREVIOUS FIELDS "
11320 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN *************"
11340 GOSUB 60000
11342 IF DT# <1 GOTO 11340
11344 IF FTY(A,N) = 1 AND DT# > 2 GOTO 11340
11350 IOPT(N) = DT#
11360 ON IOPT(N) GOTO 11560,11640,12080,12320,12500,12680,14300,13820,14060,14300,14300,14300,12320
11370 RETURN
11380 PRINT "********** IS THE DATA YOU JUST ENTERED CORRECT ***********"
11400 PRINT " 1 - CORRECT"
11420 PRINT " 2 - NOT CORRECT"
11440 PRINT "************ ENTER THE NUMBER THEN PRESS RETURN ***********"
11460 GOSUB 60000
11462 IF DT# <1 OR DT#> 2 GOTO 11460
11470 D = DT#
11480 IF D = 2 GOTO 10900
11500 RETURN
11520 GOTO 11380
11540 GOTO 10320
11560 REM ***** OPERATOR ENTRY *****
11580 PRINT "******************** OPERATOR ENTRY ******************"
11590 PRINT "The prompt will be displayed when the input is requested"
11600 PRINT "********* ENTER THE PROMPT THEN PRESS RETURN *********"
11605 MAX = 75
11610 GOSUB 62030
11615 PROMPT$(N) = A$
11620 RETURN
11640 REM ****** GET FROM ANOTHER FILE ******
11660 PRINT "*************** GET FROM ANOTHER FILE ***************"
11680 FOR F = 1 TO MAXF
11700 PRINT F;" - ";F$(F)
11720 NEXT F
11740 PRINT "****** WHICH FILE DO YOU WANT TO GET ENTRY FROM ******"
11750 PRINT "Must be the same file for all fields "
11760 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN *********"
11780 GOSUB 60000
11782 IF DT# <1 OR DT#> MAXF GOTO 11780
11784 IF HLD > 0 AND DT# >< HLD GOTO 11780
11785 IFN(N) = DT#
11787 HLD = DT#
11800 B = IFN(N)
11820 FOR T = 1 TO NREC(B)
11840 PRINT T;" - ";FLDN$(B,T)
11860 NEXT T
11880 PRINT "****** WHICH FIELD DO YOU WANT TO GET ENTRY FROM ******"
11900 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN **********"
11920 GOSUB 60000
11922 IF DT# <1 OR DT#> NREC(B) GOTO 11920
11930 IFLD(N) = DT#
11940 FOR T = 1 TO NREC(A)
11960 PRINT T;" - ";FLDN$(A,T)
11980 NEXT T
12000 PRINT "********** RECORD NUMBER EQUALS WHICH FIELD ***********"
12020 PRINT "******* ENTER THE FIELD NUMBER THEN PRESS RETURN ******"
12040 GOSUB 60000
12042 IF DT# <1 OR DT#> NREC(B) GOTO 12040
12050 IRNFLD(N) = DT#
12060 RETURN
12080 REM ***** ADD PREVIOUS FIELDS *****
12090 X(5,N) = DT#
12100 PRINT "************* ADD PREVIOUS FIELDS ************"
12120 PRINT "***** HOW MANY FIELDS DO YOU WANT TO ADD *****"
12140 PRINT "***** ENTER THE NUMBER THEN PRESS RETURN *****"
12145 GOSUB 60000
12147 IF DT# <1 OR DT#> NREC(A) GOTO 12145
12150 NOS(N) = DT#
12160 FOR T = 1 TO NREC(A)
12180 PRINT T;" - ";FLDN$(A,T)
12200 NEXT T
12220 FOR J = 1 TO NOS(N)
12240 PRINT "***** ENTER THE ";J;"th FIELD TO BE ADDED *****"
12260 GOSUB 60000
12262 IF DT# <1 OR DT#> NREC(A) GOTO 12260
12264 IF FTY(A,DT#) = 1 GOTO 12260
12270 ADDFLD(N,J) = DT#
12280 NEXT J
12300 RETURN
12320 REM ***** SUBTRACT FIELDS *****
12340 IF IOPT(N) = 4 THEN PRINT "******** SUBTRACT FIELD X - FIELD Y *****"
12350 IF IOPT(N) = 13 THEN PRINT "******* DIVIDE FIELD X BY FIELD Y ********"
12360 FOR T = 1 TO NREC(A)
12380 PRINT T;" - ";FLDN$(A,T)
12400 NEXT T
12440 PRINT "***** ENTER FIELD X THEN PRESS RETURN *****"
12445 GOSUB 60000
12447 IF DT# <1 OR DT#> NREC(A) GOTO 12445
12448 IF FTY(A,DT#) = 1 GOTO 12445
12450 SUBX(N) = DT#
12460 PRINT "***** ENTER FIELD Y THEN PRESS RETURN *****"
12462 GOSUB 60000
12464 IF DT# <1 OR DT#> NREC(A) GOTO 12462
12465 SUBY(N) = DT#
12467 IF FTY(A,DT#) = 1 GOTO 12462
12480 RETURN
12500 REM ***** MULTIPY FIELDS *****
12520 PRINT "************ MULTIPLY FIELDS *************"
12540 FOR T = 1 TO NREC(A)
12560 PRINT T;" - ";FLDN$(A,T)
12580 NEXT T
12600 PRINT "********** FIELD X TIMES FIELD Y **********"
12620 PRINT "***** ENTER FIELD X THEN PRESS RETURN *****"
12625 GOSUB 60000
12627 IF DT# <1 OR DT#> NREC(A) GOTO 12625
12628 IF FTY(A,DT#) = 1 GOTO 12625
12630 MULX(N) = DT#
12640 PRINT "***** ENTER FIELD Y THEN PRESS RETURN *****"
12645 GOSUB 60000
12647 IF DT# <1 OR DT#> NREC(A) GOTO 12645
12648 IF FTY(A,DT#) = 1 GOTO 12645
12650 MULY(N) = DT#
12660 RETURN
12680 REM ********* TAX COMPUTE *********
12700 GOSUB 500
12720 PRINT "***************** IS THE TAX TABLE *****************"
12740 PRINT " 1 - CONSTANT "
12760 PRINT " 2 - VARIABLE "
12780 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN ********"
12782 IF DT# <1 OR DT#> 2 GOTO 12800
12800 GOSUB 60000
12802 IF DT# <1 OR DT#> 2 GOTO 12800
12810 X(1,N) = DT#
12820 ON X(1,N) GOSUB 13240,13380
12840 GOSUB 500
12860 PRINT "***************** IS THE PAY PERIOD *****************"
12880 PRINT " 1 - CONSTANT "
12900 PRINT " 2 - VARIABLE "
12920 PRINT "******** ENTER THE NUMBER THEN PRESS RETURN *********"
12940 GOSUB 60000
12942 IF DT# <1 OR DT#> 2 GOTO 12940
12950 X(3,N) = DT#
12960 ON X(3,N) GOSUB 13540,13660
12980 PRINT "******* WHICH FIELD IS SINGLE / MARRIED FIELD ********"
13000 FOR T = 1 TO N
13020 PRINT T;"-";FLDN$(A,T)
13040 NEXT T
13060 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN *********"
13080 GOSUB 60000
13082 IF DT# <1 OR DT#> NREC(A) GOTO 13080
13084 IF FTY(A,DT#) = 1 GOTO 13080
13090 X(5,N) = DT#
13100 PRINT "*************** WHICH FIELD IS THE PAY ****************"
13120 FOR T = 1 TO N
13140 PRINT T;"-";FLDN$(A,T)
13160 NEXT T
13180 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN *********"
13200 GOSUB 60000
13202 IF DT# <1 OR DT#> NREC(A) GOTO 13200
13204 IF FTY(A,DT#) = 1 GOTO 13200
13210 X(6,N) = DT#
13220 RETURN
13240 REM ******* TAX TABLE = CONSTANT
13260 PRINT "*************** ENTER THE TABLE NUMBER ****************"
13280 PRINT ""
13300 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN *********"
13320 PRINT ""
13340 GOSUB 60000
13350 X(2,N) = DT#
13360 RETURN
13380 REM ******* TAX TABLE VARIABLE
13400 PRINT "********* WHICH FIELD CONTAINS THE TABLE NUMBER *******"
13420 FOR T = 1 TO N
13440 PRINT T;"-";FLDN$(A,T)
13460 NEXT T
13480 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ********"
13500 GOSUB 60000
13502 IF DT# <1 OR DT#> NREC(A) GOTO 13500
13510 X(2,N) = DT#
13520 RETURN
13540 REM ******* PAY PERIOD CONSTANT
13560 PRINT "************* ENTER THE PAY PERIOD CONSTANT ***********"
13580 PRINT ""
13600 PRINT "********** ENTER THE CONSTANT THEN PRESS RETURN *******"
13620 GOSUB 60000
13630 X(4,N) = DT#
13640 RETURN
13660 REM ******* PAY PERIOD VARIABLE
13680 PRINT "****** WHICH FIELD CONTAINS THE PAY PERIOD NUMBER *****"
13700 FOR T = 1 TO N
13720 PRINT T;"-";FLDN$(A,T)
13740 NEXT T
13760 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN *********"
13780 GOSUB 60000
13782 IF DT# <1 OR DT#> NREC(A) GOTO 13780
13783 IF DT# = 1 GOTO 13780
13790 X(4,N) = DT#
13800 RETURN
13820 REM ************ MAXIMUM **************
13840 PRINT "*************** MAXIMUM OF ITEMS ****************"
13860 PRINT "***** HOW MANY ITEMS DO YOU WANT TO COMPARE *****"
13880 GOSUB 60000
13890 NOS(N) = DT#
13900 FOR T = 1 TO NREC(A)
13920 PRINT T;" - ";FLDN$(A,T)
13940 NEXT T
13960 FOR J = 1 TO NOS(N)
13980 PRINT "****** ENTER THE ";J;"th ITEM TO BE COMPARED *****"
14000 GOSUB 60000
14002 IF DT# <1 OR DT#> NREC(A) GOTO 14000
14004 IF FTY(A,DT#) = 1 GOTO 14000
14010 MAXMIN(N,J) = DT#
14020 NEXT J
14040 RETURN
14060 REM ************ MINIMUM **************
14080 PRINT "************** MINIMUM OF ITEMS ****************"
14100 PRINT "***** HOW MANY ITEMS DO YOU WANT TO COMPARE *****"
14120 GOSUB 60000
14130 NOS(N) = DT#
14140 FOR T = 1 TO NREC(A)
14160 PRINT T;" - ";FLDN$(A,T)
14180 NEXT T
14200 FOR J = 1 TO NOS(N)
14220 PRINT "***** ENTER THE ";J;"th ITEM TO BE COMPARED *****"
14240 GOSUB 60000
14242 IF DT# <1 OR DT#> NREC(A) GOTO 14240
14244 IF FTY(A,DT#) = 1 GOTO 14240
14250 MAXMIN(N,J) = DT#
14260 NEXT J
14280 RETURN
14300 REM *********** CONSTANT ************
14320 PRINT "************** ENTER CONSTANT ****************"
14340 GOSUB 60180
14350 KC(N) = DT#
14360 IF IOPT(N) = 7 THEN RETURN
14380 FOR T = 1 TO NREC(A)
14400 PRINT T;" - ";FLDN$(A,T)
14420 NEXT T
14440 PRINT "********* WHAT FIELD IS OPERATED ON **********"
14460 GOSUB 60000
14462 IF DT# <1 OR DT#> NREC(A) GOTO 14460
14464 IF FTY(A,DT#) = 1 GOTO 14460
14470 CFLD(N) = DT#
14480 RETURN
14500 REM ********** OPEN IPUTD **********
14520 GOSUB 500
14540 PRINT "************* WRITING DATA ON FILE ***************"
14560 N$ = "IPUTD" + AH$
14580 OPEN "O",#1,N$
14600 WRITE #1,NREC(A)
14620 FOR N = 1 TO NREC(A)
14640 WRITE #1,IOPT(N)
14660 ON IOPT(N) GOTO 14680,14740,14800,14940,15000,15060,15260,15140,15140,15260,15260,15260,14940
14680 REM ***** OPERATOR ENTRY *****
14700 WRITE #1,PROMPT$(N)
14720 GOTO 15300
14740 REM ***** GET FROM ANOTHER FILE *****
14760 WRITE #1,IFN(N),IFLD(N),IRNFLD(N)
14780 GOTO 15300
14800 REM ***** ADD PREVIOUS FIELDS ******
14820 WRITE #1,NOS(N)
14840 FOR T = 1 TO NOS(N)
14860 Q = ADDFLD(N,T)
14880 WRITE #1,ADDFLD(N,T)
14900 NEXT T
14920 GOTO 15300
14940 REM ***** SUBTRACT PREVIOUS FIELDS ******
14960 WRITE #1, SUBX(N),SUBY(N)
14980 GOTO 15300
15000 REM ***** MULTIPLY FIELDS *****
15020 WRITE #1, MULX(N),MULY(N)
15040 GOTO 15300
15060 REM ***** TAX TABLE *****
15080 WRITE #1,X(1,N),X(2,N),X(3,N),X(4,N),X(5,N),X(6,N)
15100 GOTO 15300
15120 WRITE #1,CMOPT(N)
15140 REM ***** MAXIMUM ******
15160 WRITE #1,NOS(N)
15180 FOR T = 1 TO NOS(N)
15200 WRITE #1,MAXMIN(N,T)
15220 NEXT T
15240 GOTO 15300
15260 REM ***** CONSTANT *****
15280 WRITE #1,KC(N),CFLD(N)
15300 NEXT N
15320 CLOSE #1
15340 RETURN
15600 REM ********** OPEN IPUTD **********
15620 GOSUB 500
15640 PRINT "************* READING DATA FROM FILE ***************"
15660 N$ = "IPUTD" + A$
15680 OPEN "I",#1,N$
15700 INPUT #1,NREC(A)
15720 FOR N = 1 TO NREC(A)
15740 INPUT #1,IOPT(N)
15760 ON IOPT(N) GOTO 15780,15840,15900,16020,16080,16140,16320,16200,16200,16320,16320,16320,16020
15780 REM ***** OPERATOR ENTRY *****
15800 INPUT #1,PROMPT$(N)
15820 GOTO 16360
15840 REM ***** GET FROM ANOTHER FILE *****
15860 INPUT #1,IFN(N),IFLD(N),IRNFLD(N)
15880 GOTO 16360
15900 REM ***** ADD PREVIOUS FIELDS ******
15920 INPUT #1,NOS(N)
15940 FOR T = 1 TO NOS(N)
15960 INPUT #1,ADDFLD(N,T)
15980 NEXT T
16000 GOTO 16360
16020 REM ***** SUBTRACT PREVIOUS FIELDS ******
16040 INPUT #1, SUBX(N),SUBY(N)
16060 GOTO 16360
16080 REM ***** MULTIPLY FIELDS *****
16100 INPUT #1, MULX(N),MULY(N)
16120 GOTO 16360
16140 REM ***** GET FROM A TABLE *****
16160 INPUT #1,X(1,N),X(2,N),X(3,N),X(4,N),X(5,N),X(6,N)
16180 GOTO 16360
16200 REM ***** MAXIMUM ******
16220 INPUT #1,NOS(N)
16240 FOR T = 1 TO NOS(N)
16260 INPUT #1,MAXMIN(N,T)
16280 NEXT T
16300 GOTO 16360
16320 REM ***** CONSTANT *****
16340 INPUT #1,KC(N),CFLD(N)
16360 NEXT N
16380 CLOSE #1
16400 RETURN
16420 REM ********** PRINT IPUTD **********
16460 GOSUB 500
16480 PRINT N$
16500 FOR N = 1 TO NREC(A)
16520 PRINT "********** ";N;" ";FLDN$(A,N);" ************"
16540 PRINT " INPUT OPTION ";IOPT(N);" ";
16560 ON IOPT(N) GOTO 16580,16660,16800,16920,17020,17120,17620,17480,17480,17620,17620,17620,16920
16563 PRINT ""
16565 GOTO 17680
16580 REM ***** OPERATOR ENTRY *****
16600 PRINT "OPERATOR ENTRY"
16620 PRINT "PROMPT ";PROMPT$(N)
16640 GOTO 17680
16660 REM ***** GET FROM ANOTHER FILE *****
16680 PRINT "GET FROM ANOTHER FILE "
16690 PRINT "FROM FILE: FROM FIELD: SOURCE RECORD NUMBER IS THIS FIELDS VALUE:"
16700 Q=IFN(N)
16720 W = IFLD(N)
16740 Z = IRNFLD(N)
16760 PRINT F$(Q),TAB(15) FLDN$(Q,W),TAB(38) FLDN$(A,Z)
16780 GOTO 17680
16800 REM ***** ADD PREVIOUS FIELDS ******
16820 PRINT "ADD PREVIOUS FIELDS #OF ADDS : ";NOS(N)
16840 FOR T = 1 TO NOS(N)
16860 PRINT "ADD THIS FIELD ";ADDFLD(N,T);FLDN$(A,Q)
16880 NEXT T
16900 GOTO 17680
16920 REM ***** SUBTRACT PREVIOUS FIELDS ******
16940 Q = SUBX(N)
16960 W = SUBY(N)
16980 IF IOPT(N) = 4 THEN PRINT "SUBTRACT ";SUBX(N);FLDN$(A,Q);SUBY(N);FLDN$(A,W)
16990 IF IOPT(N) = 13 THEN PRINT "DIVIDE ";SUBX(N);FLDN$(A,Q);SUBY(N);FLDN$(A,W)
17000 GOTO 17680
17020 REM ***** MULTIPLY FIELDS *****
17040 Q = MULX(N)
17060 W = MULY(N)
17080 PRINT "MULTIPLY "; MULX(N);FLDN$(A,Q);MULY(N);FLDN$(A,W)
17100 GOTO 17680
17120 REM ***** GET FROM A TABLE *****
17140 ON X(1,N) GOSUB 17340,17280
17160 ON X(3,N) GOSUB 17440,17380
17180 Y = X(5,N)
17200 PRINT "SINGLE MARRIED FIELD NUMBER =";X(5,N);FLDN$(A,Y)
17220 Y = X(6,N)
17240 PRINT "PAY FIELD NUMBER = "X(6,N);FLDN$(A,Y)
17260 GOTO 17680
17280 Y = X(2,N)
17300 PRINT " TAX TABLE VARIES NUMBER = FIELD ";FLDN$(A,Y)
17320 RETURN
17340 PRINT "TAX TABLE CONSTANT NUMBER =";X(2,N)
17360 RETURN
17380 Y = X(4,N)
17400 PRINT "PAY PERIOD VARIES NUMBER = FIELD ";FLDN$(A,Y)
17420 RETURN
17440 PRINT "PAY PERIOD CONSTANT NUMBER = ";X(4,N)
17460 RETURN
17480 REM ***** MAXIMUM ******
17500 PRINT "MAX OR MIN NUMBER OF ITMS";NOS(N)
17520 FOR T = 1 TO NOS(N)
17540 Q = MAXMIN(N,T)
17560 PRINT "COMPARE : ";MAXMIN(N,T);FLDN$(A,Q)
17580 NEXT T
17600 GOTO 17680
17620 REM ***** CONSTANT *****
17640 Q = CFLD(N)
17660 PRINT "CONSTANT";KC(N);CFLD(N);FLDN$(A,Q)
17680 NEXT N
17700 PRINT "******* PRESS ANY KEY TO CONTINUE *******"
17720 IF INKEY$ = "" GOTO 17720
17740 RETURN
17760 REM ********** LPRINT IPUTD **********
17800 GOSUB 500
17820 LPRINT N$
17840 FOR N = 1 TO NREC(A)
17860 LPRINT "********** ";N;" ";FLDN$(A,N);" ************"
17880 LPRINT " INPUT OPTION ";IOPT(N);" ";
17900 ON IOPT(N) GOTO 17920,18000,18140,18260,18360,18460,18960,18820,18820,18960,18960,18960,18260
17905 LPRINT ""
17910 GOTO 19020
17920 REM ***** OPERATOR ENTRY *****
17940 LPRINT "OPERATOR ENTRY"
17960 LPRINT "PROMPT ";PROMPT$(N)
17980 GOTO 19020
18000 REM ***** GET FROM ANOTHER FILE *****
18020 LPRINT "GET FROM ANOTHER FILE "
18030 LPRINT "FROM FILE: FROM FIELD SOURCE RECORD NUMBER IS THIS FIELDS VALUE:"
18040 Q=IFN(N)
18060 W = IFLD(N)
18080 Z = IRNFLD(N)
18100 LPRINT F$(Q),TAB(15) FLDN$(Q,W),TAB(39) FLDN$(A,Z)
18120 GOTO 19020
18140 REM ***** ADD PREVIOUS FIELDS ******
18160 LPRINT "ADD PREVIOUS FIELDS #OF ADDS : ";NOS(N)
18180 FOR T = 1 TO NOS(N)
18200 LPRINT "ADD THIS FIELD ";ADDFLD(N,T);FLDN$(A,Q)
18220 NEXT T
18240 GOTO 19020
18260 REM ***** SUBTRACT PREVIOUS FIELDS ******
18280 Q = SUBX(N)
18300 W = SUBY(N)
18320 IF IOPT(N) = 13 THEN LPRINT "DIVIDE ";SUBX(N);FLDN$(A,Q);SUBY(N);FLDN$(A,W)
18330 IF IOPT(N) = 4 THEN LPRINT "SUBTRACT ";SUBX(N);FLDN$(A,Q);SUBY(N);FLDN$(A,W)
18340 GOTO 19020
18360 REM ***** MULTIPLY FIELDS *****
18380 Q = MULX(N)
18400 W = MULY(N)
18420 LPRINT "MULTIPLY "; MULX(N);FLDN$(A,Q);MULY(N);FLDN$(A,W)
18440 GOTO 19020
18460 REM ***** GET FROM A TABLE *****
18480 ON X(1,N) GOSUB 18680,18620
18500 ON X(3,N) GOSUB 18780,18720
18520 Y = X(5,N)
18540 LPRINT "SINGLE MARRIED FIELD NUMBER =";X(5,N);FLDN$(A,Y)
18560 Y = X(6,N)
18580 LPRINT "PAY FIELD NUMBER = "X(6,N);FLDN$(A,Y)
18600 GOTO 19020
18620 Y = X(2,N)
18640 LPRINT " TAX TABLE VARIES NUMBER = FIELD ";FLDN$(A,Y)
18660 RETURN
18680 LPRINT "TAX TABLE CONSTANT NUMBER =";X(2,N)
18700 RETURN
18720 Y = X(4,N)
18740 LPRINT "PAY PERIOD VARIES NUMBER = FIELD ";FLDN$(A,Y)
18760 RETURN
18780 LPRINT "PAY PERIOD CONSTANT NUMBER = ";X(4,N)
18800 RETURN
18820 REM ***** MAXIMUM ******
18840 LPRINT "MAX OR MIN NUMBER OF ITMS";NOS(N)
18860 FOR T = 1 TO NOS(N)
18880 Q = MAXMIN(N,T)
18900 LPRINT "COMPARE : ";MAXMIN(N,T);FLDN$(A,Q)
18920 NEXT T
18940 GOTO 19020
18960 REM ***** CONSTANT *****
18980 Q = CFLD(N)
19000 LPRINT "CONSTANT";KC(N);CFLD(N);FLDN$(A,Q)
19020 NEXT N
19040 RETURN
23780 REM ************* READ SUBROUTINE *************
23800 OPEN "I",#1,"FFILE"
23820 INPUT #1,MAXF
23840 FOR A = 1 TO MAXF
23860 INPUT #1,A,F$(A),NREC(A),L(A)
23880 FOR N = 1 TO NREC(A)
23900 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N)
23920 IF FTY(A,N) = 2 THEN INPUT #1,KY(A,N),KEYLIST(A,N)
23940 NEXT N
23960 NEXT A
23980 CLOSE #1
24000 RETURN
50000 REM ********** INTRO
50010 GOSUB 500
50100 PRINT " I N P U T P R O G R A M 3.0 "
50105 PRINT ""
50110 PRINT " Copyright 1984 by Potomac Pacific Engineering Inc."
50120 PRINT ""
50130 PRINT "This program is licensed FREE to all users with some restrictions"
50165 PRINT " See the manual for more information on the license."
50167 PRINT ""
50920 GOSUB 23780
50950 PRINT "****************** PRESS ANY KEY TO CONTINUE *****************";
50960 IF INKEY$ = "" GOTO 50960
50970 RETURN
51000 REM ***** EXIT TO SYSTEM
51100 GOSUB 500
51110 CLOSE
51120 PRINT " -BYE, Have a nice day"
51130 END
52000 REM ***** INTRO 1
52010 GOSUB 500
52100 PRINT " Put the DATA DISK in the default disk drive "
52110 PRINT ""
52120 PRINT " ***** THEN PRESS ANY KEY TO CONTINUE *****"
52130 PRINT ""
52140 PRINT " The CUSTOM programs only use the PROGRAM DATA DISK"
52150 PRINT "Keep it in the default disk drive at all times during this program."
52200 IF INKEY$ = "" GOTO 52200
52210 RETURN
60000 REM ******* INTEGER LESS THEN 100 CHECK ********
60010 MAX = 2
60020 ACT$ = "1234567890=<>^"
60030 IF NE = 0 THEN ACT$ = "1234567890"
60040 PRINT ">__<";
60045 GOTO 60240
60050 REM
60060 REM ******* INTEGER *******
60070 MAX = 8
60080 ACT$ = "1234567890-+,=<>^"
60090 IF NE = 0 THEN ACT$ = "1234567890-+,"
60100 PRINT ">________<";
60110 GOTO 60240
60120 REM ******* SINGLE PRECISION *******
60130 MAX = 10
60140 ACT$ = "1234567890-+,.%$=<>^"
60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60160 PRINT ">__________<";
60170 GOTO 60240
60180 REM ******* DOUBLE PRECISION *******
60190 MAX = 20
60200 ACT$ = "1234567890-+,.%$=<>^"
60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60220 PRINT ">____________________<";
60230 GOTO 60240
60240 REM ********** NUMBER CHECK **********
60250 A$ = ""
60260 K$(20) = " "
60270 KTMAX = 0
60280 FOR T9 = 1 TO MAX
60290 K$(T9) = " "
60300 NEXT T9
60310 DIG$ = "1234567890."
60320 DOTFLG = 0
60330 T2 = MAX + 1
60340 FOR T6 = 1 TO T2
60350 PRINT CHR$(CH);
60360 NEXT T6
60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370
60380 KT = 0
60390 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
60400 KT = KT + 1
60410 REM
60420 W$ = INKEY$
60430 IF W$ = "" GOTO 60420
60440 C = ASC(W$)
60450 IF C = 0 THEN GOSUB 61900
60460 IF C = 13 GOTO 60580
60470 IF C = 17 OR C = 8 GOTO 61150
60480 IF C = 19 GOTO 60670
60490 IF C = 4 GOTO 60720
60500 IF C = 6 GOTO 60780
60510 IF C = 1 GOTO 60960
60520 IF KT > MAX GOTO 60410
60530 IF INSTR(ACT$,W$) = 0 GOTO 61230
60540 K$(KT) = W$
60550 PRINT K$(KT);
60560 IF KT > KTMAX THEN KTMAX = KT
60570 GOTO 60400
60580 REM ********** RETURN **********
60590 FOR T9 = 1 TO KTMAX
60600 A$ = A$ + K$(T9)
60610 NEXT T9
60620 IF KTMAX = 0 THEN PRINT "1"
60630 IF KTMAX = 0 THEN DT# = 1
60640 IF KTMAX = 0 THEN RETURN
60650 PRINT ""
60660 GOTO 61260
60670 REM ********* MOVE CURSE BACK ********
60680 IF KT = 1 GOTO 60410
60690 KT = KT - 1
60700 PRINT CHR$(CH);
60710 GOTO 60410
60720 REM ********* MOVE CURSER FORWARD *********
60730 IF KT >= MAX GOTO 60410
60740 IF KT > (KTMAX + 1) GOTO 60410
60750 PRINT K$(KT);
60760 KT = KT + 1
60770 GOTO 60410
60780 REM ********** INSERT ***********
60790 IF KT > KTMAX GOTO 60410
60800 X9 = MAX
60810 WHILE X9 > KT
60820 X9 = X9 - 1
60830 K$(X9 + 1) = K$(X9)
60840 WEND
60850 K$(KT) = " "
60860 KTMAX = KTMAX + 1
60870 IF KTMAX > MAX THEN KTMAX = MAX
60880 FOR T9 = KT TO KTMAX
60890 PRINT K$(T9);
60900 NEXT T9
60910 T6 = (KTMAX - KT) + 1
60920 FOR T7 = 1 TO T6
60930 PRINT CHR$(CH);
60940 NEXT T7
60950 GOTO 60410
60960 REM ********** DELETE ***********
60970 IF KT > KTMAX GOTO 60410
60980 IF KTMAX = 1 GOTO 60410
60990 K$(MAX + 1) = ""
61000 X9 = KT
61010 WHILE X9 <= MAX
61020 K$(X9) = K$(X9 + 1)
61030 X9 = X9 + 1
61040 WEND
61050 KTMAX = KTMAX - 1
61060 FOR T9 = KT TO KTMAX
61070 PRINT K$(T9);
61080 NEXT T9
61090 PRINT "_";
61100 T7 = (KTMAX - KT) + 2
61110 FOR T8 = 1 TO T7
61120 PRINT CHR$(CH);
61130 NEXT T8
61140 GOTO 60410
61150 REM ********* BACKSPACE ********
61160 IF KT = 1 GOTO 60410
61170 KT = KT - 1
61180 PRINT CHR$(CH);
61190 K$(KT) = " "
61200 PRINT "_";
61210 PRINT CHR$(CH);
61220 GOTO 60410
61230 REM ******* INPUT NOT ACCEPTABLE ********
61240 PRINT CHR$(7);
61250 GOTO 60420
61260 REM ********* CLEAR STRINGS ********
61270 MAX = LEN(A$)
61280 D2$ = ""
61290 D1$ = ""
61300 DFLG = 0
61310 FOR Q93 = 1 TO MAX
61320 R$ = MID$(A$,Q93,1)
61330 IF INSTR(DIG$,R$) = 0 GOTO 61400
61340 IF R$ = "." OR DFLG = 1 GOTO 61380
61350 IF DFLG = 1 GOTO 61380
61360 D2$ = D2$ + R$
61370 GOTO 61400
61380 D1$ = D1$ + R$
61390 DFLG = 1
61400 NEXT Q93
61410 DA# = VAL(D2$)
61420 D1# = VAL(D1$)
61430 DT# = DA# + D1#
61440 IF K$(1) = "-" THEN DT# = -DT#
61450 RETURN
61900 REM ****** CHECK FOR ASC0
61910 S4$ = INKEY$
61920 C2 = ASC(S4$)
61930 IF C2 = 83 THEN C = 1
61940 IF C2 = 82 THEN C = 6
61950 IF C2 = 75 THEN C = 19
61960 IF C2 = 77 THEN C = 4
61970 RETURN
62000 REM ********** ALPHANUMERIC CHECK **************
62010 MAX = FL(A,Q)
62020 GOTO 62040
62030 REM ******** MAX SET IN PROGRAM ********
62040 A$ = ""
62050 PRINT ">";
62060 FOR N9 = 1 TO MAX
62070 K$(N9) = ""
62080 PRINT "_";
62090 NEXT N9
62100 PRINT "<";
62110 T2 = MAX + 1
62120 FOR T4 = 1 TO T2
62130 PRINT CHR$(CH);
62140 NEXT T4
62150 KT = 0
62160 KTMAX = 1
62170 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
62180 KT = KT + 1
62190 PRINT TAB(KT+1)"";
62200 K$ = INKEY$
62210 IF K$ = "" GOTO 62200
62220 C = ASC(K$)
62230 IF C = 0 THEN GOSUB 61900
62240 IF C = 13 GOTO 62350
62250 IF C = 17 OR C = 8 GOTO 62920
62260 IF C = 19 GOTO 62450
62270 IF C = 4 GOTO 62500
62280 IF C = 6 GOTO 62560
62290 IF C = 1 GOTO 62730
62300 IF KT > MAX GOTO 62190
62310 K$(KT) = K$
62320 PRINT K$(KT);
62330 IF KT > KTMAX THEN KTMAX = KT
62340 GOTO 62180
62350 REM ********** RETURN **********
62360 FOR T9 = 1 TO MAX
62370 A$ = A$ + K$(T9)
62420 NEXT T9
62430 PRINT ""
62440 RETURN
62450 REM ********* MOVE CURSE BACK ********
62460 IF KT = 1 GOTO 62190
62470 KT = KT - 1
62480 PRINT CHR$(CH);
62490 GOTO 62190
62500 REM ********* MOVE CURSER FORWARD *********
62510 IF KT >= MAX GOTO 62190
62520 IF KT > KTMAX GOTO 62190
62530 PRINT K$(KT);
62540 KT = KT + 1
62550 GOTO 62190
62560 REM ********** INSERT ***********
62570 X9 = MAX
62580 WHILE X9 > KT
62590 X9 = X9 - 1
62600 K$(X9 + 1) = K$(X9)
62610 WEND
62620 K$(KT) = " "
62630 KTMAX = KTMAX + 1
62640 IF KTMAX > MAX THEN KTMAX = MAX
62650 FOR T9 = KT TO KTMAX
62660 PRINT K$(T9);
62670 NEXT T9
62680 T6 = (KTMAX - KT) +1
62690 FOR T7 = 1 TO T6
62700 PRINT CHR$(CH);
62710 NEXT T7
62720 GOTO 62190
62730 REM ********** DELETE ***********
62740 IF KT > KTMAX GOTO 62200
62750 IF KTMAX = 1 GOTO 62190
62760 K$(MAX + 1) = ""
62770 X9 = KT
62780 WHILE X9 <= KTMAX
62790 K$(X9) = K$(X9 + 1)
62800 X9 = X9 + 1
62810 WEND
62820 KTMAX = KTMAX - 1
62830 FOR T9 = KT TO KTMAX
62840 PRINT K$(T9);
62850 NEXT T9
62860 PRINT "_";
62870 T7 = (KTMAX - KT) + 2
62880 FOR T6 = 1 TO T7
62890 PRINT CHR$(CH);
62900 NEXT T6
62910 GOTO 62190
62920 REM ********* BACKSPACE ********
62930 IF KT = 1 GOTO 62190
62940 K$(KT) = " "
62950 KT = KT - 1
62960 K$(KT) = " "
62970 PRINT CHR$(CH);
62980 PRINT "_";
62990 PRINT CHR$(CH);
63000 GOTO 62190
CLIMITS.BAS
4 DEFINT A-W,Y-Z
5 DIM F$(15),FLDN$(17,40),FTY(17,40),FL(17,40)
13 DIM L(17),NREC(17)
16 DIM KY(17,40),KEYLIST(17,40)
35 DIM K$(80)
40 DIM IDEXA(30),IDEXB(30),IDEXC(30),MFLG(30)
50 DIM MIND#(30),MAXD#(30)
70 CH = 29
75 PRINT FRE(0)
80 GOSUB 52000
100 GOSUB 50000
150 GOSUB 24000
200 GOTO 40000
500 REM ******* CLS
510 CLS
520 RETURN
20000 REM ****** PRINT OUR MAXIMUMS AND MINIMUMS
20100 PRINT " FIELD MINIMUM MAXIMUM "
20210 FOR T = 1 TO NREC(A)
20220 PRINT T;TAB(5) FLDN$(A,T);TAB(30) MIND#(T);TAB(50) MAXD#(T)
20230 NEXT T
20240 PRINT "********* PRESS ANY KEY TO CONTINUE ********"
20245 IF INKEY$ = "" THEN 20245
20250 RETURN
21000 REM ****** LPRINT OUR MAXIMUMS AND MINIMUMS
21100 LPRINT " FIELD MINIMUM MAXIMUM "
21210 FOR T = 1 TO NREC(A)
21220 LPRINT T;TAB(5) FLDN$(A,T);TAB(30) MIND#(T);TAB(50) MAXD#(T)
21230 NEXT T
21250 RETURN
23780 REM ************* READ SUBROUTINE *************
23800 OPEN "I",#1,"FFILE"
23820 INPUT #1,MAXF
23840 FOR A = 1 TO MAXF
23860 INPUT #1,A,F$(A),NREC(A),L(A)
23880 FOR N = 1 TO NREC(A)
23900 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N)
23920 IF FTY(A,N) = 2 THEN INPUT #1,KY(A,N),KEYLIST(A,N)
23940 NEXT N
23960 NEXT A
23980 CLOSE #1
23990 RETURN
24000 REM ********** READ IDEX SUBROUTINE
24100 OPEN "I",#1,"IDEX"
24110 FOR T = 1 TO MAXF
24120 INPUT #1,IDEXA(T),IDEXB(T),IDEXC(T),MFLG(T)
24130 NEXT T
24140 CLOSE #1
24150 RETURN
25000 REM ********** WRITE IDEX SUBROUTINE
25100 OPEN "O",#1,"IDEX"
25110 FOR T = 1 TO 30
25120 WRITE #1,IDEXA(T),IDEXB(T),IDEXC(T),MFLG(T)
25130 NEXT T
25140 CLOSE #1
25150 RETURN
26000 REM *********** READ MAX MIN DATA
26100 A$ = STR$(A)
26110 A$ = MID$(A$,2)
26120 A$ = "MAXMIN" + A$
26200 OPEN "I",#1,A$
26210 FOR T = 1 TO NREC(A)
26220 INPUT #1,MAXD#(T),MIND#(T)
26230 NEXT T
26240 CLOSE #1
26250 RETURN
27000 REM *********** WRITEMAX MIN DATA
27100 A$ = STR$(A)
27110 A$ = MID$(A$,2)
27120 A$ = "MAXMIN" + A$
27200 OPEN "O",#1,A$
27210 FOR T = 1 TO NREC(A)
27220 WRITE #1,MAXD#(T),MIND#(T)
27230 NEXT T
27240 CLOSE #1
27250 RETURN
28000 REM ********** READ IDEX SUBROUTINE
28100 GOSUB 500
28105 PRINT "FILE LIMITS"
28110 FOR T = 1 TO MAXF
28112 T2 = IDEXA(T)
28114 T3 = IDEXB(T)
28116 T4 = IDEXC(T)
28120 PRINT T;
28122 IF MFLG(T) = 2 THEN PRINT TAB(15)"YES" ELSE PRINT TAB(15)"NO"
28130 NEXT T
28150 RETURN
29000 REM ********** LPRINT IDEX SUBROUTINE
29100 GOSUB 500
29105 LPRINT "FILE LIMITS"
29110 FOR T = 1 TO MAXF
29112 T2 = IDEXA(T)
29114 T3 = IDEXB(T)
29116 T4 = IDEXC(T)
29120 LPRINT T;
29122 IF MFLG(T) = 2 THEN LPRINT TAB(15)"YES" ELSE LPRINT TAB(15)"NO"
29130 NEXT T
29150 RETURN
30000 REM ******* INPUT MAXD AND MIND
30100 GOSUB 500
30110 PRINT T;" - ";FLDN$(A,T)
30120 PRINT "*** WHAT IS THE MAXIMUM VALUE YOU WANT FOR THIS FIELD ***"
30130 GOSUB 60180
30140 MAXD#(T) = DT#
30200 PRINT "*** WHAT IS THE MINIMUM VALUE YOU WANT FOR THIS FIELD ***"
30210 GOSUB 60180
30220 MIND#(T) = DT#
30300 RETURN
40000 REM ****** INITIAL MENU
40100 GOSUB 500
40110 PRINT "********************** INITIAL MENU ************************"
40120 PRINT " 0 - EXIT PROGRAM "
40130 PRINT " 1 - TURN MAX MIN OFF OR ON "
40140 PRINT " 2 - SHOW MAXIMUMS AND MINIMUMS ON SCREEN"
40150 PRINT " 3 - SHOW MAX OPTION FOR EACH FILE ON SCREEN"
40160 PRINT " 4 - PRINT MAXIMUMS AND MINIMUMS ON PAPER"
40170 PRINT " 5 - PRINT MAX OPTION FOR EACH FILE ON PAPER"
40180 PRINT " 6 - ENTER ALL NEW MAXIMUMS AND MINIMUMS FOR A FILE"
40190 PRINT " 7 - CHANGE THE MAXIMUM AND MINIMUMS FOR A SINGLE FIELD"
40200 PRINT "************ ENTER THE NUMBER THEN PRESS RETURN ************"
40210 GOSUB 60000
40220 IF DT# < 0 OR DT# > 7 THEN 40210
40230 T = DT#
40240 IF T = 0 THEN GOTO 51000
40250 ON T GOTO 41000,42000,43000,44000,45000,46000,47000
41000 REM ******** CHANGE INDEX OR TURN MAX MIN OFF
41100 GOSUB 500
41110 GOSUB 56000
41180 GOSUB 500
41500 PRINT "**** DO YOU WANT LIMITS FOR THIS FILE ****"
41510 PRINT " 1 - NO "
41520 PRINT " 2 - YES"
41530 PRINT "*** ENTER THE NUMBER THEN PRESS RETURN ***"
41540 GOSUB 60000
41550 MFLG(A) = DT#
41700 GOSUB 25000
41710 GOTO 40000
42000 REM ******** SHOW MAXIMINS AND MINIMIMS ON SCREEN
42040 GOSUB 500
42050 GOSUB 56000
42055 IF MFLG(A) <> 2 THEN 40000
42060 GOSUB 26000
42100 GOSUB 500
42200 GOSUB 20000
42300 GOTO 40000
43000 REM ******** SHOW INDEX AND MAX OPTION ON SCREEN
43100 GOSUB 28000
43150 PRINT "****** PRESS ANY KEY TO CONTINUE ******"
43200 IF INKEY$ = "" THEN 43200
43300 GOTO 40000
44000 REM ******** PRINT MAXIMUM AND MINIMUMS ON PAPER
44040 GOSUB 500
44050 GOSUB 56000
44055 IF MFLG(A) <> 2 THEN 40000
44060 GOSUB 26000
44100 GOSUB 500
44200 GOSUB 21000
44300 GOTO 40000
45000 REM ******** PRINT INDEX FIELDS AND MAX OPTION ON PAPER
45100 GOSUB 29000
45300 GOTO 40000
46000 REM ******* ENTER ALL NEW MAXIMUMS AND MINIMUMS FOR A FILE
46100 GOSUB 500
46110 GOSUB 56000
46180 FOR T = 1 TO NREC(A)
46185 IF FTY(A,T) = 1 GOTO 46200
46190 GOSUB 30000
46200 NEXT T
46210 GOSUB 27000
46300 GOTO 40000
47000 REM ******** CHANGE THE MAXIMUMS AND MINIMUMS FOR A SINGLE FIELD
47100 GOSUB 500
47110 GOSUB 56000
47115 GOSUB 26000
47120 GOSUB 500
47130 PRINT "**** WHAT FIELD DO YOU WANT TO CHANGE THE MAXIMUMS AND MINIMUMS ****"
47180 FOR T = 1 TO NREC(A)
47185 PRINT T;" - ";FLDN$(A,T)
47200 NEXT T
47210 PRINT "***** ENTER THE NUMBER THEN PRESS RETURN *****"
47220 GOSUB 60000
47230 IF DT# < 1 OR DT# > NREC(A) THEN 47220
47240 T = DT#
47250 GOSUB 30000
47810 GOSUB 27000
47900 GOTO 40000
50000 REM ********** INTRO
50010 GOSUB 500
50100 PRINT " L I M I T S P R O G R A M 3.0 "
50105 PRINT ""
50110 PRINT " Copyright 1984 by Potomac Pacific Engineering Inc."
50120 PRINT ""
50130 PRINT "This program is licensed FREE to all users with some restrictions "
50165 PRINT " See the manual for more information on the license."
50167 PRINT ""
50920 GOSUB 23780
50950 PRINT "****************** PRESS ANY KEY TO CONTINUE *******************";
50960 IF INKEY$ = "" GOTO 50960
50970 RETURN
51000 REM ***** EXIT TO SYSTEM
51100 GOSUB 500
51110 CLOSE
51120 PRINT " -BYE, Have a nice day"
51130 END
52000 REM ***** INTRO 1
52010 GOSUB 500
52100 PRINT " Put the DATA DISK in the default disk drive "
52110 PRINT ""
52120 PRINT " ***** THEN PRESS ANY KEY TO CONTINUE *****"
52130 PRINT ""
52140 PRINT " The CUSTOM programs only use the PROGRAM DATA DISK"
52150 PRINT "Keep it in the default disk drive at all times during this program."
52200 IF INKEY$ = "" GOTO 52200
52210 RETURN
56000 REM **** WHAT FILE
56105 PRINT "*********** WHICH FILE DO YOU WANT ************"
56110 FOR T = 1 TO MAXF
56120 PRINT T;" - ";F$(T)
56130 NEXT T
56140 PRINT "****** ENTER THE NUMBER THEN PRESS RETURN *****"
56150 GOSUB 60000
56160 IF DT# < 1 OR DT# > MAXF THEN 56150
56170 A = DT#
56200 RETURN
60000 REM ******* INTEGER LESS THEN 100 CHECK ********
60010 MAX = 2
60020 ACT$ = "1234567890=<>^"
60030 IF NE = 0 THEN ACT$ = "1234567890"
60040 PRINT ">__<";
60050 GOTO 60240
60060 REM ******* INTEGER *******
60070 MAX = 8
60080 ACT$ = "1234567890-+,=<>^"
60090 IF NE = 0 THEN ACT$ = "1234567890-+,"
60100 PRINT ">________<";
60110 GOTO 60240
60120 REM ******* SINGLE PRECISION *******
60130 MAX = 10
60140 ACT$ = "1234567890-+,.%$=<>^"
60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60160 PRINT ">__________<";
60170 GOTO 60240
60180 REM ******* DOUBLE PRECISION *******
60190 MAX = 20
60200 ACT$ = "1234567890-+,.%$=<>^"
60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60220 PRINT ">____________________<";
60230 GOTO 60240
60240 REM ********** NUMBER CHECK **********
60250 A$ = ""
60260 K$(20) = " "
60270 KTMAX = 0
60280 FOR T9 = 1 TO MAX
60290 K$(T9) = " "
60300 NEXT T9
60310 DIG$ = "1234567890."
60320 DOTFLG = 0
60330 T2 = MAX + 1
60340 FOR T6 = 1 TO T2
60350 PRINT CHR$(CH);
60360 NEXT T6
60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370
60380 KT = 0
60390 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
60400 KT = KT + 1
60410 REM
60420 W$ = INKEY$
60430 IF W$ = "" GOTO 60420
60440 C = ASC(W$)
60450 IF C = 0 THEN GOSUB 61900
60460 IF C = 13 GOTO 60580
60470 IF C = 17 OR C = 8 GOTO 61150
60480 IF C = 19 GOTO 60670
60490 IF C = 4 GOTO 60720
60500 IF C = 6 GOTO 60780
60510 IF C = 1 GOTO 60960
60520 IF KT > MAX GOTO 60410
60530 IF INSTR(ACT$,W$) = 0 GOTO 61230
60540 K$(KT) = W$
60550 PRINT K$(KT);
60560 IF KT > KTMAX THEN KTMAX = KT
60570 GOTO 60400
60580 REM ********** RETURN **********
60590 FOR T9 = 1 TO KTMAX
60600 A$ = A$ + K$(T9)
60610 NEXT T9
60620 IF KTMAX = 0 THEN PRINT "1"
60630 IF KTMAX = 0 THEN DT# = 1
60640 IF KTMAX = 0 THEN RETURN
60650 PRINT ""
60660 GOTO 61260
60670 REM ********* MOVE CURSE BACK ********
60680 IF KT = 1 GOTO 60410
60690 KT = KT - 1
60700 PRINT CHR$(CH);
60710 GOTO 60410
60720 REM ********* MOVE CURSER FORWARD *********
60730 IF KT >= MAX GOTO 60410
60740 IF KT > (KTMAX + 1) GOTO 60410
60750 PRINT K$(KT);
60760 KT = KT + 1
60770 GOTO 60410
60780 REM ********** INSERT ***********
60790 IF KT > KTMAX GOTO 60410
60800 X9 = MAX
60810 WHILE X9 > KT
60820 X9 = X9 - 1
60830 K$(X9 + 1) = K$(X9)
60840 WEND
60850 K$(KT) = " "
60860 KTMAX = KTMAX + 1
60870 IF KTMAX > MAX THEN KTMAX = MAX
60880 FOR T9 = KT TO KTMAX
60890 PRINT K$(T9);
60900 NEXT T9
60910 T6 = (KTMAX - KT) + 1
60920 FOR T7 = 1 TO T6
60930 PRINT CHR$(CH);
60940 NEXT T7
60950 GOTO 60410
60960 REM ********** DELETE ***********
60970 IF KT > KTMAX GOTO 60410
60980 IF KTMAX = 1 GOTO 60410
60990 K$(MAX + 1) = ""
61000 X9 = KT
61010 WHILE X9 <= MAX
61020 K$(X9) = K$(X9 + 1)
61030 X9 = X9 + 1
61040 WEND
61050 KTMAX = KTMAX - 1
61060 FOR T9 = KT TO KTMAX
61070 PRINT K$(T9);
61080 NEXT T9
61090 PRINT "_";
61100 T7 = (KTMAX - KT) + 2
61110 FOR T8 = 1 TO T7
61120 PRINT CHR$(CH);
61130 NEXT T8
61140 GOTO 60410
61150 REM ********* BACKSPACE ********
61160 IF KT = 1 GOTO 60410
61170 KT = KT - 1
61180 PRINT CHR$(CH);
61190 K$(KT) = " "
61200 PRINT "_";
61210 PRINT CHR$(CH);
61220 GOTO 60410
61230 REM ******* INPUT NOT ACCEPTABLE ********
61240 PRINT CHR$(7);
61250 GOTO 60420
61260 REM ********* CLEAR STRINGS ********
61270 MAX = LEN(A$)
61280 D2$ = ""
61290 D1$ = ""
61300 DFLG = 0
61310 FOR Q93 = 1 TO MAX
61320 R$ = MID$(A$,Q93,1)
61330 IF INSTR(DIG$,R$) = 0 GOTO 61400
61340 IF R$ = "." OR DFLG = 1 GOTO 61380
61350 IF DFLG = 1 GOTO 61380
61360 D2$ = D2$ + R$
61370 GOTO 61400
61380 D1$ = D1$ + R$
61390 DFLG = 1
61400 NEXT Q93
61410 DA# = VAL(D2$)
61420 D1# = VAL(D1$)
61430 DT# = DA# + D1#
61440 IF K$(1) = "-" THEN DT# = -DT#
61450 RETURN
61900 REM ****** CHECK FOR ASC0
61910 S4$ = INKEY$
61920 C2 = ASC(S4$)
61930 IF C2 = 83 THEN C = 1
61940 IF C2 = 82 THEN C = 6
61950 IF C2 = 75 THEN C = 19
61960 IF C2 = 77 THEN C = 4
61970 RETURN
62000 REM ********** ALPHANUMERIC CHECK **************
62010 MAX = FL(A,Q)
62020 GOTO 62040
62030 REM ******** MAX SET IN PROGRAM ********
62040 A$ = ""
62050 PRINT ">";
62060 FOR N9 = 1 TO MAX
62070 K$(N9) = ""
62080 PRINT "_";
62090 NEXT N9
62100 PRINT "<";
62110 T2 = MAX + 1
62120 FOR T4 = 1 TO T2
62130 PRINT CHR$(CH);
62140 NEXT T4
62150 KT = 0
62160 KTMAX = 1
62170 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
62180 KT = KT + 1
62190 PRINT TAB(KT+1)"";
62200 K$ = INKEY$
62210 IF K$ = "" GOTO 62200
62220 C = ASC(K$)
62230 IF C = 0 THEN GOSUB 61900
62240 IF C = 13 GOTO 62350
62250 IF C = 17 OR C = 8 GOTO 62920
62260 IF C = 19 GOTO 62450
62270 IF C = 4 GOTO 62500
62280 IF C = 6 GOTO 62560
62290 IF C = 1 GOTO 62730
62300 IF KT > MAX GOTO 62190
62310 K$(KT) = K$
62320 PRINT K$(KT);
62330 IF KT > KTMAX THEN KTMAX = KT
62340 GOTO 62180
62350 REM ********** RETURN **********
62360 FOR T9 = 1 TO MAX
62370 A$ = A$ + K$(T9)
62420 NEXT T9
62430 PRINT ""
62440 RETURN
62450 REM ********* MOVE CURSE BACK ********
62460 IF KT = 1 GOTO 62190
62470 KT = KT - 1
62480 PRINT CHR$(CH);
62490 GOTO 62190
62500 REM ********* MOVE CURSER FORWARD *********
62510 IF KT >= MAX GOTO 62190
62520 IF KT > KTMAX GOTO 62190
62530 PRINT K$(KT);
62540 KT = KT + 1
62550 GOTO 62190
62560 REM ********** INSERT ***********
62570 X9 = MAX
62580 WHILE X9 > KT
62590 X9 = X9 - 1
62600 K$(X9 + 1) = K$(X9)
62610 WEND
62620 K$(KT) = " "
62630 KTMAX = KTMAX + 1
62640 IF KTMAX > MAX THEN KTMAX = MAX
62650 FOR T9 = KT TO KTMAX
62660 PRINT K$(T9);
62670 NEXT T9
62680 T6 = (KTMAX - KT) +1
62690 FOR T7 = 1 TO T6
62700 PRINT CHR$(CH);
62710 NEXT T7
62720 GOTO 62190
62730 REM ********** DELETE ***********
62740 IF KT > KTMAX GOTO 62200
62750 IF KTMAX = 1 GOTO 62190
62760 K$(MAX + 1) = ""
62770 X9 = KT
62780 WHILE X9 <= KTMAX
62790 K$(X9) = K$(X9 + 1)
62800 X9 = X9 + 1
62810 WEND
62820 KTMAX = KTMAX - 1
62830 FOR T9 = KT TO KTMAX
62840 PRINT K$(T9);
62850 NEXT T9
62860 PRINT "_";
62870 T7 = (KTMAX - KT) + 2
62880 FOR T6 = 1 TO T7
62890 PRINT CHR$(CH);
62900 NEXT T6
62910 GOTO 62190
62920 REM ********* BACKSPACE ********
62930 IF KT = 1 GOTO 62190
62940 K$(KT) = " "
62950 KT = KT - 1
62960 K$(KT) = " "
62970 PRINT CHR$(CH);
62980 PRINT "_";
62990 PRINT CHR$(CH);
63000 GOTO 62190
CRC.TXT
PC-SIG Disk No. #214, version v2
The following is a list of the file checksums which should be produced by
the CRCK4 program on this disk. If the CRC numbers do not match the following
list you may have a bad file. To use type: CRCK4 <filespec>
CRCK4 output for this disk:
CRCK ver 4.2B (MS DOS VERSION )
CTL-S pauses, CTL-C aborts
--> FILE: MAIN .BAS CRC = FB A4
--> FILE: SCAN .BAS CRC = 9D 97
--> FILE: CHANGE .BAS CRC = E0 A1
--> FILE: FORM .BAS CRC = 3E B3
--> FILE: TRANSFER.BAS CRC = 3D CB
--> FILE: SORT .BAS CRC = 5F C0
--> FILE: CFILE .BAS CRC = BC E7
--> FILE: CINPUT .BAS CRC = CD 21
--> FILE: CTRANSFE.BAS CRC = 6E 70
--> FILE: CFORM .BAS CRC = 17 E6
--> FILE: CLIMITS .BAS CRC = 91 45
--> FILE: CREAL .BAS CRC = 53 59
--> FILE: CSCREEN .BAS CRC = 62 C0
--> FILE: ASCII .BAS CRC = A4 B5
--> FILE: TESTASCI.BAS CRC = 3D 17
--> FILE: READ .ME CRC = EF B9
---------------------> SUM OF CRCS = 7F 5B
DONE
These and other Public Domain and user-supported programs from:
PC Software Interest Group (PC-SIG)
1125 Stewart Ct Suite G
Sunnyvale, CA 94086
(408) 730-9291
CREAL.BAS
4 DEFINT A-W,Y-Z
5 DIM F$(15),FLDN$(17,40),FTY(17,40),FL(17,40)
13 DIM L(17),NREC(17)
16 DIM KY(17,40),KEYLIST(17,40)
35 DIM K$(80)
40 DIM IDEXA(30),IDEXB(30),IDEXC(30),MFLG(30)
50 DIM MIND#(30),MAXD#(30)
60 DIM REALFLG(30)
70 CH = 29
75 PRINT FRE(0)
80 GOSUB 52000
100 GOSUB 50000
150 GOSUB 24000
200 GOTO 40000
500 REM ******* CLS
510 CLS
520 RETURN
20000 REM ****** SHOW REALTIME DATA ON SCREEN
20100 GOSUB 500
20110 PRINT "TRANSFER DATA TO FILE : ";F$(TFILE)
20120 IF TGTRN = 0 THEN PRINT " TARGET RECORD NUMBER ALWAYS EQUALS ONE "
20130 IF TGTRN > 0 THEN PRINT "TARGET RECORD NUMBER = VALUE OF THIS FIELD : ";FLDN$(A,TGTRN)
20140 PRINT "TRANSFER THIS FIELD : ";FLDN$(A,FLD1)
20150 PRINT "TO THIS FIELD IN TARGET FILE : ";FLDN$(TFILE,TFLD1)
20160 IF ADSUB1 = 1 THEN PRINT "ADD" ELSE PRINT "SUBTRACT"
20170 IF TFLD2 = 0 THEN 20400
20180 PRINT "SECOND TRANSFER TO THIS FIELD : ";FLDN$(TFILE,TFLD2)
20190 IF ADSUB2 = 1 THEN PRINT "ADD" ELSE PRINT "SUBTRACT"
20400 REM
20500 IF FLD2 = 0 THEN 20700
20510 PRINT ""
20520 PRINT "**** SECOND SOURCE FILE TRANSFER ****"
20640 PRINT "TRANSFER THIS FIELD : ";FLDN$(A,FLD2)
20650 PRINT "TO THIS FIELD IN TARGET FILE : ";FLDN$(TFILE,TFLD3)
20660 IF ADSUB3 = 1 THEN PRINT "ADD" ELSE PRINT "SUBTRACT"
20670 IF TFLD3 = 0 THEN 20700
20680 PRINT "SECOND TRANSFER TO THIS FIELD : ";FLDN$(TFILE,TFLD4)
20690 IF ADSUB4 = 1 THEN PRINT "ADD" ELSE PRINT "SUBTRACT"
20700 PRINT "******* PRESS ANY KEY TO CONTINUE ********"
20750 IF INKEY$ = "" THEN 20750
20800 RETURN
21000 REM ****** SHOW REALTIME DATA ON SCREEN
21100 GOSUB 500
21110 LPRINT "TRANSFER DATA TO FILE : ";F$(TFILE)
21120 IF TGTRN = 0 THEN LPRINT " TARGET RECORD NUMBER ALWAYS EQUALS ONE "
21130 IF TGTRN > 0 THEN LPRINT "TARGET RECORD NUMBER = VALUE OF THIS FIELD ";FLDN$(A,TGTRN)
21140 LPRINT "TRANSFER THIS FIELD : ";FLDN$(A,FLD1)
21150 LPRINT "TO THIS FIELD IN TARGET FILE : ";FLDN$(TFILE,TFLD1)
21160 IF ADSUB1 = 1 THEN LPRINT "ADD" ELSE LPRINT "SUBTRACT"
21170 IF TFLD2 = 0 THEN 20400
21180 LPRINT "SECOND TRANSFER TO THIS FIELD : ";FLDN$(TFILE,TFLD2)
21190 IF ADSUB2 = 1 THEN LPRINT "ADD" ELSE LPRINT "SUBTRACT"
21400 REM
21500 IF FLD2 = 0 THEN 20700
21510 LPRINT ""
21520 LPRINT "**** SECOND SOURCE FILE TRANSFER ****"
21640 LPRINT "TRANSFER THIS FIELD : ";FLDN$(A,FLD2)
21650 LPRINT "TO THIS FIELD IN TARGET FILE : ";FLDN$(TFILE,TFLD3)
21660 IF ADSUB3 = 1 THEN LPRINT "ADD" ELSE LPRINT "SUBTRACT"
21670 IF TFLD3 = 0 THEN 20700
21680 LPRINT "SECOND TRANSFER TO THIS FIELD : ";FLDN$(TFILE,TFLD4)
21690 IF ADSUB4 = 1 THEN LPRINT "ADD" ELSE LPRINT "SUBTRACT"
21700 PRINT "******* PRESS ANY KEY TO CONTINUE ********"
21800 RETURN
23780 REM ************* READ SUBROUTINE *************
23800 OPEN "I",#1,"FFILE"
23820 INPUT #1,MAXF
23840 FOR A = 1 TO MAXF
23860 INPUT #1,A,F$(A),NREC(A),L(A)
23880 FOR N = 1 TO NREC(A)
23900 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N)
23920 IF FTY(A,N) = 2 THEN INPUT #1,KY(A,N),KEYLIST(A,N)
23940 NEXT N
23960 NEXT A
23980 CLOSE #1
23990 RETURN
24000 REM ********** READ IDEX SUBROUTINE
24100 OPEN "I",#1,"REALTIME"
24110 FOR T = 1 TO MAXF
24120 INPUT #1,REALFLG(T)
24130 NEXT T
24140 CLOSE #1
24150 RETURN
25000 REM ********** WRITE IDEX SUBROUTINE
25100 OPEN "O",#1,"REALTIME"
25110 FOR T = 1 TO 30
25120 WRITE #1,REALFLG(T)
25130 NEXT T
25140 CLOSE #1
25150 RETURN
25400 REM
26000 REM *********** READ MAX MIN DATA
26100 A$ = STR$(A)
26110 A$ = MID$(A$,2)
26120 A$ = "REAL" + A$
26200 OPEN "I",#1,A$
26220 INPUT #1,TFILE,FLD1,FLD2,TFLD1,TFLD2,TFLD3,TFLD4,ADSUB1,ADSUB2,ADSUB3,ADSUB4,TGTRN
26240 CLOSE #1
26250 RETURN
27000 REM *********** WRITEMAX MIN DATA
27100 A$ = STR$(A)
27110 A$ = MID$(A$,2)
27120 A$ = "REAL" + A$
27200 OPEN "O",#1,A$
27220 WRITE #1,TFILE,FLD1,FLD2,TFLD1,TFLD2,TFLD3,TFLD4,ADSUB1,ADSUB2,ADSUB3,ADSUB4,TGTRN
27240 CLOSE #1
27250 RETURN
28000 REM ********** READ IDEX SUBROUTINE
28100 GOSUB 500
28105 PRINT "FILE REALTIME TRANSFER"
28110 FOR T = 1 TO MAXF
28120 PRINT T;
28122 IF REALFLG(T) = 2 THEN PRINT TAB(15)"YES" ELSE PRINT TAB(15)"NO"
28130 NEXT T
28150 RETURN
29000 REM ********** LPRINT IDEX SUBROUTINE
29100 GOSUB 500
29105 LPRINT "FILE REALTIME OPTION "
29110 FOR T = 1 TO MAXF
29120 LPRINT T;
29122 IF REALFLG(T) = 2 THEN LPRINT TAB(15)"YES" ELSE LPRINT TAB(15)"NO"
29130 NEXT T
29150 RETURN
30000 REM ****** INPUT REALTIME DATA
30100 GOSUB 500
30110 PRINT "***** WHAT FILE DO YOU WANT TO TRANSFER THE DATA TO *****"
30120 FOR T = 1 TO MAXF
30130 PRINT T;" - ";F$(T)
30140 NEXT T
30150 GOSUB 60000
30160 IF DT# < 1 OR DT# >MAXF THEN 30150
30170 TFILE = DT#
30200 GOSUB 500
30210 PRINT "***** WHAT IS THE FIRST FIELD YOU WANT TRANSFERED *****"
30220 FOR T = 1 TO NREC(A)
30230 PRINT T;" - ";FLDN$(A,T)
30240 NEXT T
30250 PRINT "***** WHAT IS THE FIRST FIELD YOU WANT TRANSFERED *****"
30260 GOSUB 60000
30270 IF DT# < 1 OR DT# > NREC(A) THEN 30260
30275 IF FTY(A,DT#) < 4 THEN 30260
30280 FLD1 = DT#
30285 PRINT "***** WHAT FIELD VALUE IS THE RECORD NUMBER OF THE TARGET FILE *****"
30287 PRINT " enter zero if the target record number is always one "
30290 GOSUB 60000
30292 IF DT# < 0 OR DT# > NREC(A) THEN 30290
30295 TGTRN = DT#
30300 GOSUB 500
30310 FOR T = 1 TO NREC(TFILE)
30320 PRINT T;" - ";FLDN$(TFILE,T)
30330 NEXT T
30340 PRINT "***** WHICH FIELD IS THE FIRST FIELD YOU WANT THE DATA TRANSFERED TO ****"
30350 GOSUB 60000
30360 IF DT# < 1 OR DT# > NREC(TFILE) THEN 30350
30365 IF FTY(TFILE,DT#) < 4 THEN 30350
30370 TFLD1 = DT#
30380 PRINT "DO YOU WANT THE DATA TO BE 1-ADDED OR 2-SUBTRACTED FROM THIS FIELD"
30385 GOSUB 60000
30390 IF DT# < 1 OR DT# > 2 THEN 30385
30400 ADSUB1 = DT#
30420 PRINT "WHICH FIELD IS THE SECOND FIELD YOU WANT TO TRANSFER THE DATA TO - 0 FOR NONE"
30430 GOSUB 60000
30433 IF DT# = 0 THEN TFLD2 = 0
30435 IF DT# = 0 THEN 31200
30440 IF DT# < 0 OR DT# > NREC(TFILE) THEN 30430
30445 IF FTY(TFILE,DT#) < 4 THEN 30430
30450 TFLD2 = DT#
30460 PRINT "DO YOU WANT THE DATA 1-ADDED OR 2-SUBTRACTED FROM THIS FIELD "
30470 GOSUB 60000
30480 IF DT# < 1 OR DT# > 2 THEN 30470
30490 ADSUB2 = DT#
31200 GOSUB 500
31210 PRINT "***** WHAT IS THE SECOND FIELD YOU WANT TRANSFERED *****"
31220 FOR T = 1 TO NREC(A)
31230 PRINT T;" - ";FLDN$(A,T)
31240 NEXT T
31250 PRINT "***** WHAT IS THE SECOND FIELD YOU WANT TRANSFERED *****"
31255 PRINT " ENTER ZERO IF YOU DO NOT WANT A SECOND FIELD TRANSFERED "
31260 GOSUB 60000
31270 IF DT# < 0 OR DT# > NREC(A) THEN 31260
31271 IF DT# = 0 THEN FLD2 = 0
31272 IF DT# = 0 THEN RETURN
31275 IF FTY(A,DT#) < 4 THEN 31260
31280 FLD2 = DT#
31300 GOSUB 500
31310 FOR T = 1 TO NREC(TFILE)
31320 PRINT T;" - ";FLDN$(TFILE,T)
31330 NEXT T
31340 PRINT "***** WHICH FIELD IS THE FIRST FIELD YOU WANT THE DATA TRANSFERED TO ****"
31350 GOSUB 60000
31360 IF DT# < 1 OR DT# > NREC(TFILE) THEN 31350
31365 IF FTY(TFILE,DT#) < 4 THEN 31350
31370 TFLD3 = DT#
31380 PRINT "DO YOU WANT THE DATA TO BE 1-ADDED OR 2-SUBTRACTED FROM THIS FIELD"
31385 GOSUB 60000
31390 IF DT# < 1 OR DT# > 2 THEN 31385
31400 ADSUB3 = DT#
31420 PRINT "WHICH FIELD IS THE SECOND FIELD YOU WANT TO TRANSFER THE DATA TO - 0 FOR NONE"
31430 GOSUB 60000
31433 IF DT# = 0 THEN TFLD4 = 0
31435 IF DT# = 0 THEN RETURN
31440 IF DT# < 0 OR DT# > NREC(TFILE) THEN 31430
31445 IF FTY(TFILE,DT#) < 4 THEN 31430
31450 TFLD4 = DT#
31460 PRINT "DO YOU WANT THE DATA 1-ADDED OR 2-SUBTRACTED FROM THIS FIELD "
31470 GOSUB 60000
31480 IF DT# < 1 OR DT# > 2 THEN 31270
31490 ADSUB4 = DT#
31900 RETURN
40000 REM ****** INITIAL MENU
40100 GOSUB 500
40110 PRINT "********************** INITIAL MENU ************************"
40120 PRINT " 0 - EXIT PROGRAM "
40130 PRINT " 1 - TURN REALTIME OFF OR ON "
40140 PRINT " 2 - SHOW REALTIME DATA ON SCREEN"
40150 PRINT " 3 - SHOW REALTIME OPTION FOR EACH FILE ON SCREEN"
40160 PRINT " 4 - PRINT REALTIME DATA ON PAPER"
40170 PRINT " 5 - PRINT REALTIME OPTION FOR EACH FILE ON PAPER"
40180 PRINT " 6 - ENTER REALTIME DATA FOR A FILE "
40200 PRINT "************ ENTER THE NUMBER THEN PRESS RETURN ************"
40210 GOSUB 60000
40220 IF DT# < 0 OR DT# > 7 THEN 40210
40230 T = DT#
40240 IF T = 0 THEN GOTO 51000
40250 ON T GOTO 41000,42000,43000,44000,45000,46000,47000
41000 REM ******** TURN REALTIME OPTION ON OR OFF
41100 GOSUB 500
41110 GOSUB 56000
41180 GOSUB 500
41500 PRINT "**** DO YOU WANT REALTIME TRANSFER ****"
41510 PRINT " 1 - NO "
41520 PRINT " 2 - YES"
41530 PRINT "*** ENTER THE NUMBER THEN PRESS RETURN ***"
41540 GOSUB 60000
41550 REALFLG(A) = DT#
41700 GOSUB 25000
41710 GOTO 40000
42000 REM ******** SHOW REALTIME DATA ON SCREEN
42040 GOSUB 500
42050 GOSUB 56000
42055 IF REALFLG(A) <> 2 THEN 40000
42060 GOSUB 26000
42100 GOSUB 500
42200 GOSUB 20000
42300 GOTO 40000
43000 REM ******** SHOW REALTIME DATA ON SCREEN
43100 GOSUB 28000
43150 PRINT "****** PRESS ANY KEY TO CONTINUE ******"
43200 IF INKEY$ = "" THEN 43200
43300 GOTO 40000
44000 REM ******** PRINT MAXIMUM AND MINIMUMS ON PAPER
44040 GOSUB 500
44050 GOSUB 56000
44055 IF REALFLG(A) <> 2 THEN 40000
44060 GOSUB 26000
44100 GOSUB 500
44200 GOSUB 21000
44300 GOTO 40000
45000 REM ******** PRINT INDEX FIELDS AND MAX OPTION ON PAPER
45100 GOSUB 29000
45300 GOTO 40000
46000 REM ******* ENTER REALTIME DATA FOR A FILE
46100 GOSUB 500
46110 GOSUB 56000
46190 GOSUB 30000
46210 GOSUB 27000
46300 GOTO 40000
47000 REM ******** CHANGE THE MAXIMUMS AND MINIMUMS FOR A SINGLE FIELD
47100 GOSUB 500
47110 GOSUB 56000
47115 GOSUB 26000
47120 GOSUB 500
47130 PRINT "**** WHAT FIELD DO YOU WANT TO CHANGE THE MAXIMUMS AND MINIMUMS ****"
47180 FOR T = 1 TO NREC(A)
47185 PRINT T;" - ";FLDN$(A,T)
47200 NEXT T
47210 PRINT "***** ENTER THE NUMBER THEN PRESS RETURN *****"
47220 GOSUB 60000
47230 IF DT# < 1 OR DT# > NREC(A) THEN 47220
47240 T = DT#
47250 GOSUB 30000
47810 GOSUB 27000
47900 GOTO 40000
50000 REM ********** INTRO
50010 GOSUB 500
50100 PRINT " R E A L T I M E P R O G R A M 3.0 "
50105 PRINT ""
50110 PRINT " Copyright 1984 by Potomac Pacific Engineering Inc."
50120 PRINT ""
50130 PRINT "This program is licensed FREE to all users with some restrictions "
50165 PRINT " See the manual for more information on the license."
50167 PRINT ""
50920 GOSUB 23780
50950 PRINT "****************** PRESS ANY KEY TO CONTINUE *******************";
50960 IF INKEY$ = "" GOTO 50960
50970 RETURN
51000 REM ***** EXIT TO SYSTEM
51100 GOSUB 500
51110 CLOSE
51120 PRINT " -BYE, Have a nice day"
51130 END
52000 REM ***** INTRO 1
52010 GOSUB 500
52100 PRINT " Put the DATA DISK in the default disk drive "
52110 PRINT ""
52120 PRINT " ***** THEN PRESS ANY KEY TO CONTINUE *****"
52130 PRINT ""
52140 PRINT " The CUSTOM programs only use the PROGRAM DATA DISK"
52150 PRINT "Keep it in the default disk drive at all times during this program."
52200 IF INKEY$ = "" GOTO 52200
52210 RETURN
56000 REM **** WHAT FILE
56105 PRINT "*********** WHICH FILE DO YOU WANT ************"
56110 FOR T = 1 TO MAXF
56120 PRINT T;" - ";F$(T)
56130 NEXT T
56140 PRINT "****** ENTER THE NUMBER THEN PRESS RETURN *****"
56150 GOSUB 60000
56160 IF DT# < 1 OR DT# > MAXF THEN 56150
56170 A = DT#
56200 RETURN
60000 REM ******* INTEGER LESS THEN 100 CHECK ********
60010 MAX = 2
60020 ACT$ = "1234567890=<>^"
60030 IF NE = 0 THEN ACT$ = "1234567890"
60040 PRINT ">__<";
60050 GOTO 60240
60060 REM ******* INTEGER *******
60070 MAX = 8
60080 ACT$ = "1234567890-+,=<>^"
60090 IF NE = 0 THEN ACT$ = "1234567890-+,"
60100 PRINT ">________<";
60110 GOTO 60240
60120 REM ******* SINGLE PRECISION *******
60130 MAX = 10
60140 ACT$ = "1234567890-+,.%$=<>^"
60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60160 PRINT ">__________<";
60170 GOTO 60240
60180 REM ******* DOUBLE PRECISION *******
60190 MAX = 20
60200 ACT$ = "1234567890-+,.%$=<>^"
60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60220 PRINT ">____________________<";
60230 GOTO 60240
60240 REM ********** NUMBER CHECK **********
60250 A$ = ""
60260 K$(20) = " "
60270 KTMAX = 0
60280 FOR T9 = 1 TO MAX
60290 K$(T9) = " "
60300 NEXT T9
60310 DIG$ = "1234567890."
60320 DOTFLG = 0
60330 T2 = MAX + 1
60340 FOR T6 = 1 TO T2
60350 PRINT CHR$(CH);
60360 NEXT T6
60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370
60380 KT = 0
60390 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
60400 KT = KT + 1
60410 REM
60420 W$ = INKEY$
60430 IF W$ = "" GOTO 60420
60440 C = ASC(W$)
60450 IF C = 0 THEN GOSUB 61900
60460 IF C = 13 GOTO 60580
60470 IF C = 17 OR C = 8 GOTO 61150
60480 IF C = 19 GOTO 60670
60490 IF C = 4 GOTO 60720
60500 IF C = 6 GOTO 60780
60510 IF C = 1 GOTO 60960
60520 IF KT > MAX GOTO 60410
60530 IF INSTR(ACT$,W$) = 0 GOTO 61230
60540 K$(KT) = W$
60550 PRINT K$(KT);
60560 IF KT > KTMAX THEN KTMAX = KT
60570 GOTO 60400
60580 REM ********** RETURN **********
60590 FOR T9 = 1 TO KTMAX
60600 A$ = A$ + K$(T9)
60610 NEXT T9
60620 IF KTMAX = 0 THEN PRINT "1"
60630 IF KTMAX = 0 THEN DT# = 1
60640 IF KTMAX = 0 THEN RETURN
60650 PRINT ""
60660 GOTO 61260
60670 REM ********* MOVE CURSE BACK ********
60680 IF KT = 1 GOTO 60410
60690 KT = KT - 1
60700 PRINT CHR$(CH);
60710 GOTO 60410
60720 REM ********* MOVE CURSER FORWARD *********
60730 IF KT >= MAX GOTO 60410
60740 IF KT > (KTMAX + 1) GOTO 60410
60750 PRINT K$(KT);
60760 KT = KT + 1
60770 GOTO 60410
60780 REM ********** INSERT ***********
60790 IF KT > KTMAX GOTO 60410
60800 X9 = MAX
60810 WHILE X9 > KT
60820 X9 = X9 - 1
60830 K$(X9 + 1) = K$(X9)
60840 WEND
60850 K$(KT) = " "
60860 KTMAX = KTMAX + 1
60870 IF KTMAX > MAX THEN KTMAX = MAX
60880 FOR T9 = KT TO KTMAX
60890 PRINT K$(T9);
60900 NEXT T9
60910 T6 = (KTMAX - KT) + 1
60920 FOR T7 = 1 TO T6
60930 PRINT CHR$(CH);
60940 NEXT T7
60950 GOTO 60410
60960 REM ********** DELETE ***********
60970 IF KT > KTMAX GOTO 60410
60980 IF KTMAX = 1 GOTO 60410
60990 K$(MAX + 1) = ""
61000 X9 = KT
61010 WHILE X9 <= MAX
61020 K$(X9) = K$(X9 + 1)
61030 X9 = X9 + 1
61040 WEND
61050 KTMAX = KTMAX - 1
61060 FOR T9 = KT TO KTMAX
61070 PRINT K$(T9);
61080 NEXT T9
61090 PRINT "_";
61100 T7 = (KTMAX - KT) + 2
61110 FOR T8 = 1 TO T7
61120 PRINT CHR$(CH);
61130 NEXT T8
61140 GOTO 60410
61150 REM ********* BACKSPACE ********
61160 IF KT = 1 GOTO 60410
61170 KT = KT - 1
61180 PRINT CHR$(CH);
61190 K$(KT) = " "
61200 PRINT "_";
61210 PRINT CHR$(CH);
61220 GOTO 60410
61230 REM ******* INPUT NOT ACCEPTABLE ********
61240 PRINT CHR$(7);
61250 GOTO 60420
61260 REM ********* CLEAR STRINGS ********
61270 MAX = LEN(A$)
61280 D2$ = ""
61290 D1$ = ""
61300 DFLG = 0
61310 FOR Q93 = 1 TO MAX
61320 R$ = MID$(A$,Q93,1)
61330 IF INSTR(DIG$,R$) = 0 GOTO 61400
61340 IF R$ = "." OR DFLG = 1 GOTO 61380
61350 IF DFLG = 1 GOTO 61380
61360 D2$ = D2$ + R$
61370 GOTO 61400
61380 D1$ = D1$ + R$
61390 DFLG = 1
61400 NEXT Q93
61410 DA# = VAL(D2$)
61420 D1# = VAL(D1$)
61430 DT# = DA# + D1#
61440 IF K$(1) = "-" THEN DT# = -DT#
61450 RETURN
61900 REM ****** CHECK FOR ASC0
61910 S4$ = INKEY$
61920 C2 = ASC(S4$)
61930 IF C2 = 83 THEN C = 1
61940 IF C2 = 82 THEN C = 6
61950 IF C2 = 75 THEN C = 19
61960 IF C2 = 77 THEN C = 4
61970 RETURN
62000 REM ********** ALPHANUMERIC CHECK **************
62010 MAX = FL(A,Q)
62020 GOTO 62040
62030 REM ******** MAX SET IN PROGRAM ********
62040 A$ = ""
62050 PRINT ">";
62060 FOR N9 = 1 TO MAX
62070 K$(N9) = ""
62080 PRINT "_";
62090 NEXT N9
62100 PRINT "<";
62110 T2 = MAX + 1
62120 FOR T4 = 1 TO T2
62130 PRINT CHR$(CH);
62140 NEXT T4
62150 KT = 0
62160 KTMAX = 1
62170 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
62180 KT = KT + 1
62190 PRINT TAB(KT+1)"";
62200 K$ = INKEY$
62210 IF K$ = "" GOTO 62200
62220 C = ASC(K$)
62230 IF C = 0 THEN GOSUB 61900
62240 IF C = 13 GOTO 62350
62250 IF C = 17 OR C = 8 GOTO 62920
62260 IF C = 19 GOTO 62450
62270 IF C = 4 GOTO 62500
62280 IF C = 6 GOTO 62560
62290 IF C = 1 GOTO 62730
62300 IF KT > MAX GOTO 62190
62310 K$(KT) = K$
62320 PRINT K$(KT);
62330 IF KT > KTMAX THEN KTMAX = KT
62340 GOTO 62180
62350 REM ********** RETURN **********
62360 FOR T9 = 1 TO MAX
62370 A$ = A$ + K$(T9)
62420 NEXT T9
62430 PRINT ""
62440 RETURN
62450 REM ********* MOVE CURSE BACK ********
62460 IF KT = 1 GOTO 62190
62470 KT = KT - 1
62480 PRINT CHR$(CH);
62490 GOTO 62190
62500 REM ********* MOVE CURSER FORWARD *********
62510 IF KT >= MAX GOTO 62190
62520 IF KT > KTMAX GOTO 62190
62530 PRINT K$(KT);
62540 KT = KT + 1
62550 GOTO 62190
62560 REM ********** INSERT ***********
62570 X9 = MAX
62580 WHILE X9 > KT
62590 X9 = X9 - 1
62600 K$(X9 + 1) = K$(X9)
62610 WEND
62620 K$(KT) = " "
62630 KTMAX = KTMAX + 1
62640 IF KTMAX > MAX THEN KTMAX = MAX
62650 FOR T9 = KT TO KTMAX
62660 PRINT K$(T9);
62670 NEXT T9
62680 T6 = (KTMAX - KT) +1
62690 FOR T7 = 1 TO T6
62700 PRINT CHR$(CH);
62710 NEXT T7
62720 GOTO 62190
62730 REM ********** DELETE ***********
62740 IF KT > KTMAX GOTO 62200
62750 IF KTMAX = 1 GOTO 62190
62760 K$(MAX + 1) = ""
62770 X9 = KT
62780 WHILE X9 <= KTMAX
62790 K$(X9) = K$(X9 + 1)
62800 X9 = X9 + 1
62810 WEND
62820 KTMAX = KTMAX - 1
62830 FOR T9 = KT TO KTMAX
62840 PRINT K$(T9);
62850 NEXT T9
62860 PRINT "_";
62870 T7 = (KTMAX - KT) + 2
62880 FOR T6 = 1 TO T7
62890 PRINT CHR$(CH);
62900 NEXT T6
62910 GOTO 62190
62920 REM ********* BACKSPACE ********
62930 IF KT = 1 GOTO 62190
62940 K$(KT) = " "
62950 KT = KT - 1
62960 K$(KT) = " "
62970 PRINT CHR$(CH);
62980 PRINT "_";
62990 PRINT CHR$(CH);
63000 GOTO 62190
CSCREEN.BAS
4 DEFINT A-W,Y-Z
5 DIM F$(15),FLDN$(17,40),FTY(17,40),FL(17,40)
13 DIM L(17),NREC(17)
16 DIM KY(17,40),KEYLIST(17,40)
35 DIM K$(80)
40 DIM SCRN(40),LE(40),CE(40),LEK(40),CEK(40),SW$(19)
50 DIM SUMF(40)
70 CH = 29
75 PRINT FRE(0)
77 GOSUB 52000
80 GOSUB 50000
100 GOTO 1000
200 GOTO 40000
500 REM ******* CLS
510 CLS
520 RETURN
600 REM ******* LOCATE 20,1
610 LOCATE 20,1
620 FOR T3= 1 TO 5
630 PRINT " ";
640 NEXT T3
650 LOCATE 20,1
660 RETURN
1000 REM ****** INITIAL MENU
1100 GOSUB 500
1110 PRINT "************** WHICH OPTION DO YOU WANT ****************"
1130 PRINT " 0 - EXIT PROGRAM"
1140 PRINT " 1 - ENTER A NEW SCREEN DESCRIPTION"
1150 PRINT " 2 - READ A SCREEN DESCRIPTION"
1160 PRINT " 3 - PRINT A SCREEN DESCRIPTION ON PAPER"
1170 PRINT " 4 - CHANGE A SCREEN DESCRIPTION "
1200 PRINT "******** ENTER THE NUMBER THEN PRESS RETURN ************"
1210 GOSUB 60000
1215 IF DT# < 0 OR DT# > 4 THEN 1210
1220 T = DT#
1230 IF T = 0 THEN GOTO 51000
1240 ON T GOTO 10000,20000,30000,40000
8000 REM ***** FILE NAME ACCEPLABLE TEST ************
8010 TEST = 1
8100 FOR Q = 1 TO LEN(A$)
8110 K$(Q) = MID$(A$,Q,1)
8120 C = ASC(K$(Q))
8130 IF C < 48 OR C > 122 THEN TEST = 4
8140 IF Q = 1 AND ( C < 65 OR C > 122 ) THEN TEST = 4
8150 NEXT Q
8190 RETURN
10000 REM ****** ENTER A SCREEN DESCRIPTION
10100 GOSUB 500
10200 PRINT "***** WHICH FILE DO YOU WANT TO ENTER A SCREEN DESCRIPTIN FOR *****"
10210 FOR T = 1 TO MAXF
10220 PRINT T;" - ";F$(T)
10230 NEXT T
10300 PRINT "***** ENTER THE FILE NUMBER THEN PRESS RETURN *****"
10310 GOSUB 60000
10320 IF DT# < 1 OR DT# > MAXF GOTO 10310
10330 A = DT#
10500 GOSUB 26000
10600 SCRN(A) = 5
10610 GOSUB 25000
11000 REM ***** INPUT INTRO
11100 GOSUB 500
12000 REM ***** INPUT OVERLAYS
12100 GOSUB 500
12110 PRINT " ----5----10---15---20---25---30---35---40---45---50---55---60---65---70---- "
12120 MAX = 78
12130 FOR TF= 1 TO 18
12132 GOSUB 12140
12134 NEXT TF
12136 GOTO 13000
12140 GOSUB 62030
12150 SW$(TF) = A$
12160 RETURN
13000 REM ******** INPUT LOCATIONS OF FIELDS *********
13100 FOR T = 1 TO NREC(A)
13110 GOSUB 600
13112 GOSUB 13120
13115 NEXT T
13117 GOTO 14000
13120 PRINT "FIELD NUMBER :";T;" FIELD NAME :";FLDN$(A,T)
13130 PRINT "WHICH LINE DO YOU WANT ENTRY ON "
13400 GOSUB 60000
13410 IF DT# < 0 OR DT# > 18 THEN 13400
13420 LE(T) = DT#
13500 PRINT "WHICH COLUMN DO YOU WANT THE ENTRY TO START AT"
13510 SPRT = 5
13600 GOSUB 60000
13610 IF DT# < 1 OR DT# > 78 THEN 13600
13620 CE(T) = DT#
13700 IF FTY(A,T) = 2 AND KY(A,T) = 2 THEN GOSUB 13800
13710 RETURN
13800 REM *******
13820 GOSUB 600
13830 PRINT "WHICH LINE DO YOU WANT THE KEY PRINTED ON "
13840 GOSUB 60000
13850 IF DT# < 0 OR DT# > 18 THEN 13840
13860 LEK(T) = DT#
13870 PRINT "WHICH COLUMN DO YOU WANT THE KEY PRINTED ON "
13875 SPRT = 5
13880 GOSUB 60000
13900 IF DT# < 0 OR DT# > 78 THEN 13880
13910 CEK(T) = DT#
13920 RETURN
14000 REM ******* PUT DATA ON FILES
14010 GOSUB 15000
14100 A$ = STR$(A)
14110 A$ = MID$(A$,2)
14120 A$ = "SCREEN" + A$
14200 GOSUB 27000
14300 GOTO 1000
15000 REM ******** REPEATING FIELDS
15100 GOSUB 500
15200 PRINT " DO YOU WANT TO USE THE REPEATING FIELDS OPTION "
15210 PRINT ""
15220 PRINT " 1 - NO "
15230 PRINT " 2 - YES"
15300 PRINT ""
15310 PRINT "***** ENTER THE NUMBER THEN PRESS RETURN *****"
15320 GOSUB 60000
15330 IF DT# < 1 OR DT# > 2 THEN 15320
15340 RPT = DT#
15350 IF RPT = 1 THEN RETURN
15400 REM ****** INPUTING DATA
15410 GOSUB 500
15415 PRINT "******** WHICH FIELD IS THE LAST EQUAL FIELD ********"
15420 FOR T = 1 TO NREC(A)
15430 PRINT T;" - ";FLDN$(A,T)
15440 NEXT T
15450 PRINT "****** ENTER THE NUMBER THEN PRESS RETURN ******"
15460 GOSUB 60000
15470 IF DT# < 1 OR DT# > NREC(A) THEN 15460
15480 LSTE = DT#
15500 REM ****** INPUTING FIELDS TO SUM
15510 GOSUB 500
15520 T2 = LSTE + 1
15530 FOR T = T2 TO NREC(A)
15540 GOSUB 500
15550 PRINT T;" - ";FLDN$(A,T)
15560 PRINT "***** DO YOU WANT THIS FIELD SUMMED *****"
15570 PRINT " 1 - NO "
15580 PRINT " 2 - YES , SUM THIS FIELD "
15590 PRINT "***** ENTER THE NUMBER THEN PRESS RETURN *****"
15600 GOSUB 60000
15610 IF DT# < 1 OR DT# > 2 THEN 15600
15615 IF FTY(A,T) = 1 AND DT# = 2 THEN 15600
15620 SUMF(T) = DT#
15630 NEXT T
15640 RETURN
20000 REM ******* READ A SCREEN DESCRIPTION
20100 GOSUB 500
20110 GOSUB 26000
20120 PRINT "******* WHICH SCREEN DO YOU WANT TO SEE *******"
20130 FOR T = 1 TO MAXF
20140 IF SCRN(T) <> 0 THEN PRINT T;" - ";F$(T)
20150 NEXT T
20160 PRINT "***** ENTER THE NUMBER THEN PRESS RETURN *****"
20170 GOSUB 60000
20180 IF DT# < 1 OR DT# > MAXF THEN 20170
20190 IF SCRN(DT#) = 0 THEN 20170
20200 A = DT#
20300 REM ******* GET FILE
20310 A$ = STR$(A)
20320 A$ = MID$(A$,2)
20330 A$ = "SCREEN"+A$
20340 GOSUB 28000
20400 REM ******* PRINT OVERLAYS
20410 GOSUB 500
20420 PRINT "******** TOP LINE RESERVED FOR FILE NAME AND RECORD NUMBER *********"
20430 FOR T = 1 TO 18
20440 PRINT SW$(T)
20450 NEXT T
20460 PRINT "******** PRESS ANY KEY TO CONTINUE ********"
20470 IF INKEY$ = "" THEN 20470
20500 REM ******* PRINT FIELD LOCATIONS
20510 GOSUB 500
20515 PRINT " FIELD LINE COLUMN KEY LINE KEY COLUMN"
20520 FOR T = 1 TO NREC(A)
20530 PRINT T;FLDN$(A,T) TAB(30) LE(T); TAB(40) CE(T);
20540 IF FTY(A,T) = 2 THEN PRINT TAB(50) LEK(T);TAB(60) CEK(T);
20550 PRINT ""
20560 NEXT T
20600 PRINT "********* PRESS ANY KEY TO CONTINUE ************"
20610 IF INKEY$ = "" THEN 20610
20800 GOSUB 21000
20900 GOTO 1000
21000 REM ****** PRINT REPEATING FIELDS
21100 GOSUB 500
21110 IF RPT = 2 THEN GOTO 21200
21120 PRINT " NO REPEATING FIELDS SPECIFIED "
21130 PRINT ""
21140 PRINT "***** PRESS ANY KET TO CONTINUE ******"
21150 IF INKEY$ = "" THEN 21150
21160 RETURN
21200 REM ******** PRINT REPEATING FIELDS
21210 PRINT "REPEATING FIELDS SPECIFIED "
21220 PRINT "LAST EQUAL FIELD IS FIELD NUMBER ";LSTE;" - ";FLDN$(A,LSTE)
21230 PRINT ""
21240 PRINT "THE REPEATING FIELDS ARE : "
21250 T2 = LSTE + 1
21260 FOR T = T2 TO NREC(A)
21270 PRINT T;" - ";FLDN$(A,T);
21280 IF SUMF(T) = 2 THEN PRINT " -THIS FIELD IS SUMMED ";
21285 PRINT ""
21290 NEXT T
21300 PRINT ""
21310 PRINT " PRESS ANY KEY TO CONTINUE "
21320 IF INKEY$ = "" THEN 21320
21330 RETURN
23780 REM ************* READ SUBROUTINE *************
23800 OPEN "I",#1,"FFILE"
23820 INPUT #1,MAXF
23840 FOR A = 1 TO MAXF
23860 INPUT #1,A,F$(A),NREC(A),L(A)
23880 FOR N = 1 TO NREC(A)
23900 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N)
23920 IF FTY(A,N) = 2 THEN INPUT #1,KY(A,N),KEYLIST(A,N)
23940 NEXT N
23960 NEXT A
23980 CLOSE #1
24000 RETURN
25000 REM ************ WRITE SCREEN TEST *********
25100 OPEN "O",#1,"SCTEST"
25200 FOR T = 1 TO 40
25300 WRITE #1,SCRN(T)
25400 NEXT T
25500 CLOSE #1
25600 RETURN
26000 REM ************ READ SCREEN TEST *********
26100 OPEN "I",#1,"SCTEST"
26200 FOR T = 1 TO 40
26300 INPUT #1,SCRN(T)
26400 NEXT T
26500 CLOSE #1
26600 RETURN
27000 REM ************ WRITE SCREEN DESCRIPTION *********
27100 OPEN "O",#1,A$
27110 FOR T = 1 TO 18
27120 WRITE #1,SW$(T)
27130 NEXT T
27210 FOR T = 1 TO NREC(A)
27220 WRITE #1,LE(T),CE(T)
27230 IF FTY(A,T) = 2 THEN WRITE #1,LEK(T),CEK(T)
27240 NEXT T
27242 WRITE #1,RPT
27244 IF RPT = 2 THEN GOSUB 27400
27250 CLOSE #1
27300 RETURN
27400 WRITE #1,LSTE
27410 T2 = LSTE + 1
27420 FOR T = T2 TO NREC(A)
27430 WRITE #1,SUMF(T)
27440 NEXT T
27450 RETURN
28000 REM ************ READ SCREEN DESCRIPTION *********
28100 OPEN "I",#1,A$
28110 FOR T = 1 TO 18
28120 INPUT #1,SW$(T)
28130 NEXT T
28210 FOR T = 1 TO NREC(A)
28220 INPUT #1,LE(T),CE(T)
28230 IF FTY(A,T) = 2 THEN INPUT #1,LEK(T),CEK(T)
28240 NEXT T
28242 INPUT #1,RPT
28244 IF RPT = 2 THEN GOSUB 28400
28250 CLOSE #1
28300 RETURN
28400 INPUT #1,LSTE
28410 T2 = LSTE + 1
28420 FOR T = T2 TO NREC(A)
28430 INPUT #1,SUMF(T)
28440 NEXT T
28450 RETURN
30000 REM ******* PRINT A SCREEN DESCRIPTION ON PAPER
30100 GOSUB 500
30110 GOSUB 26000
30115 PRINT "************** MAKE SURE YOUR PRINTER IS ON **************"
30120 PRINT "******* WHICH SCREEN DO YOU WANT TO PRINT ON PAPER *******"
30130 FOR T = 1 TO MAXF
30140 IF SCRN(T) <> 0 THEN PRINT T;" - ";F$(T)
30150 NEXT T
30160 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN *********"
30170 GOSUB 60000
30180 IF DT# < 1 OR DT# > MAXF THEN 30170
30190 IF SCRN(DT#) = 0 THEN 30170
30200 A = DT#
30300 REM ******* GET FILE
30310 A$ = STR$(A)
30320 A$ = MID$(A$,2)
30330 A$ = "SCREEN"+A$
30340 GOSUB 28000
30400 REM ******* PRINT OVERLAYS
30410 GOSUB 500
30420 LPRINT "******** TOP LINE RESERVED FOR FILE NAME AND RECORD NUMBER *********"
30430 FOR T = 1 TO 18
30440 LPRINT SW$(T)
30450 NEXT T
30500 REM ******* PRINT FIELD LOCATIONS
30510 GOSUB 500
30515 LPRINT " FIELD LINE COLUMN KEY LINE KEY COLUMN"
30520 FOR T = 1 TO NREC(A)
30530 LPRINT T;FLDN$(A,T) TAB(30) LE(T); TAB(40) CE(T);
30540 IF FTY(A,T) = 2 THEN LPRINT TAB(50) LEK(T);TAB(60) CEK(T);
30550 LPRINT ""
30560 NEXT T
30800 GOSUB 31000
30900 GOTO 1000
31000 REM ****** PRINT REPEATING FIELDS
31110 IF RPT = 2 THEN GOTO 31200
31120 LPRINT " NO REPEATING FIELDS SPECIFIED "
31160 RETURN
31200 REM ******** PRINT REPEATING FIELDS
31210 LPRINT "REPEATING FIELDS SPECIFIED "
31220 LPRINT "LAST EQUAL FIELD IS FIELD NUMBER ";LSTE;" - ";FLDN$(A,LSTE)
31230 LPRINT ""
31240 LPRINT "THE REPEATING FIELDS ARE : "
31250 T2 = LSTE + 1
31260 FOR T = T2 TO NREC(A)
31270 LPRINT T;" - ";FLDN$(A,T);
31280 IF SUMF(T) = 2 THEN LPRINT " -THIS FIELD IS SUMMED ";
31285 LPRINT ""
31290 NEXT T
31300 RETURN
40000 REM ******* CHANGE A SCREEN DESCRIPTION
40100 GOSUB 500
40110 GOSUB 26000
40120 PRINT "******* WHICH SCREEN DO YOU WANT TO CHANGE ******"
40130 FOR T = 1 TO MAXF
40140 IF SCRN(T) <> 0 THEN PRINT T;" - ";F$(T)
40150 NEXT T
40160 PRINT "***** ENTER THE NUMBER THEN PRESS RETURN *****"
40170 GOSUB 60000
40180 IF DT# < 1 OR DT# > MAXF THEN 20170
40190 IF SCRN(DT#) = 0 THEN 20170
40200 A = DT#
40300 REM ******* GET FILE
40310 A$ = STR$(A)
40320 A$ = MID$(A$,2)
40330 A$ = "SCREEN"+A$
40335 AH$ = A$
40340 GOSUB 28000
41000 REM ******* CHANGE MENU
41100 GOSUB 500
41110 PRINT "********** WHAT TYPE OF CHANGE ***********"
41120 PRINT " 0 - NO CHANGE / DONE WITH CHANGE
41130 PRINT " 1 - CHANGE THE LOCATION OF A FIELD "
41140 PRINT " 2 - CHANGE AN OVERLAY LINE "
41145 PRINT " 3 - CHANGE THE REPEATING FIELDS"
41150 PRINT "**** ENTER THE NUMBER THEN PRESS RETURN ****"
41200 GOSUB 60000
41210 IF DT# < 0 OR DT# > 3 THEN 41200
41220 T = DT#
41225 T = T + 1
41230 ON T GOTO 41300,42000,43000,44000
41300 REM ****** DONE WRITE TO FILE
41305 A$ = AH$
41310 GOSUB 27000
41320 GOTO 1000
42000 REM ******** CHANGE THE LOCATION OF A FIELD
42100 GOSUB 500
42110 PRINT "***** WHICH FIELD LOCATION DO YOU WANT TO CHANGE *****"
42120 FOR T = 1 TO NREC(A)
42130 PRINT T;" - ";FLDN$(A,T)
42140 NEXT T
42150 PRINT "***** ENTER THE NUMBER THE PRESS RETURN ******"
42160 GOSUB 60000
42170 IF DT# < 1 OR DT# > NREC(A) THEN 42160
42180 T = DT#
42190 GOSUB 13120
42200 GOTO 41000
43000 REM ******** CHANGE OVERLAY LINE
43100 PRINT "WHICH LINE DO YOU WANT TO CHANGE "
43200 GOSUB 60000
43210 IF DT# < 1 OR DT# > 18 THEN 43200
43220 TF = DT#
43230 PRINT "ENTER THE NEW OVERLAY LINE "
43240 MAX = 78
43250 GOSUB 12140
43300 GOTO 41000
44000 REM ****** CHANGE THE REPEATING FIELDS
44100 GOSUB 15000
44200 GOTO 41000
50000 REM ********** INTRO
50010 GOSUB 500
50100 PRINT " S C R E E N D E S C R I P T I O 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"
50165 PRINT " See the manual for more information on the license."
50167 PRINT ""
50920 GOSUB 23780
50950 PRINT "****************** PRESS ANY KEY TO CONTINUE *****************";
50960 IF INKEY$ = "" GOTO 50960
50970 RETURN
51000 REM ***** EXIT TO SYSTEM
51100 GOSUB 500
51110 CLOSE
51120 PRINT " -BYE, Have a nice day"
51130 END
52000 REM ***** INTRO 1
52010 GOSUB 500
52100 PRINT " Put the DATA DISK in the default disk drive "
52110 PRINT ""
52120 PRINT " ***** THEN PRESS ANY KEY TO CONTINUE *****"
52130 PRINT ""
52140 PRINT " The CUSTOM programs only use the PROGRAM DATA DISK"
52150 PRINT "Keep it in the default disk drive at all times during this program."
52200 IF INKEY$ = "" GOTO 52200
52210 RETURN
60000 REM ******* INTEGER LESS THEN 100 CHECK ********
60010 MAX = 2
60020 ACT$ = "1234567890=<>^"
60030 IF NE = 0 THEN ACT$ = "1234567890"
60040 PRINT ">__<";
60050 GOTO 60240
60060 REM ******* INTEGER *******
60070 MAX = 8
60080 ACT$ = "1234567890-+,=<>^"
60090 IF NE = 0 THEN ACT$ = "1234567890-+,"
60100 PRINT ">________<";
60110 GOTO 60240
60120 REM ******* SINGLE PRECISION *******
60130 MAX = 10
60140 ACT$ = "1234567890-+,.%$=<>^"
60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60160 PRINT ">__________<";
60170 GOTO 60240
60180 REM ******* DOUBLE PRECISION *******
60190 MAX = 20
60200 ACT$ = "1234567890-+,.%$=<>^"
60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60220 PRINT ">____________________<";
60230 GOTO 60240
60240 REM ********** NUMBER CHECK **********
60250 A$ = ""
60260 K$(20) = " "
60270 KTMAX = 0
60280 FOR T9 = 1 TO MAX
60290 K$(T9) = " "
60300 NEXT T9
60310 DIG$ = "1234567890."
60320 DOTFLG = 0
60330 T2 = MAX + 1
60340 FOR T6 = 1 TO T2
60350 PRINT CHR$(CH);
60360 NEXT T6
60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370
60380 KT = 0
60390 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
60400 KT = KT + 1
60410 REM
60420 W$ = INKEY$
60430 IF W$ = "" GOTO 60420
60440 C = ASC(W$)
60450 IF C = 0 THEN GOSUB 61900
60460 IF C = 13 GOTO 60580
60470 IF C = 17 OR C = 8 GOTO 61150
60480 IF C = 19 GOTO 60670
60490 IF C = 4 GOTO 60720
60500 IF C = 6 GOTO 60780
60510 IF C = 1 GOTO 60960
60520 IF KT > MAX GOTO 60410
60530 IF INSTR(ACT$,W$) = 0 GOTO 61230
60540 K$(KT) = W$
60550 PRINT K$(KT);
60560 IF KT > KTMAX THEN KTMAX = KT
60570 GOTO 60400
60580 REM ********** RETURN **********
60590 FOR T9 = 1 TO KTMAX
60600 A$ = A$ + K$(T9)
60610 NEXT T9
60620 IF KTMAX = 0 THEN PRINT "1";
60630 IF KTMAX = 0 THEN DT# = 1
60650 IF SPRT < 5 THEN PRINT ""
60652 SPRT = 0
60655 IF KTMAX = 0 THEN RETURN
60660 GOTO 61260
60670 REM ********* MOVE CURSE BACK ********
60680 IF KT = 1 GOTO 60410
60690 KT = KT - 1
60700 PRINT CHR$(CH);
60710 GOTO 60410
60720 REM ********* MOVE CURSER FORWARD *********
60730 IF KT >= MAX GOTO 60410
60740 IF KT > (KTMAX + 1) GOTO 60410
60750 PRINT K$(KT);
60760 KT = KT + 1
60770 GOTO 60410
60780 REM ********** INSERT ***********
60790 IF KT > KTMAX GOTO 60410
60800 X9 = MAX
60810 WHILE X9 > KT
60820 X9 = X9 - 1
60830 K$(X9 + 1) = K$(X9)
60840 WEND
60850 K$(KT) = " "
60860 KTMAX = KTMAX + 1
60870 IF KTMAX > MAX THEN KTMAX = MAX
60880 FOR T9 = KT TO KTMAX
60890 PRINT K$(T9);
60900 NEXT T9
60910 T6 = (KTMAX - KT) + 1
60920 FOR T7 = 1 TO T6
60930 PRINT CHR$(CH);
60940 NEXT T7
60950 GOTO 60410
60960 REM ********** DELETE ***********
60970 IF KT > KTMAX GOTO 60410
60980 IF KTMAX = 1 GOTO 60410
60990 K$(MAX + 1) = ""
61000 X9 = KT
61010 WHILE X9 <= MAX
61020 K$(X9) = K$(X9 + 1)
61030 X9 = X9 + 1
61040 WEND
61050 KTMAX = KTMAX - 1
61060 FOR T9 = KT TO KTMAX
61070 PRINT K$(T9);
61080 NEXT T9
61090 PRINT "_";
61100 T7 = (KTMAX - KT) + 2
61110 FOR T8 = 1 TO T7
61120 PRINT CHR$(CH);
61130 NEXT T8
61140 GOTO 60410
61150 REM ********* BACKSPACE ********
61160 IF KT = 1 GOTO 60410
61170 KT = KT - 1
61180 PRINT CHR$(CH);
61190 K$(KT) = " "
61200 PRINT "_";
61210 PRINT CHR$(CH);
61220 GOTO 60410
61230 REM ******* INPUT NOT ACCEPTABLE ********
61240 PRINT CHR$(7);
61250 GOTO 60420
61260 REM ********* CLEAR STRINGS ********
61270 MAX = LEN(A$)
61280 D2$ = ""
61290 D1$ = ""
61300 DFLG = 0
61310 FOR Q93 = 1 TO MAX
61320 R$ = MID$(A$,Q93,1)
61330 IF INSTR(DIG$,R$) = 0 GOTO 61400
61340 IF R$ = "." OR DFLG = 1 GOTO 61380
61350 IF DFLG = 1 GOTO 61380
61360 D2$ = D2$ + R$
61370 GOTO 61400
61380 D1$ = D1$ + R$
61390 DFLG = 1
61400 NEXT Q93
61410 DA# = VAL(D2$)
61420 D1# = VAL(D1$)
61430 DT# = DA# + D1#
61440 IF K$(1) = "-" THEN DT# = -DT#
61450 RETURN
61900 REM ****** CHECK FOR ASC0
61910 S4$ = INKEY$
61920 C2 = ASC(S4$)
61930 IF C2 = 83 THEN C = 1
61940 IF C2 = 82 THEN C = 6
61950 IF C2 = 75 THEN C = 19
61960 IF C2 = 77 THEN C = 4
61970 RETURN
62000 REM ********** ALPHANUMERIC CHECK **************
62010 MAX = FL(A,Q)
62020 GOTO 62040
62030 REM ******** MAX SET IN PROGRAM ********
62040 A$ = ""
62050 PRINT ">";
62060 FOR N9 = 1 TO MAX
62070 K$(N9) = ""
62080 PRINT "_";
62090 NEXT N9
62100 PRINT "<";
62110 T2 = MAX + 1
62120 FOR T4 = 1 TO T2
62130 PRINT CHR$(CH);
62140 NEXT T4
62150 KT = 0
62160 KTMAX = 1
62170 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
62180 KT = KT + 1
62190 PRINT TAB(KT+1)"";
62200 K$ = INKEY$
62210 IF K$ = "" GOTO 62200
62220 C = ASC(K$)
62230 IF C = 0 THEN GOSUB 61900
62240 IF C = 13 GOTO 62350
62250 IF C = 17 OR C = 8 GOTO 62920
62260 IF C = 19 GOTO 62450
62270 IF C = 4 GOTO 62500
62280 IF C = 6 GOTO 62560
62290 IF C = 1 GOTO 62730
62300 IF KT > MAX GOTO 62190
62310 K$(KT) = K$
62320 PRINT K$(KT);
62330 IF KT > KTMAX THEN KTMAX = KT
62340 GOTO 62180
62350 REM ********** RETURN **********
62360 FOR T9 = 1 TO MAX
62370 A$ = A$ + K$(T9)
62420 NEXT T9
62430 PRINT ""
62440 RETURN
62450 REM ********* MOVE CURSE BACK ********
62460 IF KT = 1 GOTO 62190
62470 KT = KT - 1
62480 PRINT CHR$(CH);
62490 GOTO 62190
62500 REM ********* MOVE CURSER FORWARD *********
62510 IF KT >= MAX GOTO 62190
62520 IF KT > KTMAX GOTO 62190
62530 PRINT K$(KT);
62540 KT = KT + 1
62550 GOTO 62190
62560 REM ********** INSERT ***********
62570 X9 = MAX
62580 WHILE X9 > KT
62590 X9 = X9 - 1
62600 K$(X9 + 1) = K$(X9)
62610 WEND
62620 K$(KT) = " "
62630 KTMAX = KTMAX + 1
62640 IF KTMAX > MAX THEN KTMAX = MAX
62650 FOR T9 = KT TO KTMAX
62660 PRINT K$(T9);
62670 NEXT T9
62680 T6 = (KTMAX - KT) +1
62690 FOR T7 = 1 TO T6
62700 PRINT CHR$(CH);
62710 NEXT T7
62720 GOTO 62190
62730 REM ********** DELETE ***********
62740 IF KT > KTMAX GOTO 62200
62750 IF KTMAX = 1 GOTO 62190
62760 K$(MAX + 1) = ""
62770 X9 = KT
62780 WHILE X9 <= KTMAX
62790 K$(X9) = K$(X9 + 1)
62800 X9 = X9 + 1
62810 WEND
62820 KTMAX = KTMAX - 1
62830 FOR T9 = KT TO KTMAX
62840 PRINT K$(T9);
62850 NEXT T9
62860 PRINT "_";
62870 T7 = (KTMAX - KT) + 2
62880 FOR T6 = 1 TO T7
62890 PRINT CHR$(CH);
62900 NEXT T6
62910 GOTO 62190
62920 REM ********* BACKSPACE ********
62930 IF KT = 1 GOTO 62190
62940 K$(KT) = " "
62950 KT = KT - 1
62960 K$(KT) = " "
62970 PRINT CHR$(CH);
62980 PRINT "_";
62990 PRINT CHR$(CH);
63000 GOTO 62190
CTRANSFE.BAS
4 DEFINT A-W,Y-Z
5 DIM F$(17),FLDN$(17,30),FTY(17,30),FL(17,30),IOPT(30)
13 DIM L(17),NREC(17)
14 DIM SN$(30),SFN(30),DTOPT(10)
21 DIM TX(10,10)
22 DIM D(10),TFN(10),FLDTCT(10,50,1),KTSUM(10),SUMFN(10)
23 DIM SUMF(10,30),KTSUMAF(30),SAFFN(30),SAFADD(10,30),SAFACCTO(10,30)
24 DIM SAFFLDN(10,30)
25 DIM S#(30)
26 DIM MAX(5,30),Z%(10),SU#(30),D#(30),EFN(10,30)
35 DIM K$(80)
42 DIM SUM(30),MAXK(10),SUMRN(10,30),SUMFLDN(10,30),MAXSAF(5)
44 DIM SUMAFOPT(30),SUMOPT(30),RNTNBOPT(10),DY(30),FLDTC(10,50,1)
46 DIM SUMFLD(10,30)
50 D = 1
70 CH = 29
75 PRINT "MEMORY FREE",FRE(0)
80 GOSUB 52000
100 GOSUB 50000
200 GOTO 20000
500 REM ******* CLS
510 CLS
520 RETURN
20000 REM ********** TRANSFER PROGRAM *********
20010 GOSUB 500
20100 GOSUB 24620
20120 GOSUB 500
20130 HLD = 0
20140 PRINT "************ DATA TRANSFER DESCRIPTION MENU **************"
20160 PRINT ""
20180 PRINT " 0 - EXIT "
20190 PRINT ""
20200 PRINT " 1 - ENTER A TRANSFER DESCRIPTION"
20210 PRINT ""
20220 PRINT " 2 - READ A SINGLE TRANSFER DESCRIPTION"
20230 PRINT ""
20240 PRINT " 3 - PRINT ON PAPER ONE TRANSFER DESCRIPTION "
20260 PRINT ""
20280 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN ************"
20300 GOSUB 60000
20302 IF DT# <0 OR DT#> 3 GOTO 20300
20310 T = DT#
20315 IF T = 0 GOTO 51000
20320 ON T GOTO 20340,20420,20640
20340 REM *** ENTER A TRANSFER DESCRIPTION ***
20360 GOSUB 20820
20380 GOSUB 24020
20400 GOTO 20120
20420 REM *** READ A SINGE TRANSFER DESCRIPTION ***
20440 GOSUB 500
20460 PRINT "******* WHICH TRANSFER DESCRIPTION DO YOU WANT TO SEE *******"
20480 FOR T = 1 TO MAXS
20500 PRINT T;"- ";SN$(T)
20520 NEXT T
20540 PRINT "************ ENTER THE NUMBER THEN PRESS RETURN *************"
20560 GOSUB 60000
20562 IF DT# <1 OR DT#> MAXS GOTO 20560
20570 S = DT#
20580 GOSUB 25220
20600 PRINT "******* PRESS ANY KEY TO CONTINUE *******"
20610 IF INKEY$ = "" THEN GOTO 20610
20620 GOTO 20120
20640 REM *** PRINT ON PAPER ONE TRANSFER DESCRIPTION ***
20660 PRINT "***** WHAT TRANSFER DESCRIPTION DO YOU WANT PRINTED *****"
20680 FOR T = 1 TO MAXS
20700 PRINT T;"- ";SN$(T)
20720 NEXT T
20740 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN ***********"
20760 GOSUB 60000
20762 IF DT# <1 OR DT#> MAXS GOTO 20760
20770 S = DT#
20780 GOSUB 26500
20800 GOTO 20120
20820 REM ************ NEW TRANSFER ENTRY *************
20840 GOSUB 500
20860 PRINT "**************** NEW TRANSFER DATA ENTRY ****************"
20880 PRINT ""
20900 PRINT "***** WHAT NUMBER IS THIS DATA TRANSFER OPTION *****"
20920 FOR T = 1 TO MAXS
20940 PRINT T;"-";SN$(T)
20960 NEXT T
20980 PRINT " ------ ENTER A NUMBER FROM 1 TO ";MAXS+1;" ------"
21000 PRINT "********* ENTER ZERO TO RETURN TO FIRST MENU ********"
21020 GOSUB 60000
21022 IF DT# <0 OR DT#> MAXS +1 GOTO 21020
21026 IF DT# = 0 GOTO 20000
21030 S = DT#
21040 IF S > MAXS +1 THEN GOTO 20840
21060 IF S > MAXS THEN MAXS = S
21080 PRINT "**** WHAT NAME DO YOU WANT TO GIVE THIS TRANSFER ****"
21090 MAX = 40
21100 GOSUB 62030
21110 SN$(S) = A$
21120 GOSUB 500
21130 PRINT "************* WHICH FILE IS THE SOURCE FILE *************"
21140 FOR T = 1 TO MAXF
21160 PRINT T;"-";F$(T)
21180 NEXT T
21200 PRINT "***** ENTER THE SOURCE FILE NUMBER THEN PRESS RETURN *****"
21210 GOSUB 60000
21212 IF DT# <1 OR DT#> MAXF GOTO 21210
21215 SFN(S) = DT#
21220 SFN = SFN(S)
21230 DY(SFN) = NREC(SFN)
21240 PRINT "********* DIRECT DATA TRANSFER OPTION **********"
21260 PRINT " 1 - TRANSFER"
21280 PRINT " 2 - NO TRNASFER"
21290 PRINT "****** ENTER THE NUMBER THEN PRESS RETURN ******"
21300 GOSUB 60000
21302 IF DT# <1 OR DT#> 2 GOTO 21300
21310 DTOPT(S) = DT#
21320 IF DTOPT(S) = 2 GOTO 22040
21340 GOSUB 500
21350 PRINT "*************** WHICH FILE IS THE TARGET FILE *************"
21360 FOR T = 1 TO MAXF
21380 PRINT T;"-";F$(T)
21400 NEXT T
21410 PRINT "****** ENTER THE TARGET FILE NUMBER THEN PRESS RETURN ******"
21420 GOSUB 60000
21422 IF DT# <1 OR DT#> MAXF GOTO 21420
21430 TFN(S) = DT#
21440 TFN = TFN(S)
21460 GOSUB 500
21480 PRINT "************ RECORD NUMBERING FOR TARGET OPTION ************"
21500 PRINT " 0 - EQUALS SOURCE FILE NUMBER "
21510 PRINT " Record Number of target is = to the value of source field :"
21520 FOR T = 1 TO NREC(SFN)
21540 PRINT " ";T;"-";FLDN$(SFN,T)
21560 NEXT T
21580 PRINT "*************** ENTER NUMBER THEN PRESS RETURN **************"
21590 GOSUB 60000
21592 IF DT# <0 OR DT#> NREC(SFN) GOTO 21590
21594 IF FTY(SFN,DT#) = 1 GOTO 21590
21600 RNTNBOPT(S) = DT#
21620 D = 1
21640 FOR N = 1 TO NREC(TFN)
21660 GOSUB 500
21680 PRINT "FIELD #";N;" ";FLDN$(TFN,N)
21700 PRINT "************* FIELD TARGET CHANGE *************"
21720 PRINT " 1 -DO NOT CHANGE "
21730 PRINT " Change with source field :"
21740 FOR T = 1 TO NREC(SFN)
21760 PRINT " ";T+1;"-";FLDN$(SFN,T)
21780 NEXT T
21800 PRINT "***** ENTER THE NUMBER THEN PRESS RETURN ******"
21810 T4 = NREC(SFN) + 1
21820 GOSUB 60000
21822 IF DT# <1 OR DT#> T4 GOTO 21820
21823 IF DT# = 1 GOTO 21830
21824 T2 = DT#
21827 IF FTY(SFN,T2-1) >< FTY(TFN,N) GOTO 21820
21830 FLDTC(S,N,D) = DT#
21840 IF FLDTC(S,N,D) = 1 GOTO 21980
21860 PRINT "****************** TYPE OF CHANGE *****************"
21880 PRINT " 1 - ADD -source field and target field"
21900 PRINT " 2 - REPLACE -target field equals source field"
21920 PRINT " 3 - SUBTRACT -target field minus source field"
21940 PRINT "******* ENTER THE NUMBER THEN PRESS RETURN ********"
21950 GOSUB 60000
21952 IF DT# <1 OR DT#> 3 GOTO 21950
21954 IF FTY(TFN,N) = 1 AND DT# >< 2 GOTO 21950
21960 FLDTCT(S,N,D) = DT#
21980 NEXT N
22000 IF D = 2 GOTO 22040
22020 GOSUB 500
22040 REM ******** SUM OPTION *******
22080 PRINT "********** SUM ACCORDING TO FIELD OPTION ***********"
22100 PRINT " 1 - SUM"
22120 PRINT " 2 - DO NOT SUM"
22130 PRINT "******** ENTER THE NUMBER THEN PRESS RETURN ********"
22140 GOSUB 60000
22142 IF DT# <1 OR DT#> 2 GOTO 22140
22150 SUMOPT(S) = DT#
22160 IF SUMOPT(S) = 2 GOTO 22720
22180 GOSUB 500
22200 A = SFN(S)
22220 GOSUB 23400
22240 PRINT "***** HOW MANY FIELDS DO YOU WANT SUMMED *****"
22260 PRINT "***** ENTER THE NUMBER THEN PRESS RETURN *****"
22280 GOSUB 60000
22282 IF DT# <1 OR DT#> NREC(SFN) GOTO 22280
22290 KTSUM(S) = DT#
22300 FOR K = 1 TO KTSUM(S)
22320 GOSUB 500
22340 GOSUB 23400
22360 PRINT "WHICH FIELD IS THE ";K;"th FIELD YOU WANT SUMED"
22380 GOSUB 60000
22382 IF DT# <1 OR DT#> NREC(SFN) GOTO 22280
22384 IF FTY(SFN,DT#) = 1 GOTO 22280
22390 SUMF(S,K) = DT#
22400 GOSUB 500
22410 PRINT "******* WHICH FILE DO YOU WANT THIS SUM SENT TO *******"
22415 PRINT "The file must be the same for all sums."
22420 PRINT ""
22440 FOR N = 1 TO MAXF
22460 PRINT "FILE NUMBER ";N;" FILE NAME ";F$(N)
22480 NEXT N
22500 PRINT ""
22520 PRINT "******* WHICH FILE DO YOU WANT THIS SUM SENT TO *******"
22540 GOSUB 60000
22542 IF DT# <1 OR DT#> MAXF GOTO 22540
22545 IF (HLD > 0) AND (DT# <> HLD) GOTO 22540
22547 HLD = DT#
22550 SUMFN(S) = DT#
22560 PRINT "*** WHICH RECORD NUMBER DO YOU WANT THE SUM SENT TO ***"
22565 GOSUB 60000
22567 IF DT# <1 GOTO 22565
22570 SUMRN(S,K) = DT#
22580 GOSUB 500
22590 PRINT "******* WHICH FIELD DO YOU WANT THIS SUM SENT TO ********"
22600 SFN = SFN(S)
22620 FOR P = 1 TO NREC(HLD)
22640 PRINT "FIELD #";P;FLDN$(HLD,P)
22660 NEXT P
22680 PRINT "***** WHICH FIELD NUMBER DO YOU WANT THE SUM SENT TO *****"
22685 GOSUB 60000
22687 IF DT# <1 OR DT#> NREC(HLD) GOTO 22685
22688 IF FTY(HLD,DT#) = 1 GOTO 22685
22690 SUMFLDN(S,K) = DT#
22700 NEXT K
22720 REM ********* SUM ACCORDING TO ANOTHER FIELD OPTION **********
22740 GOSUB 500
22760 PRINT "******* SUM WITH SUBTOTALS BY ANOTHER FIELD ******"
22780 PRINT " 1 - SUM"
22800 PRINT " 2 - DO NOT SUM"
22810 PRINT "******** ENTER THE NUMBER THEN PRESS RETURN ******"
22815 GOSUB 60000
22816 IF DT# <1 OR DT#> 2 GOTO 22815
22820 SUMAFOPT(S) = DT#
22840 IF SUMAFOPT(S) = 2 THEN GOTO 23380
22860 FOR T = 1 TO NREC(SFN)
22880 PRINT T;"-";FLDN$(SFN,T)
22900 NEXT T
22910 PRINT "****** NUMBER OF FIELDS YOU WANT ADDED ******"
22920 GOSUB 60000
22922 IF DT# <1 OR DT#> NREC(SFN) GOTO 22920
22930 KTSUMAF(S) = DT#
22940 FOR K = 1 TO KTSUMAF(S)
22960 GOSUB 500
22980 SFN = SFN(S)
23000 PRINT ""
23020 FOR N = 1 TO NREC(SFN)
23040 PRINT "FIELD # ";N;" ";FLDN$(SFN,N)
23060 NEXT N
23080 PRINT ""
23100 PRINT "************** WHAT FIELD DO YOU WANT SUMMED ****************"
23105 GOSUB 60000
23107 IF DT# <1 OR DT#> NREC(SFN) GOTO 23105
23108 IF FTY(SFN,DT#) = 1 GOTO 23105
23110 SAFADD(S,K) = DT#
23120 PRINT "**** WHAT FIELD DO YOU WANT THE SUBTOTALS GROUPED BY ******"
23125 GOSUB 60000
23127 IF DT#< 1 OR DT# >NREC(SFN) GOTO 23125
23128 IF FTY(SFN,DT#) >< 2 GOTO 23125
23130 SAFACCTO(S,K) = DT#
23140 GOSUB 500
23160 PRINT ""
23180 FOR A = 1 TO MAXF
23200 PRINT "FILE # ";A;" ";F$(A)
23220 NEXT A
23240 PRINT ""
23260 PRINT "*********** WHAT FILE DO YOU WANT THE SUM IN *********"
23265 GOSUB 60000
23267 IF DT#< 1 OR DT# >MAXF GOTO 23265
23268 IF HLD > 0 AND DT# >< HLD GOTO 23265
23269 HLD = DT#
23270 SAFFN(S) = DT#
23280 A = SAFFN(S)
23300 GOSUB 23400
23320 PRINT "*********** WHAT FIELD DO YOU WANT THE SUM IN *********"
23325 GOSUB 60000
23327 IF DT#< 1 OR DT# >NREC(A) GOTO 23325
23328 IF FTY(A,DT#) = 1 GOTO 23325
23330 SAFFLDN(S,K) = DT#
23360 NEXT K
23380 RETURN
23400 PRINT "-------------------------------------------------------------------------------"
23420 PRINT "FILE NUMBER : ";A
23440 PRINT "FILE NAME : "; F$(A)
23460 PRINT "NUMBER OF FIELDS : ";NREC(A)
23480 PRINT "RECORD LENGTH : ";L(A)
23500 FOR N = 1 TO NREC(A)
23520 PRINT N ;TAB(5);FLDN$(A,N);
23540 ON FTY(A,N) GOTO 23560,23600,23640,23680,23690
23560 PRINT " STRING WITH MAXIMUM LENGTH ";FL(A,N)
23580 GOTO 23700
23600 PRINT " INTEGER "
23620 GOTO 23700
23640 PRINT " SINGLE PRECISION "
23660 GOTO 23700
23680 PRINT " DOUBLE PRECISION "
23685 GOTO 23700
23690 PRINT " DOLLAR AND CENTS AMOUNT "
23700 REM ***
23720 NEXT N
23740 PRINT "-------------------------------------------------------------------------------"
23760 RETURN
23780 REM ************* READ SUBROUTINE *************
23800 OPEN "I",#1,"FFILE"
23820 INPUT #1,MAXF
23840 FOR A = 1 TO MAXF
23860 INPUT #1,A,F$(A),NREC(A),L(A)
23880 FOR N = 1 TO NREC(A)
23900 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N)
23920 IF FTY(A,N) = 2 THEN INPUT #1,D,D
23940 NEXT N
23960 NEXT A
23980 CLOSE #1
24000 RETURN
24020 REM ************ OPEN FOR OUTPUT **************
24040 OPEN "O",#2,"TFER"
24060 WRITE #2,MAXS
24080 FOR S = 1 TO MAXS
24100 D = 1
24120 WRITE #2,DTOPT(S),SUMOPT(S),SUMAFOPT(S),SN$(S),SFN(S)
24140 IF DTOPT(S) = 2 GOTO 24360
24160 WRITE #2,RNTNBOPT(S),D(S),TFN(S),NREC(TFN)
24180 TFN = TFN(S)
24200 FOR N = 1 TO NREC(TFN)
24220 WRITE #2,FLDTC(S,N,D)
24240 IF FLDTC(S,N,D) = 1 GOTO 24280
24260 WRITE #2,FLDTCT(S,N,D)
24280 NEXT N
24300 IF D = 2 GOTO 24360
24320 IF D(S) = 2 THEN D = 2
24340 IF D(S) = 2 GOTO 24200
24360 IF SUMOPT(S) = 2 GOTO 24460
24380 WRITE #2,KTSUM(S),SUMFN(S)
24400 FOR K = 1 TO KTSUM(S)
24420 WRITE #2,SUMF(S,K),SUMRN(S,K),SUMFLDN(S,K)
24440 NEXT K
24460 IF SUMAFOPT(S) = 2 GOTO 24560
24480 WRITE #2, KTSUMAF(S),SAFFN(S)
24500 FOR K = 1 TO KTSUMAF(S)
24520 WRITE #2,SAFADD(S,K),SAFACCTO(S,K),SAFFLDN(S,K),MAX(S,K)
24540 NEXT K
24560 NEXT S
24580 CLOSE #2
24600 RETURN
24620 REM ************ OPEN FOR INPUT **************
24640 OPEN "I",#2,"TFER"
24660 INPUT #2,MAXS
24680 FOR S = 1 TO MAXS
24700 D = 1
24720 INPUT #2,DTOPT(S),SUMOPT(S),SUMAFOPT(S),SN$(S),SFN(S)
24740 IF DTOPT(S) = 2 GOTO 24960
24760 INPUT #2,RNTNBOPT(S),D(S),TFN(S),DY(S)
24780 TFN = TFN(S)
24800 FOR N = 1 TO DY(S)
24820 INPUT #2,FLDTC(S,N,D)
24840 IF FLDTC(S,N,D) = 1 GOTO 24880
24860 INPUT #2,FLDTCT(S,N,D)
24880 NEXT N
24900 IF D = 2 GOTO 24960
24920 IF D(S) = 2 THEN D = 2
24940 IF D(S) = 2 GOTO 24800
24960 IF SUMOPT(S) = 2 GOTO 25060
24980 INPUT #2,KTSUM(S),SUMFN(S)
25000 FOR K = 1 TO KTSUM(S)
25020 INPUT #2,SUMF(S,K),SUMRN(S,K),SUMFLDN(S,K)
25040 NEXT K
25060 IF SUMAFOPT(S) = 2 GOTO 25160
25080 INPUT #2, KTSUMAF(S),SAFFN(S)
25100 FOR K = 1 TO KTSUMAF(S)
25120 INPUT #2,SAFADD(S,K),SAFACCTO(S,K),SAFFLDN(S,K),MAX(S,K)
25140 NEXT K
25160 NEXT S
25180 CLOSE #2
25200 RETURN
25220 REM ************ PRINT OUT INF0 **************
25240 PRINT "NUMBER OF DIFFERENT TRANSFER: ";MAXS
25260 PRINT "TRANSFER NUMBER: ";S
25280 PRINT "TRANSFER NAME : ";SN$(S)
25300 PRINT "SOURCE FILE NUMBER :";SFN(S);" ";F$(SFN(S))
25320 PRINT "THIS TRANSFER CONTAINS :"
25340 IF DTOPT(S) = 1 THEN PRINT "--DIRECT TRANSFER "
25360 IF DTOPT(S) = 2 THEN PRINT "--NO DIRECT TRANSFER "
25380 IF SUMOPT(S) = 1 THEN PRINT "--SUM FIELDS"
25400 IF SUMOPT(S) = 2 THEN PRINT "--DO NOT SUM FIELDS"
25420 IF SUMAFOPT(S) = 1 THEN PRINT "--SUM ACCORDING TO ANOTHER FIELD "
25440 IF SUMAFOPT(S) = 2 THEN PRINT "--DO NOT SUM ACCORDING TO ANOTHER FIELD "
25460 IF DTOPT(S) = 2 GOTO 25900
25480 SFN = SFN(S)
25500 PRINT "****** DIRECT TRANSFER ******"
25520 PRINT "TARGET RECORD NUMBER ";
25540 IF RNTNBOPT(S) = 0 THEN GOTO 25620
25560 T1 = RNTNBOPT(S)
25580 PRINT "= SOURCE FILE FIELD ";RNTNBOPT(S);"- ";FLDN$(SFN,T1)
25600 GOTO 25640
25620 PRINT "AUTOMATICALLY INCREMENTS "
25640 PRINT "TARGET FILE NUMBER :";TFN(S);" ";F$(TFN(S))
25660 TFN = TFN(S)
25680 FOR N = 1 TO DY(S)
25700 PRINT "FIELD ";N;"-";
25720 IF FLDTC(S,N,1) = 1 THEN PRINT "- NO CHANGE"
25740 IF FLDTC(S,N,1) = 1 GOTO 25880
25760 T1 = FLDTC(S,N,1)-1
25780 IF FLDTC(S,N,1) = 1 GOTO 25880
25800 PRINT "- CHANGED BY SOURCE FIELD ";T1;"- ";FLDN$(SFN,T1);
25820 IF FLDTCT(S,N,1) = 1 THEN PRINT " - ADDED TO "
25840 IF FLDTCT(S,N,1) = 2 THEN PRINT " - REPLACED BY"
25860 IF FLDTCT(S,N,1) = 3 THEN PRINT " - SUBTRACT FROM "
25880 NEXT N
25900 IF SUMOPT(S) = 2 GOTO 26140
25920 PRINT "******* SUM FIELDS *******"
25940 PRINT "NUMBER OF SUMS ";KTSUM(S)
25960 PRINT "ALL SUMS GO TO THIS FILE ";SUMFN(S);" ";F$(SUMFN(S))
25980 TFN = SUMFN(S)
26000 FOR K = 1 TO KTSUM(S)
26020 PRINT "****** SUM NUMBER ";K;" *******"
26040 PRINT " FIELD SUMMED = ";SUMF(S,K);FLDN$(SFN,T1)
26060 PRINT " RECORD WHERE SUM GOES ";SUMRN(S,K)
26080 T1 = SUMFLDN(S,K)
26100 PRINT " FIELD WHERE SUM GOES ";SUMFLDN(S,K);" ";FLDN$(TFN,T1)
26120 NEXT K
26140 IF SUMAFOPT(S) = 2 GOTO 26460
26160 PRINT "******* SUM FIELDS ACCORDING TO ANOTHER FIELD *******"
26180 PRINT "NUMBER OF SUMS BY ANOTHER FIELD ";KTSUMAF(S)
26200 T1 = SAFFN(S)
26220 PRINT "ALL SUMS GO TO THIS FILE ";SAFFN(S);F$(T1)
26240 TFN = SAFFN(S)
26260 FOR K = 1 TO KTSUMAF(S)
26280 PRINT "****** SUMS NUMBER ";K;" *******"
26300 T1 = SAFADD(S,K)
26320 PRINT "SUM THIS FIELD ";SAFADD(S,K);" ";FLDN$(SFN,T1)
26340 T1 = SAFACCTO(S,K)
26360 PRINT "BY THIS FIELD ";SAFACCTO(S,K);" ";FLDN$(SFN,T1)
26380 T1 = SAFFLDN(S,K)
26400 PRINT "SUM GOES TO THIS FIELD ";SAFFLDN(S,K);" ";FLDN$(TFN,T1)
26440 NEXT K
26460 REM ***
26480 RETURN
26500 REM ************ PRINT OUT INF0 **************
26520 LPRINT "NUMBER OF DIFFERENT TRANSFER: ";MAXS
26540 LPRINT "TRANSFER NUMBER: ";S
26560 LPRINT "TRANSFER NAME : ";SN$(S)
26580 LPRINT "SOURCE FILE NUMBER :";SFN(S);" ";F$(SFN(S))
26600 LPRINT "THIS TRANSFER CONTAINS :"
26620 IF DTOPT(S) = 1 THEN LPRINT "--DIRECT TRANSFER "
26640 IF DTOPT(S) = 2 THEN LPRINT "--NO DIRECT TRANSFER "
26660 IF SUMOPT(S) = 1 THEN LPRINT "--SUM FIELDS"
26680 IF SUMOPT(S) = 2 THEN LPRINT "--DO NOT SUM FIELDS"
26700 IF SUMAFOPT(S) = 1 THEN LPRINT "--SUM ACCORDING TO ANOTHER FIELD "
26720 IF SUMAFOPT(S) = 2 THEN LPRINT "--DO NOT SUM ACCORDING TO ANOTHER FIELD "
26740 IF DTOPT(S) = 2 GOTO 27180
26760 SFN = SFN(S)
26780 LPRINT "****** DIRECT TRANSFER ******"
26800 LPRINT "TARGET RECORD NUMBER ";
26820 IF RNTNBOPT(S) = 0 THEN GOTO 26900
26840 T1 = RNTNBOPT(S)
26860 LPRINT "= SOURCE FILE FIELD ";RNTNBOPT(S);"- ";FLDN$(SFN,T1)
26880 GOTO 26920
26900 LPRINT "AUTOMATICALLY INCREMENTS "
26920 LPRINT "TARGET FILE NUMBER :";TFN(S);" ";F$(TFN(S))
26940 TFN = TFN(S)
26960 FOR N = 1 TO DY(S)
26980 LPRINT "FIELD ";N;"-";
27000 IF FLDTC(S,N,1) = 1 THEN LPRINT "- NO CHANGE"
27020 IF FLDTC(S,N,1) = 1 GOTO 27160
27040 T1 = FLDTC(S,N,1)-1
27060 IF FLDTC(S,N,1) = 1 GOTO 27160
27080 LPRINT "- CHANGED BY SOURCE FIELD ";T1;"- ";FLDN$(SFN,T1);
27100 IF FLDTCT(S,N,1) = 1 THEN LPRINT " - ADDED TO "
27120 IF FLDTCT(S,N,1) = 2 THEN LPRINT " - REPLACED BY"
27140 IF FLDTCT(S,N,1) = 3 THEN LPRINT " - SUBTRACT FROM "
27160 NEXT N
27180 IF SUMOPT(S) = 2 GOTO 27420
27200 LPRINT "******* SUM FIELDS *******"
27220 LPRINT "NUMBER OF SUMS ";KTSUM(S)
27240 LPRINT "ALL SUMS GO TO THIS FILE ";SUMFN(S);" ";F$(SUMFN(S))
27260 TFN = SUMFN(S)
27280 FOR K = 1 TO KTSUM(S)
27300 LPRINT "****** SUM NUMBER ";K;" *******"
27320 LPRINT " FIELD SUMMED = ";SUMF(S,K);FLDN$(SFN,T1)
27340 LPRINT " RECORD WHERE SUM GOES ";SUMRN(S,K)
27360 T1 = SUMFLDN(S,K)
27380 LPRINT " FIELD WHERE SUM GOES ";SUMFLDN(S,K);" ";FLDN$(TFN,T1)
27400 NEXT K
27420 IF SUMAFOPT(S) = 2 GOTO 27740
27440 LPRINT "******* SUM FIELDS ACCORDING TO ANOTHER FIELD *******"
27460 LPRINT "NUMBER OF SUMS BY ANOTHER FIELD ";KTSUMAF(S)
27480 T1 = SAFFN(S)
27500 LPRINT "ALL SUMS GO TO THIS FILE ";SAFFN(S);F$(T1)
27520 TFN = SAFFN(S)
27540 FOR K = 1 TO KTSUMAF(S)
27560 LPRINT "****** SUMS NUMBER ";K;" *******"
27580 T1 = SAFADD(S,K)
27600 LPRINT "SUM THIS FIELD ";SAFADD(S,K);" ";FLDN$(SFN,T1)
27620 T1 = SAFACCTO(S,K)
27640 LPRINT "BY THIS FIELD ";SAFACCTO(S,K);" ";FLDN$(SFN,T1)
27660 T1 = SAFFLDN(S,K)
27680 LPRINT "SUM GOES TO THIS FIELD ";SAFFLDN(S,K);" ";FLDN$(TFN,T1)
27720 NEXT K
27740 REM ***
27760 RETURN
50000 REM ********** INTRO
50010 GOSUB 500
50100 PRINT " T R A N S F E R D E S C R I P T I O 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 :"
50165 PRINT " See the manual for more information on the license."
50167 PRINT ""
50920 GOSUB 23780
50950 PRINT "****************** PRESS ANY KEY TO CONTINUE *******************";
50960 IF INKEY$ = "" GOTO 50960
50970 RETURN
51000 REM ***** EXIT TO SYSTEM
51100 GOSUB 500
51110 CLOSE
51120 PRINT " -BYE, Have a nice day"
51130 END
52000 REM ***** INTRO 1
52010 GOSUB 500
52100 PRINT " Put the DATA DISK in the default disk drive "
52110 PRINT ""
52120 PRINT " ***** THEN PRESS ANY KEY TO CONTINUE *****"
52130 PRINT ""
52140 PRINT " The CUSTOM programS only use the PROGRAM DATA DISK"
52150 PRINT "Keep it in the default disk drive at all times during this program."
52200 IF INKEY$ = "" GOTO 52200
52210 RETURN
60000 REM ******* INTEGER LESS THEN 100 CHECK ********
60010 MAX = 2
60020 ACT$ = "1234567890=<>^"
60030 IF NE = 0 THEN ACT$ = "1234567890"
60040 PRINT ">__<";
60050 GOTO 60240
60060 REM ******* INTEGER *******
60070 MAX = 8
60080 ACT$ = "1234567890-+,=<>^"
60090 IF NE = 0 THEN ACT$ = "1234567890-+,"
60100 PRINT ">________<";
60110 GOTO 60240
60120 REM ******* SINGLE PRECISION *******
60130 MAX = 10
60140 ACT$ = "1234567890-+,.%$=<>^"
60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60160 PRINT ">__________<";
60170 GOTO 60240
60180 REM ******* DOUBLE PRECISION *******
60190 MAX = 20
60200 ACT$ = "1234567890-+,.%$=<>^"
60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60220 PRINT ">____________________<";
60230 GOTO 60240
60240 REM ********** NUMBER CHECK **********
60250 A$ = ""
60260 K$(20) = " "
60270 KTMAX = 0
60280 FOR T9 = 1 TO MAX
60290 K$(T9) = " "
60300 NEXT T9
60310 DIG$ = "1234567890."
60320 DOTFLG = 0
60330 T2 = MAX + 1
60340 FOR T6 = 1 TO T2
60350 PRINT CHR$(CH);
60360 NEXT T6
60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370
60380 KT = 0
60390 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
60400 KT = KT + 1
60410 REM
60420 W$ = INKEY$
60430 IF W$ = "" GOTO 60420
60440 C = ASC(W$)
60450 IF C = 0 THEN GOSUB 61900
60460 IF C = 13 GOTO 60580
60470 IF C = 17 OR C = 8 GOTO 61150
60480 IF C = 19 GOTO 60670
60490 IF C = 4 GOTO 60720
60500 IF C = 6 GOTO 60780
60510 IF C = 1 GOTO 60960
60520 IF KT > MAX GOTO 60410
60530 IF INSTR(ACT$,W$) = 0 GOTO 61230
60540 K$(KT) = W$
60550 PRINT K$(KT);
60560 IF KT > KTMAX THEN KTMAX = KT
60570 GOTO 60400
60580 REM ********** RETURN **********
60590 FOR T9 = 1 TO KTMAX
60600 A$ = A$ + K$(T9)
60610 NEXT T9
60620 IF KTMAX = 0 THEN PRINT "1"
60630 IF KTMAX = 0 THEN DT# = 1
60640 IF KTMAX = 0 THEN RETURN
60650 PRINT ""
60660 GOTO 61260
60670 REM ********* MOVE CURSE BACK ********
60680 IF KT = 1 GOTO 60410
60690 KT = KT - 1
60700 PRINT CHR$(CH);
60710 GOTO 60410
60720 REM ********* MOVE CURSER FORWARD *********
60730 IF KT >= MAX GOTO 60410
60740 IF KT > (KTMAX + 1) GOTO 60410
60750 PRINT K$(KT);
60760 KT = KT + 1
60770 GOTO 60410
60780 REM ********** INSERT ***********
60790 IF KT > KTMAX GOTO 60410
60800 X9 = MAX
60810 WHILE X9 > KT
60820 X9 = X9 - 1
60830 K$(X9 + 1) = K$(X9)
60840 WEND
60850 K$(KT) = " "
60860 KTMAX = KTMAX + 1
60870 IF KTMAX > MAX THEN KTMAX = MAX
60880 FOR T9 = KT TO KTMAX
60890 PRINT K$(T9);
60900 NEXT T9
60910 T6 = (KTMAX - KT) + 1
60920 FOR T7 = 1 TO T6
60930 PRINT CHR$(CH);
60940 NEXT T7
60950 GOTO 60410
60960 REM ********** DELETE ***********
60970 IF KT > KTMAX GOTO 60410
60980 IF KTMAX = 1 GOTO 60410
60990 K$(MAX + 1) = ""
61000 X9 = KT
61010 WHILE X9 <= MAX
61020 K$(X9) = K$(X9 + 1)
61030 X9 = X9 + 1
61040 WEND
61050 KTMAX = KTMAX - 1
61060 FOR T9 = KT TO KTMAX
61070 PRINT K$(T9);
61080 NEXT T9
61090 PRINT "_";
61100 T7 = (KTMAX - KT) + 2
61110 FOR T8 = 1 TO T7
61120 PRINT CHR$(CH);
61130 NEXT T8
61140 GOTO 60410
61150 REM ********* BACKSPACE ********
61160 IF KT = 1 GOTO 60410
61170 KT = KT - 1
61180 PRINT CHR$(CH);
61190 K$(KT) = " "
61200 PRINT "_";
61210 PRINT CHR$(CH);
61220 GOTO 60410
61230 REM ******* INPUT NOT ACCEPTABLE ********
61240 PRINT CHR$(7);
61250 GOTO 60420
61260 REM ********* CLEAR STRINGS ********
61270 MAX = LEN(A$)
61280 D2$ = ""
61290 D1$ = ""
61300 DFLG = 0
61310 FOR Q93 = 1 TO MAX
61320 R$ = MID$(A$,Q93,1)
61330 IF INSTR(DIG$,R$) = 0 GOTO 61400
61340 IF R$ = "." OR DFLG = 1 GOTO 61380
61350 IF DFLG = 1 GOTO 61380
61360 D2$ = D2$ + R$
61370 GOTO 61400
61380 D1$ = D1$ + R$
61390 DFLG = 1
61400 NEXT Q93
61410 DA# = VAL(D2$)
61420 D1# = VAL(D1$)
61430 DT# = DA# + D1#
61440 IF K$(1) = "-" THEN DT# = -DT#
61450 RETURN
61900 REM ****** CHECK FOR ASC0
61910 S4$ = INKEY$
61920 C2 = ASC(S4$)
61930 IF C2 = 83 THEN C = 1
61940 IF C2 = 82 THEN C = 6
61950 IF C2 = 75 THEN C = 19
61960 IF C2 = 77 THEN C = 4
61970 RETURN
62000 REM ********** ALPHANUMERIC CHECK **************
62010 MAX = FL(A,Q)
62020 GOTO 62040
62030 REM ******** MAX SET IN PROGRAM ********
62040 A$ = ""
62050 PRINT ">";
62060 FOR N9 = 1 TO MAX
62070 K$(N9) = ""
62080 PRINT "_";
62090 NEXT N9
62100 PRINT "<";
62110 T2 = MAX + 1
62120 FOR T4 = 1 TO T2
62130 PRINT CHR$(CH);
62140 NEXT T4
62150 KT = 0
62160 KTMAX = 1
62170 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
62180 KT = KT + 1
62190 PRINT TAB(KT+1)"";
62200 K$ = INKEY$
62210 IF K$ = "" GOTO 62200
62220 C = ASC(K$)
62230 IF C = 0 THEN GOSUB 61900
62240 IF C = 13 GOTO 62350
62250 IF C = 17 OR C = 8 GOTO 62920
62260 IF C = 19 GOTO 62450
62270 IF C = 4 GOTO 62500
62280 IF C = 6 GOTO 62560
62290 IF C = 1 GOTO 62730
62300 IF KT > MAX GOTO 62190
62310 K$(KT) = K$
62320 PRINT K$(KT);
62330 IF KT > KTMAX THEN KTMAX = KT
62340 GOTO 62180
62350 REM ********** RETURN **********
62360 FOR T9 = 1 TO MAX
62370 A$ = A$ + K$(T9)
62420 NEXT T9
62430 PRINT ""
62440 RETURN
62450 REM ********* MOVE CURSE BACK ********
62460 IF KT = 1 GOTO 62190
62470 KT = KT - 1
62480 PRINT CHR$(CH);
62490 GOTO 62190
62500 REM ********* MOVE CURSER FORWARD *********
62510 IF KT >= MAX GOTO 62190
62520 IF KT > KTMAX GOTO 62190
62530 PRINT K$(KT);
62540 KT = KT + 1
62550 GOTO 62190
62560 REM ********** INSERT ***********
62570 X9 = MAX
62580 WHILE X9 > KT
62590 X9 = X9 - 1
62600 K$(X9 + 1) = K$(X9)
62610 WEND
62620 K$(KT) = " "
62630 KTMAX = KTMAX + 1
62640 IF KTMAX > MAX THEN KTMAX = MAX
62650 FOR T9 = KT TO KTMAX
62660 PRINT K$(T9);
62670 NEXT T9
62680 T6 = (KTMAX - KT) +1
62690 FOR T7 = 1 TO T6
62700 PRINT CHR$(CH);
62710 NEXT T7
62720 GOTO 62190
62730 REM ********** DELETE ***********
62740 IF KT > KTMAX GOTO 62200
62750 IF KTMAX = 1 GOTO 62190
62760 K$(MAX + 1) = ""
62770 X9 = KT
62780 WHILE X9 <= KTMAX
62790 K$(X9) = K$(X9 + 1)
62800 X9 = X9 + 1
62810 WEND
62820 KTMAX = KTMAX - 1
62830 FOR T9 = KT TO KTMAX
62840 PRINT K$(T9);
62850 NEXT T9
62860 PRINT "_";
62870 T7 = (KTMAX - KT) + 2
62880 FOR T6 = 1 TO T7
62890 PRINT CHR$(CH);
62900 NEXT T6
62910 GOTO 62190
62920 REM ********* BACKSPACE ********
62930 IF KT = 1 GOTO 62190
62940 K$(KT) = " "
62950 KT = KT - 1
62960 K$(KT) = " "
62970 PRINT CHR$(CH);
62980 PRINT "_";
62990 PRINT CHR$(CH);
63000 GOTO 62190
FORM.BAS
3 DEFDBL X
4 DEFINT A-W,Y-Z
5 DIM F$(15),FLDN$(15,30),FTY(15,30),FL(15,30)
10 DIM X$(30),Y$(30)
13 DIM L(15),NREC(15),Z$(30)
14 DIM X(30),CK$(30),SN$(30),SFN(30),DTOPT(10)
16 DIM KY(15,30),KEYLIST(15,30),L$(10,100),LEND(30),CL(30)
18 DIM SU%(40),S!(30),FORM$(30)
19 DIM EN(80),CE(80,10),TE(80,10),Q$(80,10)
20 DIM XL(40)
21 DIM TX(6,20)
25 DIM S#(30)
35 DIM K$(80)
40 DIM EFN(10,80),MAXK(30)
61 CH = 29: PRINT FRE(0)
70 NE = 0
75 GOSUB 50000
80 GOSUB 10000
90 GOTO 30000
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 ""
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#
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 SUBROUTINE *******
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 *******
2582 PRINT C,F$(C),L(C)
2584 OPEN "R",#2,F$(C),L(C)
2586 D = 0
2588 FOR T = 1 TO NREC(C)
2590 FIELD #2,D AS DY$,FL(C,T) AS Z$(T)
2592 D = D + FL(C,T)
2594 NEXT T
2596 RETURN
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(B)/L(B)
7970 RETURN
10000 REM ************* READ SUBROUTINE *************
10004 GOSUB 10900
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,KY(A,N),KEYLIST(A,N)
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
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
11940 RETURN
13000 REM ********* CLEAR SCREEN
13010 CLS
13020 RETURN
13100 REM ********* LOCATE
13110 LOCATE LI,1
13120 RETURN
13200 FOR T% = 1 TO 80
13210 PRINT CHR$(8);
13220 NEXT T%
13222 FOR T% = 1 TO 24
13223 PRINT CHR$(11);
13224 NEXT T%
13225 LI = LI - 1
13230 FOR T% = 1 TO LI
13240 PRINT CHR$(0)
13250 NEXT T%
13590 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 *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
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)
14680 NEXT T9
14681 IF KTMAX = 0 THEN PRINT "1"
14682 IF KTMAX = 0 THEN DT# = 1
14683 IF KTMAX = 0 THEN RETURN
14684 PRINT ""
14685 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
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" THEN GOTO 30000
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 3 = 0 THEN PRINT ""
16235 IF T MOD 3 = 0 THEN T2 = -25
16237 T2 = T2 + 26
16340 NEXT T
16350 RETURN
26100 EFLG = 1
26200 PRINT "********** END OF FILE ***********"
26202 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
26204 IF INKEY$ = "" GOTO 26204
26500 REM ********* ON ERROR SUBROUTINE ***********
26600 PRINT "********** END OF FILE ***********"
26610 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
26620 IF INKEY$ = "" GOTO 26620
26635 EFLG = 1
26640 RETURN
26800 REM ********** ON ERROR GOTO **************
26900 PRINT "************ RECORD NOT FOUND *************"
30000 REM ********** FORM OUTPUT ***********
30003 CLOSE
30005 IF KD <> 5 THEN GOSUB 11000
30010 GOSUB 30300
30100 GOSUB 13000
30110 PRINT "************ PRINT A CUSTOM FORM *************"
30120 PRINT ""
30130 PRINT "****** ENTER ZERO TO EXIT THE PROGRAM *******"
30140 GOSUB 30380
30150 PRINT "******* WHAT FORM DO YOU WANT TO PRINT ? ******"
30155 GOSUB 14000
30156 IF DT# <0 OR DT# >MAXFORM GOTO 30155
30160 T = DT#
30165 IF DT# = 0 GOTO 51000
30170 N$ = FORM$(T)
30175 CLOSE
30180 GOTO 30900
30300 REM ********* INPUT LIST OF FORMS FROM DISK *********
30305 GOSUB 10900
30310 OPEN "I",#1,"FORMLIST"
30320 INPUT #1,MAXFORM
30330 FOR T = 1 TO MAXFORM
30340 INPUT #1,FORM$(T)
30350 NEXT T
30360 CLOSE #1
30370 RETURN
30380 REM ******* PRINT FORM LIST *******
30390 FOR T = 1 TO MAXFORM
30400 PRINT T;"-";FORM$(T)
30410 NEXT T
30420 RETURN
30900 REM *****
31000 REM ********** READ DATA ON FILE ***********
31005 OPEN "I",#1,N$
31010 INPUT #1,LN,MF,SFO
31015 IF SFO = 1 THEN INPUT #1,TMF,TSF,SF
31020 FOR T1 = 1 TO LN
31025 INPUT #1,EN(T1)
31030 FOR T2 = 1 TO EN(T1)
31035 INPUT #1,CE(T1,T2),TE(T1,T2)
31040 ON TE(T1,T2) GOTO 31045,31055,31065,31075,31075
31045 INPUT #1,Q$(T1,T2)
31050 GOTO 31075
31055 INPUT #1,EFN(T1,T2)
31060 GOTO 31075
31065 INPUT #1,EFN(T1,T2)
31070 GOTO 31075
31075 NEXT T2
31080 NEXT T1
31085 CLOSE
31160 GOSUB 13000
31161 A = MF
31162 PRINT "MAIN FILE = ";F$(A)
31164 GOSUB 2300
31166 GOSUB 2500
31170 GOSUB 13000
31171 GOTO 31300
31300 REM ****** END ON ERROR ROUTINE ******
31310 GOSUB 13000
31320 PRINT " CUSTOM FORM ";N$
31330 PRINT " MAIN FILE ";F$(MF)
31350 PRINT ""
31360 PRINT "***** WHAT RECORD DO YOU WANT TO START AT *****"
31362 GOSUB 14100
31364 RNS = DT#
31365 A = MF
31366 GOSUB 7800
31367 IF DT# <1 OR DT# >10000 GOTO 31362
31368 PRINT "THE HIGHEST RECORD NUMBER IS ";MRN
31370 PRINT "****** WHAT RECORD DO YOU WANT TO STOP AT ******"
31372 GOSUB 14100
31373 IF DT# <RNS OR DT# >MRN GOTO 31372
31374 RNF = DT#
31380 IF RNF > MRN GOTO 31370
31400 REM ******** START FORM LOOP ********
31410 FOR T = RNS TO RNF
31415 GET #1,T
31420 GOSUB 32000
31430 IF INKEY$ = "" GOTO 31450
31440 GOSUB 31500
31450 NEXT T
31460 GOTO 30100
31500 REM ********** PAUSE ROUTINE ************
31510 PRINT "************* PAUSE ROUTINE **************"
31520 PRINT " 1 - CONTINUE PRINTING FORMS "
31530 PRINT " 2 - DONE BACK TO INITIAL MENU "
31540 PRINT "*** ENTER THE NUMBER THEN PRESS RETURN ***"
31550 GOSUB 14000
31552 IF DT# <1 OR DT# >2 GOTO 31550
31560 IF DT# = 1 THEN RETURN
31570 CLOSE
31580 GOTO 30000
32000 REM *********** PRINT FORM *********************
32100 FOR L = 1 TO LN
32110 GOSUB 32200
32115 LPRINT ""
32120 NEXT L
32130 RETURN
32200 FOR E = 1 TO EN(L)
32210 GOSUB 32300
32220 Z$ = INKEY$
32225 IF Z$ = "" GOTO 32230
32227 GOSUB 31500
32230 NEXT E
32240 RETURN
32300 REM ********
32310 C = CE(L,E)
32320 ON TE(L,E) GOTO 32400,32600,32800,33500,33200
32400 REM ****** STRING CONSTANT ******
32410 LPRINT TAB(C) Q$(L,E);
32420 GOTO 33500
32600 REM ****** GET FROM MAIN FILE ******
32610 F = EFN(L,E)
32620 ON FTY(MF,F) GOTO 32630,32660,32700,32750,32790
32630 REM ***** String *****
32635 LPRINT TAB(C) X$(F);
32640 GOTO 33500
32660 REM ***** INTEGER ******
32665 I% = CVI(X$(F))
32670 LPRINT TAB(C) I%;
32675 GOTO 33500
32700 REM ***** SINGLE PRECISION *****
32710 I! = CVS(X$(F))
32720 LPRINT TAB(C) I!;
32730 GOTO 33500
32750 REM ***** DOUBLE PRECISION ******
32760 I# = CVD(X$(F))
32770 LPRINT TAB(C) I#;
32780 GOTO 33500
32790 REM ***** DOLLARS AND CENTS ******
32792 I# = CVD(X$(F))
32793 LPRINT TAB(C) ;
32794 LPRINT USING "**$########,.##";I#;
32796 GOTO 33500
32800 REM ****** GET FROM SECONDARY FILE ******
32810 F = EFN(L,E)
32830 I% = CVI(X$(F))
32832 T1 = KEYLIST(MF,F)
32835 W$ = L$(T1,I%)
32840 LPRINT TAB(C) W$;
33200 REM ****** BLANK LINE ******
33500 RETURN
50000 REM ********** INTRO
50010 GOSUB 13000
50100 PRINT " P R I N T F O R M P R O G R A M 3.0 "
50105 PRINT ""
50110 PRINT " Copyright 1984 by Potomac Pacific Engineering Inc."
50120 PRINT ""
50130 PRINT "This program is licensed FREE to all users with some restrictions "
50165 PRINT " See the manual for more information on the license."
50167 PRINT ""
50950 PRINT "****************** PRESS ANY KEY TO CONTINUE ******************";
50960 IF INKEY$ = "" GOTO 50960
50970 RETURN
51000 REM ******** EXIT
51100 GOSUB 13000
51200 PRINT "BYE - Have a nice day "
51300 END
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
SCAN.BAS
3 DEFDBL X
4 DEFINT A-W,Y-Z
5 DIM F$(15),FLDN$(15,30),FTY(15,30),FL(15,30)
10 DIM X$(30),Y$(30)
13 DIM L(15),NREC(15),Z$(30),EGL(30),KT(30),I#(30,10),I$(30,10),ORN(30)
14 DIM X(30),CK$(30),SN$(30),SFN(30)
16 DIM KY(15,30),KEYLIST(15,30),L$(10,100),LEND(30),CL(30)
17 DIM ORNFLG(30),FTA(30),ATF(30),BTF(30),IMAX(30)
18 DIM SU%(40),S!(30),SUM#(40)
20 DIM XL(40)
22 DIM ORFLG(30),D(30),TFN(30),KTSUM(30),SUMFN(30)
25 DIM S#(30)
26 DIM MAX(10),Z%(30),SU#(30),D#(30),EFN(10,30)
35 DIM K$(80)
42 DIM MAXK(30),SUMRN(5,5),SUMFLDN(10,5),MAXSAF(9)
60 DIM SAF#(3,200)
61 CH = 29: PRINT FRE(0)
70 NE = 0
75 GOSUB 50000
80 GOSUB 10000
90 GOSUB 11000
400 GOSUB 13000
402 IF KD < 5 THEN GOSUB 11000
404 GOSUB 13000
410 PRINT "****** SELECTIVE SCAN PROGRAM -- WHAT FILE DO YOU WANT: *****"
420 PRINT ""
425 PRINT " 0 - *** EXIT PROGRAM ***"
430 FOR I = 1 TO MAXF
440 PRINT I;" - ";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
500 GOTO 6000
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 ""
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#
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 SUBROUTINE *******
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 *******
2582 PRINT C,F$(C),L(C)
2584 OPEN "R",#2,F$(C),L(C)
2586 D = 0
2588 FOR T = 1 TO NREC(C)
2590 FIELD #2,D AS DY$,FL(C,T) AS Z$(T)
2592 D = D + FL(C,T)
2594 NEXT T
2596 RETURN
3010 GOTO 400
6000 REM ********** LOOP THROUGH FIELDS ************
6001 EFLG = 0:GOSUB 10700
6002 GOSUB 10200
6003 FOR Q = 1 TO NREC(A)
6006 GOSUB 6045
6009 NEXT Q
6010 REM ********* ADD OPTIONS *******
6011 GOSUB 6603
6012 REM ********** GET STARTING RECORD **********
6015 GOSUB 6375
6018 REM ********** GET RECORDS ***********
6021 RN = RN - 1
6024 RN = RN + 1
6027 GOSUB 6090
6029 IF MATCH = 0 THEN PRINT "RECORD NUMBER ";RN ;" CONDITIONS NOT MET"
6030 IF MATCH = 0 GOTO 6024
6033 IF ADOPT > 1 THEN GOSUB 6759
6036 REM ******** PRINT ON PAPER ********
6039 IF PRTOPT <> 1 THEN GOSUB 12000
6040 IF PRTOPT = 1 THEN GOSUB 12200
6042 GOTO 6024
6045 REM *********** LOOP THROUGH FIELDS ************
6048 GOSUB 6129
6050 IF EGL(Q) = 1 THEN RETURN
6051 IF FTY(A,Q) = 1 THEN GOTO 6069
6057 REM ****** NUMBERS ********
6060 ON EGL(Q) GOSUB 6045,6201,6234,6234,6201
6063 GOTO 6075
6066 REM ****** STRINGS *******
6069 ON EGL(Q) GOSUB 6366,6246,6279,6279,6246
6072 REM ********** OR ROUTINE ******
6075 GOSUB 6288
6078 IF DT# = 2 THEN GOSUB 6324
6087 RETURN
6090 REM ************** GET RECORDS *****************
6093 GOSUB 6396
6096 FOR Q = 1 TO NREC(A)
6099 REM *********** CONVERT STRINGS TO DECIMALS *********
6102 GOSUB 6435
6105 IF TEST = 1 THEN GOTO 6123
6108 IF TEST = 0 THEN GOSUB 6561
6111 REM ******* OR CHECK RESULTS *********
6114 IF TEST = 1 THEN GOTO 6123
6117 MATCH = 0
6120 RETURN
6123 NEXT Q
6124 MATCH = 1
6126 RETURN
6129 GOSUB 13000
6138 PRINT "FIELD NUMBER: ";Q;"FIELD NAME: ";FLDN$(A,Q)
6141 K = 0
6147 PRINT "****************** CHOSE A RELATIONSHIP *******************"
6153 PRINT " 0 - RETURN TO FILE OPTIONS "
6156 PRINT " 1 - ANY VALUE IS ACCEPTABLE"
6159 PRINT " 2 - ";FLDN$(A,Q);" EQUAL TO X"
6162 PRINT " 3 - ";FLDN$(A,Q);" GREATER THEN X"
6165 PRINT " 4 - ";FLDN$(A,Q);" LESS THEN X"
6166 PRINT " 5 - ";FLDN$(A,Q);" BETWEEN X AND Y"
6171 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ***********"
6177 REM ******* EGL MEANS EQUAL GREATER OR LESS THEN *****
6180 GOSUB 14000
6181 IF DT# < 0 OR DT#>5 GOTO 6180
6183 EGL(Q) = DT#
6189 IF EGL(Q) = 0 GOTO 3010
6192 RETURN
6195 IF FTY(A,Q)=1 THEN GOTO 6243
6198 ON EGL(Q) GOTO 6366,6201,6234,6234,6201
6201 PRINT "********** ENTER THE VALUE OF X THEN PRESS RETURN **********"
6204 K = K + 1
6207 KT(Q)=K
6209 GOSUB 14300
6210 I#(Q,K) = DT#
6211 IF EGL(Q) = 5 AND K = 2 THEN RETURN
6212 IF EGL(Q) = 5 THEN PRINT "********** ENTER THE VALUE OF Y THEN PRESS RETURN **********"
6213 IF EGL(Q) = 5 GOTO 6204
6215 PRINT "*************** MUTIPLE VALUES OF X ? *****************"
6216 PRINT " 1 - MORE VALUES OF X "
6219 PRINT " 2 - NO MORE VALUES OF X "
6222 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN **********"
6225 GOSUB 14000
6226 IF DT# <1 OR DT# > 2 GOTO 6225
6228 IF DT# = 1 GOTO 6201
6231 RETURN
6234 PRINT "******* ENTER THE VALUE OF X THEN PRESS RETURN ********"
6235 GOSUB 14300
6237 I#(Q,1) = DT#
6240 RETURN
6243 ON EGL(Q) GOTO 6366,6246,6279,6279
6246 PRINT "******* ENTER THE VALUE OF X THEN PRESS RETURN *******"
6249 K = K + 1
6252 KT(Q)=K
6253 MAX = 30
6254 GOSUB 15030
6255 I$(Q,K) = A$
6256 IF EGL(Q) = 5 AND K = 2 THEN RETURN
6257 IF EGL(Q) = 5 THEN PRINT "******* ENTER THE VALUE OF Y THEN PRESS RETURN *******"
6258 IF EGL(Q) = 5 THEN GOTO 6249
6260 PRINT "*************** MUTIPLE VALUES OF X ? *****************"
6261 PRINT " 1 - MORE VALUES OF X "
6264 PRINT " 2 - NO MORE VALUES OF X "
6267 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN **********"
6270 GOSUB 14000
6271 IF DT# <1 OR DT# >2 GOTO 6270
6273 IF DT# = 1 GOTO 6246
6276 RETURN
6279 PRINT "******* ENTER THE VALUE OF X THEN PRESS RETURN *******"
6280 MAX = 30
6281 GOSUB 15030
6282 I$(Q,1) = A$
6285 RETURN
6288 REM ************** OR / AND ROUTINE **************
6290 IF Q = NREC(A) THEN RETURN
6291 PRINT ""
6294 PRINT "***** DO YOU WANT THIS CONDITON ORed WITH ANOTHER CONDITION ****"
6297 PRINT " 1 - NO, THIS CONDITION MUST BE MEET "
6300 PRINT " 2 - YES, CHECK ANOTHER FIELD TO SEE IF IT MEETS IT'S CONDITION"
6303 PRINT " - Use only on the lower number field of the 2 you want to or"
6306 PRINT "************* ENTER THE NUMBER THEN PRESS RETURN ***************"
6309 GOSUB 14000
6310 IF DT# <1 OR DT# >2 GOTO 6309
6315 ORN(Q) = 0
6318 RETURN
6321 IF A$ ="1" GOTO 6366
6324 GOSUB 13000
6327 PRINT "-------------------- OR OPTION --------------------------"
6333 PRINT "************** WHAT FIELD DO YOU WANT ? ******************"
6336 PRINT "FIELD NUMBER: ";Q;"FIELD NAME: ";FLDN$(A,Q)
6339 PRINT "******************** ORed WITH ***************************"
6345 FOR N = (Q+1) TO NREC(A)
6348 PRINT "FIELD NUMBER: ";N;"FIELD NAME: ";FLDN$(A,N)
6351 NEXT N
6357 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ***********"
6360 GOSUB 14000
6361 IF DT# <(Q+1) OR DT# > NREC(A) GOTO 6360
6363 ORN(Q) = DT#
6366 RETURN
6369 GOSUB 6603
6372 F4 = 23
6375 GOSUB 13000
6378 PRINT "******** WHAT RECORD DO YOU WANT TO START AT *********"
6381 PRINT ""
6384 PRINT "******** ENTER THE NUMBER THEN PRESS RETURN *********"
6387 GOSUB 14100
6388 IF DT# <1 OR DT# > 10000 GOTO 6387
6390 RN = DT#
6393 RETURN
6396 REM GET RECORD
6399 IF INKEY$ <> "" THEN GOSUB 6576
6402 IF RN > MRN THEN GOSUB 26500
6403 IF EFLG = 1 GOTO 6810
6405 GET #1,RN
6417 FOR J = 1 TO NREC(A)
6420 ORFLG(J) = 0
6423 NEXT J
6426 RETURN
6429 Q = Q + 1
6432 REM
6435 ON FTY(A,Q) GOTO 6507,6441,6453,6465,6465
6438 REM ************** CONVERT STRINGS TO DECIMALS ****************
6441 I%=CVI(X$(Q))
6444 I# = I%
6447 S#(Q) = I#
6450 GOTO 6471
6453 I!=CVS(X$(Q))
6456 I# = I!
6459 S#(Q) = I#
6462 GOTO 6471
6465 I#=CVD(X$(Q))
6468 S#(Q) = I#
6471 IF ORFLG(Q) = 1 GOTO 6546
6474 REM ************** CHECK NUMBERS FOR RELATIONS ***************
6477 ON EGL(Q) GOTO 6546,6480,6492,6498,6502
6480 FOR K = 1 TO KT(Q)
6483 IF I#=I#(Q,K) GOTO 6546
6486 NEXT K
6489 GOTO 6561
6492 IF I#>I#(Q,1) GOTO 6546
6495 GOTO 6561
6498 IF I# < I#(Q,1) GOTO 6546
6501 GOTO 6561
6502 IF I# > I#(Q,1) AND I# < I#(Q,2) GOTO 6546
6503 GOTO 6561
6504 REM **************CHECK STRINGS FOR RELATIONS **************
6507 ON EGL(Q) GOTO 6546,6510,6534,6540,6544
6510 FOR K = 1 TO KT(Q)
6513 Y$ = I$(Q,K)
6516 Y = LEN(Y$)
6519 X$ = X$(Q)
6522 X$ = LEFT$(X$,Y)
6525 IF X$=I$(Q,K) GOTO 6546
6528 NEXT K
6531 GOTO 6561
6534 IF X$(Q) > I$(Q,1) GOTO 6546
6537 GOTO 6561
6540 IF X$(Q) < I$(Q,1) GOTO 6546
6543 GOTO 6561
6544 IF X$(Q) > I$(Q,1) AND X$(Q) < I$(Q,2) GOTO 6546
6545 GOTO 6561
6546 P = ORN(Q)
6549 IF P = 0 GOTO 6555
6552 ORFLG(P) = 1
6555 TEST = 1
6558 RETURN
6561 TEST = 0
6567 IF ORN(Q) <> O THEN TEST = 1 ELSE TEST = 2
6573 RETURN
6576 REM ******** PAUSE SUBROUTINE ********
6579 PRINT "****************** PAUSE SUBROUTINE **********************"
6582 PRINT " 1 - CONTINUE SCANNING"
6585 PRINT " 0 - STOP SCANNING "
6588 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ***********"
6591 GOSUB 14000
6593 IF DT# <0 OR DT# >1 GOTO 6588
6597 IF DT# = 0 THEN GOTO 6810
6600 RETURN
6603 REM ******* ADD OPTIONS FOR THE SELECTIVE SCAN ROUTINE *******
6606 GOSUB 13000
6609 PRINT "******************** ADD OPTIONS ***********************"
6612 PRINT ""
6615 PRINT " 1 - DO NOT ADD"
6618 PRINT " 2 - ADD FIELDS"
6621 PRINT " 3 - ADD FIELDS WITH SUBTOTALS BY ANOTHER FIELD "
6624 PRINT " 4 - BOTH 2 & 3"
6627 PRINT ""
6630 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN ***********"
6633 GOSUB 14000
6634 IF DT# <1 OR DT# >4 GOTO 6633
6636 ADOPT = DT#
6637 IF ADOPT > 1 THEN GOSUB 10600
6639 ON ADOPT GOTO 6756,6642,6696,6642
6642 GOSUB 13000
6645 PRINT "********** HOW MANY FIELDS DO YOU WANT TO ADD **********"
6648 PRINT ""
6651 FOR T = 1 TO NREC(A)
6654 PRINT T;" - ";FLDN$(A,T)
6657 NEXT T
6660 PRINT "********** HOW MANY FIELDS DO YOU WANT TO ADD **********"
6663 GOSUB 14000
6664 IF DT# <1 OR DT#> NREC(A) GOTO 6663
6666 KTSUM = DT#
6669 FOR T = 1 TO KTSUM
6672 PRINT "***** WHICH FIELD IS THE ";T;"th YOU WAMT TO ADD *****"
6675 GOSUB 14000
6676 IF DT# <1 OR DT#> NREC(A) GOTO 6675
6677 IF FTY(A,DT#) = 1 GOTO 6675
6678 FTA(T) = DT#
6681 NEXT T
6684 FOR T = 1 TO KTSUM
6687 SUM#(T) = 0
6690 NEXT T
6693 IF ADOPT = 2 GOTO 6756
6696 GOSUB 13000
6699 PRINT "*** HOW MANY FIELDS DO YOU WANT TO SUBTOTAL BY ANOTHER FIELD ***"
6702 PRINT ""
6705 FOR T = 1 TO NREC(A)
6708 PRINT T;" - ";FLDN$(A,T)
6711 NEXT T
6714 PRINT ""
6717 PRINT "************* ENTER THE NUMBER THEN PRESS RETURN ***************"
6720 GOSUB 14000
6721 IF DT#<1 OR DT#>NREC(A) GOTO 6720
6723 KTSAF = DT#
6724 FOR T = 1 TO KTSAF
6725 PRINT "**** WHICH FIELD IS THE ";T;" th FIELD YOU WANT TO SUBTOTAL ****"
6726 GOSUB 14000
6727 IF DT#<1 OR DT#>NREC(A) GOTO 6726
6728 IF FTY(A,DT#) = 1 GOTO 6726
6731 ATF(T) = DT#
6732 PRINT "********* WHICH FIELD DO YOU WANT SUBTOTALS GROUPED BY *********"
6733 PRINT " Must be an interger field "
6734 GOSUB 14000
6735 IF DT#<1 OR DT#>NREC(A) GOTO 6734
6736 IF FTY(A,DT#) <> 2 GOTO 6734
6737 BTF(T) = DT#
6738 IMAX(T) = 0
6739 NEXT T
6741 FOR T = 1 TO KTSAF
6744 FOR I = 1 TO 99
6747 SAF#(T,I) = 0
6750 NEXT I
6753 NEXT T
6756 RETURN
6759 REM ***** ADD SUBROUTINE *******
6765 IF ADOPT = 3 GOTO 6783
6768 FOR T = 1 TO KTSUM
6771 F = FTA(T)
6774 SUM#(T) = SUM#(T) + S#(F)
6777 NEXT T
6780 IF ADOPT = 2 THEN RETURN
6783 REM ****** ADD ACCORDING TO ANOTHER FIELD *******
6786 FOR T = 1 TO KTSAF
6789 T1 = ATF(T)
6792 T2 = BTF(T)
6793 IF T2 <= 0 THEN T2 = 99
6794 IF T2 >100 THEN T2 = 99
6795 T3 = S#(T2)
6797 IF T3 > IMAX(T) THEN IMAX(T) = T3
6798 SAF#(T,T3) = SAF#(T,T3) + S#(T1)
6804 NEXT T
6807 RETURN
6810 REM ******* PRINT SUMS ***********
6813 EFLG = 0
6819 IF ADOPT = 1 GOTO 3010
6825 PRINT "*********** PRINT SUMS ***********"
6828 IF ADOPT = 3 GOTO 6858
6831 PRINT "********* FIELD SUMS ***********"
6834 FOR T = 1 TO KTSUM
6837 T2 = FTA(T)
6840 PRINT FLDN$(A,T2),SUM#(T)
6841 IF SPRT = 2 THEN LPRINT FLDN$(A,T2),SUM#(T)
6843 NEXT T
6846 PRINT ""
6849 PRINT "PRESS ANY KEY TO CONTINUE "
6852 IF INKEY$ = "" GOTO 6852
6855 IF ADOPT = 2 GOTO 3010
6858 PRINT "****** SUM ACCORDING TO ANOTHER FIELD ********"
6861 FOR T = 1 TO KTSAF
6864 T2 = ATF(T)
6867 T3 = BTF(T)
6870 PRINT "SUM OF THIS FIELD :";FLDN$(A,T2)
6871 IF SPRT = 2 THEN LPRINT "SUM OF THIS FIELD :";FLDN$(A,T2)
6873 PRINT "SUBTOTALS BY FIELD :";FLDN$(A,T3)
6874 IF SPRT = 2 THEN LPRINT "SUBTOTALS BY FIELD :";FLDN$(A,T3)
6876 FOR I = 1 TO IMAX(T)
6879 PRINT I;"-";SAF#(T,I)
6880 IF SPRT = 2 THEN LPRINT I;"-";SAF#(T,I)
6882 NEXT I
6885 PRINT "PRESS ANY KEY TO CONTINUE "
6888 IF INKEY$ = "" GOTO 6888
6891 NEXT T
6894 GOTO 3010
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(B)/L(B)
7970 RETURN
10000 REM ************* READ SUBROUTINE *************
10004 GOSUB 10900
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,KY(A,N),KEYLIST(A,N)
10080 NEXT N
10090 NEXT A
10100 CLOSE #1
10110 RETURN
10200 REM ******* SELECTIVE SCAN CONTINUED ********
10210 GOSUB 13000
10220 PRINT "**************** SELECTIVE SCAN PROGRAM *****************"
10230 PRINT ""
10240 PRINT "******** WHAT DO YOU WANT DONE WITH THE RESULTS *********"
10250 PRINT ""
10260 PRINT " 1 - SHOWN ON THE MONITOR (TV) ONLY "
10370 PRINT " 2 - PRINT ON PAPER AND SHOWN ON THE MONITOR "
10400 PRINT ""
10500 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ***********"
10510 GOSUB 14000
10512 IF DT# <1 OR DT# >2 GOTO 10510
10520 IF DT# = 2 THEN PRTOPT = 1 ELSE PRTOPT = 0
10530 RETURN
10600 REM ******** SELECTIVE SCAN CONTINUED *********
10610 GOSUB 13000
10620 PRINT "************** DO YOU WANT THE SUMS **************"
10630 PRINT ""
10640 PRINT " 1 - SHOWN ON THE MONITOR (TV) ONLY "
10650 PRINT " 2 - PRINT ON PAPER AND SHOW ON THE MONITOR "
10660 PRINT ""
10670 PRINT "******* ENTER THE NUMBER THEN PRESS RETURN ********"
10680 GOSUB 14000
10682 IF DT# <1 OR DT# >2 GOTO 10680
10690 SPRT = DT#
10695 RETURN
10700 REM ****** SELECTIVE SCAN INTRO
10705 GOSUB 13000
10710 PRINT "************************* SELECTIVE SCAN ROUTINE ************************"
10720 PRINT ""
10730 PRINT " The selective scan routine will display each field in the file then ask"
10740 PRINT "you what conditons if any you want to place on the field. You may place "
10750 PRINT "a conditon on every field if you wish to do so. "
10755 PRINT ""
10760 PRINT " The computer will then display only the records that meet the conditions"
10770 PRINT "that you specified. The computer will give you the option to add the records"
10780 PRINT "Only the records that meet the conditons you specified will be added."
10790 PRINT "If you want to add all the records do not put any condition on any of the "
10800 PRINT "fields.
10805 PRINT ""
10810 PRINT " If you do specify a condition for a field the computer will ask you if you "
10815 PRINT "want to OR the conditon with a condition of another field. If you chose the"
10820 PRINT "OR option only one of the conditions will need to be meet for the record to "
10825 PRINT "be acceptable. You may OR two or more conditions together."
10830 PRINT " If you use the OR option. Specify the or condition only once on the lowest"
10840 PRINT "number field that you are ORING together. For example if you wantto OR the "
10850 PRINT "second and fourth field specify the OR conditions on the second field not"
10855 PRINT "on the fourth field. See the manual for more information."
10865 PRINT ""
10870 PRINT "*********************** PRESS ANY KEY TO CONTINUE ************************"
10880 IF INKEY$ = "" GOTO 10880
10890 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
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
11940 RETURN
12000 REM ****** PRINT SUBROUTINE *****
12010 PRINT "************* FILE : ";F$(A);"- ";"RECORD NUMBER: ";RN;" *************"
12020 FOR Q = 1 TO NREC(A)
12025 IF Q MOD 20 = 0 THEN GOSUB 12170
12030 PRINT Q; TAB(5) FLDN$(A,Q);
12040 ON FTY(A,Q) GOTO 12050,12070,12100,12130,12142
12050 PRINT TAB(26) X$(Q)
12060 GOTO 12150
12070 I%=CVI(X$(Q))
12075 PRINT TAB(25) I%;
12080 IF KY(A,Q) <> 2 THEN PRINT ""
12082 IF KY(A,Q) <> 2 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 GOTO 12150
12100 I!=CVS(X$(Q))
12110 PRINT TAB(25) I!
12120 GOTO 12150
12130 I#=CVD(X$(Q))
12140 PRINT TAB(25) I#
12141 GOTO 12150
12142 I#=CVD(X$(Q))
12144 PRINT TAB(26);
12146 PRINT USING "**$########.##";I#
12150 NEXT Q
12152 IF Q < 20 THEN RETURN
12153 PRINT""
12154 PRINT ""
12155 PRINT ""
12156 PRINT ""
12157 PRINT ""
12160 RETURN
12170 RETURN
12180 IF INKEY$ = "" GOTO 12180
12190 RETURN
12200 PRINT ""
12210 LPRINT ""
12220 PRINT "RECORD NUMBER: ";RN
12230 LPRINT "RECORD NUMBER: ";RN
12240 FOR Q = 1 TO NREC(A)
12250 PRINT Q;TAB(5) FLDN$(A,Q);
12260 LPRINT Q;TAB(5) FLDN$(A,Q);
12270 ON FTY(A,Q) GOTO 12280,12310,12350,12390,12425
12280 PRINT TAB(26) X$(Q)
12290 LPRINT TAB(26) X$(Q)
12300 GOTO 12480
12310 I%=CVI(X$(Q))
12312 PRINT TAB(25) I%;
12314 LPRINT TAB(25) I%;
12316 IF KY(A,Q) <> 2 THEN PRINT ""
12318 IF KY(A,Q) <> 2 THEN LPRINT ""
12320 IF KY(A,Q) <> 2 THEN GOTO 12480
12322 T1 = KEYLIST(A,Q)
12324 W$ = L$(T1,I%)
12326 PRINT TAB(30) "key: ";W$
12328 LPRINT TAB(30) "key: ";W$
12330 GOTO 12480
12340 GOTO 12480
12350 I!=CVS(X$(Q))
12360 PRINT TAB(25) I!
12370 LPRINT TAB(25) I!
12380 GOTO 12480
12390 I#=CVD(X$(Q))
12400 PRINT TAB(25) I#
12410 LPRINT TAB(25) I#
12420 GOTO 12480
12425 I#=CVD(X$(Q))
12430 PRINT TAB(26);
12440 PRINT USING "**$########.##";I#
12450 LPRINT TAB(26);
12460 LPRINT USING "**$########.##";I#
12480 NEXT Q
12490 RETURN
12500 PRINT ""
12510 LPRINT ""
12520 PRINT "RECORD # ";RN;" ";
12530 LPRINT "RECORD # ";RN;" ";
12540 FOR Q = 1 TO NREC(A)
12545 IF LEND(Q)= 5 THEN PRINT ""
12547 IF LEND(Q)= 5 THEN LPRINT ""
12548 T2 = CL(Q) + 6
12550 PRINT TAB(CL(Q))"<";Q;">";
12560 LPRINT TAB(CL(Q))"<";Q;">";
12570 ON FTY(A,Q) GOTO 12580,12610,12730,12770,12810
12580 PRINT TAB(T2) X$(Q);
12590 LPRINT TAB(T2) X$(Q);
12600 GOTO 12860
12610 I%=CVI(X$(Q))
12620 PRINT TAB(T2)I%;
12630 LPRINT TAB(T2)I%;
12660 IF KY(A,Q) <> 2 THEN GOTO 12860
12670 T1 = KEYLIST(A,Q)
12680 W$ = L$(T1,I%)
12685 T1 = CL(Q) + 11
12690 PRINT TAB(T1)"key: ";W$;
12700 LPRINT TAB(T1)"key: ";W$;
12720 GOTO 12860
12730 I!=CVS(X$(Q))
12740 PRINT TAB(T2)I!;
12750 LPRINT TAB(T2)I!;
12760 GOTO 12860
12770 I#=CVD(X$(Q))
12780 PRINT TAB(T2)I#;
12790 LPRINT TAB(T2)I#;
12800 GOTO 12860
12810 I#=CVD(X$(Q))
12820 PRINT TAB(T2) "";
12830 PRINT USING "**$########,.##";I#;
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:PRINT T;CL(T); " RETURNED FROM 12910 "
12907 IF C > COLM THEN GOSUB 12970
12908 PRINT T;CL(T): NEXT T
12909 RETURN
12910 ON FTY(A,T) GOTO 12920,12930,12940,12950,12950
12920 C = C + FL(A,T) + 5
12925 RETURN
12930 C = C + 11
12933 IF KY(A,T) = 2 THEN C = C + 30
12935 RETURN
12940 C = C + 13
12945 RETURN
12950 C = C + 18
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
13100 REM ********* LOCATE
13110 LOCATE LI,1
13120 RETURN
13200 FOR T% = 1 TO 80
13210 PRINT CHR$(8);
13220 NEXT T%
13222 FOR T% = 1 TO 24
13223 PRINT CHR$(11);
13224 NEXT T%
13225 LI = LI - 1
13230 FOR T% = 1 TO LI
13240 PRINT CHR$(0)
13250 NEXT T%
13590 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 *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
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
14683 IF KTMAX = 0 THEN RETURN
14684 PRINT ""
14685 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" 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 3 = 0 THEN PRINT ""
16235 IF T MOD 3 = 0 THEN T2 = -25
16237 T2 = T2 + 26
16340 NEXT T
16350 RETURN
26000 REM ******* ON ERROR ROUTINE ************
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 ********* ON ERROR SUBROUTINE ***********
26600 PRINT "********** END OF FILE ***********"
26610 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
26620 IF INKEY$ = "" GOTO 26620
26635 EFLG = 1
26640 RETURN
26800 REM ********** ON ERROR GOTO **************
26900 PRINT "************ RECORD NOT FOUND *************"
50000 REM ********** INTRO
50010 GOSUB 13000
50100 PRINT " S C A 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"
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
SORT.BAS
4 DEFINT K,F,T,L,R,N
5 DIM K$(55)
6 DIM FLDN$(1,60),FTY(1,60),FL(1,60)
8 DIM NREC(17),FD(3),Z$(60),L(50),R(50),F$(17)
10 CH = 29
12 GOSUB 8000
15 GOSUB 13000
16 H = A
17 GOSUB 7000
19 DEFSTR Z
20 A = H
25 GOSUB 9000
30 FLG = 0
45 L = 0
50 FOR T = 1 TO NREC(A)
55 L = L + FL(1,T)
60 NEXT T
70 DEFINT T
90 GOSUB 11000
100 GOSUB 10000
400 REM ****** GET DATA FROM DISKS *******
403 PRINT FRE(0)
405 GOSUB 16000
420 FOR T = 1 TO 30000
429 IF T > MRN GOTO 26000
430 GET #1,T
433 FOR T1 = 1 TO KTH
435 N = FD(T1)
436 IF FTY(1,N) = 1 GOTO 500
438 IF T1 = 1 THEN X(T) = 0
439 X(T) = X(T)*1E+06
440 ON FTY(1,N) GOTO 500,550,600,650,650
500 LET X(T) = Z$(N)
510 GOTO 700
550 X(T) = CVI(Z$(N)) + X(T)
560 GOTO 700
600 X(T) = CVS(Z$(N)) + X(T)
610 GOTO 700
650 X(T) = CVD(Z$(N)) + X(T)
700 NEXT T1
705 T(T) = T
710 NEXT T
1200 LP = 1
1210 FLG = 0
2000 REM
2010 M = 5000
2020 GOSUB 30000
2110 GOSUB 2200
2120 GOSUB 30000
2130 GOTO 3000
2200 REM
2210 L(1) = 1
2220 R(1) = MAXR
2230 S = 1
2240 IF (L(S)) < R(S) THEN 2270
2250 S = S - 1
2260 GOTO 2640
2270 I = L(S)
2280 J = R(S)
2290 P1= X(J)
2300 M = (I + J)/2
2310 IF (J - I<6) THEN 2400
2320 IF ((P1>X(I)) AND (P1<X(M))) THEN 2400
2330 IF ((P1<X(I)) AND (P1>X(M))) THEN 2400
2340 IF ((X(I)<X(M)) AND (X(I)>P1)) THEN 2380
2350 IF ((X(I)>X(M)) AND (X(I)<P1)) THEN 2380
2360 SWAP X(M),X(J)
2365 SWAP T(M),T(J)
2370 GOTO 2390
2380 SWAP X(I),X(J)
2385 SWAP T(I),T(J)
2390 P1 = X(J)
2400 WHILE (I<J)
2410 WHILE (X(I)< P1)
2420 I = I + 1
2430 WEND
2440 J=J-1
2450 WHILE (I<J)AND(P1<X(J))
2460 J = J-1
2470 WEND
2480 IF (I>=J) THEN 2510
2490 SWAP X(I),X(J)
2500 SWAP T(I),T(J)
2510 WEND
2520 J = R(S)
2530 SWAP X(I),X(J)
2540 SWAP T(I),T(J)
2550 IF (I - L(S)>=R(S)-I) THEN 2600
2560 L(S + 1) = L(S)
2570 R(S + 1) = I - 1
2580 L(S) = I + 1
2590 GOTO 2630
2600 L(S + 1) = I + 1
2610 R(S + 1) = R(S)
2620 R(S) = I - 1
2630 S = S + 1
2640 IF (S > 0) THEN 2240
2650 RETURN
3000 REM ******** PUT IN FILE ************
3100 GOSUB 9100
3110 Q$ = "B:"+F$(A)
3200 GOSUB 9200
3300 FOR Q = 1 TO MAXR
3310 RN = T(Q)
3312 GET #1,RN
3330 LSET Z1$ = Y$
3340 PUT #2,Q
3350 NEXT Q
3500 CLOSE
3600 GOSUB 15000
3620 PRINT "SORT FINISHED "
3630 END
7000 GOSUB 12000
7005 OPEN "I",#1,"FFILE"
7010 INPUT #1,MAXF
7020 FOR A = 1 TO MAXF
7030 INPUT #1,A,F$(A),NREC(A),L(A)
7040 FOR N = 1 TO NREC(A)
7050 INPUT #1,FLDN$(1,N),FTY(1,N),FL(1,N)
7055 IF FTY(1,N) = 2 THEN INPUT #1,KY,KEYLIST
7060 NEXT N
7065 IF A = AHLD THEN RETURN
7070 NEXT A
7080 CLOSE #1
7100 RETURN
8000 GOSUB 12000
8005 OPEN "I",#1,"FFILE"
8010 INPUT #1,MAXF
8020 FOR A = 1 TO MAXF
8030 INPUT #1,A,F$(A),NREC(A),L(A)
8040 FOR N = 1 TO NREC(A)
8050 INPUT #1,FLDN$(1,N),FTY(1,N),FL(1,N)
8055 IF FTY(1,N) = 2 THEN INPUT #1,KY,KEYLIST
8060 NEXT N
8070 NEXT A
8080 CLOSE #1
8100 RETURN
9000 REM ******* OPEN FILE SUBROUTINE *******
9010 CLOSE #1
9020 OPEN "R",#1,F$(A),L(A)
9030 D = 0
9040 FOR T = 1 TO NREC(A)
9050 FIELD #1,D AS D$,FL(1,T) AS Z$(T)
9060 D = D + FL(1,T)
9070 NEXT T
9080 RETURN
9100 REM ******* OPEN FILE SUBROUTINE *******
9110 CLOSE #1
9120 OPEN "R",#1,F$(A),L
9140 PRINT " L(A) ";L
9150 FIELD #1,L AS Y$
9180 RETURN
9200 REM ******* OPEN FILE SUBROUTINE *******
9210 CLOSE #2
9220 OPEN "R",#2,Q$,L
9250 FIELD #2,L AS Z1$
9280 RETURN
10000 REM ******* INITAL SELECTION ********
10010 GOSUB 15000
10100 PRINT "************** SORT FILE PROGRAM **************"
10105 PRINT "FILE NUMBER = ";A;" FILE NAME = ";F$(A)
10110 PRINT ""
10120 FOR T = 1 TO NREC(A)
10130 PRINT T;"- ";FLDN$(1,T)
10140 NEXT T
10150 PRINT ""
10160 PRINT "*** HOW MANY FIELDS DO YOU WANT TO SORT BY ? ***"
10170 PRINT "************** ENTER 1,2, OR 3 ***************"
10180 GOSUB 60000
10185 IF DT#<1 OR DT#>3 GOTO 10180
10190 KTH= DT#
10200 PRINT "*** WHICH FIELD IS THE PRIMARY SORT FIELD ? ***"
10210 GOSUB 60000
10212 IF DT#<1 OR DT#>NREC(A) GOTO 10210
10215 T3 = FD(1)
10218 FD(1) = DT#
10219 T3 = DT#
10220 IF KTH= 1 GOTO 10275
10230 PRINT "*********** WHICH FIELD IS THE SECONDARY FIELD ? **********"
10232 PRINT "- If the primary values are equal"
10234 PRINT "the record with the lowest secondary value will be stored first "
10240 GOSUB 60000
10242 IF DT#<1 OR DT#>NREC(A) GOTO 10240
10244 IF FTY(1,DT#) = 1 GOTO 10410
10246 FD(2) = DT#
10250 IF KTH= 2 GOTO 10275
10260 PRINT "************ WHICH FIELD IS THE THIRD FIELD ? *************"
10262 PRINT "- If both the primary value and the secondary value are equal"
10264 PRINT "the record with the lowest third value will be stored first"
10270 GOSUB 60000
10272 IF DT#<1 OR DT#>NREC(A) GOTO 10270
10273 IF FTY(1,DT#) = 1 GOTO 10410
10274 FD(3) = DT#
10275 ON FTY(1,T3) GOSUB 10400,10600,10500,10500,10500
10280 RETURN
10400 DEFSTR X,P
10410 IF KTH> 1 THEN PRINT "******** STRING VARIABLES MAY ONLY BE SORTED BY ONE FIELD ********"
10420 IF KTH> 1 GOTO 10100
10430 DIM X(3000),T(3000)
10490 RETURN
10500 DEFDBL X,P
10505 DIM X(3000),T(3000)
10510 RETURN
10600 IF KTH> 1 GOTO 10500
10610 DEFINT X,P
10620 DIM X(6000),T(6000)
10630 RETURN
11000 REM ******* INTRODUCTION ********
11100 GOSUB 15000
11110 PRINT "************************ SORT PROGRAM *************************"
11114 PRINT ""
11116 PRINT " Copyright 1984 by Potomac Pacific Engineering "
11120 PRINT ""
11130 PRINT "FILE NUMBER : ";A;" FILE NAME : ";F$(A)
11140 PRINT ""
11200 PRINT ""
11210 PRINT "Up to 6000 records may be sorted on ONE INTEGER FIELD "
11220 PRINT "Up to 3000 records may be sorted on ONE ALFANUMRIC FIELDS "
11230 PRINT "Up to 3000 records may be sorted on THREE DIFFERENT NUMERIC FIELDS"
11240 PRINT " Depending on what version of Basic you are using you may be able"
11250 PRINT "to increase the number of records you can sort by changing the "
11260 PRINT "DIM (dimension) statement in lines 10400 -10630. The compiled
11270 PRINT "Version can handle 10000,42000, and 42000 records respectfully."
11300 PRINT ""
11310 PRINT "The sort program reads the file on the default disk drive, sorts"
11320 PRINT "the records, then writes a sorted file with the same file name"
11330 PRINT "on a disk drive B. "
11940 PRINT ""
11950 PRINT "****************** PRESS ANY KEY TO CONTINUE ******************"
11960 IF INKEY$ = "" GOTO 11960
11970 RETURN
12000 REM *****
12005 GOSUB 15000
12010 PRINT " Put the DATA floppy disk in the default disk drive "
12020 PRINT ""
12030 PRINT " ****** PRESS ANY KEY TO CONTINUE ***** "
12040 IF INKEY$ = "" GOTO 12040
12050 RETURN
13000 REM *****
13100 GOSUB 15000
13110 PRINT "****************** SORT PROGRAM *******************"
13120 PRINT ""
13130 PRINT "********** WHICH FILE DO YOU WANT TO SORT *********"
13140 FOR T = 1 TO MAXF
13150 PRINT T;" - ";F$(T)
13160 NEXT T
13170 PRINT "***** ENTER THE FILE NUMBER THEN PRESS RETURN ******"
13180 GOSUB 60000
13185 IF DT#<1 OR DT# >MAXF GOTO 13180
13190 A = DT#
13195 AHLD = A
13200 RETURN
14000 REM ***** SORT SELECTION
14100 GOSUB 15000
14110 PRINT "******************* SORT PROGRAM ********************"
14120 PRINT ""
14130 PRINT "DO YOU WANT TO SORT A FILE ON :"
14140 PRINT ""
14150 PRINT " 1. ONLY ONE INTEGER FIELD"
14160 PRINT ""
14170 PRINT " 2. ONE TO THREE NUMERIC FIELDS "
14180 PRINT ""
14190 PRINT " 3. A STRING FIELD"
14200 PRINT ""
14300 PRINT "******* ENTER THE NUMBER THEN PRESS RETURN ********"
14400 GOSUB 60000
14410 T = DT#
14420 ON T GOTO 14500,14700,14900
14500 REM
14520 GOSUB 12000
14540 RUN "SORTINT"
14700 GOTO 10
14900 REM
14920 GOSUB 12000
14940 RUN "SORTSTR"
15000 REM ****** CLEAR SCREEN
15010 CLS
15020 RETURN
16000 REM ****** FIND MAX RECORD
16100 MRN = LOF(1)/L(A)
16200 RETURN
26000 REM ******* ON ERROR ROUTINE ************
26200 PRINT "END OF FILE"
26205 MAXR = T - 1
26206 PRINT MAXR," MAX RECORD "
26210 GOTO 1200
30000 FOR T = 1 TO MAXR
31000 PRINT X(T)
32000 NEXT T
33000 RETURN
60000 REM ******* INTEGER LESS THEN 100 CHECK ********
60010 MAX = 2
60020 ACT$ = "1234567890=<>^"
60030 IF NE = 0 THEN ACT$ = "1234567890"
60040 PRINT ">__<";
60050 GOTO 60240
60060 REM ******* INTEGER *******
60070 MAX = 8
60080 ACT$ = "1234567890-+,=<>^"
60090 IF NE = 0 THEN ACT$ = "1234567890-+,"
60100 PRINT ">________<";
60110 GOTO 60240
60120 REM ******* SINGLE PRECISION *******
60130 MAX = 10
60140 ACT$ = "1234567890-+,.%$=<>^"
60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60160 PRINT ">__________<";
60170 GOTO 60240
60180 REM ******* DOUBLE PRECISION *******
60190 MAX = 20
60200 ACT$ = "1234567890-+,.%$=<>^"
60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60220 PRINT ">____________________<";
60230 GOTO 60240
60240 REM ********** NUMBER CHECK **********
60250 A$ = ""
60260 K$(20) = " "
60270 KTMAX = 0
60280 FOR T9 = 1 TO MAX
60290 K$(T9) = " "
60300 NEXT T9
60310 DIG$ = "1234567890."
60320 DOTFLG = 0
60330 T2 = MAX + 1
60340 FOR T6 = 1 TO T2
60350 PRINT CHR$(CH);
60360 NEXT T6
60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370
60380 KT = 0
60390 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
60400 KT = KT + 1
60410 REM
60420 W$ = INKEY$
60430 IF W$ = "" GOTO 60420
60440 C = ASC(W$)
60450 IF C = 0 THEN GOSUB 61900
60460 IF C = 13 GOTO 60580
60470 IF C = 17 OR C = 8 GOTO 61150
60480 IF C = 19 GOTO 60670
60490 IF C = 4 GOTO 60720
60500 IF C = 6 GOTO 60780
60510 IF C = 1 GOTO 60960
60520 IF KT > MAX GOTO 60410
60530 IF INSTR(ACT$,W$) = 0 GOTO 61230
60540 K$(KT) = W$
60550 PRINT K$(KT);
60560 IF KT > KTMAX THEN KTMAX = KT
60570 GOTO 60400
60580 REM ********** RETURN **********
60590 FOR T9 = 1 TO KTMAX
60600 A$ = A$ + K$(T9)
60610 NEXT T9
60620 IF KTMAX = 0 THEN PRINT "1"
60630 IF KTMAX = 0 THEN DT# = 1
60640 IF KTMAX = 0 THEN RETURN
60650 PRINT ""
60660 GOTO 61260
60670 REM ********* MOVE CURSE BACK ********
60680 IF KT = 1 GOTO 60410
60690 KT = KT - 1
60700 PRINT CHR$(CH);
60710 GOTO 60410
60720 REM ********* MOVE CURSER FORWARD *********
60730 IF KT >= MAX GOTO 60410
60740 IF KT > (KTMAX + 1) GOTO 60410
60750 PRINT K$(KT);
60760 KT = KT + 1
60770 GOTO 60410
60780 REM ********** INSERT ***********
60790 IF KT > KTMAX GOTO 60410
60800 X9 = MAX
60810 WHILE X9 > KT
60820 X9 = X9 - 1
60830 K$(X9 + 1) = K$(X9)
60840 WEND
60850 K$(KT) = " "
60860 KTMAX = KTMAX + 1
60870 IF KTMAX > MAX THEN KTMAX = MAX
60880 FOR T9 = KT TO KTMAX
60890 PRINT K$(T9);
60900 NEXT T9
60910 T6 = (KTMAX - KT) + 1
60920 FOR T7 = 1 TO T6
60930 PRINT CHR$(CH);
60940 NEXT T7
60950 GOTO 60410
60960 REM ********** DELETE ***********
60970 IF KT > KTMAX GOTO 60410
60980 IF KTMAX = 1 GOTO 60410
60990 K$(MAX + 1) = ""
61000 X9 = KT
61010 WHILE X9 <= MAX
61020 K$(X9) = K$(X9 + 1)
61030 X9 = X9 + 1
61040 WEND
61050 KTMAX = KTMAX - 1
61060 FOR T9 = KT TO KTMAX
61070 PRINT K$(T9);
61080 NEXT T9
61090 PRINT "_";
61100 T7 = (KTMAX - KT) + 2
61110 FOR T8 = 1 TO T7
61120 PRINT CHR$(CH);
61130 NEXT T8
61140 GOTO 60410
61150 REM ********* BACKSPACE ********
61160 IF KT = 1 GOTO 60410
61170 KT = KT - 1
61180 PRINT CHR$(CH);
61190 K$(KT) = " "
61200 PRINT "_";
61210 PRINT CHR$(CH);
61220 GOTO 60410
61230 REM ******* INPUT NOT ACCEPTABLE ********
61240 PRINT CHR$(7);
61250 GOTO 60420
61260 REM ********* CLEAR STRINGS ********
61270 MAX = LEN(A$)
61280 D2$ = ""
61290 D1$ = ""
61300 DFLG = 0
61310 FOR Q93 = 1 TO MAX
61320 R$ = MID$(A$,Q93,1)
61330 IF INSTR(DIG$,R$) = 0 GOTO 61400
61340 IF R$ = "." OR DFLG = 1 GOTO 61380
61350 IF DFLG = 1 GOTO 61380
61360 D2$ = D2$ + R$
61370 GOTO 61400
61380 D1$ = D1$ + R$
61390 DFLG = 1
61400 NEXT Q93
61410 DA# = VAL(D2$)
61420 D1# = VAL(D1$)
61430 DT# = DA# + D1#
61440 IF K$(1) = "-" THEN DT# = -DT#
61450 RETURN
61900 REM ****** CHECK FOR ASC0
61910 S4$ = INKEY$
61920 C2 = ASC(S4$)
61930 IF C2 = 83 THEN C = 1
61940 IF C2 = 82 THEN C = 6
61950 IF C2 = 75 THEN C = 19
61960 IF C2 = 77 THEN C = 4
61970 RETURN
TESTASCI.BAS
100 OPEN "I",#1,"ASCIDATA"
200 LINE INPUT #1,A$
300 PRINT A$
400 IF EOF(1) = 0 THEN 200
500 END
TRANSFER.BAS
3 DEFDBL X
4 DEFINT A-W,Y-Z
5 DIM F$(15),FLDN$(15,30),FTY(15,30),FL(15,30),IOPT(30)
10 DIM X$(30),Y$(30)
13 DIM L(15),NREC(15),Z$(30)
14 DIM X(30),CK$(30),SN$(30),SFN(10),DTOPT(10)
16 DIM LEND(30),CL(30)
17 DIM FTA(10),ATF(10),BTF(10),IMAX(10)
18 DIM SU%(40),S!(30),SUM#(40)
22 DIM ORFLG(10),D(10),TFN(10),FLDTCT(10,30,1),KTSUM(30),SUMFN(30)
23 DIM SUMF(10,30),KTSUMAF(30),SAFFN(30),SAFADD(10,30),SAFACCTO(10,30)
24 DIM SAFFLDN(10,30)
25 DIM S#(30)
26 DIM MAX(10),Z%(30),SU#(30),D#(30),EFN(10,30)
35 DIM K$(80)
42 DIM MAXK(30),SUMRN(10,30),SUMFLDN(10,30),MAXSAF(5)
44 DIM SUMAFOPT(10),SUMOPT(10),RNTNBOPT(10),DY(10),FLDTC(10,30,1)
46 DIM SUMFLD(10,30)
60 DIM SAF#(3,200)
61 CH = 29: PRINT FRE(0)
62 GOSUB 50000
70 NE = 0
80 GOSUB 10000
1000 GOTO 18000
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 ""
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#
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 SUBROUTINE *******
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 *******
2582 PRINT C,F$(C),L(C)
2584 OPEN "R",#2,F$(C),L(C)
2586 D = 0
2588 FOR T = 1 TO NREC(C)
2590 FIELD #2,D AS DY$,FL(C,T) AS Z$(T)
2592 D = D + FL(C,T)
2594 NEXT T
2596 RETURN
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(B)/L(B)
7970 RETURN
10000 REM ************* READ SUBROUTINE *************
10004 GOSUB 10900
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,D
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
10995 RETURN
11000 REM ******** LOAD KEYLIST *********
11010 RETURN
13000 REM ********* CLEAR SCREEN
13010 CLS
13020 RETURN
13100 REM ********* LOCATE
13110 LOCATE LI,1
13120 RETURN
13200 FOR T% = 1 TO 80
13210 PRINT CHR$(8);
13220 NEXT T%
13222 FOR T% = 1 TO 24
13223 PRINT CHR$(11);
13224 NEXT T%
13225 LI = LI - 1
13230 FOR T% = 1 TO LI
13240 PRINT CHR$(0)
13250 NEXT T%
13590 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 *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
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)
14680 NEXT T9
14681 IF KTMAX = 0 THEN PRINT "1"
14682 IF KTMAX = 0 THEN DT# = 1
14683 IF KTMAX = 0 THEN RETURN
14684 PRINT ""
14685 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
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$
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 3 = 0 THEN PRINT ""
16235 IF T MOD 3 = 0 THEN T2 = -25
16237 T2 = T2 + 26
16340 NEXT T
16350 RETURN
18000 REM ********** TRANSFER MENU **************
18005 IF DTFLG >< 1 THEN GOSUB 19000
18007 GOSUB 13000
18010 PRINT "**************** TRANSFER MENU ******************"
18020 PRINT ""
18025 PRINT " 0 - EXIT THE PROGRAM"
18030 FOR N = 1 TO MAXS
18040 PRINT " ";N;"- ";SN$(N)
18050 NEXT N
18060 PRINT ""
18070 PRINT "******* ENTER THE NUMBER AND PRESS RETURN *******"
18075 GOSUB 14000
18076 IF DT# <0 OR DT# >MAXS GOTO 18075
18078 IF DT# = 0 THEN GOTO 51000
18080 SOPT = DT#
18085 GOSUB 13000
18090 A = SFN(SOPT)
18092 PRINT F$(A),"SOURCE FILE"
18094 GOSUB 2300
18096 GOSUB 2500
18098 IF DTOPT(SOPT) = 1 THEN GOSUB 21000
18099 GOSUB 13000
18100 PRINT ""
18110 PRINT "***** WHAT RECORD NUMBER DO YOU WANT TO START AT *****"
18120 PRINT ""
18130 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN *********"
18135 GOSUB 14200
18136 IF DT# <1 OR DT# >10000 GOTO 18135
18140 RNSS = DT#
18200 PRINT ""
18202 GOSUB 7800
18204 PRINT "THE HIGHEST NUMBERED RECORD IS ";MRN
18210 PRINT "******** WHICH IS THE LAST RECORD YOU WANT TO TRANSFER ********"
18220 PRINT ""
18230 PRINT "************* ENTER THE NUMBER THEN PRESS RETURN **************"
18235 GOSUB 14200
18236 IF DT# <1 OR DT# >MRN GOTO 18235
18240 RNSF = DT#
18250 IF RNSF > MRN GOTO 18204
18300 SFN = SFN(SOPT)
18500 GOTO 20000
19000 REM ************ OPEN FOR INPUT **************
19005 GOSUB 10900
19010 OPEN "I",#2,"TFER"
19020 INPUT #2,MAXS
19030 FOR S = 1 TO MAXS
19040 D = 1
19050 INPUT #2,DTOPT(S),SUMOPT(S),SUMAFOPT(S),SN$(S),SFN(S)
19060 IF DTOPT(S) = 2 GOTO 19170
19070 INPUT #2,RNTNBOPT(S),D(S),TFN(S),DY(S)
19080 TFN = TFN(S)
19090 FOR N = 1 TO DY(S)
19100 INPUT #2,FLDTC(S,N,D)
19110 IF FLDTC(S,N,D) = 1 GOTO 19130
19120 INPUT #2,FLDTCT(S,N,D)
19130 NEXT N
19140 IF D = 2 GOTO 19170
19150 IF D(S) = 2 THEN D = 2
19160 IF D(S) = 2 GOTO 19090
19170 IF SUMOPT(S) = 2 GOTO 19220
19180 INPUT #2,KTSUM(S),SUMFN(S)
19190 FOR K = 1 TO KTSUM(S)
19200 INPUT #2,SUMF(S,K),SUMRN(S,K),SUMFLDN(S,K)
19210 NEXT K
19220 IF SUMAFOPT(S) = 2 GOTO 19270
19230 INPUT #2, KTSUMAF(S),SAFFN(S)
19240 FOR K = 1 TO KTSUMAF(S)
19250 INPUT #2,SAFADD(S,K),SAFACCTO(S,K),SAFFLDN(S,K),DY
19260 NEXT K
19270 NEXT S
19280 CLOSE #2
19285 DTFLG = 1
19290 RETURN
20000 REM ****** DATA TRANSFER PROGRAM ******
20095 REM ***** INITIALIZE SUMS TO ZERO *****
20100 GOSUB 20900
20105 PRINT "*** INITIALIXE SUMS
20110 REM *** OPEN SOURCE FILE ****
20112 GOSUB 13000
20140 REM ** IF DTOPT(SOPT) = 1 THEN GOSUB 21000
20150 REM ******* START READING LOOP **********
20160 FOR RN = RNSS TO RNSF
20180 GET #1,RN
20195 REM ******* CONVERT STRINGS TO INTEGERS
20200 GOSUB 21066
20205 PRINT "*** READING RECORD NUMBER ";RN
20210 REM ******* RECORD NUMBERING
20220 IF DTOPT(SOPT) = 1 THEN GOSUB 21700
20230 REM ***** TRANSFER DATA
20240 IF DTOPT(SOPT) = 1 THEN GOSUB 21900
20250 REM ***** ADD ACCORDING TO FIELDS
20260 IF SUMOPT(SOPT) = 1 THEN GOSUB 24000
20270 IF SUMAFOPT(SOPT) = 1 THEN GOSUB 24100
20300 NEXT RN
20500 REM ****** RESUME FROM ON ERROR
20510 REM ****** MOVE FIELDS TO FILE
20520 IF SUMOPT(SOPT) = 1 THEN GOSUB 25600
20530 IF SUMAFOPT(SOPT) = 1 THEN GOSUB 25800
20590 CLOSE
20600 GOTO 18000
20900 REM ****** CLEAR VARIABLES ******
20910 FOR N = 1 TO KTSUM
20920 SUM#(N) = 0
20930 NEXT N
20950 IF SUMAFOPT = 2 GOTO 20998
20960 FOR P = 1 TO KTSUMAF
20970 FOR N = 1 TO MAX(P)
20980 SAF#(P,N) = 0
20990 NEXT N
20995 NEXT P
20998 RETURN
21000 REM *********** DATA TRANSFER OPTION **********
21005 TFN = TFN(SOPT)
21010 B = TFN
21015 GOSUB 13000
21017 PRINT F$(B)," TARGET FILE "
21018 AHLD = A
21019 A = B
21020 GOSUB 2300
21030 GOSUB 2550
21032 A = AHLD
21040 RETURN
21066 FOR K = 1 TO NREC(A)
21068 REM ******** CONVERT EACH RECORD TO DECIMAL **********
21070 ON FTY(A,K) GOTO 21100,21200,21300,21400,21400
21100 Z$(K) = X$(K)
21110 GOTO 21500
21150 REM ******* START READING LOOP **********
21200 Z%(K) = CVI(X$(K))
21205 SU#(K) = Z%(K)
21210 GOTO 21500
21300 S!(K) = CVS(X$(K))
21305 SU#(K) = S!(K)
21310 GOTO 21500
21400 D#(K) = CVD(X$(K))
21405 SU#(K) = D#(K)
21410 GOTO 21500
21500 NEXT K
21510 RETURN
21590 REM ******* GET SECOND FILE **********
21595 REM ***** OPEN B ON START UP ****
21600 IF N <> RNSS GOTO 21700
21605 FLG = 1
21610 FLDOPT = 2
21620 B = TFN
21630 GOSUB 2300
21700 REM ***** RECORD NUMBERING
21705 RNTNBOPT = RNTNBOPT(SOPT)
21710 IF RNTNBOPT = 0 GOTO 21800
21715 REM ****** B RECORD NUMBER = TO A FIELD ******
21720 RN2 = SU#(RNTNBOPT)
21730 RETURN
21790 REM ****** B RECORD NUMBER INCREMENTS FROM 1 *******
21800 RN2 = RN
21810 RETURN
21900 REM ****** GET SECOND RECORD ******
21905 PRINT "TRANSFERING TO RECORD ";RN2
21910 GET #2,RN2
22000 FOR R = 1 TO NREC(B)
22005 REM ***** NO TRASFER *****
22010 IF FLDTC(SOPT,R,1) = 1 GOTO 23900
22020 IF FTY(B,R) <> 1 GOTO 22100
22030 T = FLDTC(SOPT,R,1) - 1
22040 LSET Y$(R) = Z$(T)
22050 GOTO 23900
22095 REM ***** JUST REPLACE *****
22100 IF FLDTCT(SOPT,R,1) <> 2 GOTO 22200
22105 T = FLDTC(SOPT,R,1) - 1
22110 LSET Y$(R) = Z$(T)
22120 GOTO 23900
22200 ON FTY(B,R) GOTO 23900,22210,22300,22400,22400
22205 REM ***** INTEGER *****
22210 I%=CVI(Y$(R))
22215 T = FLDTC(SOPT,R,1) - 1
22218 D# = SU#(T)
22220 IF FLDTCT(SOPT,R,1) = 3 THEN D# = -1 * D#
22230 I% = I% + D#
22240 LSET Y$(R) = MKI$(I%)
22250 GOTO 23900
22300 REM ** SINGLE PRECISION **
22310 I!=CVS(Y$(R))
22315 T = FLDTC(SOPT,R,1) - 1
22318 D# = SU#(T)
22320 IF FLDTCT(SOPT,R,1) = 3 THEN D# = -1 * D#
22330 I! = I! + D#
22340 LSET Y$(R) = MKS$(I!)
22350 GOTO 23900
22400 REM ** DOUBLE PRECISION **
22407 Y$ = Y$(R)
22410 I#=CVD(Y$)
22415 T = FLDTC(SOPT,R,1) - 1
22416 D# = SU#(T)
22420 IF FLDTCT(SOPT,R,1) = 3 THEN D# = -1 * D#
22430 I# = I# + D#
22440 LSET Y$(R) = MKD$(I#)
22450 GOTO 23900
22990 REM ****** FINISH TRANSFER LOOP ******
23900 NEXT R
23910 PUT #2,RN2
23912 RETURN
24000 REM ******** SUM OPTION *******
24010 FOR P = 1 TO KTSUM(SOPT)
24020 T = SUMF(SOPT,P)
24030 SUM#(P) = SUM#(P) + SU#(T)
24040 NEXT P
24050 RETURN
24100 REM ***** ADD ACCORDING TO FIELDS *****
24110 IF SUMAFOPT = 2 GOTO 24285
24120 FOR P = 1 TO KTSUMAF(SOPT)
24130 T = SAFADD(SOPT,P)
24140 F = SAFACCTO(SOPT,P)
24150 I = SU#(F)
24155 IF I > MAXSAF(P) THEN MAXSAF(P) = I
24160 SAF#(P,I) = SAF#(P,I) + SU#(T)
24170 NEXT P
24285 RETURN
25600 REM ****** MOVE SUMS TO FILES ******
25620 CLOSE
25630 B = SUMFN(SOPT)
25645 GOSUB 13000
25647 PRINT F$(B),"FILE FOR SUMS"
25648 AHLD = A
25649 A = B
25650 GOSUB 2300
25660 GOSUB 2550
25665 A = AHLD
25670 FOR P = 1 TO KTSUM(SOPT)
25700 RN = SUMRN(SOPT,P)
25710 GET 2,RN
25720 T = SUMFLDN(SOPT,P)
25725 S# = SUM#(P)
25727 PRINT "SUM";S#;" FIELD ";T
25730 ON FTY(B,T) GOSUB 25790,25772,25780,25790,25790
25750 PUT #2,RN
25760 NEXT P
25770 RETURN
25772 LSET Y$(T) = MKI$(S#)
25775 RETURN
25780 LSET Y$(T) = MKS$(S#)
25785 RETURN
25790 LSET Y$(T) = MKD$(S#)
25795 RETURN
25800 REM ******* PUT SUM ACCORDING TO FIELDS IN FILES *******
25810 CLOSE
25820 B = SAFFN(SOPT)
25823 GOSUB 13000
25825 PRINT F$(B),"FILE FOR SUMS ACCORDINT TO FIELDS "
25827 AHLD = A
25828 A = B
25830 GOSUB 2300
25833 A = AHLD
25835 GOSUB 2550
25850 FOR P = 1 TO KTSUMAF(SOPT)
25852 T = SAFFLDN(SOPT,P)
25860 FOR J = 1 TO MAXSAF(P)
25865 S# = SAF#(P,J)
25870 GET #2,J
25880 ON FTY(B,T) GOSUB 25984,25984,25990,25995,25995
25890 PUT #2,J
25895 PRINT P,J,S#,A,T
25900 NEXT J
25910 NEXT P
25980 CLOSE
25982 RETURN
25984 LSET Y$(T) = MKI$(S#)
25986 RETURN
25990 LSET Y$(T) = MKS$(S#)
25992 RETURN
25995 LSET Y$(T) = MKD$(S#)
25997 RETURN
26000 REM ******* ON ERROR ROUTINE ************
26100 EFLG = 1
26200 PRINT "********** END OF FILE ***********"
26202 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
26204 IF INKEY$ = "" GOTO 26204
26500 REM ********* ON ERROR SUBROUTINE ***********
26600 PRINT "********** END OF FILE ***********"
26610 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
26620 IF INKEY$ = "" GOTO 26620
26635 EFLG = 1
26640 RETURN
26800 REM ********** ON ERROR GOTO **************
26900 PRINT "************ RECORD NOT FOUND *************"
50000 REM ********** INTRO
50010 GOSUB 13000
50100 PRINT " T R A N S F E R P R O G R A M 3.0 "
50105 PRINT ""
50110 PRINT " Copyright 1984 by Potomac Pacific Engineering Inc."
50120 PRINT ""
50130 PRINT "This program is licensed FREE to all users with some restrictions"
50165 PRINT " See the manual for more information on the license."
50167 PRINT ""
50950 PRINT "****************** PRESS ANY KEY TO CONTINUE *******************";
50960 IF INKEY$ = "" GOTO 50960
50970 RETURN
51000 REM ******** EXIT
51100 GOSUB 13000
51105 GOSUB 13000
51110 PRINT " -BYE, Have a nice day
51120 END
51200 PRINT "BYE - Have a nice day "
51300 END
Directory of PC-SIG Library Disk #0214
Volume in drive A has no label
Directory of A:\
ASCII BAS 10368 3-10-83 1:30a
CFILE BAS 18944 3-10-83 12:18a
CFORM BAS 18944 3-10-83 12:22a
CHANGE BAS 29824 3-10-83 12:06a
CINPUT BAS 27008 1-01-80
CLIMITS BAS 13696 3-10-83 12:23a
CRC TXT 1334 1-01-80 12:11a
CRCK4 COM 1536 10-21-82 5:50p
CREAL BAS 18048 1-01-80
CSCREEN BAS 19456 1-01-80
CTRANSFE BAS 25856 3-10-83 12:20a
FORM BAS 13824 3-10-83 12:07a
MAIN BAS 50304 1-01-80
READ ME 1243 1-01-85 12:07p
SCAN BAS 31232 3-10-83 12:04a
SORT BAS 12288 3-10-83 12:10a
TESTASCI BAS 128 3-10-83 1:32a
TRANSFER BAS 17536 3-10-83 12:08a
18 file(s) 311569 bytes
0 bytes free