home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / misc1 / db-comm.lzh / TM_PROC.PRG < prev    next >
Encoding:
Text File  |  1986-08-08  |  3.6 KB  |  243 lines
  1.  
  2. *
  3. *
  4. *
  5. *
  6. *
  7.  
  8. PROCEDURE tm_list
  9.  
  10. PARAMETERS tm_dbase
  11.  
  12. USE &tm_dbase
  13.  
  14. head_msg = nl+nl+nl+nl+;
  15.     "File #  Band  Frequency  Callsign"+nl+;
  16.     "------  ----  ---------  --------"
  17. CALL outport WITH head_msg
  18.  
  19. GOTO TOP
  20.  
  21. list_cont = .t.
  22. tm_count = 0
  23. DO WHILE .not. eof() .and. list_cont
  24.  
  25.     msg = nl+STR(file_num,6)+"  "+STR(freq_band,4)+"  "+;
  26.         STR(frequency,8,3)+"   "+callsign
  27.     CALL outport WITH msg
  28.  
  29.     tm_count = tm_count + 1
  30.     IF tm_count > 19
  31.         tm_count = 0
  32.         DO pause WITH head_msg
  33.     ENDIF
  34.  
  35.     SKIP
  36.  
  37. ENDDO    
  38.  
  39. USE
  40.  
  41. IF list_cont
  42.     DO pause WITH ""
  43. ENDIF
  44.  
  45. RETURN
  46.  
  47. *
  48. *
  49. *
  50. *
  51.  
  52. PROCEDURE tm_input
  53.  
  54. PARAMETERS tm_dbase
  55.  
  56. ip_msg = "Creating record with a File Number: "
  57. inp_ok = .t.
  58. DO WHILE inp_ok
  59.     msg = nl+nl+"Enter File number to input (CR for next, or 'E' to End) :"
  60.     CALL outport WITH msg
  61.  
  62.     ans = SPACE(7)
  63.     DO getstr WITH ans
  64.  
  65.     IF ans $ 'Ee'
  66.         inp_ok = .f.
  67.     ELSE
  68.         USE &tm_dbase
  69.         IF len(ans) > 0
  70.             m_file = VAL(ans)
  71.             SEEK m_file
  72.             IF EOF()
  73.                 APPEND BLANK
  74.                 DO rec_upd WITH m_file, ip_msg
  75.             ELSE
  76.                 msg = nl+nl+"Cannot Duplicate file number"
  77.                 CALL outport WITH msg
  78.             ENDIF
  79.         ELSE
  80.             GOTO BOTTOM
  81.             m_file = file_num + 1
  82.             APPEND BLANK
  83.             DO rec_upd WITH m_file, ip_msg
  84.         ENDIF
  85.         USE
  86.     ENDIF
  87. ENDDO        
  88.     
  89. RETURN
  90.  
  91.  
  92.  
  93. *
  94. *
  95. *
  96. *
  97. *
  98.  
  99. PROCEDURE tm_upd
  100.  
  101. PARAMETERS tm_dbase
  102.  
  103. upd_ok = .t.
  104. DO WHILE upd_ok
  105.     msg = nl+nl+"Enter File number to update (or CR to end) :"
  106.     CALL outport WITH msg
  107.  
  108.     ans = SPACE(7)
  109.     DO getstr WITH ans
  110.  
  111.     IF len(ans) = 0
  112.         upd_ok = .f.
  113.     ELSE
  114.         USE &tm_dbase
  115.         m_file = VAL(ans)
  116.         ? m_file
  117.         SEEK m_file
  118.         IF .NOT. EOF()
  119.             DO rec_upd WITH m_file, "Updating File Number: "
  120.         ELSE
  121.             msg = nl+nl+"Record Not found"
  122.             CALL outport WITH msg
  123.         ENDIF
  124.     ENDIF
  125. ENDDO        
  126.     
  127. RETURN
  128.  
  129. *
  130. *
  131. *
  132. *
  133. *
  134.  
  135. PROCEDURE rec_upd
  136.  
  137. PARAMETER arrl_file, upd_msg
  138.  
  139. val_msg = nl+nl+"Enter new value: "
  140.  
  141. u_fn = STR(arrl_file,6)
  142. u_fb = STR(freq_band,4)
  143. u_f = STR(frequency,8,3)
  144. u_cs = callsign
  145.  
  146. msg = nl+nl+upd_msg+u_fn+nl
  147. CALL outport WITH msg
  148.  
  149. rec_ok = .f.
  150. DO WHILE .NOT. rec_ok
  151.     uok = .f.
  152.     DO WHILE .NOT. uok
  153.         msg = nl+nl+"Frequency Band: "+u_fb+nl+nl+"OK ?"
  154.         CALL outport WITH msg
  155.         ans = SPACE(1)
  156.         DO getstr WITH ans
  157.         uok =  ans $ "Yy"
  158.         if .NOT. uok
  159.             CALL outport WITH val_msg
  160.             u_fb = SPACE(20)
  161.             DO getstr WITH u_fb
  162.         ENDIF    
  163.     ENDDO        
  164.     
  165.     uok = .f.
  166.     DO WHILE .NOT. uok
  167.         msg = nl+nl+"Freuqency: "+u_f+nl+nl+"OK ?"
  168.         CALL outport WITH msg
  169.         ans = SPACE(1)
  170.         DO getstr WITH ans
  171.         uok =  ans $ "Yy"
  172.         if .NOT. uok
  173.             CALL outport WITH val_msg
  174.             u_f = SPACE(20)
  175.             DO getstr WITH u_f
  176.         ENDIF    
  177.     ENDDO        
  178.     
  179.     uok = .f.
  180.     DO WHILE .NOT. uok
  181.         msg = nl+nl+"Callsign: "+u_cs+nl+nl+"OK ?"
  182.         CALL outport WITH msg
  183.         ans = SPACE(1)
  184.         DO getstr WITH ans
  185.         uok =  ans $ "Yy"
  186.         if .NOT. uok
  187.             CALL outport WITH val_msg
  188.             u_cs = SPACE(20)
  189.             DO getstr WITH u_cs
  190.             u_cs = UPPER(u_cs)
  191.         ENDIF    
  192.     ENDDO        
  193.     ans = SPACE(1)
  194.     msg = nl+nl+"Record OK ?"
  195.     CALL outport WITH msg
  196.     DO getstr  WITH ans
  197.     IF ans $ "Yy"
  198.         rec_ok = .t.
  199.         REPLACE file_num WITH arrl_file, freq_band WITH VAL(u_fb);
  200.             frequency WITH  VAL(u_f), callsign WITH u_cs
  201.     ENDIF
  202.  
  203. ENDDO    
  204. RETURN
  205.     
  206.  
  207. PROCEDURE pause
  208.  
  209. PARAMETERS p_head
  210.  
  211. p_msg = nl+nl+"Hit any Character to continue or S to stop: "
  212. CALL outport WITH p_msg
  213.  
  214. p_msg = SPACE(1)
  215. DO getstr with p_msg
  216.  
  217. IF p_msg $ "Ss"
  218.     list_cont = .f.
  219. ELSE
  220.     CALL outport WITH p_head
  221. ENDIF
  222.  
  223. RETURN
  224.  
  225. *
  226. *
  227. *
  228. *
  229. *
  230.  
  231. PROCEDURE getstr
  232.  
  233. PARAMETER string
  234.  
  235. CALL inport WITH string
  236.  
  237. IF asc(string) > 128
  238.     errmsg = nl+nl+"Timeout"+nl+nl
  239.     CALL outport WITH errmsg
  240.     RETURN TO MASTER
  241. ENDIF
  242. RETURN
  243.