home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / a / dbref.lbr / ACTION.RZF / ACTION.REF
Encoding:
Text File  |  1993-10-26  |  5.1 KB  |  184 lines

  1. * DATE 05/08/85  16:32
  2. * action.ref
  3. STOR CHR(peek (063)) TO dr
  4. REST from rdata additive
  5. * make sure index is in right order
  6. STOR 'Y' TO command
  7. ERAS
  8. STOR 'A' TO select
  9. @ 05,10 SAY 'This module print a list of all references in the file which have'
  10. @ 06,10 SAY "an 'ACTION' notation. You can select a specific ACTION LETTER"
  11. @ 07,10 SAY 'or all files which have an action notation.'
  12. STOR 'A' TO selec
  13. @ 13,10 SAY 'Do you want the report alphabetically by <A>uthor or <T>itle ? '
  14. @ 13,74 GET selec PICTURE '!'
  15. READ
  16. DO WHIL @(selec,'AT')=0
  17.  @ 13,74 GET selec PICTURE '!'
  18.  READ
  19. ENDD
  20. CLEA GETS
  21. IF selec = 'A'
  22.  SET index TO &dr.:&aindex
  23. ELSE
  24.  SET INDEX TO &dr.:&tindex
  25. ENDI
  26. RELE selec
  27. GO TOP
  28. STOR 'X' TO act
  29. @ 15,10 SAY "What ACTION letter shall we report on ('X' for all) ? "
  30. @ 15,74 GET act PICTURE '!'
  31. READ
  32. IF act <> ' '
  33.  REST from printrf.dat additive
  34.  ERAS
  35.  STOR 0 TO pagen
  36.  STOR 0 TO counter
  37.  IF PRINTER = 'Y'
  38.   SET PRINT ON
  39.   SET MARGIN TO 5
  40.   IF SHIFT = 'Y'
  41.    SET CONSOLE OFF
  42.    ? CHR(chr121) + CHR(chr122) + CHR(chr123)
  43.    SET CONSOLE ON
  44.   ENDI shift
  45.  ENDI printer
  46.  IF act = 'X'
  47.   LOCA for action <> ' '
  48.  ELSE
  49.   LOCA for action = '&act'
  50.  ENDI
  51.  IF .NOT. EOF
  52.   STOR t TO more
  53.  ELSE
  54.   STOR f TO more
  55.  ENDI
  56.  DO WHIL more
  57. * do page counter etc
  58.   IF $(date(),4,1) = '0'
  59.    STOR $(date(),5,1) TO date2
  60.   ELSE
  61.    STOR $(date(),4,2) TO date2
  62.   ENDI
  63.   DO CASE
  64.   CASE $(date(),1,2) = '01'
  65.    STOR 'January ' + date2 + ', 19' + $(date(),7,2) TO date1
  66.   CASE $(date(),1,2) = '02'
  67.    STOR 'February ' + date2 + ', 19' + $(date(),7,2) TO date1
  68.   CASE $(date(),1,2) = '03'
  69.    STOR 'March ' + date2 + ', 19' + $(date(),7,2) TO date1
  70.   CASE $(date(),1,2) = '04'
  71.    STOR 'April ' + date2 + ', 19' + $(date(),7,2) TO date1
  72.   CASE $(date(),1,2) = '05'
  73.    STOR 'May ' + date2 + ', 19' + $(date(),7,2) TO date1
  74.   CASE $(date(),1,2) = '06'
  75.    STOR 'June ' + date2 + ', 19' + $(date(),7,2) TO date1
  76.   CASE $(date(),1,2) = '07'
  77.    STOR 'July ' + date2 + ', 19' + $(date(),7,2) TO date1
  78.   CASE $(date(),1,2) = '08'
  79.    STOR 'August ' + date2 + ', 19' + $(date(),7,2) TO date1
  80.   CASE $(date(),1,2) = '09'
  81.    STOR 'September ' + date2 + ', 19' + $(date(),7,2) TO date1
  82.   CASE $(date(),1,2) = '10'
  83.    STOR 'October ' + date2 + ', 19' + $(date(),7,2) TO date1
  84.   CASE $(date(),1,2) = '11'
  85.    STOR 'November ' + date2 + ', 19' + $(date(),7,2) TO date1
  86.   CASE $(date(),1,2) = '12'
  87.    STOR 'December ' + date2 + ', 19' + $(date(),7,2) TO date1
  88.   ENDC
  89.   STOR pagen+1 TO pagen
  90.   STOR 7 TO lineno
  91.   ERAS
  92.   IF .NOT. EOF
  93.    ? caption
  94.    ? ' '
  95.    ? 'Report of ' +date1 + '.                                                                                ' + 'PAGE ' + STR(pagen,2)
  96.    ? "--------------------------------------------------------------------------------------------------------------------------"
  97.    ? ' '
  98.   ENDI .NOT. EOF
  99. * now fill up rest of page to 55 lines with names etc
  100.   DO WHIL lineno < 55
  101. * now do a page if not end of file
  102.    IF .NOT. EOF
  103.     STOR counter + 1 TO counter
  104.     STOR '                                              ' TO blnks
  105.     IF author <> ' '
  106.      STOR TRIM(author)+'. ' TO auth
  107.     ENDI
  108.     IF LEN(auth)+LEN(TRIM($(title1,1,60)))+LEN(TRIM($(title1,61,60))) > 125
  109.      ? auth + $(title1,1,60)
  110.      ? $(blnks,1,LEN(auth))+$(title1,61,60)
  111.      STOR lineno+2 TO lineno
  112.     ELSE
  113.      ? auth +TRIM($(title1,1,60))+' '+TRIM($(title1,61,60))
  114.      STOR lineno+1 TO lineno
  115.     ENDI
  116.     IF title2 <> ' '
  117.      ? '          '+title2
  118.      STOR lineno+1 TO lineno
  119.     ENDI title
  120.     IF publdat <> ' '
  121.      ? '          '+TRIM(publdat)+'. '+librdat
  122.      STOR lineno+1 TO lineno
  123.     ENDI
  124.     IF publdat = ' ' .AND. librdat <> ' '
  125.      ? '          '+librdat
  126.      STOR lineno +1 TO lineno
  127.     ENDI
  128.     ? '  '
  129.     STOR lineno+1 TO lineno
  130.     CONT
  131. * however, skip again if record deleted
  132.     IF *
  133.      CONT
  134.     ENDI
  135.    ELSE
  136.     STOR f TO more
  137.     STOR 60 TO lineno
  138.    ENDI not EOF
  139.   ENDD while lineno < 55
  140.   IF .NOT. EOF
  141.    SET PRINT OFF
  142.    @ 20,00 SAY '     *********************************************************************     '
  143.    @ 21,00
  144.    @ 22,00
  145.    @ 21,10 SAY 'CHANGE PAPER IF NECESSARY AND THEN HIT ANY KEY TO RESTART'
  146.    SET CONSOLE OFF
  147.    WAIT
  148.    SET CONSOLE ON
  149.    IF printer = 'Y'
  150.     SET PRINT ON
  151.    ENDI
  152.   ENDI
  153.  ENDD more
  154.  SET PRINT OFF
  155.  @ 20,00 SAY '     *********************************************************************     '
  156.  @ 21,00
  157.  @ 22,00
  158.  @ 21,10 SAY 'CHANGE PAPER IF NECESSARY AND THEN HIT ANY KEY TO RESTART'
  159.  SET CONSOLE OFF
  160.  WAIT
  161.  SET CONSOLE ON
  162.  IF printer = 'Y'
  163.   SET PRINT ON
  164.  ENDI
  165.  ? ' '
  166.  ? "--------------------------------------------------------------------------------------------------------------------------"
  167.  ? ' '
  168.  ? '            THE TOTAL NUMBER OF REFERENCES LISTED WAS   ' + STR(counter,3,0)
  169. * if it was on turn it off
  170.  EJEC
  171.  SET PRINT OFF
  172.  IF PRINTER = 'Y' .AND. SHIFT = 'Y'
  173.   SET PRINT ON
  174.   ? CHR(chrreg1) + CHR(chrreg2) + CHR(chrreg3)
  175.   SET PRINT OFF
  176.  ENDI printer
  177. ENDI command = 'Y'
  178. * release local variables
  179. RELE pagen, lineno, counter
  180. * restore memory varibles
  181. SET INDEX TO &dr.:&tindex
  182. STOR t TO more
  183. STOR t TO first
  184.