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

BASIC Source File | 1983-03-10 | 30KB | 1,003 lines

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
*"
61800 PRINT ""
61805 PRINT "                   Press any key to conti