home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / a / dbref.lbr / COD.RZF / COD.REF
Encoding:
Text File  |  1993-10-26  |  6.3 KB  |  223 lines
  1. * DATE 04/26/85  20:30
  2. * cod.ref
  3. STOR CHR(peek (063)) TO dr
  4. REST from rdata additive
  5. SET COLON OFF
  6. SET INDEX TO &dr.:&cindex
  7. STOR '     ' TO one, two, thr,four,five,six,seve,eigh,nine,ten,ele,twel
  8. STOR '     ' TO thir,ften,fift,sixt,sev,eig,nin,twe
  9. @ 2, 1 SAY "This module will make a list of all"
  10. @ 2,62 SAY ">"
  11. @ 2,63 GET one PICTURE '99999'
  12. @ 2,68 SAY "<"
  13. @ 3, 1 SAY "of the references which you list on"
  14. @ 3,62 SAY ">"
  15. @ 3,63 GET two PICTURE '99999'
  16. @ 3,68 SAY "<"
  17. @ 4, 1 SAY "the right side of the screen."
  18. @ 4,62 SAY ">"
  19. @ 4,63 GET thr PICTURE '99999'
  20. @ 4,68 SAY "<"
  21. @ 5,62 SAY ">"
  22. @ 5,63 GET four PICTURE '99999'
  23. @ 5,68 SAY "<"
  24. @ 6, 1 SAY "You can enter as many code numbers"
  25. @ 6,62 SAY ">"
  26. @ 6,63 GET five PICTURE '99999'
  27. @ 6,68 SAY "<"
  28. @ 7, 1 SAY "as you wish - up to a total of 20."
  29. @ 7,62 SAY ">"
  30. @ 7,63 GET six PICTURE '99999'
  31. @ 7,68 SAY "<"
  32. @ 8,62 SAY ">"
  33. @ 8,63 GET seve PICTURE '99999'
  34. @ 8,68 SAY "<"
  35. @ 9,01 SAY "(Control 'Q' to end.)"
  36. @ 9,62 SAY ">"
  37. @ 9,63 GET eigh PICTURE '99999'
  38. @ 9,68 SAY "<"
  39. @ 10,62 SAY ">"
  40. @ 10,63 GET nine PICTURE '99999'
  41. @ 10,68 SAY "<"
  42. @ 11,62 SAY ">"
  43. @ 11,63 GET ten PICTURE '99999'
  44. @ 11,68 SAY "<"
  45. @ 12,62 SAY ">"
  46. @ 12,63 GET ele PICTURE '99999'
  47. @ 12,68 SAY "<"
  48. @ 13,62 SAY ">"
  49. @ 13,63 GET twel PICTURE '99999'
  50. @ 13,68 SAY "<"
  51. @ 14,62 SAY ">"
  52. @ 14,63 GET thir PICTURE '99999'
  53. @ 14,68 SAY "<"
  54. @ 15,62 SAY ">"
  55. @ 15,63 GET ften PICTURE '99999'
  56. @ 15,68 SAY "<"
  57. @ 16,62 SAY ">"
  58. @ 16,63 GET fift PICTURE '99999'
  59. @ 16,68 SAY "<"
  60. @ 17,62 SAY ">"
  61. @ 17,63 GET sixt PICTURE '99999'
  62. @ 17,68 SAY "<"
  63. @ 18,62 SAY ">"
  64. @ 18,63 GET sev PICTURE '99999'
  65. @ 18,68 SAY "<"
  66. @ 19,62 SAY ">"
  67. @ 19,63 GET eig PICTURE '99999'
  68. @ 19,68 SAY "<"
  69. @ 20,62 SAY ">"
  70. @ 20,63 GET nin PICTURE '99999'
  71. @ 20,68 SAY "<"
  72. @ 21,62 SAY ">"
  73. @ 21,63 GET twe PICTURE '99999'
  74. @ 21,68 SAY "<"
  75. READ
  76. CLEA gets
  77. STOR one+two+thr+four+five+six+seve+eigh+nine+ten+ele+twel+thir+ften+fift+sixt+sev+eig+nin+twe +'          ' TO list
  78. STOR 1 TO first
  79. STOR one TO name
  80. RELE one, two, thr,four,five,six,seve,eigh,nine,ten,ele,twel
  81. RELE thir,ften,fift,sixt,sev,eig,nin,twe
  82. REST from printrf.dat additive
  83. ERAS
  84. STOR 0 TO pagen
  85. STOR 0 TO counter
  86. IF PRINTER = 'Y'
  87.  SET PRINT ON
  88.  SET MARGIN TO 5
  89.  IF SHIFT = 'Y'
  90.   SET CONSOLE OFF
  91.   ? CHR(chr121) + CHR(chr122) + CHR(chr123)
  92.   SET CONSOLE ON
  93.  ENDI shift
  94. ENDI printer
  95. STOR t TO more
  96. DO WHIL more
  97. * do page counter etc
  98.  IF $(date(),4,1) = '0'
  99.   STOR $(date(),5,1) TO date2
  100.  ELSE
  101.   STOR $(date(),4,2) TO date2
  102.  ENDI
  103.  DO CASE
  104.  CASE $(date(),1,2) = '01'
  105.   STOR 'January ' + date2 + ', 19' + $(date(),7,2) TO date1
  106.  CASE $(date(),1,2) = '02'
  107.   STOR 'February ' + date2 + ', 19' + $(date(),7,2) TO date1
  108.  CASE $(date(),1,2) = '03'
  109.   STOR 'March ' + date2 + ', 19' + $(date(),7,2) TO date1
  110.  CASE $(date(),1,2) = '04'
  111.   STOR 'April ' + date2 + ', 19' + $(date(),7,2) TO date1
  112.  CASE $(date(),1,2) = '05'
  113.   STOR 'May ' + date2 + ', 19' + $(date(),7,2) TO date1
  114.  CASE $(date(),1,2) = '06'
  115.   STOR 'June ' + date2 + ', 19' + $(date(),7,2) TO date1
  116.  CASE $(date(),1,2) = '07'
  117.   STOR 'July ' + date2 + ', 19' + $(date(),7,2) TO date1
  118.  CASE $(date(),1,2) = '08'
  119.   STOR 'August ' + date2 + ', 19' + $(date(),7,2) TO date1
  120.  CASE $(date(),1,2) = '09'
  121.   STOR 'September ' + date2 + ', 19' + $(date(),7,2) TO date1
  122.  CASE $(date(),1,2) = '10'
  123.   STOR 'October ' + date2 + ', 19' + $(date(),7,2) TO date1
  124.  CASE $(date(),1,2) = '11'
  125.   STOR 'November ' + date2 + ', 19' + $(date(),7,2) TO date1
  126.  CASE $(date(),1,2) = '12'
  127.   STOR 'December ' + date2 + ', 19' + $(date(),7,2) TO date1
  128.  ENDC
  129.  STOR pagen+1 TO pagen
  130.  STOR 7 TO lineno
  131.  ERAS
  132.  ? caption
  133.  ? ' '
  134.  ? 'Report of ' +date1 + '.                                                                                ' + 'PAGE ' + STR(pagen,2)
  135.  ? "--------------------------------------------------------------------------------------------------------------------------"
  136.  ? ' '
  137. * now fill up rest of page to 55 lines with names etc
  138.  DO WHIL lineno < 55
  139.   DO WHIL name <> ' ' .AND. lineno < 55
  140.    STOR $(list,first,5) TO name
  141.    IF name <> ' '
  142.     FIND &name
  143.      IF # <> 0
  144.     STOR counter + 1 TO counter
  145.     STOR '                                              ' TO blnks
  146.     IF author <> ' '
  147.      STOR TRIM(author)+'. ' TO auth
  148.     ENDI
  149.     IF LEN(auth)+LEN(TRIM($(title1,1,60)))+LEN(TRIM($(title1,61,60))) > 125
  150.      ? auth + $(title1,1,60)
  151.      ? $(blnks,1,LEN(auth))+$(title1,61,60)
  152.      STOR lineno+2 TO lineno
  153.     ELSE
  154.      ? auth +TRIM($(title1,1,60))+' '+TRIM($(title1,61,60))
  155.      STOR lineno+1 TO lineno
  156.     ENDI
  157.     IF title2 <> ' '
  158.      ? '          '+title2
  159.      STOR lineno+1 TO lineno
  160.     ENDI title
  161.     IF publdat <> ' '
  162.      ? '          '+TRIM(publdat)+'. '+librdat
  163.      STOR lineno+1 TO lineno
  164.     ENDI
  165.     IF publdat = ' ' .AND. librdat <> ' '
  166.      ? '          '+librdat
  167.      STOR lineno +1 TO lineno
  168.     ENDI
  169.     ? '  '
  170.     STOR lineno+1 TO lineno
  171.    ENDI
  172.    STOR first + 5 TO first
  173.  ELSE
  174.     STOR f TO more
  175.     STOR 80 TO lineno
  176.    ENDI
  177.   ENDD while name
  178.  ENDD while lineno < 55
  179.  IF .NOT. EOF
  180.   SET PRINT OFF
  181.   @ 20,00 SAY '     *********************************************************************     '
  182.   @ 21,00
  183.   @ 22,00
  184.   @ 21,10 SAY 'CHANGE PAPER IF NECESSARY AND THEN HIT ANY KEY TO RESTART'
  185.   SET CONSOLE OFF
  186.   WAIT
  187.   SET CONSOLE ON
  188.   IF printer = 'Y'
  189.    SET PRINT ON
  190.   ENDI
  191.  ENDI
  192. ENDD more
  193. SET PRINT OFF
  194. @ 20,00 SAY '     *********************************************************************     '
  195. @ 21,00
  196. @ 22,00
  197. @ 21,10 SAY 'CHANGE PAPER IF NECESSARY AND THEN HIT ANY KEY TO RESTART'
  198. SET CONSOLE OFF
  199. WAIT
  200. SET CONSOLE ON
  201. IF printer = 'Y'
  202.  SET PRINT ON
  203. ENDI
  204. ? ' '
  205. ? "--------------------------------------------------------------------------------------------------------------------------"
  206. ? ' '
  207. ? '            THE TOTAL NUMBER OF REFERENCES LISTED WAS   ' + STR(counter,3,0)
  208. * if it was on turn it off
  209. EJEC
  210. SET PRINT OFF
  211. IF PRINTER = 'Y' .AND. SHIFT = 'Y'
  212.  SET PRINT ON
  213.  ? CHR(chrreg1) + CHR(chrreg2) + CHR(chrreg3)
  214.  SET PRINT OFF
  215. ENDI printer
  216. * release local variables
  217. RELE pagen, lineno, counter
  218. SET COLON ON
  219. * restore memory varibles
  220. SET INDEX TO &dr.:&tindex
  221. STOR t TO more
  222. STOR t TO first
  223.