home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol285 / phone.prg < prev    next >
Encoding:
Text File  |  1986-12-22  |  2.1 KB  |  84 lines
  1. **    Last revision: April 17, 1986 at 18:54
  2. * phone.ag
  3. * this module makes a phone list of names, home and office phones
  4. * it can be adjusted to print otherwise information
  5. SET MARGIN TO 10
  6. * GET a starting AND ending points in FILES
  7. STOR 'A' TO stletter
  8. @ 17,12 SAY 'Letter of alphabet at which to start report'
  9. @ 17,57 GET stletter PICTURE '!'
  10. READ
  11. STOR 'Z' TO llet
  12. @ 18,12 SAY 'Letter of alphabet at which to end report'
  13. @ 18,57 GET llet PICTURE '!'
  14. READ
  15. STOR ASC(llet)+1 TO finish
  16. * goto starting point or next if no find
  17. IF stletter = 'A'
  18.  GO TOP
  19. ELSE
  20.  SEEK stletter
  21.  DO WHIL (EOF() .OR. BOF())
  22.   STOR ASC(stletter) + 1 TO start1
  23.   STOR CHR(start1) TO stletter
  24.   SEEK stletter
  25.  ENDD whil #
  26. ENDI stletter
  27. * initialize variables
  28. STOR 0 TO pageno
  29. STOR .t. TO more
  30. SET MARGIN TO 10
  31. DO WHIL more
  32. * do page counter etc
  33.  STOR pageno + 1 TO pageno
  34.  STOR 6 TO lineno
  35.  CLEAR
  36. * eject a page and skip down 2 lines
  37. IF printer = 'Y'
  38.  SET PRINT ON
  39.  EJEC
  40. ENDIF
  41. * and write title
  42.  ? '========================== TELEPHONE LIST =========================='
  43.  ? ' '
  44.  ? '         ' + DTOC(DATE()) + '                                            PAGE: ' + str(pageno,2)
  45.  ? ' '
  46.  ? '      NAME                   HOME PHONE         OFFICE PHONE'
  47.  ? ' '
  48. * now fill up restore of page to 55 lines with names etc
  49.  DO WHIL lineno < 55
  50. * now do a page if not end of files
  51.   IF .not. EOF()
  52.    IF ASC(lastname) <= finish
  53. * make first name to length=10 and...
  54. * create a blank to pad names to constant length
  55.     STOR trim(fname)+ ' ' + lastname TO mname
  56.     STOR SUBSTR(mname,1,23) TO mname
  57.     ? mname+ '      ' + phone + '      ' + ophone
  58. * if it is end of files quit
  59.     STOR lineno +1 TO lineno
  60.     SKIP
  61. * if deleted, skip again
  62.     IF DELETE()
  63.      SKIP
  64.     ENDI
  65.    ELSE
  66.     SKIP
  67.    ENDI $(lastname)
  68.   ELSE
  69.    STOR .f. TO more
  70.    STOR 60 TO lineno
  71.   ENDI not eof
  72.  ENDD WHILE lineno < 55
  73. ENDD more
  74. * if it was on turn it off
  75. IF printer = 'Y'
  76. EJEC
  77. ENDIF
  78. SET MARGIN TO 0
  79. SET PRINT OFF
  80. SET ALTERNATE OFF
  81. SET MARGIN TO 0
  82. RETURN
  83.  
  84.