home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / dx / cqwlog / cqwwlog.bas next >
Encoding:
BASIC Source File  |  1988-03-06  |  18.4 KB  |  405 lines
  1. 10 '   CQWWLOG.BAS version 1.2 -  Copyright (C) 1986,1987 by Clarke Greene K1JX  NOT FOR COMMERCIAL USE
  2. 20 '
  3. 30 '   This Microsoft (tm) BASIC program will build a complete log package for the CQ Worldwide DX Contest.
  4. 40 '
  5. 50 '   The file containing the log entries must be an ASCII file in the following format: 
  6. 60 '               (each band requires a separate log entry file)
  7. 70 '
  8. 80 '          TIME         CALLSIGN            RCV'D REPORT  (each log entry must be followed by a carriage return)
  9. 90 '
  10. 100 '   At least one space must be between each field of each log entry. Only a changed digit in the time field must
  11. 110 '   be present; for example, if the contest begins at 1800Z and the first contact is made at 1802Z and the second
  12. 120 '   contact is made at 1805Z, then only 5 need be entered in the time field. If the third contact is made at
  13. 130 '   1812Z, then 12 should be entered in the time field. If the next contact is made at 1812Z, then no number need be
  14. 140 '   entered in the time field (however, be sure to enter a space to indicate separation between fields).
  15. 150 '
  16. 160 '   These files will be produced:
  17. 170 '            <filename>.LOG - this is a complete log ready for printing
  18. 180 '            <filename>.DUP - this is a sorted duplicate listing ready for printing
  19. 190 '            <filename>.SUM - this is a summary sheet ready for printing
  20. 200 '
  21. 210 '
  22. 220 '    Depending on the version of BASIC for your particular machine, the CLS (Clear Screen) command must
  23. 230 '   be changed.  Consult your own computer's BASIC documentation for more information.
  24. 240 '
  25. 250 '
  26. 260 '   If compiling (a VERY good idea for several orders of magnitude improvement in speed), use O and E switches 
  27. 270 '
  28. 280 '   This program also uses a prefix library file (DXPREFIX.LIB), which MUST be on the same disc (and in the
  29. 290 '   same subdirectory) as this program.
  30. 300 '
  31. 310 '
  32. 320 WARNING$="Copyrigh⌠ (C⌐ 1986,198╖ b∙ Clarkσ Greenσ K1J╪  NO╘ FO╥ COMMERCIA╠ USE"
  33. 330 '
  34. 340 '  Define arrays and variables
  35. 350 DEFINT A-Z : OPTION BASE 1
  36. 360 DIM ENTRY$(1500), MULT$(175), PFX$(900), CTRY$(900), CNT$(900), WIERDPFX$(50), WIERDCTRY$(50), WIERDCNT$(50), AMBCTRY$(10)
  37. 370 DIM Q(175), ZONE(40)
  38. 380 BLANK$=" " : BL$="" : SLANT$="/" : TRUE=-1
  39. 390 DUPE1$="  - Duplica" : DUPE2$="te QSO -"
  40. 400 '  Define format strings for printouts
  41. 410 LOGFORM$=" \      \  \  \   \           \   \   \   \   \   \         \\           \  #"
  42. 420 DUPFORM$="     \          \   \          \   \          \   \          \   \          \"
  43. 430 SUMFORM$="     \          \   \          \   \          \   \          \   \          \"
  44. 440 FOOTFORM$=" ##         ##          ##        ###"
  45. 450 '
  46. 460 CLS
  47. 470 PRINT TAB(26) "CQWW DX Contest Log Processor" : PRINT : PRINT
  48. 480 '
  49. 490 '  Read Prefix table file
  50. 500 PRINT TAB(5)  "Reading prefix library...  ";
  51. 510 I=0                                         ' initialize array subscript
  52. 520 OPEN "DXPREFIX.LIB" FOR INPUT AS #1
  53. 530  WHILE NOT EOF(1)
  54. 540   I=I+1
  55. 550   INPUT #1, PFX$(I), DUMMY$, CTRY$(I), CNT$(I)               ' DUMMT$ is a dummy variable for data not used
  56. 560   WEND
  57. 570 CLOSE
  58. 580 TABLESIZE=I                                     ' prefix table length
  59. 590 PRINT "done"
  60. 600 '
  61. 610 '  Get user input
  62. 620 PRINT : PRINT TAB(5) "What is the station callsign?  ";
  63. 630  INPUT "", MYCALL$
  64. 640   THISENTRY$=MYCALL$ : IF INSTR(THISENTRY$,SLANT$)>0 THEN GOSUB 3130 ELSE THISPFX$=LEFT$(THISENTRY$,4)
  65. 650   GOSUB 3260 : IF NOT INLIST THEN GOSUB 3400
  66. 660   MYCTRY$=THISCTRY$ : MYCNT$=THISCNT$ : IF MYCNT$="NA" THEN MYCNTPTS=2 ELSE MYCNTPTS=1
  67. 670 PRINT : PRINT TAB(5) "What is the station's WAZ zone?  ";
  68. 680  INPUT "", MYZONE$
  69. 690   IF VAL(MYZONE$)<1 OR VAL(MYZONE$)>40 THEN PRINT CHR$(7);: GOTO 670
  70. 700   IF VAL(MYZONE$)<10 AND LEN(MYZONE$)=1 THEN MYZONE$="0"+MYZONE$
  71. 710 PRINT : PRINT TAB(5) "What is the beginning date of the contest? <dd/mm/yr> ";
  72. 720  INPUT "", STARTDATE$
  73. 730   MARK=INSTR(STARTDATE$,"/") : IF MARK=0 THEN MARK=INSTR(STARTDATE$,"-")
  74. 740   STARTDAY=VAL(LEFT$(STARTDATE$,MARK-1))
  75. 750   STARTDATE$=RIGHT$(STARTDATE$,LEN(STARTDATE$)-MARK)
  76. 760   MARK=INSTR(STARTDATE$,"/") : IF MARK=0 THEN MARK=INSTR(STARTDATE$,"-")
  77. 770   MON=VAL(LEFT$(STARTDATE$,MARK-1))
  78. 780    IF MON=10 THEN MON$=" Oct.  " : RST$="59" ELSE MON$=" Nov.  " : RST$="599"
  79. 790    SENT$=RST$+MYZONE$
  80. 800   YR$=RIGHT$(STARTDATE$,LEN(STARTDATE$)-MARK)
  81. 810 PRINT : PRINT TAB(5) "What is the GMT starting time for the contest?  ";
  82. 820  INPUT "", STARTGMT$
  83. 830 PRINT : PRINT TAB(5) "What file is the log extract located in?  ";
  84. 840  INPUT "", INFILE$ : GOSUB 2940                              ' check to see if file is valid
  85. 850  IF INSTR(INFILE$,".")<>0 THEN OUTFILE$=LEFT$(INFILE$,INSTR(INFILE$,".")-1) ELSE OUTFILE$=INFILE$
  86. 860 PRINT : PRINT TAB(5) "What frequency band is the log extract for?  ";
  87. 870  INPUT "", BAND$
  88. 880 '
  89. 890 '  Build log file
  90. 900 CLS
  91. 910 PRINT : PRINT TAB(5) "Duping and counting...  ";
  92. 920 '
  93. 930 '  Clear arrays
  94. 940 FOR I=1 TO 1500
  95. 950  ENTRY$(I)=BL$
  96. 960  NEXT I
  97. 970 FOR I=1 TO 175
  98. 980  MULT$(I)=BL$
  99. 990  Q(I)=1
  100. 1000  NEXT I
  101. 1010 FOR I=1 TO 40
  102. 1020  ZONE(I)=0
  103. 1030  NEXT I
  104. 1040 '
  105. 1050 '  Initialize variables
  106. 1060 RAWTOTAL=0 : QSOS=0 : DUPES=0 : CTRYNR=0 : ZONENR=0 : TOTPOINTS=0
  107. 1070 PGQSOS=0 : PGZONES=0 : PGCTRY=0 : PGPTS=0
  108. 1080 DAY=STARTDAY : PREVIOUSGMT$=STARTGMT$
  109. 1090 '
  110. 1100 '  Open input file and output .LOG file
  111. 1110 OPEN INFILE$ FOR INPUT AS #1
  112. 1120 OPEN OUTFILE$+".LOG" FOR OUTPUT AS #2
  113. 1130 '
  114. 1140 '  Input data, process, and enter into output file
  115. 1150  WHILE NOT EOF(1)
  116. 1160   LINE INPUT #1, THISENTRY$                     ' read entire line from disc file
  117. 1170    WHILE ASC(RIGHT$(THISENTRY$,1))<48 AND LEN(THISENTRY$)>0
  118. 1180     THISENTRY$=LEFT$(THISENTRY$,LEN(THISENTRY$)-1)          ' strip off trailing spaces,etc
  119. 1190     WEND
  120. 1200    IF LEN(THISENTRY$)>0 THEN RAWTOTAL=RAWTOTAL+1 ELSE GOTO 1870
  121. 1210 '
  122. 1220 '  Separate received report from THISENTRY$
  123. 1230   RCVD$=BL$                         ' initialize RCVD$ to be null string
  124. 1240   WHILE ASC(RIGHT$(THISENTRY$,1))>=48
  125. 1250    RCVD$=RIGHT$(THISENTRY$,1)+RCVD$
  126. 1260    THISENTRY$=LEFT$(THISENTRY$,LEN(THISENTRY$)-1)         ' parse last character of string
  127. 1270    WEND
  128. 1280     IF LEN(RCVD$)<=2 THEN RCVD$=RST$+RCVD$             ' if no RST was typed, append std report
  129. 1290     IF LEN(RCVD$)<(LEN(RST$)+2) THEN RCVD$=LEFT$(RCVD$,LEN(RST$))+"0"+RIGHT$(RCVD$,1)
  130. 1300   WHILE ASC(RIGHT$(THISENTRY$,1))<48
  131. 1310    THISENTRY$=LEFT$(THISENTRY$,LEN(THISENTRY$)-1)           ' strip off trailing spaces,etc
  132. 1320    WEND
  133. 1330 '
  134. 1340 '  Separate GMT from THISENTRY$
  135. 1350   WHILE ASC(LEFT$(THISENTRY$,1))<48
  136. 1360    THISENTRY$=RIGHT$(THISENTRY$,LEN(THISENTRY$)-1)          ' strip off leading spaces
  137. 1370    WEND
  138. 1380   IF INSTR(THISENTRY$,BLANK$)<>0 THEN GMT$=LEFT$(THISENTRY$,INSTR(THISENTRY$,BLANK$)-1) ELSE GMT$=BL$
  139. 1390   THISENTRY$=RIGHT$(THISENTRY$,(LEN(THISENTRY$)-LEN(GMT$)))
  140. 1400   WHILE LEFT$(THISENTRY$,1)=BLANK$
  141. 1410    THISENTRY$=RIGHT$(THISENTRY$,LEN(THISENTRY$)-1)          ' strip off leading spaces
  142. 1420    WEND
  143. 1430 '  Fill in missing time data 
  144. 1440   GMT$=LEFT$(PREVIOUSGMT$,(4-LEN(GMT$)))+GMT$
  145. 1450   THEDATE$=BL$ : IF GMT$<PREVIOUSGMT$ THEN DAY=DAY+1 : THEDATE$=STR$(DAY)+MON$
  146. 1460 '
  147. 1470 '  Check for dupes
  148. 1480   DUPE.QSO=NOT TRUE : POINTS=3
  149. 1490   FOR J=1 TO QSOS
  150. 1491    IF LEN(ENTRY$(J))<>LEN(THISENTRY$) GOTO 1510
  151. 1500    IF ENTRY$(J)=THISENTRY$ THEN NEWZONE$=DUPE1$ : NEWCTRY$=DUPE2$ : DUPES=DUPES+1 : POINTS=0 : DUPE.QSO=TRUE : J=QSOS
  152. 1510    NEXT J
  153. 1520     IF DUPE.QSO GOTO 1820                                   ' skip over prefix search if this entry is a dupe
  154. 1530    QSOS=QSOS+1 : ENTRY$(QSOS)=THISENTRY$
  155. 1540 '
  156. 1550 '  Determine zone and search zone table for new multiplier
  157. 1560   NEWZONE$=BL$
  158. 1570   THISZONE$=RIGHT$(RCVD$,2)
  159. 1580   J=VAL(THISZONE$) : IF J<1 OR J>40 THEN GOSUB 3050
  160. 1590    IF ZONE(J)=0 THEN ZONENR=ZONENR+1 : NEWZONE$="Zone #"+STR$(ZONENR) : PGZONES=PGZONES+1
  161. 1600   ZONE(J)=ZONE(J)+1
  162. 1610 '
  163. 1620 '  Determine prefix and search prefix library for contact country and continent
  164. 1630   IF INSTR(THISENTRY$,SLANT$)>0 THEN GOSUB 3130 ELSE THISPFX$=LEFT$(THISENTRY$,4)
  165. 1640   GOSUB 3260 : IF NOT INLIST THEN GOSUB 3400 : PRINT TAB(5) "Back to duping and counting...  ";
  166. 1650   IF ASC(THISCTRY$)<48 THEN GOSUB 3640                      ' resolve ambiguous prefix
  167. 1660 '
  168. 1670 '  Search multiplier table for new country
  169. 1680   NEWMULT=TRUE : NEWCTRY$=BL$
  170. 1690   FOR J=1 TO CTRYNR
  171. 1700    IF MULT$(J)=THISCTRY$ THEN Q(J)=Q(J)+1 : NEWMULT=NOT TRUE : J=CTRYNR
  172. 1710    NEXT J
  173. 1720    IF NEWMULT THEN CTRYNR=CTRYNR+1 : MULT$(CTRYNR)=THISCTRY$ : NEWCTRY$=THISCTRY$+" #"+STR$(CTRYNR) : PGCTRY=PGCTRY+1
  174. 1730 '
  175. 1740 '  Determine point value for QSO
  176. 1750   IF THISCTRY$=MYCTRY$ THEN POINTS=0 : GOTO 1780            ' contacts in your own country are worth 0 points
  177. 1760   IF THISCNT$=MYCNT$ THEN POINTS=MYCNTPTS
  178. 1770 '
  179. 1780 '  Update page totals
  180. 1790   PGQSOS=PGQSOS+1 : PGPTS=PGPTS+POINTS
  181. 1800   TOTPOINTS=TOTPOINTS+POINTS
  182. 1810 '
  183. 1820 '  Write entry to file  
  184. 1830    IF (RAWTOTAL-1) MOD 50=0 THEN GOSUB 3860         ' print header if this is the beginning of a page
  185. 1840   PRINT #2, USING LOGFORM$; THEDATE$; GMT$; THISENTRY$; SENT$; RCVD$; NEWZONE$; NEWCTRY$; POINTS
  186. 1850    IF RAWTOTAL MOD 50=0 THEN GOSUB 3930                     ' print footer if this is the end of a page
  187. 1860   PREVIOUSGMT$=GMT$ : GMT$=BL$
  188. 1870  WEND
  189. 1880 IF RAWTOTAL MOD 50<>0 THEN PRINT#2, CHR$(12)                ' if a form feed hasn't been printed, print one now
  190. 1890 CLOSE
  191. 1900 PRINT "done"
  192. 1910 '
  193. 1920 '  Build dupe sheet
  194. 1930  PRINT : PRINT TAB(5) "Preparing dupe sheet...  ";
  195. 1940 '  Sort callsigns for dupe sheet
  196. 1950 M=QSOS\2
  197. 1960 WHILE M>0
  198. 1970  FOR I=M+1 TO QSOS
  199. 1980   J=I-M
  200. 1990   WHILE J>0
  201. 2000    IF ENTRY$(J)>ENTRY$(J+M) THEN SWAP ENTRY$(J),ENTRY$(J+M) : J=J-M ELSE J=0
  202. 2010    WEND
  203. 2020   NEXT I
  204. 2030  M=M\2
  205. 2040  WEND
  206. 2050 '
  207. 2060 '  Enter dupe sheet into file
  208. 2070 OPEN OUTFILE$+".DUP" FOR OUTPUT AS #1
  209. 2080  IF QSOS MOD 250=0 THEN LASTPAGE=QSOS\250 ELSE LASTPAGE=QSOS\250+1
  210. 2090 FOR PAGE=1 TO LASTPAGE
  211. 2100  PRINT #1, SPC(20-(LEN(MYCALL$)+LEN(BAND$))/2); MYCALL$; " -- Dupe Sheet for ";
  212. 2110   PRINT #1, BAND$; " MHz Band -- Page"; STR$(PAGE)
  213. 2120  PRINT #1, BL$ : PRINT #1, BL$
  214. 2130  FOR ROW=1 TO 50
  215. 2140   E=(PAGE-1)*250+ROW
  216. 2150   PRINT #1, USING DUPFORM$; ENTRY$(E); ENTRY$(E+50); ENTRY$(E+100); ENTRY$(E+150); ENTRY$(E+200)
  217. 2160   NEXT ROW
  218. 2170  PRINT #1, CHR$(12)                                  ' go to next page
  219. 2180  NEXT PAGE
  220. 2190 CLOSE
  221. 2200 PRINT "done"
  222. 2210 '
  223. 2220 '  Build summary listing
  224. 2230 PRINT : PRINT TAB(5) "Preparing summary sheet...  ";
  225. 2240 '  Sort countries for summary sheet
  226. 2250 M=CTRYNR\2
  227. 2260 WHILE M>0
  228. 2270  FOR I=M+1 TO CTRYNR
  229. 2280   J=I-M
  230. 2290   WHILE J>0
  231. 2300    IF MULT$(J)>MULT$(J+M) THEN SWAP MULT$(J),MULT$(J+M) : SWAP Q(J),Q(J+M) : J=J-M ELSE J=0
  232. 2310    WEND
  233. 2320   NEXT I
  234. 2330  M=M\2
  235. 2340  WEND
  236. 2350 '
  237. 2360 '  Append number of qsos per country onto country prefixes
  238. 2370 FOR I=1 TO CTRYNR
  239. 2380  MULT$(I)=MULT$(I)+SPACE$(6-LEN(MULT$(I)))+" -"+STR$(Q(I))
  240. 2390  NEXT I
  241. 2400 '
  242. 2410 '  Enter country listing into file
  243. 2420 OPEN OUTFILE$+".SUM" FOR OUTPUT AS #1
  244. 2430  PRINT #1, SPC(12-(LEN(MYCALL$)+LEN(BAND$))/2); MYCALL$; " -- Summary Sheet for "; BAND$;
  245. 2440   PRINT #1, " MHz Band - "; YR$; " CQWW DX Contest" 
  246. 2450  PRINT #1, BL$
  247. 2460  PRINT #1, TAB(15); "Country Listing and number of contacts per Country"
  248. 2470  PRINT #1, BL$ : PRINT #1, BL$
  249. 2480  IF CTRYNR MOD 5=0 THEN LASTROW=CTRYNR\5 ELSE LASTROW=CTRYNR\5+1
  250. 2490  FOR ROW=1 TO LASTROW
  251. 2500   PRINT #1, USING SUMFORM$; MULT$(ROW); MULT$(ROW+LASTROW); MULT$(ROW+LASTROW*2); MULT$(ROW+LASTROW*3); MULT$(ROW+LASTROW*4)
  252. 2510   NEXT ROW
  253. 2520 '
  254. 2530 '  Build listing of zones worked and contacts per zone
  255. 2540  J=0
  256. 2550  FOR I=1 TO 40
  257. 2560   IF ZONE(I)>0 THEN J=J+1 : MULT$(J)="Zone"+STR$(I)+" -"+STR$(ZONE(I))
  258. 2570   NEXT I                                                    ' put zone count into array
  259. 2580  FOR I=J TO 40
  260. 2590   MULT$(I)=BL$
  261. 2600   NEXT I                                                     ' blank out remainder of array
  262. 2610 '
  263. 2620 '  Enter zone listing
  264. 2630  PRINT #1, BL$ 
  265. 2640  PRINT #1, TAB(18); "Zone Listing and number of contacts per Zone"
  266. 2650  PRINT #1, BL$ 
  267. 2660  IF ZONENR MOD 5=0 THEN LASTROW=ZONENR\5 ELSE LASTROW=ZONENR\5+1
  268. 2670  FOR ROW=1 TO LASTROW
  269. 2680   PRINT #1, USING SUMFORM$; MULT$(ROW); MULT$(ROW+LASTROW); MULT$(ROW+LASTROW*2); MULT$(ROW+LASTROW*3); MULT$(ROW+LASTROW*4)
  270. 2690   NEXT ROW
  271. 2700 '
  272. 2710 '  Enter summary into file
  273. 2720  PRINT #1, BL$ : PRINT #1, BL$
  274. 2730  PRINT #1, "     Total Valid QSOs - "; STR$(QSOS); "       Dupes - "; STR$(DUPES)
  275. 2740  PRINT #1, "     QSO points - "; STR$(TOTPOINTS)
  276. 2750  PRINT #1, "     Zones - "; STR$(ZONENR)
  277. 2760  PRINT #1, "     Countries - "; STR$(CTRYNR)
  278. 2770 CLOSE
  279. 2780 PRINT "done"
  280. 2790 '
  281. 2800 '  Print results
  282. 2810 CLS : PRINT CHR$(7)
  283. 2820 PRINT : PRINT TAB(5) "Results for the "; BAND$; " MHz band" 
  284. 2830 PRINT : PRINT TAB(8) "Valid QSOs: "; QSOS
  285. 2840 PRINT : PRINT TAB(8) "Duplicate QSOs: "; DUPES
  286. 2850 PRINT : PRINT TAB(8) "QSO points: "; TOTPOINTS
  287. 2860 PRINT : PRINT TAB(8) "Zones: "; ZONENR
  288. 2870 PRINT : PRINT TAB(8) "Countries: "; CTRYNR
  289. 2880 PRINT : PRINT : PRINT 
  290. 2890 PRINT TAB(5) "Type C to continue with another band for this contest,"
  291. 2900 PRINT : PRINT TAB(5) "or any other key to Exit   ";
  292. 2910 ANS$=INPUT$(1)
  293. 2920  IF ANS$="C" OR ANS$="c" THEN CLS : GOTO 830 ELSE CLS : SYSTEM
  294. 2930 '
  295. 2940 '  Subroutine to trap missing file
  296. 2950 ON ERROR GOTO 3000
  297. 2960 OPEN INFILE$ FOR INPUT AS #1                         ' try opening file
  298. 2970 ON ERROR GOTO 0
  299. 2980 CLOSE
  300. 2990 RETURN
  301. 3000 PRINT CHR$(7) : PRINT TAB(4) "That file does not exist - type X to Exit or any other key to continue ";
  302. 3010 ANS$=INPUT$(1) : IF ANS$="X" OR ANS$="x" THEN CLS : SYSTEM
  303. 3020 PRINT 
  304. 3030 RESUME 830
  305. 3040 '
  306. 3050 '  Subroutine to clear up impossible zone number
  307. 3060  PRINT CHR$(7) : PRINT
  308. 3070  PRINT TAB(5) "The zone for "; THISENTRY$; " ["; THISZONE$; "] must be incorrect."
  309. 3080  PRINT : PRINT TAB(8) "What is the correct zone number?  "; 
  310. 3090   INPUT "", THISZONE$ : J=VAL(THISZONE$)
  311. 3100   IF J<1 OR J>40 GOTO 3060
  312. 3110  PRINT : PRINT TAB(5) "Back to duping and counting...  ";
  313. 3120  RETURN
  314. 3130 '
  315. 3140 '  Subroutine to determine prefix from portable designator
  316. 3150  MARK=INSTR(THISENTRY$,SLANT$)
  317. 3160  IF MARK>3 THEN THISPFX$=RIGHT$(THISENTRY$,LEN(THISENTRY$)-MARK) ELSE THISPFX$=LEFT$(THISENTRY$,MARK-1)
  318. 3170  IF LEN(THISPFX$)>1 GOTO 3240                        ' have prefix - return
  319. 3180  IF ASC(THISPFX$)>58 OR ASC(THISPFX$)<47 THEN THISPFX$=LEFT$(THISENTRY$,4) : GOTO 3240 ' (local portable designator)
  320. 3190  K=2                                                 ' find position of first numeral in call
  321. 3200  WHILE (ASC(MID$(THISENTRY$,K,1))>57 OR ASC(MID$(THISENTRY$,K,1))<48) AND K<LEN(THISENTRY$)
  322. 3210   K=K+1
  323. 3220   WEND
  324. 3230  THISPFX$=LEFT$(THISENTRY$,K-1)+THISPFX$              ' new prefix = portable number in old prefix
  325. 3240  RETURN
  326. 3250 '
  327. 3260 '  Subroutine to search prefix library for standard country prefix and continent
  328. 3270   K=4 : INLIST=NOT TRUE : SAVEDPFX$=THISPFX$
  329. 3280   WHILE K>0 AND INLIST=NOT TRUE
  330. 3290    THISPFX$=LEFT$(THISPFX$,K)
  331. 3300    LOW=1 : HIGH=TABLESIZE : INLIST=NOT TRUE                 ' initial values for binary sort
  332. 3310    WHILE LOW<=HIGH AND INLIST=NOT TRUE
  333. 3320     L=(LOW+HIGH)\2
  334. 3330     IF THISPFX$=PFX$(L) THEN INLIST=TRUE : THISCTRY$=CTRY$(L) : THISCNT$=CNT$(L)
  335. 3340     IF THISPFX$<PFX$(L) THEN HIGH=L-1 ELSE LOW=L+1
  336. 3350     WEND
  337. 3360    K=K-1
  338. 3370    WEND
  339. 3380   RETURN
  340. 3390 '
  341. 3400 '  Subroutine to search unusual prefix list 
  342. 3410  IF NRWIERDPFX=0 GOTO 3510                     ' if the supplementary prefix list is empty, skip ahead
  343. 3420   K=4
  344. 3430   WHILE K>0
  345. 3440    SAVEDPFX$=LEFT$(SAVEDPFX$,K)
  346. 3450    FOR J=1 TO NRWIERDPFX
  347. 3460     IF SAVEDPFX$=WIERDPFX$(J) THEN INLIST=TRUE : THISCTRY$=WIERDCTRY$(J) : THISCNT$=WIERDCNT$(J) : J=NRWIERDPFX : K=1
  348. 3470     NEXT J
  349. 3480    K=K-1
  350. 3490    WEND
  351. 3500   IF INLIST THEN RETURN                       ' if the prefix was found, return
  352. 3510 '  Routine to get prefix definition and continent from user for prefix not found in library
  353. 3520  PRINT CHR$(7) : PRINT
  354. 3530  PRINT TAB(5) "The prefix for "; THISENTRY$; " can't be found in the prefix library."
  355. 3540  PRINT : PRINT TAB(8) "What is the callsign prefix?  "; 
  356. 3550   INPUT "", HELDPFX$
  357. 3560  PRINT : PRINT TAB(8) "What standard prefix is that equivalent to?  ";
  358. 3570   INPUT "", THISPFX$
  359. 3580   GOSUB 3260 : IF NOT INLIST GOTO 3520
  360. 3590   NRWIERDPFX=NRWIERDPFX+1 : WIERDPFX$(NRWIERDPFX)=HELDPFX$
  361. 3600   WIERDCTRY$(NRWIERDPFX)=THISCTRY$ : WIERDCNT$(NRWIERDPFX)=THISCNT$
  362. 3610  PRINT
  363. 3620  RETURN
  364. 3630 '
  365. 3640 '  Subroutine to resolve ambiguous prefix with user interaction
  366. 3650  THISCTRY$=RIGHT$(THISCTRY$,LEN(THISCTRY$)-1)               ' strip initial delimiter
  367. 3660   J=0
  368. 3670   WHILE LEN(THISCTRY$)>0
  369. 3680    J=J+1
  370. 3690    MARK=INSTR(THISCTRY$,".")
  371. 3700    AMBCTRY$(J)=LEFT$(THISCTRY$,MARK-1)                      ' put multipiler name into array
  372. 3710    THISCTRY$=RIGHT$(THISCTRY$,LEN(THISCTRY$)-MARK)
  373. 3720    WEND
  374. 3730  PRINT CHR$(7) : PRINT
  375. 3740  PRINT TAB(5) "The prefix for "; THISENTRY$; " could indicate several different countries."
  376. 3750  PRINT : PRINT TAB(8) "The possiblities are:" : PRINT
  377. 3760  FOR K=1 TO J
  378. 3770   PRINT TAB(11) STR$(K); ". "; AMBCTRY$(K)                  ' print choices to screen
  379. 3780   NEXT K
  380. 3790  PRINT : PRINT TAB(8) "Type the number of the correct country. > ";
  381. 3800   INPUT "", CHOICE$
  382. 3810   K=VAL(CHOICE$) : IF K > J OR K < 1 THEN PRINT CHR$(7); : GOTO 3790
  383. 3820  THISCTRY$=AMBCTRY$(K)
  384. 3830  PRINT : PRINT TAB(5) "Back to duping and counting...  ";
  385. 3840  RETURN
  386. 3850 '
  387. 3860 '  Subroutine to print log sheet header
  388. 3870  PRINT #2, "   "; MYCALL$; "  "; BAND$; " MHz Log";  TAB(72); "Page"; STR$(RAWTOTAL\50+1)
  389. 3880  PRINT #2, "   Date    Time   Callsign        Sent    Rcvd    New Zone   New Country   Pt."
  390. 3890  PRINT #2, " "; STRING$(78,45)
  391. 3900  THEDATE$=STR$(DAY)+MON$
  392. 3910  RETURN 
  393. 3920 '
  394. 3930 '  Subroutine to print log sheet footer
  395. 3940  IF RAWTOTAL MOD 50=0 GOTO 3980                             ' if at the end of a page, jump ahead
  396. 3950  FOR J=1 TO 50-(RAWTOTAL MOD 50)
  397. 3960   PRINT #2, BL$
  398. 3970   NEXT J                                                     ' fill last page with blank lines
  399. 3980  PRINT #2, " "; STRING$(78,45)
  400. 3990  PRINT #2, "    Totals for this page:  Valid QSOs - ";
  401. 4000   PRINT #2, USING FOOTFORM$; PGQSOS; PGZONES; PGCTRY; PGPTS
  402. 4010  PRINT #2, CHR$(12)
  403. 4020  PGQSOS=0 : PGZONES=0 : PGCTRY=0 : PGPTS=0                 ' reset page counts
  404. 4030  RETURN
  405.