C
C         ADDRESS / PHONE NO. LIST        by Bruce W. Roeckel
C       *--------------------------*                         
C          OPTION #2,3,4,5 - PRINTOUTS             
C
C
$STORAGE:2
C
C
      SUBROUTINE LOOK
C
C          LISTS MASTER FILE TO SCREEN FOR BROWSING
C
      COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
      CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
      CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
      CHARACTER PH1(200)*14,PH2(200)*14
C
      COMMON/MAIN2/ STRID,SORT,MNUM
      INTEGER*4 STRID(200),SORT(200),MNUM
C
      CHARACTER*1 ANS
      CHARACTER*25 OPTION
C
C          CALL HEADER WITH OPTION PARAMETER
C
      OPTION='Browse Master File'
      CALL HEADER(OPTION)
C
C          SET UP PARAMS IN GROUPS OF 5 
C
      DO 500 I=1,MNUM,5 
      IH=1
      IV=6
      CALL UPTOP(IH,IV)
      CALL KEYOFF
      WRITE(*,'(X)')
C
C          LIST DATABASE, ONE SCREEN AT A TIME
C
      DO 200 K=I,I+4 
      IF(K.LE.MNUM) THEN
         CALL BOLD
            WRITE(*,100) FIRST(K)
  100       FORMAT(1X,A23,\)
         CALL OFF
         WRITE(*,110) CITY(K),STATE(K),ZIP(K),PH1(K)
  110    FORMAT(2X,A23,1X,A2,1X,A5,2X,A14)
         CALL BOLD
            WRITE(*,115) (LAST(M,K),M=1,12)
  115       FORMAT(1X,12A1,\)
         CALL OFF
         WRITE(*,120) ADD1(K),PH2(K)
  120    FORMAT(13X,A30,4X,A14)
         IF(ADD2(K).NE.' ') THEN
            WRITE(*,'(27X,A30)') ADD2(K)
         ELSE
            WRITE(*,125)
  125       FORMAT(79(' '))
         ENDIF
      ELSE
         WRITE(*,150)
  150    FORMAT(79(' '),/,79(' '),/,79(' '))
      ENDIF
  200 CONTINUE
      IH=1
      IV=23
      CALL UPTOP(IH,IV)
      CALL KEYON
         IF(K.LE.MNUM) THEN
            WRITE(*,'(A17,\)') ' More ... Q=Quit '
         ELSE
            WRITE(*,'(A17,\)') ' End of file ... '
         ENDIF
         READ(*,'(A1)') ANS
            IF((ANS.EQ.'Q') .OR. (ANS.EQ.'q')) RETURN
  500 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE MLIST
C
C          LISTS MASTER FILE TO PRINTER
C
      COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
      CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
      CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
      CHARACTER PH1(200)*14,PH2(200)*14
C
      COMMON/MAIN2/ STRID,SORT,MNUM
      INTEGER*4 STRID(200),SORT(200),MNUM
C
      COMMON/REVNO/ PGM,AUTHOR,YEAR,DATE,REV
      CHARACTER PGM*21,AUTHOR*21,YEAR*4,DATE*8,REV*2
C
      CHARACTER RAMDSK*80
      INTEGER UNIT,SEL(7)
C
C          FIND OUT WHICH PAGES TO PRINT
C
      CALL LGROUP(SEL)
      IF(SEL(1).EQ.0) RETURN
C
C          DISPLAY MESSAGE
C
      IH=1
      IV=21
      CALL MOVEIT(IH,IV)
      CALL BOLD
         WRITE(*,'(/,5X,A26,\)') 'Please Wait .... Printing '
      CALL OFF
C
C          ISSUE PRINTER COMMANDS FOR SMALL TYPE      
C
      UNIT=6
      OPEN(UNIT,FILE='PRN')
      WRITE(UNIT,'(1X,A1,A2)') 155,'2z'
      WRITE(UNIT,'(1X,A1,A2)') 155,'2w'
      IF(SEL(7).EQ.1) THEN
         WRITE(UNIT,20) DATE,YEAR,REV
   20    FORMAT(/,1H1,///
     A       //,1X,' ----------------------------------------      |',
     B        /,1X,'        A D D R E S S   B O O K                |',
     C        /,1X,' ----------------------------------------      |',
     D       //,1X,'            as of ',A8,
     E    29(/),1X,'(C) ',A4,' by Rocksoft',13X,'Ver. ',A2,'       |',
     F     ////,1X,'-----------------------------------------------|')
      ENDIF
C
C         PRINT ADDRESS BOOK, TWO LETTERS PER SECTION, TWO  SECTIONS PER PAGE
C
      ICNT=2
      LINE=0
      DO 800 LM=1,6,2
      IF(SEL(LM).LE.0) GOTO 800
      DO 700 I=SEL(LM),SEL(LM+1),2
      CALL CHECK(ICNT,I,LINE)
         DO 500 M=1,MNUM
         IF(LINE.LE.0)  CALL CHECK(ICNT,I,LINE)
         IF (((SORT(M)/10000).EQ.I) .OR. ((SORT(M)/10000).EQ.I+1)) THEN
            CALL PBOLD(UNIT)
               WRITE(UNIT,200) FIRST(M),(LAST(J,M),J=1,12)
  200          FORMAT(/,7X,A23,2X,12A1,'    |')
               LINE=LINE-1
            CALL POFF(UNIT)
            WRITE(RAMDSK,'(A23,1X,A2,1X,A5)') CITY(M),STATE(M),ZIP(M)
            ILEN=32
            CALL SQUISH(RAMDSK,ILEN)
            IF(ADD2(M).NE.' ') THEN
               WRITE(UNIT,210) ADD1(M),ADD2(M),RAMDSK,PH1(M),PH2(M)
  210          FORMAT(6X,A30,
     A              /,7X,A30,
     B              /,7X,A32,
     C              /,7X,A14,4X,A14)
            ELSE
               WRITE(UNIT,220) ADD1(M),RAMDSK,PH1(M),PH2(M)
  220          FORMAT(6X,A30,
     B              /,7X,A32,
     C              /,7X,A14,4X,A14,/)
            ENDIF
         ENDIF
  500    CONTINUE
  700 CONTINUE
  800 CONTINUE
C
C         RESET PRINTER BACK TO NORMAL
C
      WRITE(UNIT,'(1X,A1,A2)') 155,'0z'
      WRITE(UNIT,'(1X,A1,A2)') 155,'0w'
      CLOSE(UNIT)
C
      RETURN
      END
C
C
C
      SUBROUTINE LGROUP(SEL)       
C
C         SELECTS LETTER GROUP TO PRINT             
C
      INTEGER SEL(7)
      REAL CHK
      CHARACTER*1 FRST,SCND,THRD
C
      COMMON/LETT/ ALPHA,ALPH2
      CHARACTER*1 ALPHA(26),ALPH2(26)
C
C         INITIALIZE WORK VARIABLES  
C
      DO 50 I=1,7
      SEL(I)=0
   50 CONTINUE
C
C         ASK FOR PAGES TO BE PRINTED
C
      IH=1
      IV=21
      CALL MOVEIT(IH,IV)
      CALL BOLD
         WRITE(*,100) 
  100    FORMAT(/,5X,'Enter 3 Letters to Print or "ALL" ==> [   ]',\)
         ILEN=5
         CALL CURLT(ILEN)
      READ(*,'(3A1)') FRST,SCND,THRD
      CALL OFF
      IF((FRST.EQ.' ') .AND. (SCND.EQ.' ') .AND. (THRD.EQ.' ')) RETURN
C
C         FIGURE OUT WHAT TO PRINT
C
      IF(((FRST.EQ.'A') .OR. (FRST.EQ.'a')) .AND.
     A   ((SCND.EQ.'L') .OR. (SCND.EQ.'l')) .AND.
     B   ((THRD.EQ.'L') .OR. (THRD.EQ.'l'))) THEN
            SEL(1)=1
            SEL(2)=26
            SEL(7)=1
      ELSE
         DO 200 I=1,26
         IF((FRST.EQ.ALPHA(I)) .OR. (FRST.EQ.ALPH2(I))) THEN
            CHK=REAL(I)/2.0 - I/2
            IF(CHK.EQ.0.0) THEN
               SEL(1)=I-1
            ELSE
               SEL(1)=I
            ENDIF
            SEL(2)=SEL(1)+1
         ENDIF
         IF((SCND.EQ.ALPHA(I)) .OR. (SCND.EQ.ALPH2(I))) THEN
            CHK=REAL(I)/2.0 - I/2
            IF(CHK.EQ.0.0) THEN
               SEL(3)=I-1
            ELSE
               SEL(3)=I
            ENDIF
            SEL(4)=SEL(3)+1
         ENDIF
         IF((THRD.EQ.ALPHA(I)) .OR. (THRD.EQ.ALPH2(I))) THEN
            CHK=REAL(I)/2.0 - I/2
            IF(CHK.EQ.0.0) THEN
               SEL(5)=I-1
            ELSE
               SEL(5)=I
            ENDIF
            SEL(6)=SEL(5)+1
         ENDIF
  200    CONTINUE
C
C           NOW, CHECK FOR DUPLICATE REQUESTS
C
         IF(SEL(1).EQ.SEL(3)) THEN
            SEL(3)=0
            SEL(4)=0
         ENDIF
         IF(SEL(3).EQ.SEL(5)) THEN
            SEL(5)=0
            SEL(6)=0
         ENDIF
         IF(SEL(1).EQ.SEL(5)) THEN
            SEL(5)=0
            SEL(6)=0
         ENDIF
C
C         ASK IF NEW COVER NEEDED    
C
         IH=1
         IV=21
         CALL MOVEIT(IH,IV)
         CALL BOLD
            WRITE(*,500) 
  500       FORMAT(/,5X,'Would You Like a New Cover (Y/N) ? ==> [ ]',\)
            ILEN=3
            CALL CURLT(ILEN)
         READ(*,'(A1)') FRST
         IF((FRST.EQ.'Y') .OR. (FRST.EQ.'y')) SEL(7)=1
         CALL OFF
      ENDIF
      RETURN
      END
C
C
C
      SUBROUTINE CHECK(ICNT,I,LINE)
C
C         CHECK PAGE STATUS FOR MASTER LISTING LOGIC
C
      INTEGER ICNT,UNIT,LINE
C
      COMMON/LETT/ ALPHA,ALPH2
      CHARACTER*1 ALPHA(26),ALPH2(26)
C
      UNIT=6
      ICNT=ICNT+1
      IF(ICNT.GT.2) THEN
         ICNT=1
         LINE=6
         WRITE(UNIT,'(1H1)')
         WRITE(UNIT,100) (ALPHA(K),K=I,I+1)
  100    FORMAT(/,42X,A1,'/',A1,/)
      ELSEIF(ICNT.GT.1) THEN
         DO 200 K=1,LINE
         WRITE(UNIT,'(/////)')
  200    CONTINUE
         WRITE(UNIT,'(//,A35,/)')'-----------------------------------'
         LINE=6
         WRITE(UNIT,100) (ALPHA(K),K=I,I+1)
      ENDIF
      RETURN
      END
C
C
C
      SUBROUTINE BKLT
C
C          CREATES WALLET SIZE ADDRESS BOOK
C
      COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
      CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
      CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
      CHARACTER PH1(200)*14,PH2(200)*14
C
      COMMON/MAIN2/ STRID,SORT,MNUM
      INTEGER*4 STRID(200),SORT(200),MNUM
C
      CHARACTER RAMDSK*80
      INTEGER UNIT,MAXNUM,PNUM,ARRAY(200)
      UNIT=6
C
C          CALL ROUTINE TO SELECT CUSTOMERS
C
      MAXNUM=9
      CALL PICKEM(MAXNUM,PNUM,ARRAY)
         IF(PNUM.LE.0) RETURN
      IH=1
      IV=23
      CALL UPTOP (IH,IV)
      CALL BOLD
         WRITE(*,15)
   15    FORMAT('   Please Wait .... Printing          ',
     A          '                                      ',\)
      CALL OFF
C
C          ISSUE PRINTER COMMANDS FOR SMALL TYPE      
C
      OPEN(UNIT,FILE='PRN')
      WRITE(UNIT,'(1X,A1,A2)') 155,'2z'
      WRITE(UNIT,'(1X,A1,A2)') 155,'2w'
   10 FORMAT(1X,'|                                        |',
     A     /,1X,'|----------------------------------------| <-- CUT')
   20 FORMAT(1X,'|                                        |',
     A     /,1X,'|-                                      -| <-- FOLD')
C
C          PRINT BOOKLET COVER
C
      WRITE(UNIT,'(1H1)')
      WRITE(UNIT,10)
      WRITE(UNIT,500)
C
C          PRINT ALL ENTRIES IN FILE   
C
      DO 400 K=1,MAXNUM,3
         WRITE(UNIT,20)
         DO 300 J=K,K+2
         I=ARRAY(J)
         IF(J.GT.PNUM) THEN
            WRITE(UNIT,100)
  100       FORMAT(   ' |                                        |',
     A        /,' |                                        |',
     B        /,' |                                        |',
     C        /,' |                                        |',
     D        /,' |                                        |',
     E        /,' |                                        |')
         ELSEIF(ADD2(I).NE.' ') THEN
            WRITE(RAMDSK,'(A23,1X,A2,1X,A5)') CITY(I),STATE(I),ZIP(I)
            ILEN=32
            CALL SQUISH(RAMDSK,ILEN)
            WRITE(UNIT,150) FIRST(I),(LAST(M,I),M=1,12),ADD1(I),
     A      ADD2(I),RAMDSK,PH1(I),PH2(I)
  150       FORMAT(' | ',39X,'|',    
     A           /,' |    ',A23,1X,12A1,'|',
     B           /,' |    ',A30,6X,'|',
     C           /,' |    ',A30,6X,'|',
     D           /,' |    ',A32,4X,'|',
     E           /,' |    ',A14,2X,A14,6X,'|')
         ELSE
            WRITE(RAMDSK,'(A23,1X,A2,1X,A5)') CITY(I),STATE(I),ZIP(I)
            ILEN=32
            CALL SQUISH(RAMDSK,ILEN)
            WRITE(UNIT,200) FIRST(I),(LAST(M,I),M=1,12),ADD1(I),
     A      RAMDSK,PH1(I),PH2(I)
  200       FORMAT(' | ',39X,'|',    
     A           /,' |    ',A23,1X,12A1,'|',
     B           /,' |    ',A30,6X,'|',
     C           /,' |    ',A32,4X,'|',
     D           /,' |    ',A14,2X,A14,6X,'|',
     E           /,' | ',39X,'|')
         ENDIF
  300    CONTINUE
  400 CONTINUE
      WRITE(UNIT,10)
  500 FORMAT(   ' |                                        |',
     A        /,' |                                        |',
     B        /,' |                                        |',
     C        /,' |                                        |',
     D        /,' |             A D D R E S S              |',
     E        /,' |                                        |',
     F        /,' |                  and                   |',
     G        /,' |                                        |',
     H        /,' |            P H O N E   N O .           |',
     I        /,' |                                        |',
     J        /,' |             B O O K L E T              |',
     K        /,' |                                        |',
     L        /,' |                                        |',
     M        /,' |                                        |',
     N        /,' |                                        |',
     O        /,' |                                        |',
     P        /,' |                                        |',
     Q        /,' | (C) 1986 by Rocksoft                   |')
C
C         RESET PRINTER BACK TO NORMAL
C
      WRITE(UNIT,'(1X,A1,A2)') 155,'0z'
      WRITE(UNIT,'(1X,A1,A2)') 155,'0w'
      CLOSE(UNIT)
C
      RETURN
      END
C
C
C
      SUBROUTINE PHONE
C
C          CREATES PHONE NUMBER ONLY LISTING
C
      COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
      CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
      CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
      CHARACTER PH1(200)*14,PH2(200)*14
C
      COMMON/MAIN2/ STRID,SORT,MNUM
      INTEGER*4 STRID(200),SORT(200),MNUM
C
      INTEGER UNIT,MAXNUM,PNUM,ARRAY(200)
      UNIT=6
C
C          CALL ROUTINE TO SELECT CUSTOMERS
C
      MAXNUM=18
      CALL PICKEM(MAXNUM,PNUM,ARRAY)
         IF(PNUM.LE.0) RETURN
      IH=1
      IV=23
      CALL UPTOP (IH,IV)
      CALL BOLD
         WRITE(*,15)
   15    FORMAT('   Please Wait .... Printing          ',
     A          '                                      ',\)
      CALL OFF
C
C          ISSUE PRINTER COMMANDS FOR SMALL TYPE      
C
      OPEN(UNIT,FILE='PRN')
      WRITE(UNIT,'(1X,A1,A2)') 155,'2z'
      WRITE(UNIT,'(1X,A1,A2)') 155,'2w'
   10 FORMAT(1X,'|                                        |',
     A     /,1X,'|----------------------------------------| <-- CUT')
   20 FORMAT(1X,'|----------------------------------------| <-- CUT',
     A     /,1X,'|   PHONE NO. SUMMARY       * Rocksoft * |',
     B     /,1X,'|----------------------------------------|',
     C     /,1X,'|                                        |')
C
C          PRINT ALL ENTRIES SELECTED  
C
      WRITE(UNIT,'(1H1)')
      WRITE(UNIT,20)
      DO 400 J=1,MAXNUM
         I=ARRAY(J)
         IF(J.GT.PNUM) THEN
            WRITE(UNIT,100)
  100       FORMAT(' |                                        |',
     A           /,' |                                        |')
         ELSEIF(PH2(I).EQ.' ') THEN
            WRITE(UNIT,200) FIRST(I),PH1(I)
  200       FORMAT(' | ',A23,' ',A14,' |',    
     A           /,' | ',38X,' |')
         ELSE
            WRITE(UNIT,250) FIRST(I),PH1(I),PH2(I)
  250       FORMAT(' | ',A23,' ',A14,' |',    
     A           /,' | ',17X,' Work: ',A14,' |')
         ENDIF
  400 CONTINUE
      WRITE(UNIT,10)
C
C         RESET PRINTER BACK TO NORMAL
C
      WRITE(UNIT,'(1X,A1,A2)') 155,'0z'
      WRITE(UNIT,'(1X,A1,A2)') 155,'0w'
      CLOSE(UNIT)
C
      RETURN
      END
C
C
C
      SUBROUTINE PICKEM(MAXNUM,PNUM,ARRAY)
C
C          SELECTS PEOPLE FOR PRINTOUTS       
C
      COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
      CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
      CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
      CHARACTER PH1(200)*14,PH2(200)*14
C
      COMMON/MAIN2/ STRID,SORT,MNUM
      INTEGER*4 STRID(200),SORT(200),MNUM
C
      INTEGER MAXNUM,ARRAY(200),PNUM,LU
      CHARACTER*1 ANS,KEY
      CHARACTER*25 OPTION
C
C          CALL HEADER WITH OPTION PARAMETER
C
    5 CONTINUE
      OPTION='Printout Selection'
      CALL HEADER(OPTION)
C
C          INITIALIZE POINTERS
C
      DO 10 K=1,200
      ARRAY(K)=0
   10 CONTINUE
C
C          PRINT INSTRUCTIONS          
C
      IH=1
      IV=20
      CALL UPTOP(IH,IV)
         WRITE(*,'(X)')
      CALL ULINE
         WRITE(*,'(80X)')
      CALL OFF
         WRITE(*,50)
   50    FORMAT(/,'   ( )elect   ( )elp   ( )uit                    ')
      CALL BOLD
      IV=23
      IH=6
      CALL UPTOP(IH,IV)
         WRITE(*,'(A1)') 'S'
      IH=17
      CALL UPTOP(IH,IV)
         WRITE(*,'(A1)') 'H'
      IH=26
      CALL UPTOP(IH,IV)
         WRITE(*,'(A1)') 'Q'
      IH=50
      CALL UPTOP(IH,IV)
      CALL BLINK
         WRITE(*,'(A25,I3.3)') '  Total Selected : 000 / ',MAXNUM
      CALL OFF
C
C          SET UP PARAMS IN GROUPS OF 12
C
      PNUM=0
      DO 500 I=1,MNUM,12
      CALL KEYOFF
      IH=1
      IV=6
      CALL UPTOP(IH,IV)
      WRITE(*,'(X)')
C
C          LIST DATABASE, ONE SCREEN AT A TIME
C
      DO 200 K=I,I+11
      IF(K.LE.MNUM) THEN
         CALL BOLD
         WRITE(*,100) (LAST(J,K),J=1,12)
  100    FORMAT(7X,'_',2X,12A1,\)
         CALL OFF
         WRITE(*,110) FIRST(K),PH1(K),PH2(K)
  110    FORMAT(1X,A23,A14,1X,A14)
      ELSE
         WRITE(*,150)
  150    FORMAT(8X,70(' '))
      ENDIF
  200 CONTINUE
      CALL KEYON
      IV=6
      DO 300 K=I,I+11
      IF(K.LE.MNUM) THEN
         IH=10
         IV=IV+1
         CALL UPTOP(IH,IV)
            READ(*,'(A1)') ANS
            IF((ANS.EQ.'H') .OR. (ANS.EQ.'h')) THEN
               KEY='2'
               LU=15
               CALL HELP(KEY,LU)
               GOTO 5
            ELSEIF((ANS.EQ.'S') .OR. (ANS.EQ.'s')) THEN
               PNUM=PNUM+1
               ARRAY(PNUM)=K
               IH1=69
               IV1=23
               CALL UPTOP(IH1,IV1)
               CALL BOLD
               CALL BLINK
                  WRITE(*,'(I3.3)') PNUM
               CALL OFF
               IF(PNUM.GE.MAXNUM) GOTO 600
            ELSEIF((ANS.EQ.'Q') .OR. (ANS.EQ.'q')) THEN
               GOTO 600
            ENDIF
      ENDIF
  300 CONTINUE
      IF(K.GT.MNUM) GOTO 600
  500 CONTINUE
  600 CONTINUE
      IF(PNUM.LE.0) RETURN  
      IV=23
      IH=1
      CALL UPTOP(IH,IV)
      CALL BOLD
      CALL BLINK
         WRITE(*,700)
  700    FORMAT('    Proceed with Printout of selected ',
     A          'names (Y/N) ? ==> [ ]                 ',\)
      CALL OFF
      ILEN=20
      CALL CURLT(ILEN)
      READ(*,'(A1)') ANS
         IF((ANS.EQ.'Y') .OR. (ANS.EQ.'y')) THEN
            RETURN
         ELSEIF((ANS.EQ.'N') .OR. (ANS.EQ.'n')) THEN
            PNUM=0
            RETURN
         ELSE
            CALL BELL
            GOTO 600
         ENDIF
      END
