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