home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / log / hamsys / hamcntst.bas < prev    next >
BASIC Source File  |  1987-01-02  |  22KB  |  379 lines
  1. 10 ' HAMCNTST - PROGRAM TO ENTER DURING A CONTEST
  2. 20 'CHANGE DATE - 1/1/87
  3. 30 COLOR 7,0
  4. 40 CLS
  5. 50 DEF SEG = 64 : POKE 23,64 : ' SET CAPS LOCK ON
  6. 60 ONN=-1:OFFF=0                             ' SET ON AND OFF INDICATIORS
  7. 70 ' LABELS USED   L = LINE NUMBER IN USE
  8. 80 '               F = FIELD NUMBER IN USE
  9. 90 '               R = POSITION IN FIELD
  10. 100 '               F1$ - F12$ = CURRENT FIELD NUMBERS
  11. 110 '               T$ = TITLE LINE
  12. 120 '               L$ = MASK LINE FOR VERTICAL LINES
  13. 130 OPEN "CNFG.DAT" AS 2 LEN = 58
  14. 140 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$
  15. 150 GET 2,1
  16. 160 TOPS = 3000 :       ' ********** MAXIMUM RECORDS PER DISKETTE ******
  17. 170 EXT$="DAT"                         ' Set default extension
  18. 180 DIM FL(12),FP(12),CL$(20),F1$(20),F2$(20),F3$(20),F4$(20),F5$(20),F6$(20),F7$(20),F8$(20),F9$(20),F10$(20),F11$(20),F12$(20),FLG$(20),C$(3000),F$(3000)
  19. 190 CLS : KEY OFF                      ' CLEAR SCREEN AND TURN SOFT KEYS OFF
  20. 200 PRINT "DO YOU WANT TO MATCH ON FREQUENCY?"
  21. 210 O$=INKEY$: IF O$="" GOTO 210
  22. 220 IF O$="Y" THEN FREQSW=ONN           ' SET FOR Frequency SWITCH ON
  23. 230 ' ****   SET FIELD LENGTHS
  24. 240 DATA 5,8,5,1,1,10,6,1,4,1,4,23
  25. 250 FOR I=1 TO 12:READ FL(I):DLEN=DLEN+FL(I):NEXT:'GET FIELD LENGTHS INTO ARRAY
  26. 260 '*** FIELD POSITIONS ON SCREEN
  27. 270 DATA 1,4,10,16,18,20,31,38,40,45,47,52 :FP=1:FP(1)=1
  28. 280 FOR I = 2 TO 12 :FP=FP+FL(I-1)+1:FP(I)=FP:NEXT:' GET FIELD POSTIONS
  29. 290 GOSUB 300 :GOTO 340                 ' SO THIS ROUTINE CAN BE USED ELSEWHERE
  30. 300 F7$=STRING$(FL(7),32)            ' PULL THESE SEPARATE TO NOT CLEAR
  31. 310 F8$=STRING$(FL(8),32):F9$=STRING$(FL(9),32):F6$=STRING$(FL(6),32)
  32. 320 F10$=STRING$(FL(10),32):F11$=STRING$(FL(11),32)
  33. 330 RETURN
  34. 340 GOSUB 350 : GOTO 400 :               ' CLEAR ALL FIELDS
  35. 350 F1$=STRING$(FL(1),32):F2$=STRING$(FL(2),32):F3$=STRING$(FL(3),32)
  36. 360 F4$=STRING$(FL(4),32):F5$=STRING$(FL(5),32)
  37. 370 F12$=STRING$(FL(12),32)
  38. 380 FLG$="0"                                   ' CLEAR HIGHLIGHT FLAG
  39. 390 RETURN
  40. 400 PRINT "DO YOU WANT TO EXTEND A CONTEST FILE ?"
  41. 410 O$=INKEY$: IF O$="" GOTO 410
  42. 420 CLS:GOSUB 3220:GOSUB 650              ' GET NEW HEADER INFORMATION
  43. 430 IF O$<>"Y" THEN GOTO 470            'CREATE NEW CONTEST FILE
  44. 440 FOR I= 1 TO NUMREC :GET 1,I         'READ PREVIOUS FILE
  45. 450   C$(I)=DF6$:F$(I)=LEFT$(DF7$,2)      ' BUILD FILE FROM PREVIOUS FILE
  46. 460 NEXT : U=NUMREC                     ' SET NUMBER OF RECORDS
  47. 470 ON KEY (9) GOSUB 890  :            ' GOTO ROUTINE TO MOVE LEFT
  48. 480 ON KEY (10) GOSUB 1080 :           ' GOTO ROUTINE TO MOVE RIGHT
  49. 490 ON KEY (1) GOSUB 1280  :           ' GOTO ROUTINE TO HIGHLIGHT CALL SIGN
  50. 500 ON KEY (13) GOSUB 1330  :           ' MOVE CURSOR RIGHT
  51. 510 ON KEY (12) GOSUB 1320  :           ' MOVE CURSOR LEFT
  52. 520 ON KEY (2) GOSUB 1300  :           ' SET FLAG TO HIGH INTENSITY
  53. 530 KEY 3,""                          '   DISABLE SOFT KEY TO ALLOW QSO SEARCH
  54. 540 KEY (1)ON:KEY(9)ON:KEY(10)ON:KEY(12)ON:KEY(13)ON:KEY(2)ON  ' TURN KEYS ON
  55. 550 ' ***  SET UP SCREEN AND KEYS
  56. 560 LOCATE 1,1
  57. 570 T$="QSO #   DATE   TIME  S R CALL SIGN  FREQ   R   S  R   S    COMMENTS"
  58. 580 M$="│":L$="     "+M$+"        "+M$+"     "+M$+" "+M$+" "+M$+"          "
  59. 590 L$=L$+M$+"      "+M$+" "+M$+"    "+M$+" "+M$+"    "+M$
  60. 600 PRINT T$ :                          ' PRINT HEADING
  61. 610 FOR I=1 TO 20 :PRINT L$:CL$(I)=L$+STRING$(FL(12),32):NEXT :' PRINT DIVIDER LINES
  62. 620 LOCATE 24,1 : PRINT "F1 - NEW COUNTRY |                 |                | F9 - MOVE LEFT FIELD";                            ' PRINT INSTRUCTIONS
  63. 630 LOCATE 25,1 : PRINT "F2 - QSL CARD    |                 |                | F10 - MOVE RIGHT FIELD";:                           ' PRINT INSTRUCTIONS
  64. 640 GOTO 690                               ' OPEN ALREADY TOOK PLACE
  65. 650 OPEN DR1$+"HAMLOG."+EXT$ AS 1 LEN=DLEN+1
  66. 660 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$
  67. 670 RETURN
  68. 680 ' ***
  69. 690 ' *         ENTRY FOR NEW LINE
  70. 700 ' ***
  71. 710 L=21: R=1                              ' INITIALIZE TO FIRST LINE AND FIELD
  72. 720 RSET F1$=STR$(NUMQSO):LOCATE L,1 :PRINT F1$; ' GET NEW QSO NUMBER
  73. 730 F=6 :GOSUB 1010                         ' ENTERING LIVE TRAFFIC
  74. 740 ' *** DATE, TIME STAMP, AND NUMBER  FOR BULK ENTRY
  75. 750 LOCATE L,FP(3) : PRINT F3$;
  76. 760 COLOR 0,7 : F=2  :TP$=F2$              ' INIT. TO DATE FIELD AS 1ST FLD
  77. 770 LOCATE L,FP(2):PRINT F2$;:LOCATE L,FP(2),1 'PRINT DATE FILED
  78. 780 P=FP(F):RQLEN=FL(F)+P-1                ' SET UP INITIAL FIELD
  79. 790 LOCATE ,,1 : GOTO 1530                 ' WAIT FOR FIRST ENTRY
  80. 800 ' ***
  81. 810 ' *    TIME STAMP FOR LIVE ENTRY
  82. 820 FSW=ONN                                ' SET ON
  83. 830 F2$=MID$(DATE$,4,3)+LEFT$(DATE$,3)+RIGHT$(DATE$,2) ' SET UP FOR LIVE ENTRY
  84. 840 F3$=LEFT$(TIME$,5):F=6                 ' SET UP FOR LIVE ENTRY
  85. 850 COLOR 7,0:LOCATE L,FP(2):PRINT F2$;:LOCATE L,FP(3):PRINT F3$;
  86. 860 P=FP(F):RQLEN=FL(F)+P-1                ' SET UP INITIAL FIELD
  87. 870 COLOR 0,7:GOTO 1560                    ' RESUME PROCESSING
  88. 880 ' ***
  89. 890 ' *      ROUTINE TO MOVE LEFT FIELD
  90. 900 ' ***
  91. 910 IF F = 1 THEN RETURN
  92. 920 GOSUB 2710 :  COLOR 7,0:               '  CHECK IF ANYTHING IN INPUT BUFFER
  93. 930 F=F-1 : ON F GOTO 940,950,960,970,980,1010,1020,1030,1040,1050,1060
  94. 940 LOCATE L,FP(2):PRINT F2$;:LOCATE L,FP(1): COLOR 0,7 :PRINT F1$;:COLOR 7,0:RETURN 1350
  95. 950 LOCATE L,FP(3):PRINT F3$;:LOCATE L,FP(2): COLOR 0,7 :PRINT F2$;:COLOR 7,0:RETURN 1350
  96. 960 LOCATE L,FP(4):PRINT F4$;:LOCATE L,FP(3): COLOR 0,7 :PRINT F3$;:COLOR 7,0:RETURN 1350
  97. 970 LOCATE L,FP(5):PRINT F5$;:LOCATE L,FP(4): COLOR 0,7 :PRINT F4$;:COLOR 7,0:RETURN 1350
  98. 980 IF FLG$="1" THEN COLOR 0,7            ' FLAG TO LEAVE HIGHLIGHTED ON
  99. 990 IF FLG$="2" THEN COLOR 15,0
  100. 1000 LOCATE L,FP(6):PRINT F6$;:LOCATE L,FP(5): COLOR 0,7 :PRINT F5$;:COLOR 7,0:RETURN 1350
  101. 1010 LOCATE L,FP(7):PRINT F7$;:LOCATE L,FP(6): COLOR 0,7 :PRINT F6$;:COLOR 7,0:RETURN 1350
  102. 1020 LOCATE L,FP(8):PRINT F8$;:LOCATE L,FP(7): COLOR 0,7 :PRINT F7$;:COLOR 7,0:RETURN 1350
  103. 1030 LOCATE L,FP(9):PRINT F9$;:LOCATE L,FP(8):COLOR 0,7:PRINT F8$;:COLOR 7,0:RETURN 1350
  104. 1040 LOCATE L,FP(10):PRINT F10$;:LOCATE L,FP(9):COLOR 0,7:PRINT F9$;:COLOR 7,0:RETURN 1350
  105. 1050 LOCATE L,FP(11):PRINT F11$;:LOCATE L,FP(10):COLOR 0,7:PRINT F10$;:COLOR 7,0:RETURN 1350
  106. 1060 LOCATE L,FP(12):PRINT F12$;:LOCATE L,FP(11):COLOR 0,7:PRINT F11$;:COLOR 7,0:RETURN 1350
  107. 1070 ' ***
  108. 1080 ' *               ROUTINE TO MOVE RIGHT FIELD
  109. 1090 ' ***
  110. 1100 IF F = 12 THEN RETURN       :      ' ALREADY AT END
  111. 1110 GOSUB 2710 :  COLOR 7,0:          '  CHECK IF ANYTHING IN INPUT BUFFER
  112. 1120 F=F+1 :ON F-1 GOTO 1130,1140,1150,1160,1170,1180,1210,1230,1240,1250,1260
  113. 1130 LOCATE L,FP(1):PRINT F1$;:LOCATE L,FP(2): COLOR 0,7 :PRINT F2$;:COLOR 7,0:RETURN 1350
  114. 1140 LOCATE L,FP(2):PRINT F2$;:LOCATE L,FP(3): COLOR 0,7 :PRINT F3$;:COLOR 7,0:RETURN 1350
  115. 1150 LOCATE L,FP(3):PRINT F3$;:LOCATE L,FP(4): COLOR 0,7 :PRINT F4$;:COLOR 7,0:RETURN 1350
  116. 1160 LOCATE L,FP(4):PRINT F4$;:LOCATE L,FP(5): COLOR 0,7 :PRINT F5$;:COLOR 7,0:RETURN 1350
  117. 1170 LOCATE L,FP(5):PRINT F5$;:LOCATE L,FP(6): COLOR 0,7 :PRINT F6$;:COLOR 7,0:RETURN 1350
  118. 1180 IF FLG$="1" THEN COLOR 0,7            ' FLAG TO LEAVE HIGHLIGHTED ON
  119. 1190 IF FLG$="2" THEN COLOR 15,0
  120. 1200 LOCATE L,FP(6):PRINT F6$;:LOCATE L,FP(7):COLOR 0,7:PRINT F7$;:COLOR 7,0:RETURN 1350
  121. 1210 LOCATE L,FP(7): COLOR 7,0 :PRINT F7$;
  122. 1220 LOCATE L,FP(8):PRINT F8$;
  123. 1230 LOCATE L,FP(9):PRINT F9$;
  124. 1240 LOCATE L,FP(10):PRINT F10$;
  125. 1250 LOCATE L,FP(11):PRINT F11$;:F=12
  126. 1260 LOCATE L,FP(12):COLOR 0,7:PRINT F12$; : RETURN 1350
  127. 1270 TP$=F1$ :GOTO 1530               ' SET UP INPUT BUFFER
  128. 1280 '*** ROUTINE TO HIGHLIGHT CALL SIGN
  129. 1290 IF FLG$="1" THEN FLG$="0" : RETURN ELSE FLG$="1":RETURN
  130. 1300 IF FLG$="2" THEN FLG$="0" : RETURN ELSE FLG$="2":RETURN
  131. 1310 ' *** ROUTINE TO MOVE CURSOR RIGHT OR LEFT
  132. 1320 IF R=1 THEN RETURN ELSE R=R-1:GOTO 1340
  133. 1330 IF R=FL(F) THEN RETURN ELSE R=R+1
  134. 1340 LOCATE L,P+R-1 : RETURN
  135. 1350 ' ***   GET CHARACTERS TO SCREEN
  136. 1360 COLOR 0,7                            ' TURN ON BRIGHTNESS AND CURSOR
  137. 1370 P=FP(F):R=1                           ' GET FIELD POSITION/1ST POSITION
  138. 1380 LOCATE L,P+P12                      ' LENGTH OF COMMENT OVERFLOW IF USED
  139. 1390 IF P12 <> 0 THEN R=P12+1 : P12=0     ' SET POSTION AND RESET OVERFLOW
  140. 1400 ON F GOTO 1410,1420,1430,1440,1450,1460,1470,1480,1490,1500,1510,1520
  141. 1410 TP$=F1$ :GOTO 1530               ' SET UP INPUT BUFFER
  142. 1420 TP$=F2$ :GOTO 1530               ' SET UP INPUT BUFFER
  143. 1430 TP$=F3$ :GOTO 1530               ' SET UP INPUT BUFFER
  144. 1440 TP$=F4$ :GOTO 1530               ' SET UP INPUT BUFFER
  145. 1450 TP$=F5$ :GOTO 1530               ' SET UP INPUT BUFFER
  146. 1460 TP$=F6$ :GOTO 1530                ' SET UP INPUT BUFFER
  147. 1470 TP$=F7$ :GOTO 1530                ' SET UP INPUT BUFFER
  148. 1480 TP$=F8$ :GOTO 1530                ' SET UP INPUT BUFFER
  149. 1490 TP$=F9$ :GOTO 1530                ' SET UP INPUT BUFFER
  150. 1500 TP$=F10$ :GOTO 1530               ' SET UP INPUT BUFFER
  151. 1510 TP$=F11$ :GOTO 1530               ' SET UP INPUT BUFFER
  152. 1520 TP$=F12$                          ' SET UP INPUT BUFFER
  153. 1530 LOCATE ,,1                                  ' TURN ON CURSOR
  154. 1540 O$=INKEY$ : IF O$="" GOTO 1530    ' WAIT FOR USER
  155. 1550 IF FSW=OFFF THEN GOTO 810          ' TEST FOR REAL TIME STAMP
  156. 1560 IF ASC(O$)=27 THEN GOTO 3000      ' ESCAPE PUSHED TO END
  157. 1570 IF ASC(O$) <> 8 GOTO 1610         ' BACK SPACE KEY NOT PUSHED
  158. 1580 IF R=1 THEN GOTO 1530 ELSE R=R-1  ' IF NOT IN FIRST POSITION DECREMENT
  159. 1590 MID$(TP$,R,1)=" "                 ' BLANK CHARACTER IN RECORD
  160. 1600 LOCATE L,P+R-1:PRINT " ";:LOCATE L,P+R-1:GOTO 1530  'ERASE CHAR ON SCREEN
  161. 1610 IF ASC(O$)=13 THEN GOSUB 2710 :GOSUB 2300:GOTO 690  'RETURN PUSHED
  162. 1620 '                                   ENTER FIELD/WRITE DISK AND START OVER
  163. 1630 IF ASC(O$)<>42 GOTO 1670                  ' NOT A PRTSC KEY
  164. 1640 MID$(TP$,FL(12),1)="*"                 ' SET INDICATOR MORE TO FOLLOW
  165. 1650 GOSUB 2710 :GOSUB 2300           'WRITE OUT RECORD TO CONTINUE COMMENTS
  166. 1660 F=12 : LSET F12$=S$: S$=STRING$(FL(12),32):GOSUB 300 : GOSUB 1260
  167. 1670 IF ASC(O$)<>32 THEN GOTO 1810     ' NOT SPACE BAR
  168. 1680 IF F = 12  THEN GOTO 2000                 ' SPACES ALLOWED IN COMMENTS
  169. 1690 IF F<>7 THEN GOTO 1750                    ' NOT 1ST CHARACTER OF FREQ FLD
  170. 1700 IF R<>1 GOTO 1740                         ' NOT FIRST POSITION IN RECORD
  171. 1710 MID$(TP$,4,3)="   ":LOCATE L,P+R-1:PRINT TP$;:R=4 ' Print out band number
  172. 1720 IF FREQSW THEN GOSUB 3660                      ' Check for QSO and Freq
  173. 1730 LOCATE L,P+R-1,1 :GOTO 1530               ' Set for end of freq field
  174. 1740 TP$=F7$ : GOTO 2260         ' SECOND SPACE BAR FILL IN FROM OLD FIELD
  175. 1750 IF F<> 3         THEN GOTO 1800    ' NOT TIME FIELD
  176. 1760 IF R<>1 GOTO 1790                     ' NOT FIRST POSITION IN RECORD
  177. 1770 IF DUPSW=ONN THEN LOCATE 22,31:PRINT SPACE$(9);:LOCATE P+R-1:DUPSW=OFFF
  178. 1780 MID$(TP$,4,2)="  ":LOCATE L,P+R-1:PRINT TP$;:R=4:LOCATE L,P+R-1,1 :GOTO 1530
  179. 1790 TP$=F3$ : GOTO 2260         ' SECOND SPACE BAR FILL IN FROM OLD FIELD
  180. 1800 GOSUB 1080                               ' GOTO ROUTINE TO MOVE NEXT FIELD
  181. 1810 IF LEN(O$)<>2 THEN GOTO 1990              ' NOT A CURSOR MOVEMENT KEY
  182. 1820 ' XX=POS(0);YY=CSLIN                       ' GET  CURSOR POSITION
  183. 1830 IF ASC(LEFT$(O$,1))=0 AND ASC(RIGHT$(O$,1))<>81 GOTO 1870  ' NOT PGDN
  184. 1840 IF CURDSP=0 THEN CURDSP=NUMREC+18 ELSE CURDSP=CURDSP+18
  185. 1850 IF CURDSP>NUMREC THEN GOTO 1980
  186. 1860 GOTO 1900                          ' ROUTINE TO GET PAGES
  187. 1870 IF ASC(LEFT$(O$,1))=0 AND ASC(RIGHT$(O$,1))<>73 GOTO 1990  ' NOT PGUP
  188. 1880 IF CURDSP=0 THEN CURDSP=NUMREC-18                   ' NO PREVIOUS ACTIVITY
  189. 1890 IF CURDSP-18 < 1 THEN CURDSP=1 ELSE CURDSP=CURDSP-18  ' GO BACK 18 RECORDS
  190. 1900 ' ***  ROUTINE TO GET RECORDS FOR PAGING
  191. 1910 COLOR 7,0 : TK=-1:L=2                           ' SET UP FOR ROUTINE
  192. 1920 TK=TK+1:GET 1,CURDSP+TK                 ' READ TO FIND FIRST VALID RECORD
  193. 1930 IF F1$="        " THEN GOTO 1920        ' SKIP OVER COMMENT RECORDS
  194. 1940 FOR K= CURDSP+TK TO CURDSP+18       ' READ 18 RECORDS MINUS SKIPPED ONES
  195. 1950 IF K>NUMREC THEN GOTO 1970          ' OUTSIDE DISK AREA
  196. 1960 GET 1,K:GOSUB 3040:L=L+1:NEXT:GOTO 1980
  197. 1970 FOR L =L TO 20:LOCATE L,1:PRINT L$+STRING$(FL(12),32);:NEXT
  198. 1980 LOCATE YY,XX: GOTO 1530             ' RESET AND WAIT FOR USER
  199. 1990 IF ASC(RIGHT$(O$,1))=61 THEN GOTO 3330   ' F3 PUSHED TO START QSO SEARCH
  200. 2000 IF F<>2 THEN GOTO 2040              ' NOT THE DATE FIELD
  201. 2010 IF R=3 THEN MID$(TP$,3,1)="-":PRINT "-";:R=R+1 :' INSERT - IN DATE
  202. 2020 IF R=6 THEN MID$(TP$,6,1)="-":PRINT "-";:R=R+1 :' INSERT - IN DATE
  203. 2030 GOTO 2150                           ' ALLOW OVERWRITE OF DATE
  204. 2040 IF R=1 AND F=6 THEN LOCATE 22,31:COLOR 7,0:PRINT SPACE$(9);:COLOR 0,7:' erase dup. msg
  205. 2050 IF R=1 THEN TP$=STRING$(FL(F),32):LOCATE L,P:PRINT TP$;
  206. 2060 IF R=3 AND F=3 THEN MID$(TP$,3,1)=":":PRINT ":";:R=R+1
  207. 2070 IF F=2 AND R=3 THEN MID$(TP$,3,1)="-":PRINT "-";:R=R+1 :' INSERT - IN DATE
  208. 2080 IF F=2 AND R=6 THEN MID$(TP$,6,1)="-":PRINT "-";:R=R+1 :' INSERT - IN DATE
  209. 2090 IF F<> 7 GOTO 2150                  ' NOT FREQUENCY FIELD
  210. 2100 IF R<>2 THEN GOTO 2130              ' NOT SECOND POSTION
  211. 2110 IF FREQSW THEN MID$(F7$,1,2)=LEFT$(TP$,1)+O$ :GOSUB 3660
  212. 2120 IF LEFT$(TP$,1)="3" OR LEFT$(TP$,1)="7" THEN MID$(TP$,2,2)=LEFT$(TP$,1)+".":MID$(TP$,1)=" ":LOCATE L,FP(7):PRINT TP$;:R=4
  213. 2130 IF R=3  THEN MID$(TP$,3,1)=".":PRINT ".";:R=R+1
  214. 2140 IF R=5 AND LEFT$(TP$,4)="14.4" THEN MID$(TP$,1,4)="144.":LOCATE L,FP(7):PRINT TP$;                                  ' CORRECT FOR 2 METER SIGNAL
  215. 2150 LOCATE L,P+R-1:PRINT O$;            ' PUT OUT CHARACTER
  216. 2160 MID$(TP$,R,1)=O$                    ' SET CHARACTER IN HOLDING FIELD
  217. 2170 R=R+1                             ' INCREMENT FIELD POSITION
  218. 2180 IF R<=FL(F) THEN GOTO 1530         ' GOT TO MAXIMUM CHARACTERS
  219. 2190 IF F <> 12 THEN GOTO 2260               ' NOT LAST FIELD
  220. 2200 I=FL(12)
  221. 2210 WHILE MID$(TP$,I,1) <> " "
  222. 2220   I=I-1:IF I = 0 THEN GOTO 1650     ' DECREMENT THROUGH FIELD
  223. 2230 WEND
  224. 2240 S$=MID$(TP$,I+1,FL(12)-I) :MID$(TP$,I+1,FL(12)-I)=STRING$(FL(12)-I,32)
  225. 2250 P12=FL(12)-I:GOTO 1640        'SET OFLW LENGTH / GO TO GET RID OF RECORD
  226. 2260 GOSUB 2710 :                      '  CHECK IF ANYTHING IN INPUT BUFFER
  227. 2270 COLOR 7,0                             ' SET UP TO RESTORE NORMAL COLOR
  228. 2280 GOSUB 1120
  229. 2290 ' ***
  230. 2300 '*          PUT OUT DISK RECORD
  231. 2310 ' ***
  232. 2320 LSET DF1$=F1$ : LSET DF2$=F2$ : LSET DF3$=F3$ : LSET DF4$=F4$
  233. 2330 LSET DF5$=F5$ : LSET DF6$=F6$ : LSET DF7$=F7$ : LSET DF8$=F8$
  234. 2340 LSET DF9$=F9$ : LSET DF10$=F10$ : LSET DF11$=F11$ : LSET DF12$=F12$
  235. 2350 LSET DFLG$=FLG$
  236. 2360 U=U+1                             ' INCREMENT PTR TO IN-Memory Tables
  237. 2370 C$(U)=F6$:F$(U)=LEFT$(F7$,2)      ' PUT ENTRIES INTO TABLE
  238. 2380 PUT 1,NUMREC :                    ' WRITE OUT
  239. 2390 IF NUMREC = 1 THEN LSET C$ = F2$ : STRDATE$=F2$ ' 1st rcd put date in hdr
  240. 2400 LSET D$ = F2$ : ENDDATE$ = F2$                  ' Set end date
  241. 2410 LSET A$=MKS$(NUMREC):LSET B$=MKS$(NUMQSO):PUT 3,1 ' KEEP INDEX UP TO DATE
  242. 2420 CLOSE                                 ' Force out all records
  243. 2430 GOSUB 3220:GOSUB 650                  ' Re-open files
  244. 2440 NUMREC=NUMREC+1                   ' INCREMENT TO NEXT DISK RECORD
  245. 2450 COLOR 7,0 : LOCATE 23,67: PRINT NUMREC;
  246. 2460 IF FLG$="1" THEN COLOR 0,7
  247. 2470 IF FLG$="2" THEN COLOR 15,0
  248. 2480 MID$(CL$(20),FP(1),FL(1))=F1$
  249. 2490 MID$(CL$(20),FP(2),FL(2))=F2$
  250. 2500 MID$(CL$(20),FP(3),FL(3))=F3$
  251. 2510 MID$(CL$(20),FP(4),FL(4))=F4$
  252. 2520 MID$(CL$(20),FP(5),FL(5))=F5$
  253. 2530 LOCATE L,FP(6):PRINT F6$;:MID$(CL$(20),FP(6),FL(6))=F6$
  254. 2540 COLOR 7,0
  255. 2550 LOCATE L,FP(7):PRINT F7$;:MID$(CL$(20),FP(7),FL(7))=F7$
  256. 2560 LOCATE L,FP(8):PRINT F8$;:MID$(CL$(20),FP(8),FL(8))=F8$
  257. 2570 LOCATE L,FP(9):PRINT F9$;:MID$(CL$(20),FP(9),FL(9))=F9$
  258. 2580 LOCATE L,FP(10):PRINT F10$;:MID$(CL$(20),FP(10),FL(10))=F10$
  259. 2590 LOCATE L,FP(11):PRINT F11$;:MID$(CL$(20),FP(11),FL(11))=F11$
  260. 2600 LOCATE L,FP(12):PRINT F12$;:MID$(CL$(20),FP(12),FL(12))=F12$
  261. 2610 CALSRCH$=""                                ' BLANK OUT QSO SEARCH FIELD
  262. 2620 F=6: FOR K = 1 TO 19:LOCATE K+1,1    ' SCROLL SCREEN
  263. 2630 CL$(K)=CL$(K+1): PRINT CL$(K);:NEXT
  264. 2640 LOCATE 21,1,1:PRINT L$+STRING$(FL(12),32); ' CLEAR LAST LINE
  265. 2650 IF MID$(TP$,FL(12),1)="*" THEN GOSUB 300:GOSUB 350:GOTO 2690
  266. 2660 FSW=OFFF                                ' SET SWITCH TO SYSTEM TIME STMP
  267. 2670 ' *** CLEAR FIELDS
  268. 2680 GOSUB 360
  269. 2690 LOCATE 22,1:PRINT SPACE$(79);
  270. 2700 RETURN
  271. 2710 ' GO TO APROPRIATE FIELD AND ENTER IT
  272. 2720 IF LEN(TP$)<>0 THEN GOTO 2740
  273. 2730 RETURN
  274. 2740 ON F GOTO 2750,2770,2790,2810,2830,2850,2870,2890,2910,2930,2950,2970
  275. 2750 IF LEN(TP$)=FL(1) THEN RSET F1$=TP$ : GOTO 2990
  276. 2760 RSET F1$=TP$ : GOTO 2990
  277. 2770 IF LEN(TP$)=FL(2) THEN LSET F2$=TP$ : GOTO 2990
  278. 2780 LSET F2$=TP$+STRING$(FL(2)-LEN(TP$),32) : GOTO 2990
  279. 2790 IF LEN(TP$)=FL(3) THEN LSET F3$=TP$ : GOTO 2990
  280. 2800 LSET F3$=TP$+STRING$(FL(3)-LEN(TP$),32) : GOTO 2990
  281. 2810 IF LEN(TP$)=FL(4) THEN LSET F4$=TP$ : GOTO 2990
  282. 2820 LSET F4$=TP$+STRING$(FL(4)-LEN(TP$),32) : GOTO 2990
  283. 2830 IF LEN(TP$)=FL(5) THEN LSET F5$=TP$ : GOTO 2990
  284. 2840 LSET F5$=TP$+STRING$(FL(5)-LEN(TP$),32) : GOTO 2990
  285. 2850 IF LEN(TP$)=FL(6) THEN LSET F6$=TP$
  286. 2860 LSET F6$=TP$+STRING$(FL(6)-LEN(TP$),32) : IF FREQSW=ONN THEN GOTO 2990 ELSE GOSUB 3660 :GOTO 2990
  287. 2870 IF LEN(TP$)=FL(7) THEN LSET F7$=TP$
  288. 2880 LSET F7$=TP$+STRING$(FL(7)-LEN(TP$),32) : GOTO 2990
  289. 2890 IF LEN(TP$)=FL(8) THEN LSET F8$=TP$ : GOTO 2990
  290. 2900 LSET F8$=TP$+STRING$(FL(8)-LEN(TP$),32) : GOTO 2990
  291. 2910 IF LEN(TP$)=FL(9) THEN LSET F9$=TP$ : GOTO 2990
  292. 2920 LSET F9$=TP$+STRING$(FL(9)-LEN(TP$),32) : GOTO 2990
  293. 2930 IF LEN(TP$)=FL(10) THEN LSET F10$=TP$ : GOTO 2990
  294. 2940 LSET F10$=TP$+STRING$(FL(10)-LEN(TP$),32) : GOTO 2990
  295. 2950 IF LEN(TP$)=FL(11) THEN LSET F11$=TP$ : GOTO 2990
  296. 2960 LSET F11$=TP$+STRING$(FL(11)-LEN(TP$),32) : GOTO 2990
  297. 2970 IF LEN(TP$)=FL(12) THEN LSET F12$=TP$ : GOTO 2990
  298. 2980 LSET F12$=TP$+STRING$(FL(12)-LEN(TP$),32) : GOTO 2990
  299. 2990 RETURN
  300. 3000 ' *** ROUTINE TO CLOSE DOWN
  301. 3010 COLOR 7,0                          ' RESET TO NORMAL SCREEN
  302. 3020 CLOSE:RUN "MMENU
  303. 3030 ' ***
  304. 3040 ' *         ROUTINE TO PRINT DISK RECORD
  305. 3050 ' ***
  306. 3060 LOCATE L,1:PRINT DF1$;
  307. 3070 LOCATE L,FP(2):PRINT DF2$;
  308. 3080 LOCATE L,FP(3):PRINT DF3$
  309. 3090 LOCATE L,FP(4):PRINT DF4$;
  310. 3100 LOCATE L,FP(5):PRINT DF5$
  311. 3110 IF FLG$="1" THEN COLOR 0,7
  312. 3120 IF FLG$="2" THEN COLOR 15,0
  313. 3130 LOCATE L,FP(6):PRINT DF6$;
  314. 3140 COLOR 7,0
  315. 3150 LOCATE L,FP(7):PRINT DF7$;
  316. 3160 LOCATE L,FP(8):PRINT DF8$;
  317. 3170 LOCATE L,FP(9):PRINT DF9$;
  318. 3180 LOCATE L,FP(10):PRINT DF10$;
  319. 3190 LOCATE L,FP(11):PRINT DF11$;
  320. 3200 LOCATE L,FP(12):PRINT DF12$;
  321. 3210 COLOR 7,0:RETURN
  322. 3220 ' *** ROUTINE TO GET HEADER RECORD AND DISPLAY
  323. 3230 OPEN DR1$+"HAMHDR."+EXT$ AS 3 LEN=24
  324. 3240 FIELD 3,4 AS A$,4 AS B$,8 AS C$,8 AS D$ : GET 3,1  ' SET HEADER RECORD FLD
  325. 3250 NUMREC=CVS(A$):NUMQSO=CVS(B$):STRDATE$=C$:ENDDATE$=D$  ' GET HEADER FIELDS
  326. 3260 NUMQSO=NUMQSO+1                   ' TO GET TO NEXT RECORD
  327. 3270 IF NUMREC<1 THEN NUMREC=0       ' TAKE CARE OF NEW DISKS WITH NO HEADER
  328. 3280 NUMREC=NUMREC+1                     ' POINT TO NEXT RECORD AREA TO USE
  329. 3290 COLOR 7,0                           ' To reset the color change
  330. 3300 LOCATE 23,1:PRINT "First date - ";STRDATE$;" : Last date - ";ENDDATE$;" : Number of records -";NUMREC;
  331. 3310 RETURN
  332. 3320 ' ***
  333. 3330 ' *          SEARCH BY QSO ROUTINE
  334. 3340 ' ***
  335. 3350 GOSUB 2710                                 ' CHECK IF ANYTHING KEYED IN
  336. 3360 SAVDRIV$=DR1$                    ' SAVE DRIVE BEING USED
  337. 3370 GOSUB 2860                       ' TEST FOR CHANGES BEFORE GOING ANYWHERE
  338. 3380 K=NUMREC-1                       ' START AHEAD OF CURRENT RECORD
  339. 3390 COLOR 7,0:LOCATE 22,20:PRINT "WHAT DRIVE";      ' PRINT PROMPT
  340. 3400 LOCATE 22,31:COLOR 0,7:PRINT "          ";:LOCATE 22,29
  341. 3410 O$=INKEY$ :IF O$="" GOTO 3410 ELSE DR1$=O$+":"
  342. 3420 IF O$="A" OR O$="B" THEN GOTO 3450     ' VALID DRIVE
  343. 3430 IF O$="C" OR O$="D" THEN GOTO 3450     ' VALID DRIVE
  344. 3440 GOTO 3410                        ' INVALID DRIVE
  345. 3450 COLOR 0,7:LOCATE 22,20:PRINT "CALL SIGN";      ' PRINT PROMPT
  346. 3460 LOCATE 22,31:COLOR 7,0:PRINT "          ";:LOCATE 22,29
  347. 3470 IF SAVDRIV$=DR1$ THEN GOTO 3490    ' NO NEED TO CHANGE DRIVE
  348. 3480 CLOSE 1:GOSUB 650                  ' RESET CURRENT DRIVE
  349. 3490 INPUT S$                         ' GET NEW SIGN
  350. 3500 IF LEN(S$)=0 THEN GOTO 3520      ' NOTHING ENTERED
  351. 3510 CALSRCH$="          ": LSET CALSRCH$=S$: GOTO 3530 ' USE ENTERED FIELD
  352. 3520 IF CALSRCH$="" THEN CALSRCH$=F6$   ' IF NOTHING
  353. 3530 LOCATE 22,31: PRINT SPACE$(40);    ' BLANK OUT LINE
  354. 3540 FOR K= K TO 1 STEP -1              ' SEARCH BACKWARD FOR CALL SIGN
  355. 3550 GET 1,K:IF DF6$=CALSRCH$ THEN 3590  ' NO MATCH
  356. 3560 O$=INKEY$ :IF O$="" GOTO 3580              ' TO ALLOW
  357. 3570 IF ASC(RIGHT$(O$,1))=106  THEN GOTO 3620   '  ALT-F3 TO BE PUSHED
  358. 3580 NEXT
  359. 3590 IF K=0 THEN LOCATE 22,37: PRINT"NONE FOUND          ";:GOTO 3620
  360. 3600 LOCATE 22,20:PRINT "           ";
  361. 3610 L=22:GOSUB 3040:L=21               ' DISPLAY ON BOTTOM OF SCREEN
  362. 3620 COLOR 7,0:                         ' RESET COLOR
  363. 3630 IF SAVDRIV$=DR1$ THEN GOTO 1530    ' NO NEED TO RESET
  364. 3640 CLOSE 1:DR1$=SAVDRIV$:GOSUB 650:GOTO 1530 ' RESET CURRENT DRIVE
  365. 3650 ' ***
  366. 3660 ' *          SEARCH ROUTINE FOR IN MEMORY TABLES
  367. 3670 ' ***
  368. 3680 LOCATE 22,31 : COLOR 0,7: PRINT "Looking..";:COLOR 7,0
  369. 3690 FOR H = 1 TO U                     ' SEARCH THROUGH TABLES
  370. 3700   IF F6$<> C$(H) THEN GOTO 3750    ' CALL SIGN NOT EQUAL
  371. 3710   IF FREQSW = OFFF THEN GOTO 3730  ' FOUND SIGN & DON'T CHECK FREQUENCY
  372. 3720   IF LEFT$(F7$,2) <> F$(H) THEN GOTO 3750  ' NOT SAME FREQUENCY
  373. 3730   LOCATE 22,31 : COLOR 0,7: PRINT "DUPLICATE";:COLOR 7,0
  374. 3740 GOSUB 350:DUPSW=ONN:FSW=OFFF:GOTO 690
  375. 3750 NEXT
  376. 3760 IF H>U THEN LOCATE 22,31:PRINT "NEW CONTACT";:COLOR 0,7
  377. 3770 RETURN                             ' GO BACK TO caller
  378.                           ' GO BACK TO caller
  379.