PROGRAM ENVELOPE3
C     REVISED 97-01-15; SUPRESS BLANK ENVELOPE
C     *******************************************************
C     REVISED 96-12-22; PRINT DIRECTLY ON ENVELOPES
C     REVISED 12/04/94; SPECIFIC PRINT OUTPUT FILE
C     REVISED 11/30/94 FOR DEC ALPHA
C     REVISED 1/28/90; READ LETTER NAMES FROM 'NAMES.DAT'
C     *******************************************************
C     MTYPE IS THE FILE NAME TO BE READ FOR PRINTING FROM THE
C     ACTIVE DISK
C     FF = FORMFEED
      LOGICAL*1 FF
      LOGICAL*1 MTYPE(70)
C     *******************************************************
C     NAME IS THE FIRST 70 CHARACTERS OF NAME1
      LOGICAL*1 NAME(70)
      LOGICAL*1 NAME1(71)
C     *******************************************************
C     NAMEIN IS THE FILE NAMES.DAT
      LOGICAL*1 NAMEIN(9)
      LOGICAL*1 IBLK
C     *******************************************************
      EQUIVALENCE(MTYPE(1),NAME(1))
      EQUIVALENCE(NAME(1),NAME1(2))
C     *******************************************************
C     FF = FORMFEED
      DATA FF/12/
C     *******************************************************
      DATA NAMEIN(1) /'n'/
      DATA NAMEIN(2) /'a'/
      DATA NAMEIN(3) /'m'/
      DATA NAMEIN(4) /'e'/
      DATA NAMEIN(5) /'s'/
      DATA NAMEIN(6) /'.'/
      DATA NAMEIN(7) /'d'/
      DATA NAMEIN(8) /'a'/
      DATA NAMEIN(9) /'t'/
C     *******************************************************
C      JDEV=0
C     *******************************************************
C     ITOUT = TERMINAL OUTPUT TO MONITOR SCREEN
      ITOUT=6
C     WRITE(ITOUT,3)
    3 FORMAT(' OPENING NAMES.DAT')
C     JDISK; OPEN INPUT FILE NAMES.DAT
      JDISK=9
      OPEN(UNIT=JDISK,FILE=NAMEIN,STATUS='OLD')
C     *******************************************************
C     JCOUNT COUNTS THE NUMBER OF ENVELOPES PRINTED IN THIS RUN
C     SO WE DON'T DO FORM FEED BEFORE THE FIRST ENVELOPE PRINTED
      JCOUNT=0
  999 CONTINUE
C     WRITE(ITOUT,4)
    4 FORMAT(' READING NAME OF LETTER')
      READ(JDISK,1,END=1000,ERR=1000) NAME
    1 FORMAT(70A1)
      WRITE(ITOUT,10) NAME
   10 FORMAT(' NAME = ',70A1)
C     *******************************************************
C     OPEN INPUT FILE MTYPE.DAT
C     IDISK; FILE WHICH CONTAINS LETTER TO BE PRINTED
      IDISK=10
C     WRITE(ITOUT,5)
    5 FORMAT(' READING IN LETTER FILE')
      OPEN(UNIT=IDISK,FILE=MTYPE,STATUS='OLD')
C     *******************************************************
C     WRITE(ITOUT,6)
    6 FORMAT(' PRINT THE LETTER')
      CALL ADDRES(JCOUNT)
C     CLOSE FILE IDISK; LETTER IS FINISHED
      ENDFILE IDISK
      GO TO 999
 1000 CONTINUE
      CALL EXIT
      END
      SUBROUTINE ADDRES(JCOUNT)
C     THIS VERSION READS FROM ACTIVE DISK
C     *******************************************************
C     PRINTS ADDRESS LABELS FROM LTYPE.LET
C     *******************************************************
      LOGICAL*1 IPRINT, IARR, IBLK, IYES
      LOGICAL*1 IWORD(73)
C     MTYPE IS NAME OF FILE FOR OPEN
      LOGICAL*1 MTYPE(11)
C     *******************************************************
C     FNAME IS INPUT TEXT FILE NAME
      LOGICAL*1 FNAME(8)
C     *******************************************************
C     FEXT  IS INPUT TEXT FILE EXTENSION
      LOGICAL*1 FEXT(3)
C     *******************************************************
      LOGICAL*1 EDEN(5)
      LOGICAL*1 FF
C     *****************************************************
      EQUIVALENCE(FNAME(1),MTYPE(1))
      EQUIVALENCE(FEXT(1),MTYPE(9))
C     *******************************************************
      DATA FF/12/
C     FNAME IS THE INPUT FILE NAME
      DATA FNAME(1)/'L'/
      DATA FNAME(2)/'T'/
      DATA FNAME(3)/'Y'/
      DATA FNAME(4)/'P'/
      DATA FNAME(5)/'E'/
      DATA FNAME(6)/' '/
      DATA FNAME(7)/' '/
      DATA FNAME(8)/' '/
C     *******************************************************
C     FEXT IS FILE NAME EXTENSION
      DATA FEXT(1)/'L'/
      DATA FEXT(2)/'E'/
      DATA FEXT(3)/'T'/
C     *******************************************************
C     ENHANCED DENSITY PRINTING (LA50)
      DATA EDEN(1)/27/
      DATA EDEN(2)/'['/
      DATA EDEN(3)/'2'/
      DATA EDEN(4)/'"'/
      DATA EDEN(5)/'z'/
C     *******************************************************
C     LEN IS DIMENSION OF IWORD
      DATA LEN/73/
C     MAX IS THE MAXIMUM NUMBER OF LINES ON THE LABEL
      DATA MAX/8/
      DATA IBLK/' '/
      DATA IYES/'Y'/
      DATA IARR/'^'/
      DATA IPRINT/' '/
C     *******************************************************
C     ASSIGN PRINTER SYSTEM NUMBER
      IOUT=7
      OPEN(UNIT=IOUT,FILE='naddress.print',STATUS='NEW')
C     *******************************************************
C     ASSIGN CONSOLE INPUT
      IN=5
C     *******************************************************
C     ASSIGN CONSOLE OUTPUT
      JOUT=6
C     *******************************************************
C     OPEN INPUT FILE MTYPE
      IDISK=10
C     *******************************************************
C     REWIND THE TEXT FILE TO BEGINNING
      REWIND IDISK
C     SET KOUT TO PRINTER(IOUT)
      KOUT=IOUT
C     *****************************************************
      MAX1=MAX+1
      ICOUNT=0
  999 CONTINUE
      READ(IDISK,2,END=888,ERR=777) IWORD
      IF(IPRINT.EQ.IYES) ICOUNT=ICOUNT+1
C     *****************************************************
C     SKIP A LINE BETWEEN LABELS
      IF(ICOUNT.EQ.MAX1) GO TO 666
      GO TO 7777
  666 CONTINUE
      ICOUNT=ICOUNT+1
      WRITE(IOUT, 502)
  502 FORMAT('  ')
 7777 CONTINUE
C     *****************************************************
    2 FORMAT(73A1)
C     *****************************************************
C     ARE WE AT START OF LABEL?
      IF(IWORD(1).EQ.IARR) GO TO 100
      GO TO 200
C     *****************************************************
  100 CONTINUE
      JCOUNT=JCOUNT+1
C     *****************************************************
C     PRINT OFFICE RETURN ADDRESS
C     *****************************************************
      IF(JCOUNT.EQ.1) GO TO 1111
C     EJECT PAGE TO START NEW ENVELOPE
      WRITE(IOUT,7765) FF
 7765 FORMAT(A1)
 1111 CONTINUE
      WRITE (IOUT,7766)
 7766 FORMAT(///////////,
     *'               Dr. Richard J. Radna',/,
     *'               1165 Park Avenue',/,
     *'               New York, N.Y.  10128-1210',
     *//////////)		
C     *****************************************************
      ICOUNT=0
      IPRINT=IYES
C     WRITE(JOUT,101)
  101 FORMAT(' PRINTING ENABLED')
      GO TO 999
C     *****************************************************
  200 CONTINUE
C     TEST IF WE ARE AT END OF LABEL
      IF(IPRINT.NE.IYES) GO TO 400
      IF ((IWORD(2).EQ.IBLK).AND.
     *    (IWORD(3).EQ.IBLK).AND.
     *    (IWORD(4).EQ.IBLK)) GO TO 300
      GO TO 400
C     *****************************************************
  300 CONTINUE
      IPRINT=IBLK
      ICOUNT=ICOUNT-1
      LNUM=MAX-ICOUNT
      IF(LNUM.LT.0) LNUM=MAX+LNUM+1
      LNUM=LNUM+1
C     WRITE(JOUT,3000) ICOUNT
 3000 FORMAT(I10,' LINES PRINTED')
C     WRITE(JOUT,3001) LNUM
 3001 FORMAT(I10,' LINES SKIPPED')
      IF(LNUM.EQ.0) GO TO 600
C     *****************************************************
C     SPACE DOWN TO TOP OF NEXT LABEL
      DO 500 M=1,LNUM
      WRITE(IOUT,501)
  501 FORMAT('  ')
  500 CONTINUE
C     *****************************************************
C     RESET ICOUNT TO ZERO TO PREPARE FOR NEXT ADDRESS
      ICOUNT=0
C     *****************************************************
  600 CONTINUE
C     *****************************************************
  400 CONTINUE
C     *****************************************************
      IF(IPRINT.NE.IYES) GO TO 999
      GO TO 4
C     *****************************************************
  777 CONTINUE
      WRITE(JOUT,77)
   77 FORMAT(' INPUT ERROR')
      GO TO 999
C     *****************************************************
    4 CONTINUE
C     COUNT THE NUMBER OF NON-BLANK CHARACTERS PER LINE
      DO 55 K=1,LEN
      KK=(LEN+1)-K
      IF(IWORD(KK).EQ.IBLK) GO TO 55
      GO TO 88
   55 CONTINUE
   88 CONTINUE
C     *******************************************************
C     PRINT A LINE
      WRITE(IOUT,7) (IWORD(J),J=1,KK)
    7 FORMAT('                                        ',73A1)
C     ****************************************************
      GO TO 999
C     *****************************************************
  888 CONTINUE
C     *****************************************************
C     SKIP A LINE
      WRITE(JOUT,442)
  442 FORMAT(/)
      WRITE(JOUT,1234)
 1234 FORMAT(' EXITING FROM ADDRESS')
      RETURN
      END