home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / log / hamsys / hamedit.bas < prev    next >
BASIC Source File  |  1990-09-17  |  32KB  |  562 lines
  1. 10 ' HAMEDIT  -PROGRAM TO  MAINTAIN HAM LOGS
  2. 20 'CHANGE DATE - 11/11/87
  3. 30 '
  4. 40 DIM DISKRCD(22),RCDMRKD(22)    ' To store addresses and marked of found rcds
  5. 45 FOUNDEND = 2                   ' Set up for same QSO search
  6. 50 KEY OFF
  7. 60 OPEN "CNFG.DAT" AS 2 LEN = 58
  8. 70 FIELD 2,2 AS DR1$,2 AS SPEEDLUK$,8 AS AN1$,8 AS AN2$,8 AS AN3$,5 AS RN1$,5 AS RN2$,5 AS RN3$,5 AS TR1$,5 AS TR2$,5 AS TR3$
  9. 80 GET 2,1
  10. 90 COLOR 7,0 : LOCATE ,,,6,13       ' HAVE CURSOR COVER HALF OF THE CHARACTER
  11. 100 DEF SEG = 64 : POKE 23,64 : ' SET CAPS LOCK ON
  12. 110 ' LABELS USED   L = LINE NUMBER IN USE
  13. 120 '               F = FIELD NUMBER IN USE
  14. 130 '               R = POSITION IN FIELD
  15. 140 '               F1$ - F12$ = CURRENT FIELD NUMBERS
  16. 150 '               HDR$ = TITLE LINE
  17. 160 '               L$ = MASK LINE FOR VERTICAL LINES
  18. 170 ' *** SET DRIVE LETTERS
  19. 180 ONN= -1:OFFF= 0                  ' SET LABELS
  20. 190 CLS:LOCATE 8,1:PRINT "WHICH DRIVE DO YOU WANT TO USE ?"
  21. 200 O$=INKEY$ : IF O$="" GOTO 200                ' WAIT FOR RESPONSE
  22. 210 IF O$ = "A" OR O$="B" THEN DR1$=O$+":" :GOTO 240 'DISKETTE A OR B
  23. 220 IF O$ = "C" OR O$="D" THEN DR1$=O$+":" :GOTO 240 'DRIVE C OR D
  24. 230 GOTO 190                                   ' NOT VALID DRIVE, RETRY
  25. 240 DIM FL(12),FP(12),CL$(30),F1$(30),F2$(30),F3$(30),F4$(30),F5$(30),F6$(30),F7$(30),F8$(30),F9$(30),F10$(30),F11$(30),F12$(30),FLG$(30),FLG1$(30),FLG2$(30),TP$(30)
  26. 250 ' ****   SET FIELD LENGTHS
  27. 260 DATA 5,8,5,1,1,10,6,1,4,1,4,23
  28. 270 FOR I=1 TO 12:READ FL(I):DLEN=DLEN+FL(I):NEXT:'GET FIELD LENGTHS INTO ARRAY
  29. 280 '*** FIELD POSITIONS ON SCREEN
  30. 290 DATA 1,4,10,16,18,20,31,38,40,45,47,52 :FP=1:FP(1)=1
  31. 300 FOR I = 2 TO 12 :FP=FP+FL(I-1)+1:FP(I)=FP:NEXT:' GET FIELD POSTIONS
  32. 310 GOSUB 320 :GOTO 360                 ' SO THIS ROUTINE CAN BE USED ELSEWHERE
  33. 320 F7$=STRING$(FL(7),32)            ' PULL THESE SEPARATE TO NOT CLEAR
  34. 330 F8$=STRING$(FL(8),32):F9$=STRING$(FL(9),32)
  35. 340 F10$=STRING$(FL(10),32):F11$=STRING$(FL(11),32)
  36. 350 RETURN
  37. 360 GOSUB 370 : GOTO 420 :               ' CLEAR ALL FIELDS
  38. 370 F1$=STRING$(FL(1),32):F2$=STRING$(FL(2),32):F3$=STRING$(FL(3),32)
  39. 380 F4$=STRING$(FL(4),32):F5$=STRING$(FL(5),32):F6$=STRING$(FL(6),32)
  40. 390 F12$=STRING$(FL(12),32)
  41. 400 FLG$="0"                                   ' CLEAR HIGHLIGHT FLAG
  42. 410 RETURN
  43. 420 ' ***  SET UP SCREEN AND KEYS
  44. 430 HDR$="QSO #   DATE   TIME  S R CALL SIGN  FREQ   R   S  R   S    COMMENTS"
  45. 440 M$="│":L$="     "+M$+"        "+M$+"     "+M$+" "+M$+" "+M$+"          "
  46. 450 L$=L$+M$+"      "+M$+" "+M$+"    "+M$+" "+M$+"    "+M$
  47. 460 CLS:PRINT HDR$ :                          ' PRINT HEADING
  48. 470 FOR I=1 TO 20 :PRINT L$:CL$(I)=L$+STRING$(FL(12),32):NEXT :' PRINT DIVIDER LINES
  49. 480 ON KEY (9) GOSUB 700  :            ' GOTO ROUTINE TO MOVE LEFT
  50. 490 ON KEY (10) GOSUB 880 :           ' GOTO ROUTINE TO MOVE RIGHT
  51. 500 ON KEY (1) GOSUB 1300  :           ' GOTO ROUTINE TO HIGHLIGHT CALL SIGN
  52. 510 ON KEY (13) GOSUB 1350  :           ' MOVE CURSOR RIGHT
  53. 520 ON KEY (12) GOSUB 1340  :           ' MOVE CURSOR LEFT
  54. 530 ON KEY (2) GOSUB 1320  :           ' SET FLAG TO HIGH INTENSITY
  55. 540 KEY 3,""                            ' SOFT KEY 3 OFF DOESN'T NEED SUBRTN
  56. 550 ON KEY (4) GOSUB 3130                  ' SEARCH DATE ROUTINE
  57. 560 ON KEY (7) GOSUB 1250                  ' CURSOR UP ROUTINE
  58. 570 ON KEY (5) GOSUB 3760                  ' PRINT LOG ROUTINE
  59. 580 ON KEY (6) GOSUB 5000                  ' All same QSL's
  60. 590 ON KEY (8) GOSUB 1190                  ' CURSOR DOWN ROUTINE
  61. 600 KEY (1)ON:KEY(9)ON:KEY(10)ON:KEY(12)ON:KEY(13)ON:KEY(2)ON  ' TURN KEYS ON
  62. 610 KEY(4) ON  : KEY(7) ON : KEY(8) ON :KEY(5) ON : KEY(6) ON
  63. 620 LOCATE 24,1 : PRINT "F1 - NEW COUNTRY |F3 - QSO SEARCH  |F5 - PRT/CPY LOG| F9 - MOVE LEFT FIELD";                            ' PRINT INSTRUCTIONS
  64. 630 LOCATE 25,1 : PRINT "F2 - QSL CARD    |F4 - DATE SEARCH |F6 - SAME QSOs  | F10 - MOVE RIGHT FIELD";:                           ' PRINT INSTRUCTIONS
  65. 640 GOSUB 3670                        ' GET NEW HEADER INFORMATION
  66. 650 ' ***
  67. 660 ' *              SET UP PARAMATERS FOR INITIAL SCREEN / GOTO PAGE UP
  68. 670 ' ***
  69. 680 L=2: F=1: XX=1: YY = 1: GOTO 1810  ' SET FOR LINE 2, FIELD 1, TOP LEFT SCR
  70. 690 ' ***
  71. 700 ' *               ROUTINE TO MOVE LEFT FIELD
  72. 710 ' ***
  73. 720 IF F = 1 THEN RETURN
  74. 730 GOSUB 2430                        '  CHECK IF ANYTHING IN INPUT BUFFER
  75. 740 F=F-1 : ON F GOTO 750,760,770,780,790,800,810,820,830,840,850
  76. 750 LOCATE L,FP(1):RETURN 1370
  77. 760 LOCATE L,FP(2):RETURN 1370
  78. 770 LOCATE L,FP(3):RETURN 1370
  79. 780 LOCATE L,FP(4):RETURN 1370
  80. 790 LOCATE L,FP(5):RETURN 1370
  81. 800 LOCATE L,FP(6):RETURN 1370
  82. 810 LOCATE L,FP(7):RETURN 1370
  83. 820 LOCATE L,FP(8):RETURN 1370
  84. 830 LOCATE L,FP(9):RETURN 1370
  85. 840 LOCATE L,FP(10):RETURN 1370
  86. 850 LOCATE L,FP(11):RETURN 1370
  87. 860 LOCATE L,FP(12):RETURN 1370
  88. 870 ' ***
  89. 880 ' *               ROUTINE TO MOVE RIGHT FIELD
  90. 890 ' ***
  91. 900 IF F = 12 THEN RETURN       :      ' ALREADY AT END
  92. 910 GOSUB 2430 :  COLOR 7,0:         '  CHECK IF ANYTHING IN INPUT BUFFER
  93. 920 F=F+1 : ON F-1  GOTO 760,770,780,790,800,810,820,830,840,850,860
  94. 930 RETURN
  95. 940 ' ***
  96. 950 ' *     SUBROUTINE TO MOVE CURSOR UP/DOWN
  97. 960 ' ***
  98. 970 COLOR 7,0
  99. 980 FLG$(CB)=FLG$:FLG$=FLG$(CA)             '       CHANGE ACTIVE FIELDS
  100. 990 ON F GOTO 1000,1010,1020,1030,1040,1050,1060,1070,1080,1090,1100,1110
  101. 1000 LOCATE CA,FP(1):GOTO 1120
  102. 1010 LOCATE CA,FP(2):GOTO 1120
  103. 1020 LOCATE CA,FP(3):GOTO 1120
  104. 1030 LOCATE CA,FP(4):GOTO 1120
  105. 1040 LOCATE CA,FP(5):GOTO 1120
  106. 1050 LOCATE CA,FP(6):GOTO 1120
  107. 1060 LOCATE CA,FP(7):GOTO 1120
  108. 1070 LOCATE CA,FP(8):GOTO 1120
  109. 1080 LOCATE CA,FP(9):GOTO 1120
  110. 1090 LOCATE CA,FP(10):GOTO 1120
  111. 1100 LOCATE CA,FP(11):GOTO 1120
  112. 1110 LOCATE CA,FP(12):GOTO 1120
  113. 1120 RETURN                          ' GO BACK
  114. 1130                                       ' SET UP FOR GETTING MATRIX TO FIELD
  115. 1140 F1$=F1$(L):F2$=F2$(L):F3$=F3$(L):F4$=F4$(L):F5$=F5$(L):F6$=F6$(L):F7$=F7$(L):F8$=F8$(L):F9$=F9$(L):F10$=F10$(L):F11$=F11$(L):F12$=F12$(L):FLG$=FLG$(L):FLG1$=FLG1$(L):FLG2$=FLG2$(L): RETURN
  116. 1150                                      ' SET UP FOR GETTING FIELD TO MATRIX
  117. 1160 F1$(L)=F1$:F2$(L)=F2$:F3$(L)=F3$:F4$(L)=F4$:F5$(L)=F5$:F6$(L)=F6$:F7$(L)=F7$:F8$(L)=F8$:F9$(L)=F9$:F10$(L)=F10$:F11$(L)=F11$:F12$(L)=F12$:FLG$(L)=FLG$:FLG1$(L)=FLG1$:FLG2$(L)=FLG2$
  118. 1170 RETURN
  119. 1180 ' ***
  120. 1190 ' *     ROUTINE TO MOVE CURSOR DOWN
  121. 1200 ' ***
  122. 1210 IF L = 20 THEN GOTO 1560                      ' AT THE BOTTOM - IGNORE
  123. 1220 GOSUB 2430:CB=L:CA=L+1:L=L+1:R=1                   ' SET PARAMETERS
  124. 1230 GOSUB 950:GOTO 1420                          ' MOVE CURSOR
  125. 1240 ' ***
  126. 1250 ' *     ROUTINE TO MOVE CURSOR UP
  127. 1260 ' ***
  128. 1270 IF L = 2 THEN 1560                            ' AT THE TOP - IGNORE
  129. 1280 GOSUB 2430:CB=L:CA=L-1:L=L-1:R=1              ' SET PARAMETERS
  130. 1290 GOSUB 950:GOTO 1420                          ' MOVE CURSOR
  131. 1300 '*** ROUTINE TO HIGHLIGHT CALL SIGN
  132. 1310 MODSW=ONN:IF FLG$(L)="1" THEN FLG$(L)="0" : RETURN ELSE FLG$(L)="1":RETURN
  133. 1320 MODSW=ONN: IF FLG$(L)="2" THEN FLG$(L)="0":RETURN ELSE FLG$(L)="2":RETURN
  134. 1330 ' *** ROUTINE TO MOVE CURSOR RIGHT OR LEFT
  135. 1340 IF R=1 THEN RETURN ELSE R=R-1:GOTO 1360
  136. 1350 IF R=FL(F) THEN RETURN ELSE R=R+1
  137. 1360 LOCATE L,P+R-1 : RETURN
  138. 1370 ' ***   GET CHARACTERS TO SCREEN
  139. 1380 LOCATE ,,1                         ' TURN ON  CURSOR
  140. 1390 P=FP(F):R=1                           ' GET FIELD POSITION/1ST POSITION
  141. 1400 LOCATE L,P+P12                      ' LENGTH OF COMMENT OVERFLOW IF USED
  142. 1410 IF P12 <> 0 THEN R=P12+1 : P12=0     ' SET POSTION AND RESET OVERFLOW
  143. 1420 ON F GOTO 1430,1440,1450,1460,1470,1480,1490,1500,1510,1520,1530,1540
  144. 1430 TP$=F1$(L) :GOTO 1560                ' SET UP INPUT BUFFER
  145. 1440 TP$=F2$(L) :GOTO 1560                ' SET UP INPUT BUFFER
  146. 1450 TP$=F3$(L) :GOTO 1560                ' SET UP INPUT BUFFER
  147. 1460 TP$=F4$(L) :GOTO 1560                ' SET UP INPUT BUFFER
  148. 1470 TP$=F5$(L) :GOTO 1560                ' SET UP INPUT BUFFER
  149. 1480 TP$=F6$(L) :GOTO 1560                ' SET UP INPUT BUFFER
  150. 1490 TP$=F7$(L) :GOTO 1560                ' SET UP INPUT BUFFER
  151. 1500 TP$=F8$(L) :GOTO 1560                ' SET UP INPUT BUFFER
  152. 1510 TP$=F9$(L) :GOTO 1560                ' SET UP INPUT BUFFER
  153. 1520 TP$=F10$(L) :GOTO 1560               ' SET UP INPUT BUFFER
  154. 1530 TP$=F11$(L) :GOTO 1560               ' SET UP INPUT BUFFER
  155. 1540 TP$=F12$(L)                       ' SET UP INPUT BUFFER
  156. 1550 '                            ********************************************
  157. 1560 O$=INKEY$ : IF O$="" GOTO 1560    ' WAIT FOR USER
  158. 1570 '                            ********************************************
  159. 1580 IF ASC(O$)=27 THEN GOTO 2860      ' ESCAPE PUSHED TO END
  160. 1590 IF ASC(O$) <> 13 THEN GOTO 1595   ' Not enter
  161. 1593 IF SAMEQSO THEN GOSUB 6000:GOTO 1830 ELSE GOTO 1560 'Enter after same QSO
  162. 1595 IF ASC(O$) <> 9 THEN GOTO 1600     ' Not right tab
  163. 1596 IF F <> 12 THEN TP$ = " " :FLDSW= ONN : GOSUB 880 ELSE GOTO 1560
  164. 1600 IF ASC(O$) <> 8 GOTO 1650         ' BACK SPACE KEY NOT PUSHED
  165. 1610 MID$(TP$,R,1)=" " :FLDSW=ONN      ' BLANK CHARACTER IN RECORD
  166. 1620 LOCATE L,P+R-1:PRINT " ";         ' ERASE CHAR ON SCREEN
  167. 1630 IF R<>1 THEN R=R-1                ' IF NOT IN FIRST POSITION DECREMENT
  168. 1640 LOCATE L,P+R-1:GOTO 1560          'SET UP SCREEN POSITION
  169. 1650 IF ASC(O$)<>42 GOTO 1680          ' NOT A PRTSC KEY
  170. 1660 GOSUB 2430 :GOSUB 2300            'WRITE OUT RECORD TO CONTINUE COMMENTS
  171. 1670 F=12 : LSET F12$=S$: S$=STRING$(FL(12),32):GOSUB 320 : GOSUB 990
  172. 1680 IF ASC(O$)<>32 THEN GOTO 1730     ' NOT SPACE BAR
  173. 1690 IF F = 12  THEN GOTO 2040                 ' SPACES ALLOWED IN COMMENTS
  174. 1700 IF F<>7 OR R<>1 GOTO 1720                 ' NOT 1ST CHARACTER OF FREQ FLD
  175. 1710 MID$(TP$,4,3)="   ":LOCATE L,P+R-1:PRINT TP$;:R=4:LOCATE L,P+R-1,1 :GOTO 1560
  176. 1720 GOSUB 880                               ' GOTO ROUTINE TO MOVE NEXT FIELD
  177. 1730 IF LEN(O$)<>2 THEN GOTO 2040              ' NOT A CURSOR MOVEMENT KEY
  178. 1735 IF ASC(RIGHT$(O$,1)) <> 15 THEN GOTO 1740 ' Not left tab
  179. 1736 IF F <> 1 THEN TP$ = " " :FLDSW = ONN : GOSUB 700 ELSE GOTO 1560
  180. 1740 IF ASC(LEFT$(O$,1))=0 AND ASC(RIGHT$(O$,1))<>81 GOTO 1790  ' NOT PGDN
  181. 1750 GOSUB 2430:GOSUB 2250                     ' CHECK FOR MODS
  182. 1760 IF CURDSP=0 THEN CURDSP=NUMREC+18 ELSE CURDSP=CURDSP+18
  183. 1770 IF CURDSP>NUMREC THEN GOTO 1950
  184. 1780 GOTO 1830                          ' ROUTINE TO GET PAGES
  185. 1790 IF ASC(LEFT$(O$,1))=0 AND ASC(RIGHT$(O$,1))<>73 GOTO 1960  ' NOT PGUP
  186. 1800 GOSUB 2430:GOSUB 2250                     ' CHECK FOR MODS
  187. 1810 IF CURDSP=0 THEN CURDSP=NUMREC                      ' NO PREVIOUS ACTIVITY
  188. 1820 IF CURDSP-18 < 1 THEN CURDSP=1 ELSE CURDSP=CURDSP-18  ' GO BACK 18 RECORDS
  189. 1830 ' ***  ROUTINE TO GET RECORDS FOR PAGING
  190. 1840 TK=-1:L=2                                 ' SET UP FOR ROUTINE
  191. 1850 TK=TK+1:GET 1,CURDSP+TK                 ' READ TO FIND FIRST VALID RECORD
  192. 1860 IF F1$="        " THEN GOTO 1850        ' SKIP OVER COMMENT RECORDS
  193. 1870 FOR K= CURDSP+TK TO CURDSP+18       ' READ 18 RECORDS MINUS SKIPPED ONES
  194. 1880 IF K>NUMREC THEN GOTO 1930          ' OUTSIDE DISK AREA
  195. 1890 GET 1,K:GOSUB 3490
  196. 1900 F1$(L)=DF1$:F2$(L)=DF2$:F3$(L)=DF3$:F4$(L)=DF4$:F5$(L)=DF5$:F6$(L)=DF6$
  197. 1910 F7$(L)=DF7$:F8$(L)=DF8$:F9$(L)=DF9$:F10$(L)=DF10$:F11$(L)=DF11$:F12$(L)=DF12$:FLG$(L)=DFLG$:FLG1$(L)=DFLG1$:FLG2$(L)=DFLG2$
  198. 1920 L=L+1:NEXT:GOTO 1940
  199. 1930 FOR L =L TO 20:LOCATE L,1:PRINT L$+STRING$(FL(12),32);:NEXT
  200. 1940 F1$=F1$(2):F2$=F2$(2):F3$=F3$(2):F4$=F4$(2):F5$=F5$(2):F6$=F6$(2):F7$=F7$(2):F8$=F8$(2):F9$=F9$(2):F10$=F10$(2):F11$=F11$(2):F12$=F12$(2):FLG$=FLG$(2)
  201. 1950 L=2 :F=1:XX=1:YY=2 :GOSUB 750                ' RESET AND WAIT FOR USER
  202. 1960 IF ASC(RIGHT$(O$,1))=80 THEN GOTO 1190
  203. 1970 IF ASC(RIGHT$(O$,1))=72 THEN GOTO 1250      ' CURSOR UP KEY
  204. 1980 IF ASC(RIGHT$(O$,1))=71 THEN GOSUB 2430:GOSUB 2250:CURDSP=1:GOTO 1810 'CHECK FOR MODS AND THEN GOTO BEGINNING OF FILE
  205. 1990 IF ASC(RIGHT$(O$,1))=79 THEN GOSUB 2430:GOSUB 2250:CURDSP=NUMREC-18:GOTO 1810 ' CHECK FOR MODS AND THEN GOTO END OF FILE
  206. 2000 IF ASC(RIGHT$(O$,1))=83 THEN TP$="**********":FLDSW=ONN:F=6:GOSUB 910:'<DEL> PUSHED
  207. 2010 IF ASC(RIGHT$(O$,1))=132 THEN GOSUB 2430:GOSUB 2250:CURDSP=CURDSP-50:GOTO 1810 ' -50 CTL-PGUP
  208. 2020 IF ASC(RIGHT$(O$,1))=118 THEN GOSUB 2430:GOSUB 2250:CURDSP=CURDSP+50:GOTO 1810 ' +50 CTL-PGDN
  209. 2030 IF ASC(RIGHT$(O$,1))=61 THEN GOTO 2900   ' F3 PUSHED TO START QSO SEARCH
  210. 2040 IF R=1 THEN TP$=STRING$(FL(F),32):LOCATE L,P:PRINT TP$;
  211. 2050 IF R=1 AND F=1 THEN TP$=""               ' RESET QSO FIELD TO ZERO LEN
  212. 2060 IF F=3 AND R=3 THEN MID$(TP$,3,1)=":":PRINT":":R=R+1 'INSERT IN TIME
  213. 2070 LOCATE L,P+R-1:PRINT O$;                ' PUT OUT CHARACTER
  214. 2075 IF SAMEQSO THEN RCDMRKD(L) = ONN      ' Mark changes in Same QSO routine
  215. 2080 IF F=1 THEN TP$=TP$+O$ : GOTO 2100   ' ADD TO END OF FIELD
  216. 2090 MID$(TP$,R,1)=O$                  ' SET CHARACTER IN HOLDING FIELD
  217. 2100 MODSW = ONN:FLDSW=ONN        ' SET SWITCH TO SHOW MODIFICATION ON THIS PAG
  218. 2110 R=R+1                                  ' INCREMENT FIELD POSITION
  219. 2120 IF F=4 GOTO 4090                       ' SOMETHING ENTERED INTO SEND FIELD
  220. 2130 IF R<=FL(F) THEN GOTO 1560             ' NOT AT MAXIMUM CHARACTERS
  221. 2140 IF F <> 12 THEN GOTO 2220              ' NOT LAST FIELD
  222. 2150 I=FL(12)
  223. 2160 WHILE MID$(TP$,I,1) <> " "
  224. 2170   I=I-1:IF I = 0 THEN GOTO 1660        ' DECREMENT THROUGH FIELD
  225. 2180 WEND
  226. 2190 S$=MID$(TP$,I+1,FL(12)-I) :MID$(TP$,I+1,FL(12)-I)=STRING$(FL(12)-I,32)
  227. 2200 MID$(TP$,FL(12),1)="*"                 ' SET INDICATOR MORE TO FOLLOW
  228. 2210 P12=FL(12)-I:GOTO 1660        'SET OFLW LENGTH / GO TO GET RID OF RECORD
  229. 2220 GOSUB 2430 :                      '  CHECK IF ANYTHING IN INPUT BUFFER
  230. 2230 GOSUB 920                            ' INCREMENT TO NEXT FIELD OVER
  231. 2240 ' ***
  232. 2250 ' *        CHECK FOR ANY CHANGES ON THIS PAGE
  233. 2260 ' ***
  234. 2270 IF MODSW =OFFF THEN RETURN       ' NO CHANGES ON THIS PAGE
  235. 2280 MODSW = OFFF                     ' RESET SWITCH AND CONTINUE TO DISK WRITE
  236. 2285 IF SAMEQSO THEN GOTO 6000        ' There were changes in Same QSO search
  237. 2290 '***
  238. 2300 '*          PUT OUT DISK RECORD
  239. 2310 '***
  240. 2320 Q=2                         ' START AT 1ST DISPLAYED LINE
  241. 2330 FOR K= CURDSP+TK TO CURDSP+18       ' FOR 18 RECORDS MINUS SKIPPED ONES
  242. 2340 IF K>NUMREC THEN RETURN             ' OUTSIDE DISK AREA
  243. 2350 GOSUB 6350                          ' Go set up fields for disk write
  244. 2390 Q=Q+1
  245. 2400 PUT 1,K :NEXT                   ' WRITE OUT TO "A" DRIVE
  246. 2410 CLOSE 1,3: GOSUB 3670   '  Routine to avoid splattering of records
  247. 2420 RETURN
  248. 2430 ' GO TO APROPRIATE FIELD AND ENTER IT
  249. 2440 IF FLDSW=OFFF THEN RETURN    ' NO CHANGES IN ANY FIELD
  250. 2450 FLDSW = OFFF  :MODSW=ONN      ' RESET SWITCH / KEEP PAGE MOD SWITCH
  251. 2460 ON F GOTO 2470,2490,2520,2550,2580,2610,2670,2700,2730,2760,2790,2820
  252. 2470 RSET F1$(L)=TP$                   ' RIGHT ADJUST FIELD
  253. 2480 LOCATE L,FP(1):PRINT F1$(L);:GOTO 2850
  254. 2490 IF LEN(TP$)=FL(2) THEN LSET F2$(L)=TP$ : GOTO 2510
  255. 2500 LSET F2$(L)=TP$+STRING$(FL(2)-LEN(TP$),32)
  256. 2510 LOCATE L,FP(2):PRINT F2$(L);:GOTO 2850
  257. 2520 IF LEN(TP$)=FL(3) THEN LSET F3$(L)=TP$ : GOTO 2540
  258. 2530 LSET F3$(L)=TP$+STRING$(FL(3)-LEN(TP$),32)
  259. 2540 LOCATE L,FP(3):PRINT F3$(L);:GOTO 2850
  260. 2550 IF LEN(TP$)=FL(4) THEN LSET F4$(L)=TP$ : GOTO 2570
  261. 2560 LSET F4$(L)=TP$+STRING$(FL(4)-LEN(TP$),32)
  262. 2570 LOCATE L,FP(4):PRINT F4$(L);:GOTO 2850
  263. 2580 IF LEN(TP$)=FL(5) THEN LSET F5$(L)=TP$ : GOTO 2600
  264. 2590 LSET F5$(L)=TP$+STRING$(FL(5)-LEN(TP$),32)
  265. 2600 LOCATE L,FP(5):PRINT F5$(L);:GOTO 2850
  266. 2610 IF LEN(TP$)=FL(6) THEN LSET F6$(L)=TP$ : GOTO 2630
  267. 2620 LSET F6$(L)=TP$+STRING$(FL(6)-LEN(TP$),32)
  268. 2630 LOCATE L,FP(6)
  269. 2640 IF FLG$(L)="1" THEN COLOR 0,7                  ' SET NEW COUNTRY HIGHLIGHT
  270. 2650 IF FLG$(L)="2" THEN COLOR 15,0                 ' SET SEND QSL CARD
  271. 2660 PRINT F6$(L);:COLOR 7,0:GOTO 2850
  272. 2670 IF LEN(TP$)=FL(7) THEN LSET F7$(L)=TP$ : GOTO 2690
  273. 2680 LSET F7$(L)=TP$+STRING$(FL(7)-LEN(TP$),32)
  274. 2690 LOCATE L,FP(7):PRINT F7$(L);:GOTO 2850
  275. 2700 IF LEN(TP$)=FL(8) THEN LSET F8$(L)=TP$ : GOTO 2720
  276. 2710 LSET F8$(L)=TP$+STRING$(FL(8)-LEN(TP$),32)
  277. 2720 LOCATE L,FP(8):PRINT F8$(L);:GOTO 2850
  278. 2730 IF LEN(TP$)=FL(9) THEN LSET F9$(L)=TP$ : GOTO 2750
  279. 2740 LSET F9$(L)=TP$+STRING$(FL(9)-LEN(TP$),32)
  280. 2750 LOCATE L,FP(9):PRINT F9$(L);:GOTO 2850
  281. 2760 IF LEN(TP$)=FL(10) THEN LSET F10$(L)=TP$ : GOTO 2780
  282. 2770 LSET F10$(L)=TP$+STRING$(FL(10)-LEN(TP$),32)
  283. 2780 LOCATE L,FP(10):PRINT F10$(L);:GOTO 2850
  284. 2790 IF LEN(TP$)=FL(11) THEN LSET F11$(L)=TP$ : GOTO 2810
  285. 2800 LSET F11$(L)=TP$+STRING$(FL(11)-LEN(TP$),32)
  286. 2810 LOCATE L,FP(11):PRINT F11$(L);:GOTO 2850
  287. 2820 IF LEN(TP$)=FL(12) THEN LSET F12$(L)=TP$ : GOTO 2840
  288. 2830 LSET F12$(L)=TP$+STRING$(FL(12)-LEN(TP$),32)
  289. 2840 LOCATE L,FP(12):PRINT F12$(L);:GOTO 2850
  290. 2850 RETURN
  291. 2860 ' *** ROUTINE TO CLOSE DOWN
  292. 2870 COLOR 7,0 :GOSUB 2250                  ' ANY CHANGES IN LAST PAGE
  293. 2880 CLOSE:RUN "MMENU
  294. 2890 ' ***
  295. 2900 ' *          SEARCH BY QSO ROUTINE
  296. 2910 ' ***
  297. 2920 GOSUB 2250                       ' TEST FOR CHANGES BEFORE GOING ANYWHERE
  298. 2930 K=CURDSP-1                       ' START AHEAD OF TOP OF SCREEN
  299. 2940 COLOR 0,7:LOCATE 22,20:PRINT "CALL SIGN";      ' PRINT PROMPT
  300. 2950 LOCATE 22,31:COLOR 7,0:PRINT "          ";:LOCATE 22,29
  301. 2960 INPUT S$                         ' GET NEW SIGN
  302. 2970 IF LEN(S$)=0 THEN GOTO 2990      ' NOTHING ENTERED
  303. 2980 CALSRCH$="          ": LSET CALSRCH$=S$: GOTO 3000 ' USE ENTERED FIELD
  304. 2990 IF CALSRCH$="" THEN CALSRCH$=F6$(L) ' IF NOTHING
  305. 3000 COLOR 7,0 :LOCATE 22,31: PRINT SPACE$(40);
  306. 3010 FOR K= NUMREC TO 1 STEP -1              ' SEARCH BACKWARD FOR CALL SIGN
  307. 3020 O$=INKEY$ : IF O$="" GOTO 3040      ' NO KEY PUSHED
  308. 3030 IF ASC(RIGHT$(O$,1))=106 GOTO 3090 ' BREAK OUT - A-F3
  309. 3040 GET 1,K                                      ' GET RECORD
  310. 3050 IF DF6$<>CALSRCH$ THEN NEXT        ' NO MATCH
  311. 3060 IF K=0 THEN LOCATE 22,37: PRINT"NONE FOUND          ";:GOTO 3100
  312. 3070 LOCATE 22,20:PRINT "           ";
  313. 3080 CURDSP=K : GOTO 1830                ' SET FND NUMBER AND GET SCREEN FULL
  314. 3090 LOCATE 22,20:PRINT "           ";
  315. 3100 COLOR 7,0: GOTO 1560                ' RESET SCREEN COLOR AND WAIT FOR USER
  316. 3110 IF LEN(S$)<>0 THEN LSET CALSRCH$=S$: GOTO 3000 ELSE GOTO 3000 ' USE ENTERED FIELD
  317. 3120 ' ***
  318. 3130 ' *          SEARCH BY DATE ROUTINE
  319. 3140 ' ***
  320. 3150 GOSUB 2250                       ' TEST FOR CHANGES BEFORE GOING ANYWHERE
  321. 3160 COLOR 7,0:LOCATE 22,25:PRINT "DATE";           ' PRINT PROMPT
  322. 3170 LOCATE 22,31:COLOR 0,7:PRINT "          ";:LOCATE 22,29
  323. 3180 INPUT S$ :DATSRCH$="          "
  324. 3190 IF LEN(S$)=0 THEN LSET DATSRCH$=DATE$ ELSE DATSRCH$=S$  ' SET SEARCH FIELD
  325. 3200 FOR K = NUMREC-1 TO 1 STEP -1     ' SET START OF SEARCH
  326. 3210 GET 1,K                           ' MOVE BACK THRU FILE
  327. 3220 IF DF2$="        " GOTO 3270      ' SKIP OVER COMMENT LINES
  328. 3230 IF RIGHT$(DF2$,2)<>RIGHT$(DATSRCH$,2) GOTO 3270  'PASSED THE YEAR
  329. 3240 IF MID$(DF2$,4,2)<>MID$(DATSRCH$,4,2) GOTO 3270  'PASSED THE MONTH
  330. 3250 IF LEFT$(DF2$,2)<>LEFT$(DATSRCH$,2) GOTO 3270    'PASSED THE DAY
  331. 3260 GOTO 3300                          ' FOUND THE FIRST EQUAL MATCH
  332. 3270 NEXT
  333. 3280 IF K=0 THEN LOCATE 22,37: PRINT"NONE FOUND          ";
  334. 3290 COLOR 7,0: LOCATE 1,1,1 :F=1:R=1:RETURN
  335. 3300 FOR K = K-1 TO 1 STEP -1              ' CONTINUE LOOKING TO GET OUT OF =
  336. 3310 GET 1,K                           ' MOVE BACK THRU FILE
  337. 3320 IF DF2$="        " GOTO 3360      ' SKIP OVER COMMENT LINES
  338. 3330 IF RIGHT$(DF2$,2)<>RIGHT$(DATSRCH$,2) GOTO 3370  'PASSED THE YEAR
  339. 3340 IF MID$(DF2$,4,2)<>MID$(DATSRCH$,4,2) GOTO 3370  'PASSED THE MONTH
  340. 3350 IF LEFT$(DF2$,2)<>LEFT$(DATSRCH$,2) GOTO 3370    'PASSED THE DAY
  341. 3360 NEXT
  342. 3370 K=K+1 : L=2                    ' GO BACK TO LAST RECORD AND SET PRINT LINE
  343. 3380 GET 1,K : IF DF2$="        " GOTO 3370  'SKIP COMMENTS AHEAD OF DATE
  344. 3390 CURDSP=K                            ' SET LISTING NUMBER FOR TOP OF SCREEN
  345. 3400 FOR K = K TO K+18                ' GO FORWARD AND PRINT RECORDS
  346. 3410 IF K>NUMREC GOTO 3450             ' BEYOND END OF FILE
  347. 3420 GET 1,K                           ' GET NEXT RECORD
  348. 3430 GOSUB 3490                                       ' PRINT THE DISK RECORD
  349. 3440 L=L+1 : IF L= 21 THEN GOTO 3290 ELSE NEXT  ' INCREMENT TO NEXT PRINT LINE
  350. 3450 IF L = 2 GOTO 3280              ' NO LINES PRINTED
  351. 3460 FOR L =L TO 20:LOCATE L,1:PRINT L$+STRING$(FL(12),32);:NEXT ' CLEAR REST
  352. 3470 GOTO 3290                                        '  OF SCREEN AND EXIT
  353. 3480 ' ***
  354. 3490 ' *         ROUTINE TO DISPLAY DISK RECORD
  355. 3500 ' ***
  356. 3510 LOCATE L,1:PRINT DF1$;
  357. 3520 LOCATE L,FP(2):PRINT DF2$;
  358. 3530 LOCATE L,FP(3):PRINT DF3$
  359. 3540 LOCATE L,FP(4):PRINT DF4$;
  360. 3550 LOCATE L,FP(5):PRINT DF5$
  361. 3560 IF DFLG$="1" THEN COLOR 0,7
  362. 3570 IF DFLG$="2" THEN COLOR 15,0
  363. 3580 LOCATE L,FP(6):PRINT DF6$;
  364. 3590 COLOR 7,0
  365. 3600 LOCATE L,FP(7):PRINT DF7$;
  366. 3610 LOCATE L,FP(8):PRINT DF8$;
  367. 3620 LOCATE L,FP(9):PRINT DF9$;
  368. 3630 LOCATE L,FP(10):PRINT DF10$;
  369. 3640 LOCATE L,FP(11):PRINT DF11$;
  370. 3650 LOCATE L,FP(12):PRINT DF12$;
  371. 3660 COLOR 7,0:RETURN
  372. 3670 ' *** ROUTINE TO GET HEADER RECORD AND DISPLAY
  373. 3680 OPEN DR1$+"HAMHDR.DAT" AS 3 LEN=24
  374. 3690 FIELD 3,4 AS A$,4 AS B$,8 AS C$,8 AS D$ : GET 3,1  ' SET HEADER RECORD FLD
  375. 3700 NUMREC=CVS(A$):NUMQSO=CVS(B$):STRDATE$=C$:ENDDATE$=D$  ' GET HEADER FIELDS
  376. 3710 LOCATE 23,1:PRINT "Start date - ";STRDATE$;" :  End date - ";ENDDATE$;" : Number of records -";NUMREC;
  377. 3720 OPEN DR1$+"HAMLOG.DAT" AS 1 LEN=DLEN+3
  378. 3730 FIELD 1,FL(1) AS DF1$,FL(2) AS DF2$,FL(3) AS DF3$,FL(4) AS DF4$,FL(5) AS DF5$,FL(6) AS DF6$,FL(7) AS DF7$,FL(8) AS DF8$,FL(9) AS DF9$,FL(10) AS DF10$,FL(11)AS DF11$,FL(12) AS DF12$,1 AS DFLG$,1 AS DFLG1$,1 AS DFLG2$
  379. 3740 RETURN
  380. 3750 ' ***
  381. 3760 ' *          PRINT / COPY SECTIONS OF LOG
  382. 3770 ' ***
  383. 3780 XX=POS(0) : YY=CSRLIN              '  CURSOR POSITION
  384. 3781 LOCATE 22,5: PRINT "Do you want to copy (C) or print (P)? Enter C or P";:INPUT ANS$
  385. 3782 IF ANS$ = "C" OR ANS$ = "c" THEN COPY = -1 ELSE GOTO 3790
  386. 3783 LOCATE 22,5 :PRINT STRING$(60,32);       ' Clear line
  387. 3784 LOCATE 22,5 :PRINT "WHICH DRIVE DO YOU WANT TO USE ?"
  388. 3785 O$=INKEY$ : IF O$="" GOTO 3785               ' WAIT FOR RESPONSE
  389. 3786 IF O$ = "A" OR O$="B" THEN DR5$=O$+":" :GOTO 3790 'DISKETTE A OR B
  390. 3787 IF O$ = "C" OR O$="D" THEN DR5$=O$+":" :GOTO 3790 'DRIVE C OR D
  391. 3788 GOTO 190                                   ' NOT VALID DRIVE, RETRY
  392. 3790 OKSW=0                     ' TURN OFF PREVIOUS USE OF SWITCH
  393. 3795 LOCATE 22,5 :PRINT STRING$(60,32);       ' Clear line
  394. 3800 LOCATE 22,5: PRINT "ENTER BEGINNING QSO NUMBER";:INPUT;STRT$
  395. 3810 LOCATE 22,5: PRINT "ENTER ENDING QSO NUMBER         ";
  396. 3820 IF NOT COPY THEN LPRINT  HDR$ : GOTO 3830              ' PRINT HEADING
  397. 3824 OPEN DR5$+"HAMLOG.DAT" AS 2 LEN=DLEN+3               '  or Open file
  398. 3825 FIELD 2,FL(1) AS D2F1$,FL(2) AS D2F2$,FL(3) AS D2F3$,FL(4) AS D2F4$,FL(5) AS D2F5$,FL(6) AS D2F6$,FL(7) AS DF27$,FL(8) AS D2F8$,FL(9) AS D2F9$,FL(10) AS D2F10$,FL(11)AS D2F11$,FL(12) AS D2F12$,1 AS D2FLG$,1 AS D2FLG1$,1 AS D2FLG2$
  399. 3827 CPYREC = 1                                 ' Starting record number
  400. 3830 LOCATE 22,30: INPUT;ENDN$
  401. 3840 S$=STRING$(5,32):T$=STRING$(5,32)
  402. 3850 RSET S$=STRT$ : RSET T$=ENDN$              ' SHIFT TO RIGHT SIDE
  403. 3860 K= NUMREC                                  ' SET A STARTING POINT
  404. 3870 GET 1,K                                   ' GET END RECORD NUMBER
  405. 3880 IF DF1$<" " THEN K=K-1:GOTO 3870          ' OFF THE END OF THE FILE
  406. 3890 IF T$<=DF1$ THEN GOTO 3910                ' INSIDE DISK BOUNDARY
  407. 3900 LOCATE 22,5: PRINT "HIGH VALUE OUT OF THIS DISKETTE";:GOTO 4010
  408. 3910 GET 1,1 :IF S$<DF1$ THEN LOCATE 22,5 : PRINT "QSO NUMBER REQUESTED ON ANOTHER DISK";:RETURN
  409. 3920 K=VAL(STRT$)                              ' Get keyed in value
  410. 3925 IF K = 1 THEN GOTO 3930                   ' Already know start
  411. 3928 K=VAL(STRT$)-VAL(DF1$)                    ' GO TO APPROXIMATE START
  412. 3930 FOR I = K TO NUMREC
  413. 3940 GET 1,I
  414. 3950 IF DF1$>T$ THEN GOTO 4000
  415. 3960 IF OKSW = 1 GOTO 3971
  416. 3970 IF S$=DF1$ THEN OKSW=1 ELSE GOTO 3990
  417. 3971 IF COPY THEN GOTO 3973
  418. 3972 LPRINT DF1$ TAB(FP(2)) DF2$ TAB(FP(3)) DF3$ TAB(FP(4)) DF4$ TAB(FP(5)) DF5$ TAB(FP(6)) DF6$ TAB(FP(7)) DF7$ TAB(FP(8)) DF8$ TAB(FP(9)) DF9$ TAB(FP(10)) DF10$ TAB(FP(11)) DF11$ TAB(FP(12)) DF12$; : GOTO 3990
  419. 3973 LSET D2F1$ = DF1$
  420. 3974 LSET D2F2$ = DF2$
  421. 3975 LSET D2F3$ = DF3$
  422. 3976 LSET D2F4$ = DF4$
  423. 3977 LSET D2F5$ = DF5$
  424. 3978 LSET D2F6$ = DF6$
  425. 3979 LSET D2F7$ = DF7$
  426. 3980 LSET D2F8$ = DF8$
  427. 3981 LSET D2F9$ = DF9$
  428. 3982 LSET D2F10$ = DF10$
  429. 3983 LSET D2F11$ = DF11$
  430. 3984 LSET D2F12$ = DF12$
  431. 3985 LSET D2FLG$ = DFLG$
  432. 3986 LSET D2FLG1$ = DFLG1$
  433. 3987 LSET D2FLG2$ = DFLG2$
  434. 3988 PUT 2,CPYREC : CPYREC = CPYREC + 1    ' Put out record and increment count
  435. 3989 IF CPYREC = 1 THEN STRDAT$ = D2F2$    ' Save starting record date
  436. 3990 NEXT : SAVEREC = CPYREC               ' Save last record # at end
  437. 3991 CLOSE 2:IF NOT COPY THEN GOTO 4000
  438. 3992 IF VAL(D2F1$) = 0 THEN CPYREC = CPYREC - 1 ' Search back for a non-comment
  439. 3993 GET 2,CPYREC : GOTO 3992                   '  record with valid QSO #
  440. 3994 OPEN DR5$+"HAMHDR.DAT" AS 2 LEN=24
  441. 3995 FIELD 3,4 AS A$,4 AS B$,8 AS C$,8 AS D$ : GET 3,1  ' SET HEADER RECORD FLD
  442. 3996 LSET B$ = MKS$(VAL(D2F1$))               ' Put ending QSO number in header
  443. 3997 LSET D$ = D2F2$ : LSET C$ = STRDAT$      ' Save start and end dates
  444. 3998 LSET A$ = MKS$(SAVEREC)                  ' Save total number of records
  445. 3999 PUT 2,1 : CLOSE 2
  446. 4000 LOCATE 22,5 :PRINT STRING$(60,32);
  447. 4010 COLOR 7,0:LOCATE 2,1,1
  448. 4020 RETURN
  449. 4030 ' ***
  450. 4040 ' *           SET END DATE IN HEADER
  451. 4050 ' ***
  452. 4060 GET 1,NUMREC                            ' Get last record in file
  453. 4070 LSET D$=DF2$ : PUT 3,1                  ' Set last record date in header
  454. 4080 ' ***
  455. 4090 ' *      SET UP FOR PRINT LABEL ROUTINE
  456. 4100 ' ***
  457. 4110 LOCATE ,,0   : RNUM=1                   ' Turn off cursor/init ptr
  458. 4120 KEY (12) OFF :KEY (13) OFF
  459. 4140 GOTO  4620                              ' Print radio selection
  460. 4150 O$=INKEY$: IF O$="" GOTO 4150
  461. 4160 IF ASC(O$)=13 GOTO 4200
  462. 4170 IF ASC(RIGHT$(O$,1))=75 GOTO 4600       ' Move left
  463. 4180 IF ASC(RIGHT$(O$,1))=77 GOTO 4590       ' Move right
  464. 4190 GOTO 4150                               ' Not an acceptable key
  465. 4200 ON RNUM GOTO 4210,4220,4230             ' Goto routine to set flag
  466. 4210 MASK = 3   : GOTO 4240
  467. 4220 MASK = 2   : GOTO 4240
  468. 4230 MASK = 1
  469. 4240 FLG1 =  MASK  : RNUM = 1                ' Put in flag byte
  470. 4250 LOCATE 22,25:PRINT STRING$(40,32);      ' Clear prompt line
  471. 4260 GOTO 4560                               ' Print antenna type
  472. 4270 O$=INKEY$:IF O$="" GOTO 4270
  473. 4280 IF ASC(RIGHT$(O$,1))=75 GOTO 4540        ' Move left
  474. 4290 IF ASC(RIGHT$(O$,1))=77 GOTO 4530        ' Move right
  475. 4300 IF ASC(O$)=13 GOTO 4320
  476. 4310 GOTO 4270                                ' Not an acceptable key
  477. 4320 ON RNUM GOTO 4330,4340,4350              ' Goto routine to set flag
  478. 4330 MASK = 12  : GOTO 4360
  479. 4340 MASK = 8   : GOTO 4360
  480. 4350 MASK = 4
  481. 4360 FLG1 = FLG1 + MASK  : RNUM = 1           ' Put in flag byte
  482. 4370 LOCATE 22,25:PRINT STRING$(40,32);       ' Clear prompt line
  483. 4380 GOTO 4680                                ' Print transmission type
  484. 4390 O$=INKEY$:IF O$="" GOTO 4390
  485. 4400 IF ASC(RIGHT$(O$,1))=75 GOTO 4660        ' Move left
  486. 4410 IF ASC(RIGHT$(O$,1))=77 GOTO 4650        ' Move right
  487. 4420 IF ASC(O$)=13 GOTO 4440
  488. 4430 GOTO 4270                                ' Not an acceptable flag
  489. 4440 ON RNUM GOTO 4450,4460,4470              ' Goto routine to set flag
  490. 4450 MASK = 48  : GOTO 4480
  491. 4460 MASK = 32  : GOTO 4480
  492. 4470 MASK = 16
  493. 4480 FLG1 = FLG1 + MASK                       ' Put in flag byte
  494. 4490 LSET FLG1$(L) = CHR$(FLG1) : MODSW= ONN  ' Put in flag byte / set modify
  495. 4495 RCDMRKD(L) = ONN                         ' Set that this record changed
  496. 4500 LOCATE 22,25:PRINT STRING$(40,32);       ' CLEAR PROMPT LINE
  497. 4510 KEY (12) ON :KEY (13) ON
  498. 4520 LOCATE ,,1:GOTO 2220
  499. 4530 RNUM=RNUM+1:IF RNUM>3 THEN RNUM=3 : GOTO 4550 ELSE GOTO 4550
  500. 4540 RNUM=RNUM-1:IF RNUM<1 THEN RNUM=1
  501. 4550 ON RNUM GOTO 4560,4570,4580              ' SELECT WHICH MOVE
  502. 4560 LOCATE 22,25:COLOR 0,7:PRINT AN1$;:LOCATE 22,35:COLOR 7,0:PRINT AN2$;:LOCATE 22,45:PRINT AN3$:AN$=AN1$:GOTO 4270
  503. 4570 LOCATE 22,25:PRINT AN1$;:LOCATE 22,35:COLOR 0,7:PRINT AN2$;:LOCATE 22,45:COLOR 7,0:PRINT AN3$:AN$=AN2$:GOTO 4270
  504. 4580 LOCATE 22,25:PRINT AN1$;:LOCATE 22,35:PRINT AN2$;:LOCATE 22,45:COLOR 0,7:PRINT AN3$:COLOR 7,0:AN$=AN3$:GOTO 4270
  505. 4590 RNUM=RNUM+1:IF RNUM>3 THEN RNUM=3 : GOTO 4610 ELSE GOTO 4610
  506. 4600 RNUM=RNUM-1:IF RNUM<1 THEN RNUM=1
  507. 4610 ON RNUM GOTO 4620,4630,4640              ' SELECT WHICH MOVE
  508. 4620 LOCATE 22,25:COLOR 0,7:PRINT RN1$;:LOCATE 22,35:COLOR 7,0:PRINT RN2$;:LOCATE 22,45:PRINT RN3$:RD$=RN1$:GOTO 4150
  509. 4630 LOCATE 22,25:PRINT RN1$;:LOCATE 22,35:COLOR 0,7:PRINT RN2$;:LOCATE 22,45:COLOR 7,0:PRINT RN3$:RD$=RN2$:GOTO 4150
  510. 4640 LOCATE 22,25:PRINT RN1$;:LOCATE 22,35:PRINT RN2$;:LOCATE 22,45:COLOR 0,7:PRINT RN3$:COLOR 7,0:RD$=RN3$:GOTO 4150
  511. 4650 RNUM=RNUM+1:IF RNUM>3 THEN RNUM=3 : GOTO 4670 ELSE GOTO 4670
  512. 4660 RNUM=RNUM-1:IF RNUM<1 THEN RNUM=1
  513. 4670 ON RNUM GOTO 4680,4690,4700              ' Select which move
  514. 4680 LOCATE 22,25:COLOR 0,7:PRINT TR1$;:LOCATE 22,35:COLOR 7,0:PRINT TR2$;:LOCATE 22,45:PRINT TR3$:GOTO 4390
  515. 4690 LOCATE 22,25:PRINT TR1$;:LOCATE 22,35:COLOR 0,7:PRINT TR2$;:LOCATE 22,45:COLOR 7,0:PRINT TR3$:GOTO 4390
  516. 4700 LOCATE 22,25:PRINT TR1$;:LOCATE 22,35:PRINT TR2$;:LOCATE 22,45:COLOR 0,7:PRINT TR3$:COLOR 7,0:GOTO 4390
  517. 4800 '  Put in the ability to seach again     *************************
  518. 4810 '     and continue through the data base.  *************************
  519. 4999 ' ***
  520. 5000 ' *          Find all QSO with same call sign and display
  521. 5001 ' ***
  522. 5002 GOSUB 2250                                  ' Check for any changes
  523. 5006 COLOR 0,7:LOCATE 22,20:PRINT "CALL SIGN";      ' PRINT PROMPT
  524. 5008 LOCATE 22,31:COLOR 7,0:PRINT "          ";:LOCATE 22,29
  525. 5010 INPUT S$                                    ' GET NEW SIGN
  526. 5011 LOCATE 22,20:COLOR 7,0:PRINT "                     ";:LOCATE 22,29
  527. 5012 IF LEN(S$)=0 THEN RETURN                    ' NOTHING ENTERED
  528. 5013 CALSRCH$="          ": LSET CALSRCH$=S$     ' USE ENTERED FIELD
  529. 5014 COLOR 7,0 :LOCATE 22,31: PRINT SPACE$(40);
  530. 5015 LOCATE 2,1                                  ' Set for printing 2nd line
  531. 5020 FOR I=1 TO 20 :PRINT L$:NEXT                ' Print divider lines
  532. 5035 L = 2                                       ' Set line position
  533. 5040 FOR K = 1 TO NUMREC                         ' Go through entire file
  534. 5050   GET 1,K                                   ' Read record
  535. 5060   IF CALSRCH$ <> DF6$ GOTO 5100             ' No match
  536. 5070    GOSUB 3490                              ' Print line
  537. 5073 F1$(L)=DF1$:F2$(L)=DF2$:F3$(L)=DF3$:F4$(L)=DF4$:F5$(L)=DF5$:F6$(L)=DF6$:F7$(L)=DF7$:F8$(L)=DF8$:F9$(L)=DF9$:F10$(L)=DF10$:F11$(L)=DF11$:F12$(L)=DF12$:FLG$(L)=DFLG$:FLG1$(L)=DFLG1$:FLG2$(L)=DFLG2$
  538. 5075    DISKRCD(L) = K                          ' Keep record number on line
  539. 5080    L = L + 1                               ' Get ready for next one
  540. 5090    IF L > 21 THEN LOCATE 22,31 :PRINT "Too many to display use F3 to get the rest" : GOTO 5110                        ' Gotten enough
  541. 5100 NEXT
  542. 5104 FOUNDEND = L                                  ' Set next line number
  543. 5105 SAMEQSO = ONN
  544. 5107 IF L = 2 THEN LOCATE 22,31 : PRINT "None found" : SAMEQSO =OFFF
  545. 5110 L=2 :F=1:XX=1:YY=2 :GOTO 750                ' Reset and wait for user
  546. 5999 '***
  547. 6000 '*     Routine to write out changes to same QSO search
  548. 6001 '***
  549. 6010 FOR L = 2 TO FOUNDEND
  550. 6020 IF RCDMRKD(L) = ONN THEN Q = L : RCDMRKD(L) = OFFF : GOSUB 6350 :    PUT 1,DISKRCD(L)
  551. 6030 NEXT
  552. 6035 SAMEQSO = OFFF                              ' Turn off Same QSO switch
  553. 6040 RETURN
  554. 6349 '***
  555. 6350 '*       Move fields to disk output area
  556. 6351 '***
  557. 6355 LSET DF1$=F1$(Q):LSET DF2$=F2$(Q):LSET DF3$=F3$(Q):LSET DF4$=F4$(Q)
  558. 6360 LSET DF5$=F5$(Q):LSET DF6$=F6$(Q):LSET DF7$=F7$(Q):LSET DF8$=F8$(Q)
  559. 6370 LSET DF9$=F9$(Q):LSET DF10$=F10$(Q):LSET DF11$=F11$(Q):LSET DF12$=F12$(Q)
  560. 6380 LSET DFLG$=FLG$(Q) :LSET DFLG1$=FLG1$(Q):LSET DFLG2$=FLG2$(Q)
  561. 6390 RETURN
  562.