home *** CD-ROM | disk | FTP | other *** search
/ ftp.update.uu.se / ftp.update.uu.se.2014.03.zip / ftp.update.uu.se / pub / rainbow / msdos / decus / RB113 / addr2345.for < prev    next >
Text File  |  1995-05-28  |  18KB  |  641 lines
  1. C
  2. C         ADDRESS / PHONE NO. LIST        by Bruce W. Roeckel
  3. C       *--------------------------*                         
  4. C          OPTION #2,3,4,5 - PRINTOUTS             
  5. C
  6. C
  7. $STORAGE:2
  8. C
  9. C
  10.       SUBROUTINE LOOK
  11. C
  12. C          LISTS MASTER FILE TO SCREEN FOR BROWSING
  13. C
  14.       COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
  15.       CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
  16.       CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
  17.       CHARACTER PH1(200)*14,PH2(200)*14
  18. C
  19.       COMMON/MAIN2/ STRID,SORT,MNUM
  20.       INTEGER*4 STRID(200),SORT(200),MNUM
  21. C
  22.       CHARACTER*1 ANS
  23.       CHARACTER*25 OPTION
  24. C
  25. C          CALL HEADER WITH OPTION PARAMETER
  26. C
  27.       OPTION='Browse Master File'
  28.       CALL HEADER(OPTION)
  29. C
  30. C          SET UP PARAMS IN GROUPS OF 5 
  31. C
  32.       DO 500 I=1,MNUM,5 
  33.       IH=1
  34.       IV=6
  35.       CALL UPTOP(IH,IV)
  36.       CALL KEYOFF
  37.       WRITE(*,'(X)')
  38. C
  39. C          LIST DATABASE, ONE SCREEN AT A TIME
  40. C
  41.       DO 200 K=I,I+4 
  42.       IF(K.LE.MNUM) THEN
  43.          CALL BOLD
  44.             WRITE(*,100) FIRST(K)
  45.   100       FORMAT(1X,A23,\)
  46.          CALL OFF
  47.          WRITE(*,110) CITY(K),STATE(K),ZIP(K),PH1(K)
  48.   110    FORMAT(2X,A23,1X,A2,1X,A5,2X,A14)
  49.          CALL BOLD
  50.             WRITE(*,115) (LAST(M,K),M=1,12)
  51.   115       FORMAT(1X,12A1,\)
  52.          CALL OFF
  53.          WRITE(*,120) ADD1(K),PH2(K)
  54.   120    FORMAT(13X,A30,4X,A14)
  55.          IF(ADD2(K).NE.' ') THEN
  56.             WRITE(*,'(27X,A30)') ADD2(K)
  57.          ELSE
  58.             WRITE(*,125)
  59.   125       FORMAT(79(' '))
  60.          ENDIF
  61.       ELSE
  62.          WRITE(*,150)
  63.   150    FORMAT(79(' '),/,79(' '),/,79(' '))
  64.       ENDIF
  65.   200 CONTINUE
  66.       IH=1
  67.       IV=23
  68.       CALL UPTOP(IH,IV)
  69.       CALL KEYON
  70.          IF(K.LE.MNUM) THEN
  71.             WRITE(*,'(A17,\)') ' More ... Q=Quit '
  72.          ELSE
  73.             WRITE(*,'(A17,\)') ' End of file ... '
  74.          ENDIF
  75.          READ(*,'(A1)') ANS
  76.             IF((ANS.EQ.'Q') .OR. (ANS.EQ.'q')) RETURN
  77.   500 CONTINUE
  78.       RETURN
  79.       END
  80. C
  81. C
  82. C
  83.       SUBROUTINE MLIST
  84. C
  85. C          LISTS MASTER FILE TO PRINTER
  86. C
  87.       COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
  88.       CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
  89.       CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
  90.       CHARACTER PH1(200)*14,PH2(200)*14
  91. C
  92.       COMMON/MAIN2/ STRID,SORT,MNUM
  93.       INTEGER*4 STRID(200),SORT(200),MNUM
  94. C
  95.       COMMON/REVNO/ PGM,AUTHOR,YEAR,DATE,REV
  96.       CHARACTER PGM*21,AUTHOR*21,YEAR*4,DATE*8,REV*2
  97. C
  98.       CHARACTER RAMDSK*80
  99.       INTEGER UNIT,SEL(7)
  100. C
  101. C          FIND OUT WHICH PAGES TO PRINT
  102. C
  103.       CALL LGROUP(SEL)
  104.       IF(SEL(1).EQ.0) RETURN
  105. C
  106. C          DISPLAY MESSAGE
  107. C
  108.       IH=1
  109.       IV=21
  110.       CALL MOVEIT(IH,IV)
  111.       CALL BOLD
  112.          WRITE(*,'(/,5X,A26,\)') 'Please Wait .... Printing '
  113.       CALL OFF
  114. C
  115. C          ISSUE PRINTER COMMANDS FOR SMALL TYPE      
  116. C
  117.       UNIT=6
  118.       OPEN(UNIT,FILE='PRN')
  119.       WRITE(UNIT,'(1X,A1,A2)') 155,'2z'
  120.       WRITE(UNIT,'(1X,A1,A2)') 155,'2w'
  121.       IF(SEL(7).EQ.1) THEN
  122.          WRITE(UNIT,20) DATE,YEAR,REV
  123.    20    FORMAT(/,1H1,///
  124.      A       //,1X,' ----------------------------------------      |',
  125.      B        /,1X,'        A D D R E S S   B O O K                |',
  126.      C        /,1X,' ----------------------------------------      |',
  127.      D       //,1X,'            as of ',A8,
  128.      E    29(/),1X,'(C) ',A4,' by Rocksoft',13X,'Ver. ',A2,'       |',
  129.      F     ////,1X,'-----------------------------------------------|')
  130.       ENDIF
  131. C
  132. C         PRINT ADDRESS BOOK, TWO LETTERS PER SECTION, TWO  SECTIONS PER PAGE
  133. C
  134.       ICNT=2
  135.       LINE=0
  136.       DO 800 LM=1,6,2
  137.       IF(SEL(LM).LE.0) GOTO 800
  138.       DO 700 I=SEL(LM),SEL(LM+1),2
  139.       CALL CHECK(ICNT,I,LINE)
  140.          DO 500 M=1,MNUM
  141.          IF(LINE.LE.0)  CALL CHECK(ICNT,I,LINE)
  142.          IF (((SORT(M)/10000).EQ.I) .OR. ((SORT(M)/10000).EQ.I+1)) THEN
  143.             CALL PBOLD(UNIT)
  144.                WRITE(UNIT,200) FIRST(M),(LAST(J,M),J=1,12)
  145.   200          FORMAT(/,7X,A23,2X,12A1,'    |')
  146.                LINE=LINE-1
  147.             CALL POFF(UNIT)
  148.             WRITE(RAMDSK,'(A23,1X,A2,1X,A5)') CITY(M),STATE(M),ZIP(M)
  149.             ILEN=32
  150.             CALL SQUISH(RAMDSK,ILEN)
  151.             IF(ADD2(M).NE.' ') THEN
  152.                WRITE(UNIT,210) ADD1(M),ADD2(M),RAMDSK,PH1(M),PH2(M)
  153.   210          FORMAT(6X,A30,
  154.      A              /,7X,A30,
  155.      B              /,7X,A32,
  156.      C              /,7X,A14,4X,A14)
  157.             ELSE
  158.                WRITE(UNIT,220) ADD1(M),RAMDSK,PH1(M),PH2(M)
  159.   220          FORMAT(6X,A30,
  160.      B              /,7X,A32,
  161.      C              /,7X,A14,4X,A14,/)
  162.             ENDIF
  163.          ENDIF
  164.   500    CONTINUE
  165.   700 CONTINUE
  166.   800 CONTINUE
  167. C
  168. C         RESET PRINTER BACK TO NORMAL
  169. C
  170.       WRITE(UNIT,'(1X,A1,A2)') 155,'0z'
  171.       WRITE(UNIT,'(1X,A1,A2)') 155,'0w'
  172.       CLOSE(UNIT)
  173. C
  174.       RETURN
  175.       END
  176. C
  177. C
  178. C
  179.       SUBROUTINE LGROUP(SEL)       
  180. C
  181. C         SELECTS LETTER GROUP TO PRINT             
  182. C
  183.       INTEGER SEL(7)
  184.       REAL CHK
  185.       CHARACTER*1 FRST,SCND,THRD
  186. C
  187.       COMMON/LETT/ ALPHA,ALPH2
  188.       CHARACTER*1 ALPHA(26),ALPH2(26)
  189. C
  190. C         INITIALIZE WORK VARIABLES  
  191. C
  192.       DO 50 I=1,7
  193.       SEL(I)=0
  194.    50 CONTINUE
  195. C
  196. C         ASK FOR PAGES TO BE PRINTED
  197. C
  198.       IH=1
  199.       IV=21
  200.       CALL MOVEIT(IH,IV)
  201.       CALL BOLD
  202.          WRITE(*,100) 
  203.   100    FORMAT(/,5X,'Enter 3 Letters to Print or "ALL" ==> [   ]',\)
  204.          ILEN=5
  205.          CALL CURLT(ILEN)
  206.       READ(*,'(3A1)') FRST,SCND,THRD
  207.       CALL OFF
  208.       IF((FRST.EQ.' ') .AND. (SCND.EQ.' ') .AND. (THRD.EQ.' ')) RETURN
  209. C
  210. C         FIGURE OUT WHAT TO PRINT
  211. C
  212.       IF(((FRST.EQ.'A') .OR. (FRST.EQ.'a')) .AND.
  213.      A   ((SCND.EQ.'L') .OR. (SCND.EQ.'l')) .AND.
  214.      B   ((THRD.EQ.'L') .OR. (THRD.EQ.'l'))) THEN
  215.             SEL(1)=1
  216.             SEL(2)=26
  217.             SEL(7)=1
  218.       ELSE
  219.          DO 200 I=1,26
  220.          IF((FRST.EQ.ALPHA(I)) .OR. (FRST.EQ.ALPH2(I))) THEN
  221.             CHK=REAL(I)/2.0 - I/2
  222.             IF(CHK.EQ.0.0) THEN
  223.                SEL(1)=I-1
  224.             ELSE
  225.                SEL(1)=I
  226.             ENDIF
  227.             SEL(2)=SEL(1)+1
  228.          ENDIF
  229.          IF((SCND.EQ.ALPHA(I)) .OR. (SCND.EQ.ALPH2(I))) THEN
  230.             CHK=REAL(I)/2.0 - I/2
  231.             IF(CHK.EQ.0.0) THEN
  232.                SEL(3)=I-1
  233.             ELSE
  234.                SEL(3)=I
  235.             ENDIF
  236.             SEL(4)=SEL(3)+1
  237.          ENDIF
  238.          IF((THRD.EQ.ALPHA(I)) .OR. (THRD.EQ.ALPH2(I))) THEN
  239.             CHK=REAL(I)/2.0 - I/2
  240.             IF(CHK.EQ.0.0) THEN
  241.                SEL(5)=I-1
  242.             ELSE
  243.                SEL(5)=I
  244.             ENDIF
  245.             SEL(6)=SEL(5)+1
  246.          ENDIF
  247.   200    CONTINUE
  248. C
  249. C           NOW, CHECK FOR DUPLICATE REQUESTS
  250. C
  251.          IF(SEL(1).EQ.SEL(3)) THEN
  252.             SEL(3)=0
  253.             SEL(4)=0
  254.          ENDIF
  255.          IF(SEL(3).EQ.SEL(5)) THEN
  256.             SEL(5)=0
  257.             SEL(6)=0
  258.          ENDIF
  259.          IF(SEL(1).EQ.SEL(5)) THEN
  260.             SEL(5)=0
  261.             SEL(6)=0
  262.          ENDIF
  263. C
  264. C         ASK IF NEW COVER NEEDED    
  265. C
  266.          IH=1
  267.          IV=21
  268.          CALL MOVEIT(IH,IV)
  269.          CALL BOLD
  270.             WRITE(*,500) 
  271.   500       FORMAT(/,5X,'Would You Like a New Cover (Y/N) ? ==> [ ]',\)
  272.             ILEN=3
  273.             CALL CURLT(ILEN)
  274.          READ(*,'(A1)') FRST
  275.          IF((FRST.EQ.'Y') .OR. (FRST.EQ.'y')) SEL(7)=1
  276.          CALL OFF
  277.       ENDIF
  278.       RETURN
  279.       END
  280. C
  281. C
  282. C
  283.       SUBROUTINE CHECK(ICNT,I,LINE)
  284. C
  285. C         CHECK PAGE STATUS FOR MASTER LISTING LOGIC
  286. C
  287.       INTEGER ICNT,UNIT,LINE
  288. C
  289.       COMMON/LETT/ ALPHA,ALPH2
  290.       CHARACTER*1 ALPHA(26),ALPH2(26)
  291. C
  292.       UNIT=6
  293.       ICNT=ICNT+1
  294.       IF(ICNT.GT.2) THEN
  295.          ICNT=1
  296.          LINE=6
  297.          WRITE(UNIT,'(1H1)')
  298.          WRITE(UNIT,100) (ALPHA(K),K=I,I+1)
  299.   100    FORMAT(/,42X,A1,'/',A1,/)
  300.       ELSEIF(ICNT.GT.1) THEN
  301.          DO 200 K=1,LINE
  302.          WRITE(UNIT,'(/////)')
  303.   200    CONTINUE
  304.          WRITE(UNIT,'(//,A35,/)')'-----------------------------------'
  305.          LINE=6
  306.          WRITE(UNIT,100) (ALPHA(K),K=I,I+1)
  307.       ENDIF
  308.       RETURN
  309.       END
  310. C
  311. C
  312. C
  313.       SUBROUTINE BKLT
  314. C
  315. C          CREATES WALLET SIZE ADDRESS BOOK
  316. C
  317.       COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
  318.       CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
  319.       CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
  320.       CHARACTER PH1(200)*14,PH2(200)*14
  321. C
  322.       COMMON/MAIN2/ STRID,SORT,MNUM
  323.       INTEGER*4 STRID(200),SORT(200),MNUM
  324. C
  325.       CHARACTER RAMDSK*80
  326.       INTEGER UNIT,MAXNUM,PNUM,ARRAY(200)
  327.       UNIT=6
  328. C
  329. C          CALL ROUTINE TO SELECT CUSTOMERS
  330. C
  331.       MAXNUM=9
  332.       CALL PICKEM(MAXNUM,PNUM,ARRAY)
  333.          IF(PNUM.LE.0) RETURN
  334.       IH=1
  335.       IV=23
  336.       CALL UPTOP (IH,IV)
  337.       CALL BOLD
  338.          WRITE(*,15)
  339.    15    FORMAT('   Please Wait .... Printing          ',
  340.      A          '                                      ',\)
  341.       CALL OFF
  342. C
  343. C          ISSUE PRINTER COMMANDS FOR SMALL TYPE      
  344. C
  345.       OPEN(UNIT,FILE='PRN')
  346.       WRITE(UNIT,'(1X,A1,A2)') 155,'2z'
  347.       WRITE(UNIT,'(1X,A1,A2)') 155,'2w'
  348.    10 FORMAT(1X,'|                                        |',
  349.      A     /,1X,'|----------------------------------------| <-- CUT')
  350.    20 FORMAT(1X,'|                                        |',
  351.      A     /,1X,'|-                                      -| <-- FOLD')
  352. C
  353. C          PRINT BOOKLET COVER
  354. C
  355.       WRITE(UNIT,'(1H1)')
  356.       WRITE(UNIT,10)
  357.       WRITE(UNIT,500)
  358. C
  359. C          PRINT ALL ENTRIES IN FILE   
  360. C
  361.       DO 400 K=1,MAXNUM,3
  362.          WRITE(UNIT,20)
  363.          DO 300 J=K,K+2
  364.          I=ARRAY(J)
  365.          IF(J.GT.PNUM) THEN
  366.             WRITE(UNIT,100)
  367.   100       FORMAT(   ' |                                        |',
  368.      A        /,' |                                        |',
  369.      B        /,' |                                        |',
  370.      C        /,' |                                        |',
  371.      D        /,' |                                        |',
  372.      E        /,' |                                        |')
  373.          ELSEIF(ADD2(I).NE.' ') THEN
  374.             WRITE(RAMDSK,'(A23,1X,A2,1X,A5)') CITY(I),STATE(I),ZIP(I)
  375.             ILEN=32
  376.             CALL SQUISH(RAMDSK,ILEN)
  377.             WRITE(UNIT,150) FIRST(I),(LAST(M,I),M=1,12),ADD1(I),
  378.      A      ADD2(I),RAMDSK,PH1(I),PH2(I)
  379.   150       FORMAT(' | ',39X,'|',    
  380.      A           /,' |    ',A23,1X,12A1,'|',
  381.      B           /,' |    ',A30,6X,'|',
  382.      C           /,' |    ',A30,6X,'|',
  383.      D           /,' |    ',A32,4X,'|',
  384.      E           /,' |    ',A14,2X,A14,6X,'|')
  385.          ELSE
  386.             WRITE(RAMDSK,'(A23,1X,A2,1X,A5)') CITY(I),STATE(I),ZIP(I)
  387.             ILEN=32
  388.             CALL SQUISH(RAMDSK,ILEN)
  389.             WRITE(UNIT,200) FIRST(I),(LAST(M,I),M=1,12),ADD1(I),
  390.      A      RAMDSK,PH1(I),PH2(I)
  391.   200       FORMAT(' | ',39X,'|',    
  392.      A           /,' |    ',A23,1X,12A1,'|',
  393.      B           /,' |    ',A30,6X,'|',
  394.      C           /,' |    ',A32,4X,'|',
  395.      D           /,' |    ',A14,2X,A14,6X,'|',
  396.      E           /,' | ',39X,'|')
  397.          ENDIF
  398.   300    CONTINUE
  399.   400 CONTINUE
  400.       WRITE(UNIT,10)
  401.   500 FORMAT(   ' |                                        |',
  402.      A        /,' |                                        |',
  403.      B        /,' |                                        |',
  404.      C        /,' |                                        |',
  405.      D        /,' |             A D D R E S S              |',
  406.      E        /,' |                                        |',
  407.      F        /,' |                  and                   |',
  408.      G        /,' |                                        |',
  409.      H        /,' |            P H O N E   N O .           |',
  410.      I        /,' |                                        |',
  411.      J        /,' |             B O O K L E T              |',
  412.      K        /,' |                                        |',
  413.      L        /,' |                                        |',
  414.      M        /,' |                                        |',
  415.      N        /,' |                                        |',
  416.      O        /,' |                                        |',
  417.      P        /,' |                                        |',
  418.      Q        /,' | (C) 1986 by Rocksoft                   |')
  419. C
  420. C         RESET PRINTER BACK TO NORMAL
  421. C
  422.       WRITE(UNIT,'(1X,A1,A2)') 155,'0z'
  423.       WRITE(UNIT,'(1X,A1,A2)') 155,'0w'
  424.       CLOSE(UNIT)
  425. C
  426.       RETURN
  427.       END
  428. C
  429. C
  430. C
  431.       SUBROUTINE PHONE
  432. C
  433. C          CREATES PHONE NUMBER ONLY LISTING
  434. C
  435.       COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
  436.       CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
  437.       CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
  438.       CHARACTER PH1(200)*14,PH2(200)*14
  439. C
  440.       COMMON/MAIN2/ STRID,SORT,MNUM
  441.       INTEGER*4 STRID(200),SORT(200),MNUM
  442. C
  443.       INTEGER UNIT,MAXNUM,PNUM,ARRAY(200)
  444.       UNIT=6
  445. C
  446. C          CALL ROUTINE TO SELECT CUSTOMERS
  447. C
  448.       MAXNUM=18
  449.       CALL PICKEM(MAXNUM,PNUM,ARRAY)
  450.          IF(PNUM.LE.0) RETURN
  451.       IH=1
  452.       IV=23
  453.       CALL UPTOP (IH,IV)
  454.       CALL BOLD
  455.          WRITE(*,15)
  456.    15    FORMAT('   Please Wait .... Printing          ',
  457.      A          '                                      ',\)
  458.       CALL OFF
  459. C
  460. C          ISSUE PRINTER COMMANDS FOR SMALL TYPE      
  461. C
  462.       OPEN(UNIT,FILE='PRN')
  463.       WRITE(UNIT,'(1X,A1,A2)') 155,'2z'
  464.       WRITE(UNIT,'(1X,A1,A2)') 155,'2w'
  465.    10 FORMAT(1X,'|                                        |',
  466.      A     /,1X,'|----------------------------------------| <-- CUT')
  467.    20 FORMAT(1X,'|----------------------------------------| <-- CUT',
  468.      A     /,1X,'|   PHONE NO. SUMMARY       * Rocksoft * |',
  469.      B     /,1X,'|----------------------------------------|',
  470.      C     /,1X,'|                                        |')
  471. C
  472. C          PRINT ALL ENTRIES SELECTED  
  473. C
  474.       WRITE(UNIT,'(1H1)')
  475.       WRITE(UNIT,20)
  476.       DO 400 J=1,MAXNUM
  477.          I=ARRAY(J)
  478.          IF(J.GT.PNUM) THEN
  479.             WRITE(UNIT,100)
  480.   100       FORMAT(' |                                        |',
  481.      A           /,' |                                        |')
  482.          ELSEIF(PH2(I).EQ.' ') THEN
  483.             WRITE(UNIT,200) FIRST(I),PH1(I)
  484.   200       FORMAT(' | ',A23,' ',A14,' |',    
  485.      A           /,' | ',38X,' |')
  486.          ELSE
  487.             WRITE(UNIT,250) FIRST(I),PH1(I),PH2(I)
  488.   250       FORMAT(' | ',A23,' ',A14,' |',    
  489.      A           /,' | ',17X,' Work: ',A14,' |')
  490.          ENDIF
  491.   400 CONTINUE
  492.       WRITE(UNIT,10)
  493. C
  494. C         RESET PRINTER BACK TO NORMAL
  495. C
  496.       WRITE(UNIT,'(1X,A1,A2)') 155,'0z'
  497.       WRITE(UNIT,'(1X,A1,A2)') 155,'0w'
  498.       CLOSE(UNIT)
  499. C
  500.       RETURN
  501.       END
  502. C
  503. C
  504. C
  505.       SUBROUTINE PICKEM(MAXNUM,PNUM,ARRAY)
  506. C
  507. C          SELECTS PEOPLE FOR PRINTOUTS       
  508. C
  509.       COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
  510.       CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
  511.       CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
  512.       CHARACTER PH1(200)*14,PH2(200)*14
  513. C
  514.       COMMON/MAIN2/ STRID,SORT,MNUM
  515.       INTEGER*4 STRID(200),SORT(200),MNUM
  516. C
  517.       INTEGER MAXNUM,ARRAY(200),PNUM,LU
  518.       CHARACTER*1 ANS,KEY
  519.       CHARACTER*25 OPTION
  520. C
  521. C          CALL HEADER WITH OPTION PARAMETER
  522. C
  523.     5 CONTINUE
  524.       OPTION='Printout Selection'
  525.       CALL HEADER(OPTION)
  526. C
  527. C          INITIALIZE POINTERS
  528. C
  529.       DO 10 K=1,200
  530.       ARRAY(K)=0
  531.    10 CONTINUE
  532. C
  533. C          PRINT INSTRUCTIONS          
  534. C
  535.       IH=1
  536.       IV=20
  537.       CALL UPTOP(IH,IV)
  538.          WRITE(*,'(X)')
  539.       CALL ULINE
  540.          WRITE(*,'(80X)')
  541.       CALL OFF
  542.          WRITE(*,50)
  543.    50    FORMAT(/,'   ( )elect   ( )elp   ( )uit                    ')
  544.       CALL BOLD
  545.       IV=23
  546.       IH=6
  547.       CALL UPTOP(IH,IV)
  548.          WRITE(*,'(A1)') 'S'
  549.       IH=17
  550.       CALL UPTOP(IH,IV)
  551.          WRITE(*,'(A1)') 'H'
  552.       IH=26
  553.       CALL UPTOP(IH,IV)
  554.          WRITE(*,'(A1)') 'Q'
  555.       IH=50
  556.       CALL UPTOP(IH,IV)
  557.       CALL BLINK
  558.          WRITE(*,'(A25,I3.3)') '  Total Selected : 000 / ',MAXNUM
  559.       CALL OFF
  560. C
  561. C          SET UP PARAMS IN GROUPS OF 12
  562. C
  563.       PNUM=0
  564.       DO 500 I=1,MNUM,12
  565.       CALL KEYOFF
  566.       IH=1
  567.       IV=6
  568.       CALL UPTOP(IH,IV)
  569.       WRITE(*,'(X)')
  570. C
  571. C          LIST DATABASE, ONE SCREEN AT A TIME
  572. C
  573.       DO 200 K=I,I+11
  574.       IF(K.LE.MNUM) THEN
  575.          CALL BOLD
  576.          WRITE(*,100) (LAST(J,K),J=1,12)
  577.   100    FORMAT(7X,'_',2X,12A1,\)
  578.          CALL OFF
  579.          WRITE(*,110) FIRST(K),PH1(K),PH2(K)
  580.   110    FORMAT(1X,A23,A14,1X,A14)
  581.       ELSE
  582.          WRITE(*,150)
  583.   150    FORMAT(8X,70(' '))
  584.       ENDIF
  585.   200 CONTINUE
  586.       CALL KEYON
  587.       IV=6
  588.       DO 300 K=I,I+11
  589.       IF(K.LE.MNUM) THEN
  590.          IH=10
  591.          IV=IV+1
  592.          CALL UPTOP(IH,IV)
  593.             READ(*,'(A1)') ANS
  594.             IF((ANS.EQ.'H') .OR. (ANS.EQ.'h')) THEN
  595.                KEY='2'
  596.                LU=15
  597.                CALL HELP(KEY,LU)
  598.                GOTO 5
  599.             ELSEIF((ANS.EQ.'S') .OR. (ANS.EQ.'s')) THEN
  600.                PNUM=PNUM+1
  601.                ARRAY(PNUM)=K
  602.                IH1=69
  603.                IV1=23
  604.                CALL UPTOP(IH1,IV1)
  605.                CALL BOLD
  606.                CALL BLINK
  607.                   WRITE(*,'(I3.3)') PNUM
  608.                CALL OFF
  609.                IF(PNUM.GE.MAXNUM) GOTO 600
  610.             ELSEIF((ANS.EQ.'Q') .OR. (ANS.EQ.'q')) THEN
  611.                GOTO 600
  612.             ENDIF
  613.       ENDIF
  614.   300 CONTINUE
  615.       IF(K.GT.MNUM) GOTO 600
  616.   500 CONTINUE
  617.   600 CONTINUE
  618.       IF(PNUM.LE.0) RETURN  
  619.       IV=23
  620.       IH=1
  621.       CALL UPTOP(IH,IV)
  622.       CALL BOLD
  623.       CALL BLINK
  624.          WRITE(*,700)
  625.   700    FORMAT('    Proceed with Printout of selected ',
  626.      A          'names (Y/N) ? ==> [ ]                 ',\)
  627.       CALL OFF
  628.       ILEN=20
  629.       CALL CURLT(ILEN)
  630.       READ(*,'(A1)') ANS
  631.          IF((ANS.EQ.'Y') .OR. (ANS.EQ.'y')) THEN
  632.             RETURN
  633.          ELSEIF((ANS.EQ.'N') .OR. (ANS.EQ.'n')) THEN
  634.             PNUM=0
  635.             RETURN
  636.          ELSE
  637.             CALL BELL
  638.             GOTO 600
  639.          ENDIF
  640.       END
  641.