home *** CD-ROM | disk | FTP | other *** search
/ Amiga Elysian Archive / AmigaElysianArchive.iso / bus_pers / ham.lha / ARRLDXScrn_v1.0 (.txt) < prev    next >
AmigaBASIC Source Code  |  1990-08-31  |  15KB  |  426 lines
  1. 'July 18, 1990: ARRLDXScrn was prepared by George R. Leone, K6SG, a member of 
  2. 'the River City Contesters, an Amateur Radio Club, and of the Sacramento Amiga 
  3. 'Computer Club. He assumes no responsibility for any losses incurred by its 
  4. 'use nor does he assume any responsibility for its upkeep. It is in the
  5. 'public domain and may be freely copied and distributed but may NOT be sold.
  6. 'This program will permit screen review all American Radio Relay League (ARRL) DX Contest 
  7. 'reports and permits log corrections to be made. Use ARRLDXPrt for hard copy
  8. 'print out of reports. 
  9. CLEAR ,175000
  10. WIDTH 80
  11. DIM q$(1,13),qc$(1,13),a$(3000)
  12.                                
  13.   PRINT "Before proceeding I need some information: ":PRINT
  14.   LOCATE 5,10:INPUT "Your first name ";my.nam$        'entries personalize reports
  15.   my.nam$=UCASE$(my.nam$)
  16.   LOCATE 7,10:INPUT "Your call ";my.cal$
  17.   my.cal$=UCASE$(my.cal$)
  18.   LOCATE 9,10:INPUT "ARRL Section ";my.sect$
  19.   my.sect$=UCASE$(my.sect$)
  20.   LOCATE 11,10:INPUT "State ";stat$
  21.   stat$=UCASE$(stat$)
  22.   yrin:
  23.   LOCATE 13,10:INPUT "Enter last two digits of contest year";yr$
  24.   IF yr$="" THEN GOTO yrin:
  25.  
  26. mode: LOCATE 15,34:PRINT "      "
  27.   LOCATE 15,10:INPUT "Enter mode - SSB or CW ";mode$
  28.   mode$=UCASE$(mode$)
  29.   IF mode$ <> "SSB" AND mode$ <> "CW" THEN GOTO mode
  30.   LOCATE 17,10:INPUT "Transmitter power in watts ";pwr%
  31.   OPEN "ARRLDX"+yr$+mode$ AS #1 LEN = 70    
  32.   FIELD #1,11 AS his.cal$,3 AS bnd$,8 AS dayt$,5 AS tyme$,6 AS my.nr$,6 AS his.nr$,5 AS time.prev$,5 AS time.on$,5 AS sign.in$,5 AS sign.out$,5 AS nu.mult$,1 AS poynt$,5 AS nat$ 
  33.   GOSUB clr.ctrs
  34.   
  35. menu.selection:
  36.   CLS
  37.   PRINT:PRINT TAB(20);"ARRL DX CONTEST REPORT REVIEW SELECTION"
  38.   PRINT:PRINT:PRINT TAB(15);"1.  Review Log "
  39.   PRINT:PRINT TAB(15);"2.  Review Summary Sheet"
  40.   PRINT:PRINT TAB(15);"3.  Review Dupesheet  "
  41.   PRINT:PRINT TAB(15);"4.  Review Multiplier Check Sheet"
  42.   PRINT:PRINT TAB(15);"5.  Make Log Corrections "
  43.   PRINT:PRINT TAB(15);"6.  Review Labels  "
  44.   PRINT:PRINT TAB(15);"7.  Main Menu "
  45.   
  46.   PRINT:PRINT:INPUT "Pick a number ";pn$
  47.   IF pn$ <> "1" AND pn$ <> "2" AND pn$ <> "3" AND pn$ <> "4" AND pn$ <> "5" AND pn$ <> "6" AND pn$ <> "7" THEN GOTO menu.selection
  48.   IF pn$="1" THEN GOSUB clr.ctrs:GOTO prints.log.title
  49.   IF pn$="2" THEN GOTO prints.summary.sheet
  50.   IF pn$="3" THEN GOSUB menu.first:GOTO prints.dupe.sheet
  51.   IF pn$="4" THEN GOSUB menu.first:GOTO prints.mult.list
  52.   IF pn$="5" THEN GOTO correct.log
  53.   IF pn$="6" THEN GOTO prints.labels
  54.   IF pn$="7" THEN CLOSE:CLS:CLEAR:CHAIN "ARRLDXBoot1.0"
  55.  
  56. prints.log.title:
  57.   CLS
  58.   PRINT SPC(25);"ARRL INTERNATIONAL DX COMPETITION"
  59.   PRINT:PRINT "LOG Sheet____of____";SPC(40); "MODE ";mode$
  60.   PRINT:PRINT "CALL USED: ";my.cal$
  61.   PRINT "-----------------------------------------------------------------------------"
  62.   PRINT "Band  Date      Time   Station      SENT     RCVD      NEW Mult  PTS   QSO#"
  63.   PRINT "-----------------------------------------------------------------------------"
  64.  
  65. git: 
  66.   multctr=multctr+1                      'starts total multiplier counter
  67.    x=x+1                                 'starts qso counter                                      
  68.    GET #1, x
  69.      q$(1,1)=his.cal$
  70.      q$(1,2)=bnd$
  71.      q$(1,3)=dayt$
  72.      q$(1,4)=tyme$
  73.      q$(1,5)=my.nr$
  74.      q$(1,6)=his.nr$
  75.      q$(1,11)=nu.mult$   
  76.      IF nu.mult$ = "     " THEN multctr=multctr-1  'multiplier worked before
  77.      q$(1,12)=poynt$
  78.      pts= pts+VAL(poynt$)
  79.      q$(1,13)=nat$
  80.   PRINT q$(1,2);"   ";q$(1,3);" ";" ";q$(1,4);"  "q$(1,1);"  ";q$(1,5);"   ";q$(1,6);"     ";q$(1,11);"     ";q$(1,12);"   ";x
  81.    IF bnd$="160" AND nu.mult$ <> "     " THEN ctr1=ctr1+1 
  82.    IF bnd$="160" THEN ctra=ctra+1                           'band counters working
  83.    IF bnd$="80 " AND nu.mult$ <> "     " THEN ctr2=ctr2+1
  84.    IF bnd$="80 " THEN ctrb=ctrb+1
  85.    IF bnd$="40 " AND nu.mult$ <> "     " THEN ctr3=ctr3+1
  86.    IF bnd$="40 " THEN ctrc=ctrc+1
  87.    IF bnd$="20 " AND nu.mult$ <> "     " THEN ctr4=ctr4+1
  88.    IF bnd$="20 " THEN ctrd=ctrd+1
  89.    IF bnd$="15 " AND nu.mult$ <> "     " THEN ctr5=ctr5+1
  90.    IF bnd$="15 " THEN ctre=ctre+1
  91.    IF bnd$="10 " AND nu.mult$ <> "     " THEN ctr6=ctr6+1
  92.    IF bnd$="10 " THEN ctrf=ctrf+1
  93.    IF x = LOF(1)/70  THEN GOTO last.page
  94.     IF x MOD 22 = 0 THEN GOSUB pageit     'puts 22 lines on screen
  95.      x = LOC(1)                            'marks qso counter at end of page
  96.      GOTO git
  97.      GOTO last.page
  98.  
  99. pageit:
  100.   INPUT "More - Y/N ";mor$
  101.   mor$=UCASE$(mor$)
  102.   IF mor$ <> "Y" AND mor$ <> "N" THEN GOTO pageit
  103.   IF mor$ = "N" THEN GOTO menu.selection :ELSE RETURN
  104.   
  105.  
  106. Print.footer:
  107.   pg=pg+1:PRINT
  108.   PRINT "Band/QSOs/Multipliers"    'footnotes each page with statistics
  109.   PRINT "160m";ctra;ctr1;"/ 80m";ctrb;ctr2;"/ 40m";ctrc;ctr3;"/ 20m";ctrd;ctr4;"/ 15m";ctre;ctr5;"/ 10m";ctrf;ctr6
  110.   PRINT "Contacts = ";x;"    Multipliers worked = ";multctr;"    Score = ";pts * multctr
  111.   PRINT:PRINT TAB(35); "page  ";pg
  112.   GOSUB finish
  113.   RETURN                                 
  114.  
  115. clr.ctrs:
  116.   x=0:pts=0:pg=0
  117.   ctr1=0:ctr2=0:ctr3=0:ctr4=0:ctr5=0:ctr6=0:  'band mult counters
  118.   ctra=0:ctrb=0:ctrc=0:ctrd=0:ctre=0:ctrf=0:  'band qso counters
  119.   RETURN
  120.  
  121. prints.mult.list:  xd=0
  122.   GOSUB prints.mult.title
  123.   GOSUB git.a.mult
  124.   GOSUB shell.sort
  125.   GOTO mult.output
  126.  
  127. last.page:
  128.   pg=pg+1:PRINT
  129.   PRINT "Band/QSOs/Multipliers
  130.   PRINT "160m";ctra;ctr1;"/ 80m";ctrb;ctr2;"/ 40m";ctrc;ctr3;"/ 20m";ctrd;ctr4;"/ 15m";ctre;ctr5;"/ 10m";ctrf;ctr6
  131.   PRINT:PRINT "Contacts = ";x;"    Multipliers worked = ";multctr;"    Score = ";pts * multctr
  132.   PRINT:PRINT TAB(35); "page  ";pg
  133.   GOSUB finish
  134.   PRINT CHR$(12)
  135.   GOTO menu.selection
  136.  
  137. finish:
  138.   PRINT:PRINT
  139.   PRINT "<Press any key to continue.>";
  140.   hit$ = INPUT$(1) 
  141.   RETURN
  142.  
  143. prints.mult.title:
  144.   CLS
  145.   PRINT TAB(21);"ARRL DX CONTEST MULTIPLIER CHECKSHEET""
  146.   PRINT:PRINT "Call...";my.cal$;TAB(47);"ARRL SECTION...";my.sect$
  147.   RETURN
  148.  
  149. menu.first:
  150.    pg=0:x=0
  151.    RETURN
  152.  
  153. prints.dupe.title:
  154.   CLS
  155.   PRINT TAB(27);"ARRL DX CONTEST DUPESHEET"
  156.   PRINT:PRINT "Call... ";my.cal$;TAB(47);"ARRL SECTION...";my.sect$
  157.   PRINT
  158.   RETURN
  159.  
  160.  
  161. prints.dupe.sheet:  xd=0
  162.   GOSUB git.a.call                   
  163.   GOSUB shell.sort
  164.   GOTO dupe.output                          
  165.  
  166. git.a.call:                                   'DIM a$(2000) 'cal$ array dim should equal dat.file 
  167.   FOR xd=1 TO LOF(1)/70
  168.   GET #1, xd 
  169.   a$(xd)=bnd$+" "+his.cal$
  170.     NEXT xd
  171.   RETURN
  172.  
  173. shell.sort:           
  174.   z=xd
  175.   t=xd-1
  176.   CLS
  177.  
  178. shell.algorithm:
  179.   n=LOF(1)/70
  180.   l=(2^INT(LOG(n)/LOG(2)))-1
  181.  
  182. start:
  183.   l=INT(l/2)
  184.   IF l < 1 THEN sorted.output
  185.   FOR j = 1 TO l
  186.   FOR k=j + l TO n STEP l
  187.    i=k
  188.     t$=a$(i)
  189.     compare:
  190.     IF a$(i-l) <= t$ THEN substitute
  191.     a$(i)=a$(i-l)
  192.    i=i-l
  193.    IF i > l THEN compare
  194.  
  195. substitute:
  196.   a$(i)=t$
  197.     LOCATE 1,1: PRINT t$   
  198.       NEXT k
  199.     NEXT j
  200.   GOTO start
  201.  
  202. sorted.output: 
  203.   IF pn$="4" THEN GOTO mult.output 
  204.  
  205. dupe.output:
  206.   GOSUB prints.dupe.title
  207.   PRINT
  208.   FOR xd=1 TO n
  209.   PRINT  a$(xd)" ";              'prints calls in alpha/num sequence
  210.    IF xd MOD 100 = 0 THEN GOSUB pageit         'puts 100 calls on screen
  211.    NEXT xd
  212.   GOSUB finish
  213.   PRINT CHR$(13) CHR$(12)
  214.   GOTO menu.selection
  215.  
  216. git.a.mult: 
  217.   mulit:                                
  218.   FOR xd=1 TO LOF(1)/70
  219.   GET #1, xd
  220.    IF nu.mult$="     " THEN a$(xd)=" " :ELSE a$(xd)=bnd$+" "+nu.mult$
  221.    NEXT
  222.   GOTO shell.sort
  223.  
  224. mult.output:
  225.   GOSUB prints.mult.title
  226.   PRINT
  227.   FOR xd=1 TO n
  228.    PRINT a$(xd),    'prints mults in alpha/num sequence by band
  229.    IF xd MOD 100 = 0 THEN GOSUB pageit         'puts 100 mults on screen
  230.   NEXT xd
  231.   GOSUB finish 
  232.   PRINT CHR$(13)CHR$(12)
  233.   GOTO menu.selection
  234.  
  235. prints.summary.sheet:
  236.   PRINT:PRINT STRING$(77,"-")
  237.   PRINT TAB(25);"ARRL INTERNATIONAL DX CONTEST"
  238.   PRINT STRING$(77,"-")
  239.   PRINT TAB(5);"CALL USED: ";my.cal$;TAB(27);"MODE: ";mode$;TAB(50);"ARRL SECTION: ";my.sect$
  240.   PRINT:PRINT "(Separate logs and summaries must be submitted for each mode of operation)"
  241.   PRINT
  242.   PRINT SPC(25);"Band   Valid QSOs    Countries"
  243.   PRINT SPC(25);STRING$(32,"-")
  244.   PRINT TAB(27);"160";TAB(37);ctra;TAB(50);ctr1   'prints band counters totals
  245.   PRINT TAB(27);"80";TAB(37);ctrb;TAB(50);ctr2
  246.   PRINT TAB(27);"40";TAB(37);ctrc;TAB(50);ctr3
  247.   PRINT TAB(27);"20";TAB(37);ctrd;TAB(50);ctr4
  248.   PRINT TAB(27);"15";TAB(37);ctre;TAB(50);ctr5
  249.   PRINT TAB(27);"10";TAB(37);ctrf;TAB(50);ctr6
  250.   PRINT SPC(25);STRING$(32,"-")
  251.   PRINT TAB(27);"TOTAL";TAB(37);x;TAB(50);multctr
  252.   PRINT STRING$(77,"-")
  253.   PRINT "Single Operator:( )     Single Operator Assisted:( )" 
  254.   PRINT "    ALL Band ( )
  255.   PRINT "    Single Band (check one):160( );80( );40( );20( );15( );10( )"
  256.   PRINT "    QRP - 10w or less:( ) "
  257.   GOSUB finish 
  258.   PRINT:PRINT "Multiop ( ): LIST ALL ops."
  259.   PRINT:PRINT "SCORING: ";SPC(3);"QSO'S: ";x;"  QSO Points: ";pts;"   Multipliers";multctr
  260.   PRINT:PRINT pts*multctr "Claimed Score"
  261.   PRINT:PRINT "DC Power Input: ";pwr%
  262.   PRINT STRING$(77,"-")
  263.   PRINT "Club participation?   Yes( )    No( )
  264.   PRINT "If YES, PRINT name of ARRL Affiliated Club:"
  265.   PRINT STRING$(77,"-")
  266.   PRINT:
  267.   PRINT "I have observed all competition rules as well as regulations established "
  268.   PRINT "for Amateur Radio in my country. My report is correct and true to the "
  269.   PRINT "best of my knowledge. I agree to be bound by the decisions of the ARRL "
  270.   PRINT "Awards Committee."
  271.   GOSUB finish
  272.   PRINT: 
  273.   PRINT "Date:.............  Signature............................Call: ";CA$
  274.   PRINT STRING$(77,"-")
  275.   PRINT:PRINT "Name:_______________________________________Call:___________________
  276.   PRINT:PRINT "Address:____________________________________________________________
  277.   PRINT:PRINT "City____________________________________State_______ZIP_____________
  278.   GOSUB finish
  279.   PRINT CHR$(13) CHR$(12)
  280.   GOTO menu.selection
  281.  
  282. prints.labels:
  283.   CLOSE #1
  284.   CLS
  285.     OPEN "ARRLDX"+yr$+mode$ AS #1 LEN = 70    
  286.   FIELD #1,11 AS his.cal$,3 AS bnd$,8 AS dayt$,5 AS tyme$,6 AS my.nr$,6 AS his.nr$,5 AS time.prev$,5 AS time.on$,5 AS sign.in$,5 AS sign.out$,5 AS nu.mult$,1 AS poynt$,5 AS nat$ 
  287.   i=0
  288.   LOCATE 3,5:INPUT "Do you want to print (I)ndividual or (A)ll labels? "; an$
  289.   an$=UCASE$(an$)                        'makes entries case blind
  290.   IF an$ <> "I" AND an$ <> "A" THEN GOTO prints.labels  'accepts only i or a
  291.   IF an$ = "I" THEN GOTO retrieve
  292.   IF an$ = "A" THEN GOTO git.by.call
  293.   
  294. make.labels:
  295.   PRINT
  296.   PRINT "Confirming QSO with ";q$(1,1)              'prints all labels
  297.   PRINT "DATE ";q$(1,3);": UTC ";q$(1,4)
  298.   PRINT "BAND ";q$(1,2);" M ";mo$;":MY NR ";q$(1,5)
  299.   PRINT "TNX UR ARRL DX NR ";q$(1,6)
  300.   PRINT "73, CU NEXT YR. -- ";my.nam$
  301.   PRINT
  302.   RETURN
  303.  
  304. make.a.label:
  305.   PRINT                                               'prints one label
  306.   PRINT "Confirming QSO with ";qc$(1,1)
  307.   PRINT "DATE ";qc$(1,3);": UTC ";qc$(1,4)
  308.   PRINT "BAND ";qc$(1,2);" M ";mo$;":MY NR ";qc$(1,5)
  309.   PRINT "TNX UR ARRL DX NR ";qc$(1,6)
  310.   PRINT "73, CU NEXT YR. -- ";my.nam$
  311.   PRINT
  312.   GOTO retrieve
  313.  
  314. correct.log:
  315.   CLS
  316.   CLOSE
  317.   OPEN "ARRLDX"+yr$+mode$ AS #1 LEN = 70    
  318.   FIELD #1,11 AS his.cal$,3 AS bnd$,8 AS dayt$,5 AS tyme$,6 AS my.nr$,6 AS his.nr$,5 AS time.prev$,5 AS time.on$,5 AS sign.in$,5 AS sign.out$,5 AS nu.mult$,1 AS poynt$,5 AS nat$ 
  319.   qso.ptr = 0
  320.  
  321. retrieve:
  322.   PRINT SPC(5):INPUT "Enter band or Press (M) for Menu";ans$
  323.   ans$=UCASE$(ans$)
  324.   IF ans$="M" THEN GOTO menu.selection :ELSE band$=ans$
  325.   IF band$ <> "160" THEN band$=band$+" "   'adds space to other bands for matching
  326.   INPUT "Retrieve by (C)all or (S)erial Number ";rt$
  327.   rt$=UCASE$(rt$)
  328.   IF rt$="S" THEN INPUT "Enter serial nr. ";i: GOTO git.by.ptr
  329.   INPUT "Enter Call "; cal$
  330.   cal$=UCASE$(cal$)
  331.   GOTO get.call
  332.  
  333. git.by.call:                        'This array used getting info
  334.   FOR qso.ptr = 1 TO LOF(1)/70       'for printing (A)ll labels
  335.    GET #1, qso.ptr
  336.      q$(1,1)=his.cal$
  337.      q$(1,2)=bnd$
  338.      q$(1,3)=dayt$
  339.      q$(1,4)=tyme$
  340.      q$(1,5)=my.nr$
  341.      q$(1,6)=his.nr$
  342.      q$(1,11)=nu.mult$   
  343.      q$(1,12)=poynt$
  344.      pts= pts+VAL(poynt$)               'adds points of each qso
  345.      q$(1,13)=nat$
  346.      GOSUB make.labels
  347.      IF qso.ptr <> LOF(1)/70  THEN NEXT :ELSE GOSUB finish:GOTO menu.selection
  348.     
  349. get.call: i=0   :ctr=0
  350.  
  351. goagn:
  352.   FOR i = 1 TO LOF(1)/70
  353.    GET #1, i
  354.     ctr = INSTR(his.cal$+" "," ")            'eliminates trailing blanks in 
  355.     q$(1,1) = LEFT$(his.cal$,ctr-1)          'array to permit proper call sign match.
  356.     q$(1,2)=bnd$
  357.     IF q$(1,2) = band$ AND cal$ = q$(1,1) THEN GOTO git.by.ptr
  358.     NEXT
  359.    PRINT "Call not found!":BEEP:BEEP:GOTO retrieve
  360.                                             
  361. git.by.ptr:                                 
  362.   CLS                            'This array used for correcting log entry
  363.   GET #1, i                      'and getting info for printing single labels
  364.     qc$(1,1)=his.cal$
  365.     qc$(1,2)=bnd$
  366.     qc$(1,3)=dayt$
  367.     qc$(1,4)=tyme$
  368.     qc$(1,5)=my.nr$
  369.     qc$(1,6)=his.nr$
  370.     qc$(1,7)=time.prev$
  371.     qc$(1,8)=time.om$
  372.     qc$(1,9)=sign.in$
  373.     qc$(1,10) =sign.out$
  374.     qc$(1,11)=nu.mult$   
  375.     IF nu.mult$ = "     " THEN multctr=multctr-1
  376.     qc$(1,12)=poynt$
  377.     pts= pts+VAL(poynt$)
  378.     qc$(1,13)=nat$
  379.   IF an$ = "I"  THEN GOTO make.a.label
  380.  
  381. Correct.entry:
  382.   PRINT "NOTE: To clear a field enter a pair of spaced quotation marks."
  383.   PRINT "Band  Date      Time   Station      SENT     RCVD         NEW Mult      PTS"
  384.   PRINT qc$(1,2);"   ";qc$(1,3);"  ";qc$(1,4);"  "qc$(1,1);"  ";qc$(1,5);"   ";qc$(1,6);"        ";qc$(1,11);"         ";qc$(1,12)    
  385.    INPUT "Band    :",bd$
  386.    IF bd$ <> "" THEN qc$(1,2)=bd$ 
  387.    INPUT "Date    :",m.dat$
  388.    IF m.dat$ <> "" THEN qc$(1,3)=m.dat$
  389.    INPUT "Time    :",m.time$
  390.    IF m.time$ <> "" THEN qc$(1,4)=m.time$
  391.    INPUT "Station :", h.cal$
  392.    h.cal$=UCASE$(h.cal$)
  393.    IF h.cal$ <> "" THEN  qc$(1,1)=h.cal$
  394.    INPUT "Sent    :",m.numb$
  395.    IF m.numb$ <> "" THEN qc$(1,5)=m.numb$ 
  396.    INPUT "Received:",h.nr$
  397.    IF h.nr$ <> "" THEN qc$(1,6)=h.nr$
  398.    INPUT "New Mult:",n.mult$
  399.    n.mult$=UCASE$(n.mult$)            
  400.    IF n.mult$ <> "" THEN qc$(1,11)=n.mult$
  401.    INPUT "Points  :",pint$
  402.    IF pint$ <> "" THEN qc$(1,12)=pint$
  403.   
  404.   PRINT "Band  Date      Time   Station      SENT     RCVD         NEW Mult      PTS"
  405.   PRINT qc$(1,2);"   ";qc$(1,3);"  ";qc$(1,4);"  "qc$(1,1);"  ";qc$(1,5);"   ";qc$(1,6);"        ";qc$(1,11);"         ";qc$(1,12)    
  406.   inky:a$=INKEY$:IF a$=""THEN inky        'pause routine
  407. File.it:             'enters corrected or non-corrected log record
  408.   LSET his.cal$ = qc$(1,1)
  409.   LSET bnd$ = qc$(1,2) 
  410.   LSET dayt$ = qc$(1,3)
  411.   LSET tyme$ = qc$(1,4)
  412.   LSET my.nr$ = qc$(1,5)
  413.   LSET his.nr$ =qc$(1,6)
  414.   LSET time.prev$ = qc$(1,7)
  415.   LSET time.on$ = qc$(1,8)
  416.   LSET sign.in$ = qc$(1,9)
  417.   LSET sign.out$ = qc$(1,10)
  418.   LSET nu.mult$ =qc$(1,11)
  419.   LSET poynt$ = qc$(1,12)
  420.   LSET nat$ = qc$(1,13)
  421.     PUT #1, i                 
  422.   CLS
  423.   GOTO retrieve
  424.  
  425.  
  426.