Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-07 - decus/20-0169/labels.for
There is 1 other file named labels.for in the archive. Click here to see a list.
C     RENBR(LABELS/TYPE ADDRESSES ONTO COLUMNS OF LABELS)
C
C     Donald Barth, Yale School of Management
C
C     This program writes addresses to an output file which
C     can be typed onto paralle columns of labels which are
C     mounted on fanfold paper.  The program can also write
C     the addresses  directly onto  labels on fanfold paper
C     which is fed directly into  the controlling terminal.
C
C     These addresses either are defined by a file in which
C     the  various  components of the address appear to the
C     right of at signs and a letter identifying  the  type
C     of  component,  or  are  defined  by an input file in
C     which  1  or  more  lines  starting  with  a   period
C     separates the already formatted addresses.
C
C     DESCRIPTION OF DOT FORMAT INTPUT FILE
C     ----------- -- --- ------ ------ ----
C
C     If the addresses are defined by a  dot  format  file,
C     then  at least one line starting with a period in its
C     leftmost column must appear  between  the  addresses.
C     The  lines  which  start  with  periods are otherwise
C     ignored.  One or more lines starting  with  a  period
C     can  appear  before  the  first address and after the
C     last address, but are not necessary.
C
C     If the final line of an address starts with the  word
C     Dear  and  ends with a colon or comma, then this line
C     is assumed to contain a salutation line  and  is  not
C     printed on the envelope.
C
C     DESCRIPTION OF AT SIGN FORMAT INTPUT FILE
C     ----------- -- -- ---- ------ ------ ----
C
C     Each line in an at sign format input file  defines  a
C     single   component   of  an  address.   The  first  2
C     characters  of  each  line  identify  the   type   of
C     component  and  are  not copied into the output file.
C     Those portions of the address which  require  a  full
C     line, for example department name, organization name,
C     and street address,  can  be  continued  on  as  many
C     subsequent  lines  as necessary, and are then written
C     out in the same order in which they were  encountered
C     in  the  input  file.   The various components of the
C     address can, however, be specified in any order.  The
C     following at sign character pairs are recognized.
C
C     @#  Start of new address.  Rest of line is ignored.
C     @@  End of file.  Rest of file is ignored.
C     @A  Street address.  Several can appear.
C     @C  City name.
C     @D  Department.  Several can appear.
C     @E  Name suffix (Jr., III, etc.).
C     @F  First name.
C     @G  Name for salutation. Do not include Dear or colon.
C     @I  Identification number. Any spacing. Not used.
C     @K  Top line key or code.
C     @L  Last name.
C     @M  Middle name.  Include period if initial.
C     @N  Country.  Don't include if local country.
C     @O  Organization name.  Several can appear.
C     @P  Name prefix (Mr., Ms., etc.).
C     @S  State (any form, 2 letters, 4, full, etc.).
C     @T  Title.  Several can appear.
C     @Y  Any line at bottom of address.  (@YCAMPUS MAIL).
C     @Z  Zip code (any form, 5 digits, 9, etc.).
C
C     SAMPLES OF THE 2 TYPES OF INPUT FILES
C     ------- -- --- - ----- -- ----- -----
C
C     The  at  sign  and dot  format  files shown below are
C     equivalent.
C
C     @I  608
C     @PMr.
C     @FJohn
C     @MB.
C     @LSmith
C     @EJr.
C     @TDirector
C     @DCareer Counseling Office
C     @OCentral College
C     @CRockport
C     @SCT
C     @Z06352
C     @GMr. Smith
C     @#
C     @GLinda
C     @Z51222
C     @STN
C     @CVictorville
C     @A6721 Main Street
C     @OVillage University
C     @OCollege of Science
C     @DDepartment of Chemistry
C     @LJones
C     @MF.
C     @FLinda
C     @PMs.
C     @I       611
C     @@
C
C
C     .LITERAL
C     Mr. John B. Smith, Jr.
C     Director
C     Career Counseling Office
C     Central College
C     Rockport, CT  06352
C
C     Dear Mr. Smith:
C     .END LITERAL.END SPLICE
C     .LITERAL
C     Ms. Linda F. Jones
C     Department of Chemistry
C     Village University
C     College of Science
C     6721 Main Street
C     Victorville, TN  51222
C
C     Dear Linda:
C     .END LITERAL.END SPLICE
C
C     *********************************
C     *                               *
C     *  ARRAYS USED BY THIS PROGRAM  *
C     *                               *
C     *********************************
C
      DIMENSION LTRDGT(10),LTRABC(26),LWRABC(26)
C
C     ARRAYS STORING WORD DEAR FOR FINDING SALUTATION LINES
C     LTRDEA(LMTDEA),LWRDEA(LMTDEA)
C
      DIMENSION LTRDEA(5),LWRDEA(5)
C
C     ARRAYS USED TO STORE THE SET OF ABBREVIATIONS
C     LTRSPL(MAXSPL),LTRABB(MAXABB),LNGSPL(MAXLNG),
C     LNGABB(MAXLNG)
C
      DIMENSION LTRSPL(1000),LTRABB(1000),LNGSPL(100),
     1LNGABB(100)
C
C     ARRAY USED TO STORE EACH LINE READ FROM ADDRESS FILE
C     LTRBFR(LMTBFR)
C
      DIMENSION LTRBFR(72)
C
C     ARRAYS USED TO STORE UNASSEMBLED ADDRESS IN AT FORM
C     DIMENSION ISTART(LMTKND),ICHAIN(LMTSEC),
C     LENGTH(LMTSEC),LOCATN(LMTSEC),LTRSTR(LMTSTR),
C     LTRKND(LMTKND)
C
      DIMENSION ISTART(26),ICHAIN(30),LENGTH(30),
     1LOCATN(30),LTRSTR(2000),LTRKND(26)
C
C     ARRAYS USED TO STORE WORD TO BE SEARCHED FOR
C     LTRNXT(LMTNXT),LWRNXT(LMTNXT)
C
      DIMENSION LTRNXT(40),LWRNXT(40)
C
C     ARRAYS TO STORE CODE LINE TO BE MARKED WITH *
C     LTRCOD(LMTCOD),LWRCOD(LMTCOD)
C
      DIMENSION LTRCOD(40),LWRCOD(40)
C
C     ARRAYS USED TO STORE THE ASSEMBLED ADDRESS
C     OLD ARRAYS STORE ORIGINAL FORM WHEN MUST CHANGE IT
C     LTRADR(LMTCHR),LNGLIN(LMTLIN),LTROLD(LMTCHR),
C     LNGOLD(LMTLIN)
C
      DIMENSION LTRADR(1500),LNGLIN(18),LTROLD(1500),
     1LNGOLD(18)
C
C     ARRAY USED TO STORE ROW OF LABELS READY FOR PRINTING
C     LTRLBL(LMTLIN,MAXOUT)
C
      DIMENSION LTRLBL(18,200)
C
C     ARRAY USED TO STORE ONE LINE COPIED FROM LTRLBL ARRAY
C     AND THEN TO DO SPACE TO TAB STOP CONVERSION ON THIS
C     LTRLIN(MAXOUT),LTROUT(MAXOUT)
C
      DIMENSION LTRLIN(200),LTROUT(200)
C
C     ARRAY WHICH SPECIFIES THE TYPE OF ARGUMENT WHICH
C     CAN BE TYPED BY USER WITH THE VARIOUS COMMANDS
      DIMENSION KNDANS(26)
C
      DATA LTRSPA,LTRDOT,LTRCOM,LTRCOL,LTRATS,LTRXXX,
     1LTRMIN,LTRPER,LTRSTA,LTRQUE/
     21H ,1H.,1H,,1H:,1H@,1HX,1H-,1H%,1H*,1H?/
      DATA LTRDGT /1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA LTRABC /1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1 1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,
     2 1HX,1HY,1HZ/
      DATA LWRABC /1Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
     1 1Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,1Hu,1Hv,1Hw,
     2 1Hx,1Hy,1Hz/
      DATA LTRKND /1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1 1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,
     2 1HX,1HY,1HZ/
      DATA LTRDEA/1HD,1HE,1HA,1HR,1H /
      DATA LWRDEA/1Hd,1He,1Ha,1Hr,1H /
C
C     TYPE OF ARGUMENT EXPECTED FOR A-Z TYPED AS COMMANDS
C
C     KNDANS = 0, NO ARGUMENT ALLOWED FOR THIS COMMAND
C            = 1, INTEGER
C            = 2, FRACTIONAL NUMBER
C            = 3, CHARACTER STRING
C            = 4, YES OR NO
C
C      A, B, C, D, E, F, G, H, I, J,
C      K, L, M, N, O, P, Q, R, S, T,
C      U, V, W, X, Y, Z
C
      DATA KNDANS/
     1 3, 1, 1, 4, 1, 0, 1, 2, 4, 0,
     2 0, 1, 1, 0, 1, 1, 0, 0, 4, 4,
     3 4, 0, 2, 0, 0, 0/
C
C     DIMENSION OF LIST OF ABBREVIATIONS
      DATA MAXLNG,MAXSPL,MAXABB/100,1000,1000/
C
C     DIMENSION OF WORD TO BE IN FIRST ADDRESS
      DATA LMTNXT/40/
C
C     DIMENSION OF CODE ON LABEL TO BE MARKED WITH *
      DATA LMTCOD/40/
C
C     DIMENSION OF SINGLE LINE INPUT AND OUTPUT BUFFERS
      DATA LMTBFR,MAXOUT/72,200/
C
C     DIMENSION OF THE ADDRESS COMPONENT STORAGE
      DATA LMTKND,LMTSEC,LMTONE,LMTTWO,LMTSTR/
     126,30,70,50,2000/
C
C     DIMENSION OF RECONSTRUCTED ADDRESS
      DATA LMTLIN,LMTCHR/18,1500/
C
C     DIMENSION OF WORD DEAR USED TO LOCATE SALUTATIONS
      DATA LMTDEA/5/
C
C     UNIT NUMBERS
      DATA ITTY,JTTY,IDISK,JDISK/5,5,1,20/
C
C     IDENTIFY PROGRAM TO USER
      CALL LBLHLP(ITTY,27)
C
C     DEFINE DEFAULT LABEL TYPE
C     LBLCLM = 1 COLUMN
C     LBLHIH = 1.5 INCHES HIGH
C     LBLSPC = 6 LINES PER INCH
C     LBLWID = 4 INCHES WIDE
C     LBLPCH = 10 CHARACTERS PER INCH
C     LBLOFF = 0 OFFSET OF ADDRESS FROM LEFT EDGE OF LABEL
C     LBLBOX = 10 ALIGNMENT BOXES
C     LBLDRP = 1 DROP BOTTOM LINE (=0 WOULD NOT DROP)
C     LBLCAS = 0 NO CASE CONVERSION   (= 1 WOULD CONVERT)
C     IFCODE = 0 NO INITIAL CODE LINE (= 1 WOULD INCLUDE)
C     LBLCPY = 1 NUMBER OF COPIES OF EACH LABEL
C     LBLMAX = 5000 MAXIMUM ROWS OF LABELS IN 1 OUTPUT FILE
C     MRGWID = WIDTH OF GUTTERS IN COLUMNS
C     IFSORT = 0 SINGLE PASS (=1 SEPARATES CAMPUS,ZIP,NONE)
C     LNGCOD = 0 NO LABELS ARE TO BE MARKED WITH *
C
C     ASK WHICH DEFAULT VALUE IS WANTED
      CALL LBLHLP(ITTY,28)
    1 WRITE(ITTY,2)
    2 FORMAT(' Set dimensions initially to which default? ',$)
      IALLOW=1
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(1,5,3,5,5,5,5),KIND
    3 IF(IVALUE.EQ.1)GO TO 6
      IF(IVALUE.EQ.2)GO TO 7
      WRITE(ITTY,4)
    4 FORMAT(' Unassigned value')
      GO TO 1
    5 CALL LBLHLP(ITTY,29)
      GO TO 1
C
C     SINGLE COLUMN OF LABELS 4 INCHES WIDE BY 1.5 HIGH
C     TO BE PRINTED AT 10 CHARACTERS AND 6 LINES PER INCH
    6 LBLCLM=1
      LBLHIH=1500
      LBLSPC=6
      LBLWID=4000
      LBLPCH=10
      LBLOFF=0
      LBLBOX=6
      LBLDRP=1
      LBLCAS=0
      IFCODE=0
      LBLCPY=1
      LBLMAX=5000
      MRGWID=1
      IFSORT=0
      LNGCOD=0
      IFFILE=1
      IFTABS=1
      GO TO 8
C
C     4 COLUMNS OF LABELS EACH 3.375 WIDE BY 1 HIGH
C     TO BE PRINTED AT 12 CHARACTERS AND 8 LINES PER INCH
    7 LBLCLM=4
      LBLHIH=1000
      LBLSPC=8
      LBLWID=3375
      LBLPCH=12
      LBLOFF=0
      LBLBOX=33
      LBLDRP=1
      LBLCAS=0
      IFCODE=0
      LBLCPY=1
      LBLMAX=5000
      MRGWID=4
      IFSORT=0
      LNGCOD=0
      IFFILE=1
      IFTABS=1
    8 CONTINUE
C
C     ASK USER FOR SPECIFICATIONS WHICH NEED CHANGE
    9 CALL LBLHOW(ITTY  ,JTTY  ,LBLCLM,LBLHIH,LBLSPC,
     1LBLWID,LBLPCH,LBLOFF,LBLBOX,LBLCAS,IFCODE,LBLCPY,
     2LBLMAX,MRGWID,IFSORT,LTRCOD,LMTCOD,LNGCOD,KNDANS,
     3LTRBFR,LMTBFR,LBLDRP,IFFILE,IFTABS,ISYSTM)
C
C     CONVERT LOWER CASE CODES TO UPPER
      IF(LNGCOD.LE.0)GO TO 13
      DO 12 I=1,LNGCOD
      LTRNOW=LTRCOD(I)
      LWRCOD(I)=LTRNOW
      DO 11 J=1,26
      IF(LTRNOW.NE.LTRABC(J))GO TO 10
      LWRCOD(I)=LWRABC(J)
      GO TO 12
   10 IF(LTRNOW.NE.LWRABC(J))GO TO 11
      LTRCOD(I)=LTRABC(J)
      GO TO 12
   11 CONTINUE
   12 CONTINUE
   13 CONTINUE
C
C     COMPUTE DIMENSIONS OF THE LABELS
C     MRGWID = NUMBER OF COLUMNS BETWEEN ALIGNMENT BOXES
C     MAXCLM = WIDTH OF ALIGNMENT BOXES.  PRINTING
C              CHARACTERS ARE KEPT INSIDE BOXES SO THIS IS
C              ALSO THE MAXIMUM WIDTH OF INDIVIDUAL LABEL
C     MRGHIH = NUMBER OF ROWS BETWEEN ALIGNMENT BOXES
C     MAXLIN = HEIGHT OF ALIGNMENT BOXES
C
C     ******************  ****************** -      -
C     *                *  *                * !      !
C     *                *  *                * !MAXLIN!
C     *                *  *                * !      !MAXHIH
C     ******************  ****************** -      !
C                                            !MRGHIH!
C     MR. JOHN SMITH ***  ****************** -      -
C     1234 MAIN STREET *  *                *
C     YOUR CITY, STATE *  *                *
C     *                *  *                *
C     ******************  ******************
C !   !----------------!--!
C LBLOFF      MAXCLM  MRGWID
C
      IF(MRGWID.LT.0)MRGWID=0
      IF(LBLOFF.LT.0)LBLOFF=0
      I=LBLOFF+((LBLCLM*LBLWID*LBLPCH)/1000)-MRGWID
      IF(I.LE.MAXOUT)GO TO 15
      WRITE(ITTY,14)I,MAXOUT
   14 FORMAT(' Requires',1I5,' columns, maximum is',1I4,
     1' columns'/1X)
      GO TO 9
   15 MAXCLM=((LBLWID*LBLPCH)/1000)-MRGWID
      LMTONE=MAXCLM
      LMTTWO=MAXCLM
C
C     CALCULATE HEIGHT OF LABELS
      MAXHIH=((LBLHIH*LBLSPC)/1000)
      IF(MAXHIH.LT.6)MAXHIH=6
      IF(MAXHIH.LE.LMTLIN)GO TO 17
      WRITE(ITTY,16)MAXHIH,LMTLIN
   16 FORMAT(' Requires',1I5,' lines, maximum is',1I4,
     1' lines'/1X)
      GO TO 9
   17 MRGHIH=1
      MAXLIN=MAXHIH-MRGHIH
C
C     BASE OF FILE NAME LABELS.NNN WHERE NNN=KNTFIL
      KNTFIL=0
C
C     MAXIMUM NUMBER OF ROWS OF LABELS IN SINGLE FILE
      MAXROW=LBLMAX-LBLBOX
      IF(MAXROW.LE.0)MAXROW=LBLMAX
      KNTROW=0
C
C     TOTAL NUMBER OF LABELS PRODUCED SO FAR
      KNTTTL=0
C
C     NUMBER OF ROWS OF LABELS, ALIGNMENT BOXES AND DIALOG
      KNTLBL=0
      KNTOUT=0
C
C     SET TERMINAL CHARACTERISTICS
C     TTYSET IS A SYSTEM DEPENDENT ROUTINE WHICH TURNS OFF
C     THE PAUSING AFTER A SET NUMBER OF LINES HAVE BEEN
C     TYPED ON THE TERMINAL
      IF(IFFILE.NE.0)GO TO 18
      CALL TTYSET
   18 CONTINUE
C
C     *****************************************************
C     *                                                   *
C     *  READ LIST OF WORDS TO BE REMOVED OR ABBREVIATED  *
C     *                                                   *
C     *****************************************************
C
C     ASK USER IF ABBREVIATIONS ARE TO BE ALLOWED
   19 WRITE(ITTY,20)
   20 FORMAT(' Abbreviate words in long lines (Y or N)? ',$)
      IALLOW=4
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(22,22,21,22,22,22,22),KIND
   21 IF(IVALUE.EQ.2)GO TO 23
      GO TO 26
   22 CALL LBLHLP(ITTY,33)
      GO TO 19
C
C     ASK FOR THE NAME OF THE ABBREVIATION FILE
   23 WRITE(ITTY,24)
   24 FORMAT(' File specifying abbreviations? ',$)
      ISTORE=1
      IWRITE=0
      CALL FILOPN(ISTORE,IDISK,ITTY,JTTY,IWRITE,IFOPEN)
      IF(IFOPEN.LT.0)GO TO 23
      IF(IFOPEN.EQ.0)GO TO 19
      CALL ABBREV(IDISK,KNTLNG,LTRSPL,LTRABB,
     1LNGSPL,LNGABB,MAXLNG,MAXSPL,MAXABB,ITTY)
      ISTORE=1
      CALL FILEND(ISTORE,IDISK)
      IF(KNTLNG.GT.0)GO TO 27
      WRITE(ITTY,25)
   25 FORMAT(' No abbreviations specified')
   26 KNTLNG=0
   27 CONTINUE
C
C     *************************************
C     *                                   *
C     *  ASK USER FOR NAME OF INPUT FILE  *
C     *                                   *
C     *************************************
C
   28 WRITE(ITTY,29)
   29 FORMAT(' File containing addresses? ',$)
      KNTOUT=KNTOUT+1
      ISTORE=2
      IWRITE=0
      CALL FILOPN(ISTORE,IDISK,ITTY,JTTY,IWRITE,IFOPEN)
      IF(IFOPEN.GT.0)GO TO 31
      IF(IFOPEN.EQ.0)GO TO 30
C     FILE CANNOT BE OPENED MESSAGE CONSISTS OF 2 LINES
      KNTOUT=KNTOUT+2
      KNTOUT=KNTOUT+ISYSTM
      GO TO 28
   30 KNTOUT=KNTOUT+ISYSTM
      GO TO 173
   31 KNTOUT=KNTOUT+ISYSTM
      ISTORE=2
      CALL FILEND(ISTORE,IDISK)
C
C     ASK USER TO SPECIFY UNIQUE PHRASE IN FIRST LABEL
      IF(IFFILE.NE.0)GO TO 32
      IF(KNTLBL.NE.0)GO TO 32
C
C     ******  You must change the value by which KNTOUT is
C     *NOTE*  incremented if you change the number of lines
C     ******  typed to the terminal by the LBLHLP routine.
C
      CALL LBLHLP(ITTY,34)
      KNTOUT=KNTOUT+4
      GO TO 34
   32 WRITE(ITTY,33)
   33 FORMAT(' Word or phrase unique to first label? ',$)
   34 KNTOUT=KNTOUT+ISYSTM+1
      READ(JTTY,35,END=44)LTRNXT
   35 FORMAT(40A1)
      IF(KNTLBL.EQ.0)KNTOUT=0
      MAXNXT=0
      MINNXT=0
   36 MINNXT=MINNXT+1
      IF(MINNXT.GT.LMTNXT)GO TO 51
      IF(LTRNXT(MINNXT).EQ.LTRSPA)GO TO 36
      MAXNXT=LMTNXT+1
   37 MAXNXT=MAXNXT-1
      IF(MAXNXT.LT.MINNXT)GO TO 51
      IF(LTRNXT(MAXNXT).EQ.LTRSPA)GO TO 37
      IF(MAXNXT.EQ.MINNXT)GO TO 42
      DO 41 I=MINNXT,MAXNXT
      LTRNOW=LTRNXT(I)
      LWRNXT(I)=LTRNOW
      DO 40 J=1,26
      IF(LTRNOW.EQ.LTRABC(J))GO TO 38
      IF(LTRNOW.EQ.LWRABC(J))GO TO 39
      GO TO 40
   38 LWRNXT(I)=LWRABC(J)
      GO TO 41
   39 LTRNXT(I)=LTRABC(J)
      GO TO 41
   40 CONTINUE
   41 CONTINUE
      GO TO 51
   42 IF(LTRNXT(MINNXT).NE.LTRQUE)GO TO 47
      IF(IFFILE.EQ.0)GO TO 43
      CALL LBLHLP(ITTY,35)
      KNTOUT=KNTOUT+6
      GO TO 32
C
C     ******  You must change the value by which KNTOUT is
C     *NOTE*  incremented if you change the number of lines
C     ******  typed to the terminal by the LBLHLP routine.
C
   43 CALL LBLHLP(ITTY,37)
      KNTOUT=KNTOUT+7
      GO TO 34
C
C     END OF FILE TYPED ON TERMINAL
   44 CALL TTYEOF(JTTY)
      IF(IFFILE.NE.0)GO TO 46
      IF(ISYSTM.EQ.0)WRITE(ITTY,45)
   45 FORMAT(1X)
      KNTOUT=KNTOUT-ISYSTM
      GO TO 47
   46 WRITE(ITTY,45)
      GO TO 32
C
C     BRANCH TO CODE TO PRODUCE SINGLE TARGET BOX
   47 IF(IFFILE.NE.0)GO TO 49
      LBLBOX=-LBLBOX
      GO TO 127
   48 LBLBOX=-LBLBOX
      GO TO 34
   49 WRITE(ITTY,50)
   50 FORMAT(' Word must be longer than 1 character')
      GO TO 32
C
C     *****************************
C     *                           *
C     *  PREPARE FOR FIRST LABEL  *
C     *                           *
C     *****************************
C
C     RESET LABEL COUNTERS
   51 LBLNOW=0
      KLMUSD=0
      KLMOLD=0
      IFLOAT=0
      KNTSHO=0
C
C     PREPARE FOR FIRST PASS
      IPASS=1
      IF(IFSORT.EQ.0)IPASS=3
      GO TO 53
C
C     PREPARE FOR NEXT PASS
   52 ISTORE=2
      CALL FILEND(ISTORE,IDISK)
      IPASS=IPASS+1
      IF(IPASS.GT.3)GO TO 102
      GO TO 53
C
C     OPEN THE ADDRESS FILE
   53 ISTORE=2
      CALL FILOLD(ISTORE,IDISK ,ITTY  ,IFOPEN)
      IF(IFOPEN.LE.0)GO TO 183
      IEOF=0
      JEOF=0
C
C     SET VARIABLES NEEDED FOR FIRST LABEL
      KNTINP=0
      INFORM=0
      IAUTHR=-1
      KNTTEL=0
      LOCTTL=2
   54 CONTINUE
C
C     *************************************
C     *                                   *
C     *  READ NEXT ADDRESS IN DOT FORMAT  *
C     *                                   *
C     *************************************
C
C     GET THE NEXT LABEL
   55 KNTTEL=KNTTEL+1
      IF(IAUTHR.GT.0)GO TO 69
      KNTLIN=0
      KNTCHR=0
   56 IF(IEOF.NE.0)GO TO 52
      READ(IDISK,57,END=70)LTRBFR
   57 FORMAT(72A1)
      KNTINP=KNTINP+1
      IF(IAUTHR.EQ.0)GO TO 58
      IF(LTRBFR(1).EQ.LTRATS)GO TO 68
      IAUTHR=0
C
C     STORE THE LINE IF NOT A DOT COMMAND
   58 IF(LTRBFR(1).EQ.LTRDOT)GO TO 62
      IF(KNTLIN.GE.LMTLIN)GO TO 56
      MAXPRT=LMTBFR+1
   59 MAXPRT=MAXPRT-1
      IF(MAXPRT.LE.0)GO TO 56
      IF(LTRBFR(MAXPRT).EQ.LTRSPA)GO TO 59
      I=0
   60 IF(I.GE.MAXPRT)GO TO 61
      IF(KNTCHR.GE.LMTCHR)GO TO 61
      I=I+1
      KNTCHR=KNTCHR+1
      LTRADR(KNTCHR)=LTRBFR(I)
      GO TO 60
   61 KNTLIN=KNTLIN+1
      LNGLIN(KNTLIN)=I
      GO TO 56
C
C     TRIM OFF TERMINAL SALUTATION LINE
   62 IF(KNTLIN.LE.0)GO TO 55
      MAXTST=0
      DO 63 LINE=1,KNTLIN
      MINTST=MAXTST+1
      MAXTST=MAXTST+LNGLIN(LINE)
   63 CONTINUE
      DO 64 KOLUMN=1,LMTDEA
      IF(LTRADR(MINTST).EQ.LTRDEA(KOLUMN))GO TO 64
      IF(LTRADR(MINTST).EQ.LWRDEA(KOLUMN))GO TO 64
      GO TO 67
   64 MINTST=MINTST+1
      IF(LTRADR(MAXTST).EQ.LTRCOL)GO TO 65
      IF(LTRADR(MAXTST).EQ.LTRCOM)GO TO 65
      GO TO 67
   65 KNTCHR=KNTCHR-LNGLIN(KNTLIN)
   66 KNTLIN=KNTLIN-1
   67 IF(KNTLIN.LE.0)GO TO 55
      IF(LNGLIN(KNTLIN).LE.0)GO TO 66
      GO TO 71
C
C     *****************************************
C     *                                       *
C     *  READ NEXT ADDRESS IN AT SIGN FORMAT  *
C     *                                       *
C     *****************************************
C
C     GET NEXT ADDRESS
   68 IAUTHR=1
      KNTINP=-2
   69 CALL GETADR(ITTY,IDISK,LMTKND,LMTSEC,
     1LTRKND,ISTART,ICHAIN,LENGTH,LTRSTR,KNTINP,LOCATN,
     2LMTSTR,INFORM,LTRBFR,LMTBFR)
      IF(KNTINP.EQ.0)GO TO 52
C
C     CONSTRUCT THE NEXT ADDRESS
      CALL PUTADR(LMTONE,LMTKND,LMTSEC,LMTTWO,ISTART,
     1    ICHAIN,LENGTH,LTRSTR,LOCATN,LMTSTR,LNGLIN,KNTLIN,
     2    LMTLIN,LTRADR,LMTCHR,KNTCHR,IFCODE,LOCTTL)
      IF(KNTLIN.LE.0)GO TO 55
      GO TO 71
C
C     ******************
C     *                *
C     *  EDIT ADDRESS  *
C     *                *
C     ******************
C
C     END OF FILE READ FOR DOT FORMAT INPUT FILE
   70 IEOF=1
      IF(KNTLIN.LE.0)GO TO 52
C
C     EDIT ADDRESS TO CONFORM TO LABEL SIZE
   71 CALL NXTLBL(ITTY,KNTLNG,LTRSPL,LTRABB,IFSORT,
     1LNGSPL,LNGABB,MAXLNG,MAXSPL,MAXABB,MAXCLM,KNTLIN,
     2KNTTEL,MAXLIN,IPASS ,KNTSHO,LOCTTL,LNGLIN,LNGOLD,
     3LMTLIN,LTRADR,LTROLD,LMTCHR,LBLDRP,IFFILE)
      IF(KNTLIN.LE.0)GO TO 55
C
C     CHECK IF THIS ADDRESS HAS BEEN SPECIFIED BY USER
      IF(MINNXT.GT.MAXNXT)GO TO 82
      MAXTST=0
      DO 81 LINE=1,KNTLIN
      MINTST=MAXTST+1
      MAXTST=MAXTST+LNGLIN(LINE)
      IF(MINTST.GT.MAXTST)GO TO 81
      DO 80 KOLUMN=MINTST,MAXTST
      MATCH=KOLUMN
      IF(KOLUMN.EQ.MINTST)GO TO 73
      IF(LTRADR(KOLUMN).EQ.LTRSPA)GO TO 72
      IF(LTRADR(KOLUMN).EQ.LTRCOM)GO TO 72
      GO TO 80
   72 MATCH=KOLUMN+1
   73 INNER=MINNXT
   74 IF(MATCH.GT.MAXTST)GO TO 81
      IF(LTRADR(MATCH).NE.LTRSPA)GO TO 75
      IF(LTRNXT(INNER).NE.LTRSPA)GO TO 80
      MATCH=MATCH+1
      GO TO 74
   75 IF(LTRNXT(INNER).NE.LTRSPA)GO TO 76
      IF(INNER.GE.MAXNXT)GO TO 76
      INNER=INNER+1
      GO TO 75
   76 IF(LTRADR(MATCH).EQ.LTRNXT(INNER))GO TO 77
      IF(LTRADR(MATCH).EQ.LWRNXT(INNER))GO TO 77
      GO TO 80
   77 INNER=INNER+1
      MATCH=MATCH+1
      IF(INNER.LE.MAXNXT)GO TO 74
      IF(MATCH.GT.MAXTST)GO TO 82
      LTRNOW=LTRADR(MATCH)
      IF(LTRNOW.EQ.LTRSPA)GO TO 82
      IF(LTRNOW.EQ.LTRCOM)GO TO 82
      DO 78 I=1,26
      IF(LTRNOW.EQ.LTRABC(I))GO TO 80
      IF(LTRNOW.EQ.LWRABC(I))GO TO 80
   78 CONTINUE
      DO 79 I=1,10
      IF(LTRNOW.EQ.LTRDGT(I))GO TO 80
   79 CONTINUE
      GO TO 82
   80 CONTINUE
   81 CONTINUE
      GO TO 55
   82 MINNXT=1
      MAXNXT=0
C
C     INSERT ASTERISK AT UPPER RIGHT CORNER OF LABELS
      IF(IAUTHR.LE.0)GO TO 93
      IF(LNGCOD.LE.0)GO TO 93
      NEXT=ISTART(11)
      IF(NEXT.LE.0)GO TO 93
      IFIRST=LOCATN(NEXT)
      IFINAL=IFIRST+LENGTH(NEXT)-1
      JFIRST=1
      JFINAL=LNGCOD
      GO TO 84
   83 IFIRST=IFIRST+1
      JFIRST=JFIRST+1
   84 IF(IFIRST.GT.IFINAL)GO TO 85
      IF(JFIRST.GT.JFINAL)GO TO 93
      IF(LTRCOD(JFIRST).EQ.LTRSTA)GO TO 86
      IF(LTRCOD(JFIRST).EQ.LTRPER)GO TO 83
      IF(LTRSTR(IFIRST).EQ.LTRCOD(JFIRST))GO TO 83
      IF(LTRSTR(IFIRST).EQ.LWRCOD(JFIRST))GO TO 83
      GO TO 93
   85 IF(JFIRST.GT.JFINAL)GO TO 86
      IF(LTRCOD(JFIRST).EQ.LTRSTA)GO TO 86
      GO TO 93
   86 MAXTST=0
      DO 87 I=1,KNTLIN
      MAXTST=MAXTST+LNGLIN(I)
   87 CONTINUE
      LINE=0
   88 LINE=LINE+1
      IF(LINE.GT.KNTLIN)GO TO 93
      IF(LNGLIN(LINE).EQ.0)GO TO 88
      IADD=MAXCLM-LNGLIN(LINE)
      IF(IADD.GT.(LMTCHR-MAXTST))IADD=LMTCHR-MAXTST
      IF(IADD.GT.4)IADD=IADD-1
      IF(IADD.LE.0)GO TO 93
      K=MAXTST+IADD
      MINTST=LNGLIN(LINE)
   89 IF(MAXTST.LE.MINTST)GO TO 90
      LTRADR(K)=LTRADR(MAXTST)
      K=K-1
      MAXTST=MAXTST-1
      GO TO 89
   90 LTRADR(K)=LTRSTA
      K=K-1
   91 IF(K.LE.MINTST)GO TO 92
      LTRADR(K)=LTRSPA
      K=K-1
      GO TO 91
   92 LNGLIN(LINE)=LNGLIN(LINE)+IADD
   93 GO TO 94
C
C     CONVERT LOWER CASE LETTERS TO UPPER CASE
   94 IF(LBLCAS.LE.0)GO TO 98
      MAXTST=0
      DO 97 LINE=1,KNTLIN
      MINTST=MAXTST+1
      MAXTST=MAXTST+LNGLIN(LINE)
      IF(MINTST.GT.MAXTST)GO TO 97
      DO 96 KOLUMN=MINTST,MAXTST
      LTRNOW=LTRADR(KOLUMN)
      IF(LTRNOW.EQ.LTRSPA)GO TO 96
      DO 95 J=1,26
      IF(LTRNOW.NE.LWRABC(J))GO TO 95
      LTRADR(KOLUMN)=LTRABC(J)
      GO TO 96
   95 CONTINUE
   96 CONTINUE
   97 CONTINUE
   98 CONTINUE
C
C     ****************************************
C     *                                      *
C     *  WRITE ROW OF LABELS TO OUTPUT FILE  *
C     *                                      *
C     ****************************************
C
C     CHECK IF ADD LABEL TO CURRENT FILE, APPEND TO
C     PREVIOUS FILE, OR START NEW FILE
      NOWCPY=0
   99 IF(KNTROW.LT.0)GO TO 100
      IF(KNTROW.EQ.0)GO TO 125
      IF(LBLNOW.GE.LBLCLM)GO TO 103
      GO TO 159
  100 KNTROW=-KNTROW
      IF(IFFILE.EQ.0)GO TO 159
      IF(KNTROW.GT.MAXROW)GO TO 125
      WRITE(ITTY,101)KNTFIL
  101 FORMAT(' Output file number',1I4,' is being continued')
      GO TO 159
  102 IF(KLMUSD.LE.0)GO TO 168
      JEOF=1
C
C     EJECT BLANK LINES TO ALIGN TOP OF NEXT LABEL
  103 MINHIH=1
      IF(IFFILE.NE.0)GO TO 108
      NEEDED=(KNTLBL*MAXHIH)
  104 IF(NEEDED.GE.KNTOUT)GO TO 105
      KNTLBL=KNTLBL+1
      NEEDED=NEEDED+MAXHIH
      GO TO 104
  105 IF(NEEDED.LE.KNTOUT)GO TO 108
      KNTOUT=KNTOUT+1
      IF(NEEDED.EQ.KNTOUT)GO TO 107
      WRITE(ITTY,106)
  106 FORMAT(1X)
      GO TO 105
  107 MINHIH=0
  108 CONTINUE
C
C     GENERATE THE ROW OF LABELS
  109 LINE=MINHIH
      IF(LINE.EQ.0)LINE=MAXHIH
      MAXPRT=KLMOLD+1
  110 MAXPRT=MAXPRT-1
      IF(MAXPRT.LE.0)GO TO 121
      IF(LTRLBL(LINE,MAXPRT).EQ.LTRSPA)GO TO 110
      MAXCPY=0
      IF(LBLOFF.LE.0)GO TO 112
      DO 111 I=1,LBLOFF
      IF(MAXCPY.GE.MAXOUT)GO TO 114
      MAXCPY=MAXCPY+1
      LTRLIN(MAXCPY)=LTRSPA
  111 CONTINUE
  112 DO 113 I=1,MAXPRT
      IF(MAXCPY.GE.MAXOUT)GO TO 114
      MAXCPY=MAXCPY+1
      LTRLIN(MAXCPY)=LTRLBL(LINE,I)
  113 CONTINUE
  114 IF(IFTABS.NE.0)GO TO 116
      I=0
      MAXUSD=0
  115 I=I+1
      IF(I.GT.MAXCPY)GO TO 117
      IF(I.GT.MAXOUT)GO TO 117
      LTROUT(I)=LTRLIN(I)
      IF(LTROUT(I).NE.LTRSPA)MAXUSD=I
      GO TO 115
  116 CALL TSTOPS(LTRLIN,MAXCPY,MAXOUT,LTROUT,MAXUSD)
  117 IF(MAXUSD.LE.0)GO TO 121
      IF(IFFILE.EQ.0)GO TO 119
      WRITE(JDISK,118)(LTROUT(I),I=1,MAXUSD)
  118 FORMAT(200A1)
      GO TO 124
  119 WRITE(ITTY,120)(LTROUT(I),I=1,MAXUSD)
  120 FORMAT(1X,200A1)
      GO TO 124
  121 IF(IFFILE.EQ.0)GO TO 123
      WRITE(JDISK,122)
  122 FORMAT(1X)
      GO TO 124
  123 WRITE(ITTY,122)
  124 MINHIH=MINHIH+1
      IF(MINHIH.LE.MAXHIH)GO TO 109
      MINHIH=1
      KNTOUT=KNTOUT+MAXHIH
      KNTROW=KNTROW+1
      IF(JEOF.GT.0)GO TO 168
      IF(IFFILE.EQ.0)GO TO 158
      IF(KNTROW.LE.MAXROW)GO TO 158
      ISTORE=3
      CALL FILEND(ISTORE,JDISK)
      WRITE(ITTY,169)KNTFIL,KNTLCL
C
C     *****************************
C     *                           *
C     *  START A NEW OUTPUT FILE  *
C     *                           *
C     *****************************
C
C     GET NAME OF NEXT OUTPUT FILE
  125 KNTROW=1
      IF(IFFILE.EQ.0)GO TO 126
      ISTORE=3
      CALL FILNXT(ISTORE,JDISK,ITTY,KNTFIL,1)
      IF(KNTFIL.LE.0)GO TO 181
  126 KNTLCL=0
      IF(LBLBOX.LE.0)GO TO 158
C
C     GENERATE TEMPLATE FOR ALIGNMENT BOXES
  127 DO 135 LINE=1,MAXHIH
      KNTCLM=0
      IFLOAT=0
      DO 134 KLMLBL=1,LBLCLM
      DO 131 KOLUMN=1,MAXCLM
      LTRNOW=LTRXXX
      IF(LINE.EQ.1)GO TO 130
      IF(LINE.EQ.MAXLIN)GO TO 130
      IF(LINE.EQ.MAXHIH)GO TO 129
      IF(LINE.GT.MAXLIN)GO TO 128
      IF(KOLUMN.EQ.1)GO TO 130
      IF(KOLUMN.EQ.MAXCLM)GO TO 130
  128 LTRNOW=LTRSPA
      GO TO 130
  129 LTRNOW=LTRMIN
  130 KNTCLM=KNTCLM+1
      LTRLBL(LINE,KNTCLM)=LTRNOW
  131 CONTINUE
      IF(KLMLBL.EQ.LBLCLM)GO TO 134
      LTRNOW=LTRSPA
      IF(LINE.LE.MAXLIN)GO TO 132
      IF(LINE.EQ.MAXHIH)LTRNOW=LTRMIN
  132 IFLOAT=IFLOAT+LBLWID
      I=(IFLOAT*LBLPCH)/1000
  133 IF(KNTCLM.GE.I)GO TO 134
      KNTCLM=KNTCLM+1
      LTRLBL(LINE,KNTCLM)=LTRNOW
      GO TO 133
  134 CONTINUE
  135 CONTINUE
C
C     EJECT BLANK LINES TO ALIGN TOP OF NEXT LABEL
      MINHIH=1
      IF(IFFILE.NE.0)GO TO 140
      NEEDED=(KNTLBL*MAXHIH)
  136 IF(NEEDED.GE.KNTOUT)GO TO 137
      KNTLBL=KNTLBL+1
      NEEDED=NEEDED+MAXHIH
      GO TO 136
  137 IF(NEEDED.LE.KNTOUT)GO TO 140
      KNTOUT=KNTOUT+1
      IF(NEEDED.EQ.KNTOUT)GO TO 139
      WRITE(ITTY,138)
  138 FORMAT(1X)
      GO TO 137
  139 MINHIH=0
  140 CONTINUE
C
C     WRITE OUT THE ALIGNMENT BOXES
      NOWBOX=1
  141 IF(NOWBOX.NE.LBLBOX)GO TO 143
      DO 142 I=1,KNTCLM
      LTRLBL(MAXHIH,I)=LTRSPA
  142 CONTINUE
      LTRLBL(MAXHIH,1)=LTRMIN
  143 LINE=MINHIH
      IF(LINE.EQ.0)LINE=MAXHIH
      MAXCPY=0
      IF(LBLOFF.LE.0)GO TO 145
      DO 144 I=1,LBLOFF
      IF(MAXCPY.GE.MAXOUT)GO TO 147
      MAXCPY=MAXCPY+1
      LTRLIN(MAXCPY)=LTRSPA
  144 CONTINUE
  145 DO 146 I=1,KNTCLM
      IF(MAXCPY.GE.MAXOUT)GO TO 147
      MAXCPY=MAXCPY+1
      LTRLIN(MAXCPY)=LTRLBL(LINE,I)
  146 CONTINUE
  147 IF(IFTABS.NE.0)GO TO 149
      I=0
      MAXUSD=0
  148 I=I+1
      IF(I.GT.MAXCPY)GO TO 150
      IF(I.GT.MAXOUT)GO TO 150
      LTROUT(I)=LTRLIN(I)
      IF(LTROUT(I).NE.LTRSPA)MAXUSD=I
      GO TO 148
  149 CALL TSTOPS(LTRLIN,MAXCPY,MAXOUT,LTROUT,MAXUSD)
  150 IF(MAXUSD.LE.0)GO TO 154
      IF(IFFILE.EQ.0)GO TO 152
      WRITE(JDISK,151)(LTROUT(I),I=1,MAXUSD)
  151 FORMAT(200A1)
      GO TO 157
  152 WRITE(ITTY,153)(LTROUT(I),I=1,MAXUSD)
  153 FORMAT(1X,200A1)
      GO TO 157
  154 IF(IFFILE.EQ.0)GO TO 156
      WRITE(JDISK,155)
  155 FORMAT(1X)
      GO TO 157
  156 WRITE(ITTY,155)
  157 MINHIH=MINHIH+1
      IF(MINHIH.LE.MAXHIH)GO TO 143
      MINHIH=1
      KNTOUT=KNTOUT+MAXHIH
      KNTLBL=KNTLBL+1
      NOWBOX=NOWBOX+1
      IF(NOWBOX.LE.LBLBOX)GO TO 141
      IF(LBLBOX.LE.0)GO TO 48
  158 LBLNOW=0
      KLMUSD=0
      KLMOLD=0
      IFLOAT=0
C
C     **************************************************
C     *                                                *
C     *  COPY ADDRESS TO THE STORAGE OF ROW OF LABELS  *
C     *                                                *
C     **************************************************
C
  159 LBLNOW=LBLNOW+1
      KNTTTL=KNTTTL+1
      KNTLCL=KNTLCL+1
C
C     BLANK OUT ANY COLUMNS SKIPPED BY ROUNDING WIDTHS
  160 IF(KLMOLD.GE.KLMUSD)GO TO 162
      KLMOLD=KLMOLD+1
      DO 161 LINE=1,MAXHIH
      LTRLBL(LINE,KLMOLD)=LTRSPA
  161 CONTINUE
      GO TO 160
  162 KLMOLD=KLMOLD+MAXCLM
C
C     INSERT THE NEW LABEL
      IF(KNTLIN.GT.MAXLIN)KNTLIN=MAXLIN
      MAXTST=0
      DO 167 LINE=1,MAXHIH
      IF(LINE.GT.KNTLIN)GO TO 165
      MINTST=MAXTST
      MAXTST=MAXTST+LNGLIN(LINE)
      IF(MINTST.GE.MAXTST)GO TO 165
      KLMNOW=KLMUSD
      DO 164 KOLUMN=1,MAXCLM
      KLMNOW=KLMNOW+1
      IF(MINTST.GE.MAXTST)GO TO 163
      MINTST=MINTST+1
      LTRLBL(LINE,KLMNOW)=LTRADR(MINTST)
      GO TO 164
  163 LTRLBL(LINE,KLMNOW)=LTRSPA
  164 CONTINUE
      GO TO 167
  165 KLMNOW=KLMUSD
      DO 166 KOLUMN=1,MAXCLM
      KLMNOW=KLMNOW+1
      LTRLBL(LINE,KLMNOW)=LTRSPA
  166 CONTINUE
  167 CONTINUE
      IF(KLMUSD.EQ.0)LTRLBL(MAXHIH,1)=LTRMIN
      IFLOAT=IFLOAT+LBLWID
      KLMUSD=(IFLOAT*LBLPCH)/1000
      NOWCPY=NOWCPY+1
      IF(NOWCPY.LT.LBLCPY)GO TO 99
      GO TO 54
C
C     CLOSE AND REOPEN OUTPUT FILE IN APPEND MODE
  168 IF(KNTROW.LE.0)GO TO 170
      KNTROW=-KNTROW
      IF(IFFILE.EQ.0)GO TO 170
      ISTORE=3
      CALL FILCUT(ISTORE,JDISK)
      WRITE(ITTY,169)KNTFIL,KNTLCL
  169 FORMAT(' Output file number',1I4,' contains',1I10,' labels')
  170 CONTINUE
C
C     REPORT IF COULD NOT LOCATE SPECIFIC PERSON
      IF(MINNXT.GT.MAXNXT)GO TO 172
      WRITE(ITTY,171)(LTRNXT(I),I=MINNXT,MAXNXT)
  171 FORMAT(' Could not locate ',40A1)
      KNTOUT=KNTOUT+1
  172 CONTINUE
C
C     ASK USER IF ADDITIONAL LABELS ARE TO BE PROCESSED
  173 WRITE(ITTY,174)
  174 FORMAT(' Process additional addresses (Y or N)? ',$)
      KNTOUT=KNTOUT+ISYSTM+1
      IALLOW=4
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(176,176,175,176,176,176,176),KIND
  175 IF(IVALUE.EQ.2)GO TO 28
      GO TO 177
C
C     ******  You must change the value by which KNTOUT is
C     *NOTE*  incremented if you change the number of lines
C     ******  typed to the terminal by the LBLHLP routine.
C
  176 CALL LBLHLP(ITTY,36)
      KNTOUT=KNTOUT+3
      GO TO 173
C
C     ALL DONE WITH ALL LABELS
  177 IF(KNTROW.EQ.0)GO TO 180
      IF(IFFILE.EQ.0)GO TO 178
      ISTORE=3
      CALL FILEND(ISTORE,JDISK)
  178 WRITE(ITTY,179)KNTTTL
  179 FORMAT(' Total labels produced:',1I10)
  180 GO TO 183
C
C     SOMETHING WRONG WITH OUTPUT FILE
  181 WRITE(ITTY,182)
  182 FORMAT(' Cannot open output file')
C
C     ALL DONE WITH ALL ADDRESSES
C     LEAVE ROUTINE EXITS WITHOUT TIME STAMP
  183 CALL LEAVE
      STOP
      END
      SUBROUTINE LBLHOW(ITTY  ,JTTY  ,LBLCLM,LBLHIH,LBLSPC,
     1LBLWID,LBLPCH,LBLOFF,LBLBOX,LBLCAS,IFCODE,LBLCPY,
     2LBLMAX,MRGWID,IFSORT,LTRCOD,LMTCOD,LNGCOD,KNDANS,
     3LTRBFR,LMTBFR,LBLDRP,IFFILE,IFTABS,ISYSTM)
C     RENBR(/ALLOW USER TO CHANGE LABEL DIMENSIONS)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
      DIMENSION LTRYES(6),LTRCOD(LMTCOD),KNDANS(26),
     1LTRBFR(LMTBFR)
      DATA LTRYES/1H ,1HN,1HO,1HY,1HE,1HS/
      DATA LTRSPA,LTRQUE/1H ,1H?/
C
C     LIST CURRENT SETTINGS
      IDIFFR=1
    1 CONTINUE
      IF(LNGCOD.EQ.0)WRITE(ITTY,2)
      IF(LNGCOD.GT.0)WRITE(ITTY,2)(LTRCOD(I),I=1,LNGCOD)
    2 FORMAT(' A) Asterisk on labels with code   ',100A1)
      WRITE(ITTY,3)LBLBOX
    3 FORMAT(' B) Boxes (rows of for alignment)  ',1I5)
      WRITE(ITTY,4)LBLCLM
    4 FORMAT(' C) Columns of labels              ',1I5)
      K=3+(3*LBLDRP)
      J=K-2
      WRITE(ITTY,5)(LTRYES(I),I=J,K)
    5 FORMAT(' D) Detach bottom line and zip code  ',3A1)
      WRITE(ITTY,6)LBLCPY
    6 FORMAT(' E) Each address on how many labels',1I5)
      WRITE(ITTY,7)MRGWID
    7 FORMAT(' G) Gutter width (spaces between)  ',1I5)
      HEIGHT=LBLHIH
      HEIGHT=HEIGHT/1000.0
      WRITE(ITTY,8)HEIGHT
    8 FORMAT(' H) Height of each label in inches',1F6.3)
      K=3+(3*IFCODE)
      J=K-2
      WRITE(ITTY,9)(LTRYES(I),I=J,K)
    9 FORMAT(' I) Initial code lines               ',3A1)
      WRITE(ITTY,10)LBLSPC
   10 FORMAT(' L) Line spacing (lines per inch)  ',1I5)
      WRITE(ITTY,11)LBLMAX
   11 FORMAT(' M) Maximum rows of labels in file',1I6)
      WRITE(ITTY,12)LBLOFF
   12 FORMAT(' O) Offset (extra spaces at left)  ',1I5)
      WRITE(ITTY,13)LBLPCH
   13 FORMAT(' P) Pitch (characters per inch)    ',1I5)
      K=3+(3*IFSORT)
      J=K-2
      WRITE(ITTY,14)(LTRYES(I),I=J,K)
   14 FORMAT(' S) Separate CAMPUS MAIL,zip,neither ',3A1)
      K=3+(3*IFTABS)
      J=K-2
      WRITE(ITTY,15)(LTRYES(I),I=J,K)
   15 FORMAT(' T) Tab characters replace spaces    ',3A1)
      K=3+(3*LBLCAS)
      J=K-2
      WRITE(ITTY,16)(LTRYES(I),I=J,K)
   16 FORMAT(' U) Upper case conversion            ',3A1)
      WIDTH=LBLWID
      WIDTH=WIDTH/1000.0
      WRITE(ITTY,17)WIDTH
   17 FORMAT(' W) Width of each label in inches ',1F6.3)
      WRITE(ITTY,18)
   18 FORMAT(1X)
C
C     INFORM USER OF ACTION TO BE TAKEN ON EMPTY LINE
      JDIFFR=0
      IF(IDIFFR.EQ.0)GO TO 28
      IDIFFR=0
      GO TO 116
   19 IF(IDIFFR.EQ.JDIFFR)WRITE(ITTY,20)
   20 FORMAT(' Press RETURN key extra time when all item',
     1's are correct'/
     21X)
   21 IF(IDIFFR.NE.JDIFFR)WRITE(ITTY,22)
   22 FORMAT(' Press RETURN key extra time to list all i',
     1'tems'/1X)
      JDIFFR=IDIFFR
C
C     ASK USER IF ANY OF THESE ARE TO BE CHANGED
      WRITE(ITTY,23)
   23 FORMAT(' Change item? ',$)
      IALLOW=0
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(24,25,26,25,29,25,26),KIND
   24 IF(IDIFFR.EQ.0)GO TO 116
      GO TO 1
   25 KOMAND=LETTER
C     GO TO( A, B, C, D, E, F, G, H, I, J,
C            K, L, M, N, O, P, Q, R, S, T,
C            U, V, W, X, Y, Z
      GO TO(30,39,44,49,54,26,59,64,69,26,
     1      26,74,80,26,85,90,26,26,96,101,
     2      106,26,111,26,26,26),KOMAND
   26 WRITE(ITTY,27)
   27 FORMAT(' Unknown response')
   28 CALL LBLHLP(ITTY,31)
      GO TO 21
   29 IDIFFR=0
      GO TO 1
C
C     MARK PARTICULAR CODE LINE
   30 LSTCOD=LNGCOD
      IF(KIND.EQ.4)GO TO 33
      IF(KIND.EQ.6)GO TO 38
   31 WRITE(ITTY,32)
   32 FORMAT(' Asterisks on labels with code (*,% are wil',
     1'd cards)? ',$)
      IALLOW=3
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(35,38,33,38,38,38,38),KIND
   33 LNGCOD=0
   34 IF(LNGCOD.GE.LMTCOD)GO TO 37
      IF(MINBFR.GT.MAXBFR)GO TO 37
      LNGCOD=LNGCOD+1
      LTRCOD(LNGCOD)=LTRBFR(MINBFR)
      MINBFR=MINBFR+1
      GO TO 34
   35 LNGCOD=0
      IF(LSTCOD.GT.0)WRITE(ITTY,36)
   36 FORMAT(' Cancelling previously specified code')
   37 IF((LSTCOD+LNGCOD).NE.0)IDIFFR=1
      GO TO 21
   38 CALL LBLHLP(ITTY,1)
      GO TO 31
C
C     ROWS OF ALIGNMENT BOXES
   39 IF(KIND.EQ.4)GO TO 42
      IF(KIND.EQ.6)GO TO 43
   40 WRITE(ITTY,41)
   41 FORMAT(' Number of rows of alignment boxes? ',$)
      IALLOW=1
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(21,43,42,43,43,43,43),KIND
   42 IF(IVALUE.LT.0)GO TO 43
      IF(LBLBOX.NE.IVALUE)IDIFFR=1
      LBLBOX=IVALUE
      GO TO 21
   43 CALL LBLHLP(ITTY,2)
      GO TO 40
C
C     ASK HOW MANY COLUMNS OF LABELS
   44 IF(KIND.EQ.4)GO TO 47
      IF(KIND.EQ.6)GO TO 48
   45 WRITE(ITTY,46)
   46 FORMAT(1X,'Number of parallel columns of labels? ',$)
      IALLOW=1
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(21,48,47,48,48,48,48),KIND
   47 IF(IVALUE.LT.1)GO TO 48
      IF(IVALUE.GT.4)GO TO 48
      IF(LBLCLM.NE.IVALUE)IDIFFR=1
      LBLCLM=IVALUE
      GO TO 21
   48 CALL LBLHLP(ITTY,3)
      GO TO 45
C
C     ASK IF LOWER LINE IS TO BE SEPARATED FROM REST
   49 IF(KIND.EQ.4)GO TO 52
      IF(KIND.EQ.6)GO TO 53
   50 WRITE(ITTY,51)
   51 FORMAT(' Detach bottom line and zip code from rest ',
     1'of address (Y or N)? ',$)
      IALLOW=4
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(21,53,52,53,53,53,53),KIND
   52 IVALUE=IVALUE-1
      IF(LBLDRP.NE.IVALUE)IDIFFR=1
      LBLDRP=IVALUE
      GO TO 21
   53 CALL LBLHLP(ITTY,4)
      GO TO 50
C
C     EXTRA COPIES OF EACH LABEL
   54 IF(KIND.EQ.4)GO TO 57
      IF(KIND.EQ.6)GO TO 58
   55 WRITE(ITTY,56)
   56 FORMAT(' Each address is to be printed on how many ',
     1'labels? ',$)
      IALLOW=1
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(21,58,57,58,58,58,58),KIND
   57 IF(IVALUE.LE.0)GO TO 58
      IF(LBLCPY.NE.IVALUE)IDIFFR=1
      LBLCPY=IVALUE
      GO TO 21
   58 CALL LBLHLP(ITTY,5)
      GO TO 55
C
C     GUTTER WIDTH
   59 IF(KIND.EQ.4)GO TO 62
      IF(KIND.EQ.6)GO TO 63
   60 WRITE(ITTY,61)
   61 FORMAT(' Width of gutters between labels (columns)? '
     1,$)
      IALLOW=1
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(21,63,62,63,63,63,63),KIND
   62 IF(IVALUE.LT.0)GO TO 63
      IF(MRGWID.NE.IVALUE)IDIFFR=1
      MRGWID=IVALUE
      GO TO 21
   63 CALL LBLHLP(ITTY,7)
      GO TO 60
C
C     HEIGHT OF LABELS
   64 IF(KIND.EQ.4)GO TO 67
      IF(KIND.EQ.6)GO TO 68
   65 WRITE(ITTY,66)
   66 FORMAT(' Height of labels in inches? ',$)
      IALLOW=2
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(21,68,67,68,68,68,68),KIND
   67 IVALUE=(AVALUE*1000.0)+0.5
      IF(IVALUE.LE.0)GO TO 68
      IF(LBLHIH.NE.IVALUE)IDIFFR=1
      LBLHIH=IVALUE
      GO TO 21
   68 CALL LBLHLP(ITTY,8)
      GO TO 65
C
C     INITIAL CODE LINE
   69 IF(KIND.EQ.4)GO TO 72
      IF(KIND.EQ.6)GO TO 73
   70 WRITE(ITTY,71)
   71 FORMAT(' Include initial code line (Y or N)? ',$)
      IALLOW=4
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(21,73,72,73,73,73,73),KIND
   72 IVALUE=IVALUE-1
      IF(IFCODE.NE.IVALUE)IDIFFR=1
      IFCODE=IVALUE
      GO TO 21
   73 CALL LBLHLP(ITTY,9)
      GO TO 70
C
C     LINE SPACING
   74 IF(KIND.EQ.4)GO TO 77
      IF(KIND.EQ.6)GO TO 79
   75 WRITE(ITTY,76)
   76 FORMAT(' 6 or 8 lines per inch? ',$)
      IALLOW=1
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(21,79,77,79,79,79,79),KIND
   77 IF(IVALUE.EQ.6)GO TO 78
      IF(IVALUE.EQ.8)GO TO 78
      GO TO 79
   78 IF(LBLSPC.NE.IVALUE)IDIFFR=1
      LBLSPC=IVALUE
      GO TO 21
   79 CALL LBLHLP(ITTY,12)
      GO TO 75
C
C     MAXIMUM ROWS OF LABELS IN A SINGLE OUTPUT FILE
   80 IF(KIND.EQ.4)GO TO 83
      IF(KIND.EQ.6)GO TO 84
   81 WRITE(ITTY,82)
   82 FORMAT(1X,'Maximum number of rows of labels? ',$)
      IALLOW=1
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(21,84,83,84,84,84,84),KIND
   83 IF(IVALUE.LE.0)GO TO 84
      IF(LBLMAX.NE.IVALUE)IDIFFR=1
      LBLMAX=IVALUE
      GO TO 21
   84 CALL LBLHLP(ITTY,13)
      GO TO 81
C
C     OFFSET
   85 IF(KIND.EQ.4)GO TO 88
      IF(KIND.EQ.6)GO TO 89
   86 WRITE(ITTY,87)
   87 FORMAT(1X,'Offset left label to right how many spac',
     1'es? ',$)
      IALLOW=1
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(21,89,88,89,89,89,89),KIND
   88 IF(IVALUE.LT.0)GO TO 89
      IF(LBLOFF.NE.IVALUE)IDIFFR=1
      LBLOFF=IVALUE
      GO TO 21
   89 CALL LBLHLP(ITTY,15)
      GO TO 86
C
C     PITCH
   90 IF(KIND.EQ.4)GO TO 93
      IF(KIND.EQ.6)GO TO 95
   91 WRITE(ITTY,92)
   92 FORMAT(' Pitch? ',$)
      IALLOW=1
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(21,95,93,95,95,95,95),KIND
   93 IF(IVALUE.EQ.10)GO TO 94
      IF(IVALUE.EQ.12)GO TO 94
      GO TO 95
   94 IF(LBLPCH.NE.IVALUE)IDIFFR=1
      LBLPCH=IVALUE
      GO TO 21
   95 CALL LBLHLP(ITTY,16)
      GO TO 91
C
C     SEPARATE CAMPUS MAIL, ZIP, NEITHER
   96 IF(KIND.EQ.4)GO TO 99
      IF(KIND.EQ.6)GO TO 100
   97 WRITE(ITTY,98)
   98 FORMAT(' Separate CAMPUS MAIL, ZIP and neither (Y o',
     1'r N)? ',$)
      IALLOW=4
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(21,100,99,100,100,100,100),KIND
   99 IVALUE=IVALUE-1
      IF(IFSORT.NE.IVALUE)IDIFFR=1
      IFSORT=IVALUE
      GO TO 21
  100 CALL LBLHLP(ITTY,19)
      GO TO 97
C
C     ASK IF SPACES ARE TO BE CONVERTED TO TABS
  101 IF(KIND.EQ.4)GO TO 104
      IF(KIND.EQ.6)GO TO 105
  102 WRITE(ITTY,103)
  103 FORMAT(' Convert multiple spaces to tab characters ',
     1'(Y or N)? ',$)
      IALLOW=4
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(21,105,104,105,105,105,105),KIND
  104 IVALUE=IVALUE-1
      IF(IFTABS.NE.IVALUE)IDIFFR=1
      IFTABS=IVALUE
      GO TO 21
  105 CALL LBLHLP(ITTY,20)
      GO TO 102
C
C     ASK IF CASE CONVERSION IS TO BE DONE
  106 IF(KIND.EQ.4)GO TO 109
      IF(KIND.EQ.6)GO TO 110
  107 WRITE(ITTY,108)
  108 FORMAT(' Convert lower case to upper case (Y or N)? '
     1,$)
      IALLOW=4
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(21,110,109,110,110,110,110),KIND
  109 IVALUE=IVALUE-1
      IF(LBLCAS.NE.IVALUE)IDIFFR=1
      LBLCAS=IVALUE
      GO TO 21
  110 CALL LBLHLP(ITTY,21)
      GO TO 107
C
C     WIDTH OF LABELS
  111 IF(KIND.EQ.4)GO TO 114
      IF(KIND.EQ.6)GO TO 115
  112 WRITE(ITTY,113)
  113 FORMAT(' Width of labels in inches including gutter',
     1's? ',$)
      IALLOW=2
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(21,115,114,115,115,115,115),KIND
  114 IVALUE=(AVALUE*1000.0)+0.5
      IF(IVALUE.LE.0)GO TO 115
      IF(LBLWID.NE.IVALUE)IDIFFR=1
      LBLWID=IVALUE
      GO TO 21
  115 CALL LBLHLP(ITTY,23)
      GO TO 112
C
C     ASK IF USER IS DONE WITH THIS SECTION
  116 WRITE(ITTY,117)
  117 FORMAT(' Are the above all correct (Y or N)? ',$)
      IALLOW=4
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(119,119,118,119,119,119,119),KIND
  118 IF(IVALUE.EQ.1)GO TO 19
      GO TO 120
  119 CALL LBLHLP(ITTY,30)
      GO TO 116
  120 CONTINUE
C
C     ************************************************
C     *                                              *
C     *  ASK IF ADDRESSES ARE TO BE WRITTEN TO FILE  *
C     *                                              *
C     ************************************************
C
  121 IFFILE=0
      IF(IFFILE.NE.0)GO TO 126
  122 WRITE(ITTY,123)
  123 FORMAT(' Are the addresses to be written into an ou',
     1'tput file (Y or N)? ',$)
      IALLOW=4
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(125,125,124,125,125,125,125),KIND
  124 IFFILE=0
      IF(IVALUE.EQ.2)IFFILE=1
      GO TO 126
  125 CALL LBLHLP(ITTY,38)
      GO TO 122
  126 CONTINUE
C
C     **********************************************
C     *                                            *
C     *  ASK WHICH OPERATING SYSTEM IS BEING USED  *
C     *                                            *
C     **********************************************
C
      ISYSTM=0
      IF(IFFILE.NE.0)GO TO 131
  127 WRITE(ITTY,128)
  128 FORMAT(' Did a blank line appear after the answer y',
     1'ou just typed (Y or N)? ',$)
      IALLOW=4
      CALL GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
      GO TO(130,130,129,130,130,130,130),KIND
  129 ISYSTM=0
      IF(IVALUE.EQ.2)ISYSTM=1
      GO TO 131
  130 CALL LBLHLP(ITTY,32)
      GO TO 127
  131 CONTINUE
C
C     RETURN TO CALLING PROGRAM
      RETURN
      END
      SUBROUTINE ABBREV(IDSK  ,KNTLNG,LTRSPL,LTRABB,
     1LNGSPL,LNGABB,MAXLNG,MAXSPL,MAXABB,ITTY)
C     RENBR(/READ ABBREVIATION VOCABULARY)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     This routine reads a file which specifies  the  words
C     which  can  be  deleted  or  which can be replaced by
C     shorter words to reduce the width of a label which is
C     too  wide.   Lines  which  each contain just a single
C     word  specify  the   words   which   are   considered
C     nonessentional and which can be deleted.  Lines which
C     each contain 2 words specify that the longer of the 2
C     words can be replaced by the shorter.
C
      DIMENSION LTRINP(72)
      DIMENSION LTRSPL(1000),LTRABB(1000),LNGSPL(100),LNGABB(100)
      DIMENSION LTRABC(26),LWRABC(26),LTRDGT(10),LTREQU(4)
      DATA LTRABC /1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1 1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,
     2 1HX,1HY,1HZ/
      DATA LWRABC /1Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
     1 1Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,1Hu,1Hv,1Hw,
     2 1Hx,1Hy,1Hz/
      DATA LTRDGT /1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA LTREQU/1H ,1Ht,1Ho,1H /
      DATA MAXBFR/72/
C
C     READ LIST OF ABBREVIATIONS
      KNTLNG=0
      KNTSPL=0
      KNTABB=0
    1 READ(IDSK,2,END=17)LTRINP
    2 FORMAT(100A1)
      IBEGIN=0
    3 IBEGIN=IBEGIN+1
      IF(IBEGIN.GT.MAXBFR)GO TO 1
      IF(LTRINP(IBEGIN).EQ.1H )GO TO 3
      IEND=IBEGIN
    4 IEND=IEND+1
      IF(IEND.GT.MAXBFR)GO TO 8
      IF(LTRINP(IEND).NE.1H )GO TO 4
      JBEGIN=IEND
      IEND=IEND-1
    5 JBEGIN=JBEGIN+1
      IF(JBEGIN.GT.MAXBFR)GO TO 9
      IF(LTRINP(JBEGIN).EQ.1H )GO TO 5
      JEND=JBEGIN
    6 JEND=JEND+1
      IF(JEND.GT.MAXBFR)GO TO 7
      IF(LTRINP(JEND).NE.1H )GO TO 6
    7 JEND=JEND-1
      GO TO 10
    8 IEND=IEND-1
    9 JBEGIN=1
      JEND=0
   10 IF((JEND-JBEGIN).LE.(IEND-IBEGIN))GO TO 11
      I=IBEGIN
      IBEGIN=JBEGIN
      JBEGIN=I
      I=IEND
      IEND=JEND
      JEND=I
   11 KNTLNG=KNTLNG+1
      LNGSPL(KNTLNG)=IEND-IBEGIN+1
      LNGABB(KNTLNG)=JEND-JBEGIN+1
      DO 14 KOLUMN=IBEGIN,IEND
      DO 12 I=1,26
      IF(LTRINP(KOLUMN).EQ.LTRABC(I))GO TO 13
      IF(LTRINP(KOLUMN).NE.LWRABC(I))GO TO 12
      LTRINP(KOLUMN)=LTRABC(I)
      GO TO 13
   12 CONTINUE
   13 KNTSPL=KNTSPL+1
      LTRSPL(KNTSPL)=LTRINP(KOLUMN)
   14 CONTINUE
      IF(JBEGIN.GT.JEND)GO TO 16
      DO 15 KOLUMN=JBEGIN,JEND
      KNTABB=KNTABB+1
      LTRABB(KNTABB)=LTRINP(KOLUMN)
   15 CONTINUE
   16 CONTINUE
      GO TO 1
   17 IF(KNTLNG.LE.0)GO TO 22
      WRITE(ITTY,18)
   18 FORMAT(' Abbreviations')
      I=0
      J=0
      DO 21 K=1,KNTLNG
      L=I+1
      M=J+1
      I=I+LNGSPL(K)
      J=J+LNGABB(K)
      IF(LNGABB(K).LE.0)WRITE(ITTY,19)(LTRSPL(N),N=L,I)
      IF(LNGABB(K).GT.0)WRITE(ITTY,20)(LTRSPL(N),N=L,I),
     1LTREQU,(LTRABB(N),N=M,J)
   19 FORMAT(1X,'Remove: ',100A1)
   20 FORMAT(1X,'Change: ',100A1)
   21 CONTINUE
   22 RETURN
      END
      SUBROUTINE NXTLBL(ITTY,KNTLNG,LTRSPL,LTRABB,IFSORT,
     1  LNGSPL,LNGABB,MAXLNG,MAXSPL,MAXABB,MAXCLM,KNTLIN,
     2  KNTTEL,MAXLIN,IPASS ,KNTSHO,LOCTTL,LNGLIN,LNGOLD,
     3  LMTLIN,LTRADR,LTROLD,LMTCHR,LBLDRP,IFFILE)
C     RENBR(/CHECK WIDTH AND HEIGHT OF ADDRESS)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     This routine checks the width and the height  of  the
C     address on each label.  The routine reduces the width
C     of the lines or discards lines if needed.  If a  line
C     in the address is too wide, the routine can delete or
C     replace   individual   words   specified    by    the
C     abbreviation  file,  or can split the line at a comma
C     or at  the  space  between  words.   If  the  address
C     contains  too many words, the routine can discard the
C     title line.   If  the  label  is  small  enough,  the
C     routine  moves  the  bottom  line of the label down a
C     line and shifts the zip code on the last line to  the
C     right.
C
      DIMENSION LTRLCL(10),LWRLCL(10)
      DIMENSION LTRSPL(1000),LTRABB(1000),LNGSPL(100),LNGABB(100)
      DIMENSION LTRABC(26),LWRABC(26),LTRDGT(10)
      DIMENSION LTRBFR(80),LTRLFT(9),LTRRIT(9)
      DIMENSION LNGLIN(LMTLIN),LNGOLD(LMTLIN),LTRADR(LMTCHR),
     1LTROLD(LMTCHR)
      DATA LNGLCL/10/
      DATA LTRLCL/1HC,1HA,1HM,1HP,1HU,1HS,1HM,1HA,1HI,1HL/
      DATA LWRLCL/1Hc,1Ha,1Hm,1Hp,1Hu,1Hs,1Hm,1Ha,1Hi,1Hl/
      DATA LTRLFT/1HN,1HE,1HW,1H ,1HL,1HA,1HB,1HE,1HL/
      DATA LTRRIT/1HO,1HL,1HD,1H ,1HL,1HA,1HB,1HE,1HL/
      DATA LTRABC /1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1 1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,
     2 1HX,1HY,1HZ/
      DATA LWRABC /1Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
     1 1Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,1Hu,1Hv,1Hw,
     2 1Hx,1Hy,1Hz/
      DATA LTRDGT /1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA LTREQU,LTRSTA,LTRSPA/1H=,1H*,1H /
      DATA LMTBFR/80/
C
C     DETERMINE LOCATION OF LAST LINE OF LABEL
      IF(KNTLIN.LE.0)GO TO 115
      IF(IFSORT.EQ.0)GO TO 15
      MAXTST=0
      LINE=0
    1 LINE=LINE+1
      IF(LINE.GT.KNTLIN)GO TO 2
      MINTST=MAXTST+1
      MAXTST=MAXTST+LNGLIN(LINE)
      GO TO 1
    2 CONTINUE
C
C     CHECK FOR CAMPUS MAIL ON LAST LINE OF LABEL
      IF(LNGLIN(KNTLIN).LT.11)GO TO 6
      KOLUMN=MAXTST
      J=LNGLCL
    3 IF(KOLUMN.LT.MINTST)GO TO 6
      IF(LTRADR(KOLUMN).EQ.1H )GO TO 5
      IF(LTRADR(KOLUMN).EQ.LTRLCL(J))GO TO 4
      IF(LTRADR(KOLUMN).EQ.LWRLCL(J))GO TO 4
      GO TO 6
    4 J=J-1
    5 KOLUMN=KOLUMN-1
      IF(J.GT.0)GO TO 3
      JPASS=1
      GO TO 14
    6 CONTINUE
C
C     CHECK FOR 5 DIGIT ZIP CODE ON LAST LINE OF ADDRESS
      KOLUMN=MAXTST
      DO 8 I=1,5
      IF(KOLUMN.LT.MINTST)GO TO 13
      LTRNOW=LTRADR(KOLUMN)
      DO 7 J=1,10
      IF(LTRNOW.EQ.LTRDGT(J))GO TO 8
    7 CONTINUE
      IF(I.NE.5)GO TO 13
      IF(LTRNOW.NE.1H-)GO TO 13
      GO TO 9
    8 KOLUMN=KOLUMN-1
      GO TO 12
C
C     CHECK FOR REST OF 9 DIGIT ZIP IN FORM MMMMM-NNNN
    9 DO 11 I=1,5
      KOLUMN=KOLUMN-1
      IF(KOLUMN.LT.MINTST)GO TO 13
      LTRNOW=LTRADR(KOLUMN)
      DO 10 J=1,10
      IF(LTRNOW.EQ.LTRDGT(J))GO TO 11
   10 CONTINUE
      GO TO 13
   11 CONTINUE
   12 JPASS=3
      GO TO 14
C
C     NEITHER CAMPUS MAIL NOR ZIP CODE FOUND
   13 JPASS=2
      GO TO 14
C
C     CHECK IF PRESENT LABEL IS CORRECT TYPE
   14 IF(IPASS.EQ.JPASS)GO TO 15
      KNTLIN=0
      GO TO 115
C
C     CHECK WIDTH AND HEIGHT OF STORED LABEL
   15 MAXWID=0
      DO 16 LINE=1,KNTLIN
      IF(MAXWID.LT.LNGLIN(LINE))MAXWID=LNGLIN(LINE)
   16 CONTINUE
      IF(MAXWID.GT.MAXCLM)GO TO 17
      IF(KNTLIN.LE.MAXLIN)GO TO 96
   17 CONTINUE
      KNTOLD=KNTLIN
      KOLUMN=0
      DO 19 LINE=1,KNTLIN
      LNGOLD(LINE)=LNGLIN(LINE)
      LIMIT=LNGLIN(LINE)
      IF(LIMIT.LE.0)GO TO 19
      DO 18 INDEX=1,LIMIT
      KOLUMN=KOLUMN+1
      LTROLD(KOLUMN)=LTRADR(KOLUMN)
   18 CONTINUE
   19 CONTINUE
C
C     **********************************************
C     *                                            *
C     *  REMOVE DEPARTMENT LINE IF TOO MANY LINES  *
C     *                                            *
C     **********************************************
C
      IF(KNTLIN.LE.MAXLIN)GO TO 25
      IF(LOCTTL.LE.0)GO TO 25
      IF(KNTLIN.LT.LOCTTL)GO TO 25
      MAXTST=0
      LINE=0
   20 LINE=LINE+1
      IF(LINE.GT.LOCTTL)GO TO 21
      MINTST=MAXTST+1
      MAXTST=MAXTST+LNGLIN(LINE)
      GO TO 20
   21 IF(LINE.GT.KNTLIN)GO TO 22
      IF(LTRADR(MAXTST+1).NE.1H )GO TO 22
      MAXTST=MAXTST+LNGLIN(LINE)
      LINE=LINE+1
      GO TO 21
   22 KNTLIN=KNTLIN-LINE+LOCTTL
      INDEX=LOCTTL
      KOPY=MINTST
   23 IF(INDEX.GT.KNTLIN)GO TO 25
      LNGLIN(INDEX)=LNGLIN(LINE)
      MINTST=MAXTST+1
      MAXTST=MAXTST+LNGLIN(INDEX)
      INDEX=INDEX+1
      LINE=LINE+1
   24 IF(MINTST.GT.MAXTST)GO TO 23
      LTRADR(KOPY)=LTRADR(MINTST)
      KOPY=KOPY+1
      MINTST=MINTST+1
      GO TO 24
   25 CONTINUE
C
C     ***********************************
C     *                                 *
C     *  ABBREVIATE WORDS IN LONG LINE  *
C     *                                 *
C     ***********************************
C
      IF(MAXWID.LE.MAXCLM)GO TO 53
      IF(KNTLNG.LE.0)GO TO 53
C
C     LOOK FOR LINE WHICH IS TOO LONG
      LINE=0
      MAXTST=0
   26 LINE=LINE+1
      IF(LINE.GT.KNTLIN)GO TO 53
      MINTST=MAXTST+1
      MAXTST=MAXTST+LNGLIN(LINE)
      IF(LNGLIN(LINE).LE.MAXCLM)GO TO 26
C
C     LOOK FOR NEXT WORD ON LINE
   27 IEND=MINTST-1
   28 IBEGIN=IEND
   29 IBEGIN=IBEGIN+1
   30 IF(IBEGIN.GT.MAXTST)GO TO 26
      IF(LTRADR(IBEGIN).EQ.1H )GO TO 29
      IF(LTRADR(IBEGIN).EQ.1H,)GO TO 29
      IEND=IBEGIN
   31 IEND=IEND+1
      IF(IEND.GT.MAXTST)GO TO 32
      IF(LTRADR(IEND).EQ.1H,)GO TO 32
      IF(LTRADR(IEND).EQ.1H )GO TO 32
      GO TO 31
   32 IEND=IEND-1
C
C     TRANSLATE WORD TO UPPER CASE
      IF((IEND-IBEGIN).GE.LMTBFR)GO TO 28
      KNTUPR=0
      DO 35 KOLUMN=IBEGIN,IEND
      LTRNOW=LTRADR(KOLUMN)
      DO 33 I=1,26
      IF(LTRNOW.EQ.LTRABC(I))GO TO 34
      IF(LTRNOW.NE.LWRABC(I))GO TO 33
      LTRNOW=LTRABC(I)
      GO TO 34
   33 CONTINUE
   34 KNTUPR=KNTUPR+1
      LTRBFR(KNTUPR)=LTRNOW
   35 CONTINUE
C
C     MATCH WORD IN ABBREVIATION DICTIONARY
      JEND=0
      KEND=0
      DO 37 ITEST=1,KNTLNG
      JBEGIN=JEND
      JEND=JEND+LNGSPL(ITEST)
      KEND=KEND+LNGABB(ITEST)
      IF(KNTUPR.NE.LNGSPL(ITEST))GO TO 37
      IF(KNTUPR.LE.LNGABB(ITEST))GO TO 37
      DO 36 JTEST=1,KNTUPR
      JBEGIN=JBEGIN+1
      IF(LTRBFR(JTEST).NE.LTRSPL(JBEGIN))GO TO 37
   36 CONTINUE
      MATCH=ITEST
      GO TO 38
   37 CONTINUE
      GO TO 28
C
C     REMOVE EXTRA SPACE IF NULL REPLACEMENT
   38 IF(LNGABB(MATCH).GT.0)GO TO 40
      IF(IBEGIN.EQ.MINTST)GO TO 39
      IF(LTRADR(IBEGIN-1).NE.1H )GO TO 39
      IBEGIN=IBEGIN-1
      GO TO 40
   39 IF(IEND.EQ.MAXTST)GO TO 40
      IF(LTRADR(IEND+1).EQ.1H )IEND=IEND+1
C
C     ADJUST THE LINE LENGTH
   40 IDIFFR=-IEND+IBEGIN-1+LNGABB(MATCH)
      LNGLIN(LINE)=LNGLIN(LINE)+IDIFFR
      MAXTST=MAXTST+IDIFFR
      KNTCHR=KNTCHR+IDIFFR
      IF(LNGLIN(LINE).GT.0)GO TO 44
C
C     CLOSE UP COMPLETELY EMPTY LINE
      KNTLIN=KNTLIN-1
      IF(LINE.GT.KNTLIN)GO TO 43
      DO 42 NEWLIN=LINE,KNTLIN
      LIMIT=LNGLIN(NEWLIN+1)
      LNGLIN(NEWLIN)=LIMIT
      IF(LIMIT.LE.0)GO TO 42
      DO 41 KOLUMN=1,LIMIT
      IEND=IEND+1
      LTRADR(IBEGIN)=LTRADR(IEND)
      IBEGIN=IBEGIN+1
   41 CONTINUE
   42 CONTINUE
   43 LINE=LINE-1
      GO TO 26
C
C     INSERT NEW WORD
   44 IF(LNGABB(MATCH).LE.0)GO TO 46
      I=KEND-LNGABB(MATCH)+1
      DO 45 KOLUMN=I,KEND
      LTRADR(IBEGIN)=LTRABB(KOLUMN)
      IBEGIN=IBEGIN+1
   45 CONTINUE
C
C     REMOVE EXTRA CHARACTERS OF OLD WORD
   46 KOLUMN=IBEGIN
   47 IF(KOLUMN.GT.MAXTST)GO TO 48
      IEND=IEND+1
      LTRADR(KOLUMN)=LTRADR(IEND)
      KOLUMN=KOLUMN+1
      GO TO 47
   48 NEWLIN=LINE
   49 IF(NEWLIN.GT.KNTLIN)GO TO 52
      LIMIT=LNGLIN(NEWLIN)
      IF(LIMIT.LE.0)GO TO 51
      DO 50 INDEX=1,LIMIT
      IEND=IEND+1
      LTRADR(KOLUMN)=LTRADR(IEND)
      KOLUMN=KOLUMN+1
   50 CONTINUE
   51 NEWLIN=NEWLIN+1
      GO TO 49
   52 GO TO 30
   53 CONTINUE
C
C     ******************************************
C     *                                        *
C     *  SPLIT UP LONG LINE AT COMMA OR SPACE  *
C     *                                        *
C     ******************************************
C
      DO 77 KPASS=1,2
C
C     LOOK FOR NEXT LINE TOO LONG
      LINE=0
      MAXTST=0
   54 IF(KNTLIN.GE.MAXLIN)GO TO 78
      IF(LINE.GE.KNTLIN)GO TO 77
      LINE=LINE+1
      MINTST=MAXTST+1
      MAXTST=MAXTST+LNGLIN(LINE)
      IF(LNGLIN(LINE).LE.MAXCLM)GO TO 54
C
C     LOOK FOR COMMA OR SPACE MARKING LOGICAL SPLIT
      KUTEND=MINTST+MAXCLM+1
   55 KUTEND=KUTEND-1
      IF(KUTEND.LT.MINTST)GO TO 62
      IF(KPASS.EQ.2)GO TO 56
      IF(LTRADR(KUTEND).EQ.1H,)GO TO 57
      GO TO 55
   56 IF(LTRADR(KUTEND).EQ.1H )GO TO 57
      GO TO 55
C
C     FIND END OF BLANKS AROUND REMOVED CHARACTER
   57 KUTBGN=KUTEND
   58 KUTBGN=KUTBGN-1
      IF(KUTBGN.LT.MINTST)GO TO 59
      IF(LTRADR(KUTBGN).EQ.1H )GO TO 58
   59 KUTBGN=KUTBGN+1
   60 KUTEND=KUTEND+1
      IF(KUTEND.GT.MAXTST)GO TO 61
      IF(LTRADR(KUTEND).EQ.1H )GO TO 60
   61 KUTEND=KUTEND-1
      GO TO 63
C
C     SPLIT IN MIDDLE OF WORD IF NO COMMA OR SPACE
   62 IF(KPASS.NE.2)GO TO 54
      KUTBGN=MINTST+MAXCLM
      KUTEND=KUTBGN-1
C
C     SHIFT CHARACTERS IN ADDRESS TO REMOVE CENTER SECTION
   63 NEWLIN=LINE
      NEWCLM=KUTBGN
      MINMOV=KUTEND+1
      MAXMOV=MAXTST
      GO TO 65
   64 NEWLIN=NEWLIN+1
      IF(NEWLIN.GT.KNTLIN)GO TO 67
      MINMOV=MAXMOV+1
      MAXMOV=MAXMOV+LNGLIN(NEWLIN)
   65 IF(MINMOV.GT.MAXMOV)GO TO 64
      DO 66 I=MINMOV,MAXMOV
      LTRADR(NEWCLM)=LTRADR(I)
      NEWCLM=NEWCLM+1
   66 CONTINUE
      GO TO 64
   67 CONTINUE
C
C     ADJUST LINE WHICH STARTS OR ENDS WITH REMOVED ITEM
      IF(KUTBGN.EQ.MINTST)GO TO 68
      IF(KUTEND.EQ.MAXTST)GO TO 68
      GO TO 71
   68 LNGLIN(LINE)=LNGLIN(LINE)-KUTEND+KUTBGN-1
      IF(LNGLIN(LINE).GT.0)GO TO 70
      KNTLIN=KNTLIN-1
      NEWLIN=LINE
   69 IF(NEWLIN.GT.KNTLIN)GO TO 70
      LNGLIN(NEWLIN)=LNGLIN(NEWLIN+1)
      NEWLIN=NEWLIN+1
      GO TO 69
   70 IF(KUTBGN.GT.KUTEND)GO TO 54
      MAXTST=MINTST-1
      LINE=LINE-1
      GO TO 54
C
C     SPLIT THE LONG LINE
   71 KNTLIN=KNTLIN+1
      NEWLIN=KNTLIN
   72 IF(NEWLIN.LE.LINE)GO TO 73
      LNGLIN(NEWLIN)=LNGLIN(NEWLIN-1)
      NEWLIN=NEWLIN-1
      GO TO 72
   73 LNGLIN(LINE)=KUTBGN-MINTST
      LNGLIN(LINE+1)=MAXTST-KUTEND
C
C     INSERT 2 SPACES AT START OF THE NEW LINE
      I=LMTCHR-NEWCLM+1
      IF(I.GT.2)I=2
      IF(I.LE.0)GO TO 76
      LNGLIN(LINE+1)=LNGLIN(LINE+1)+I
      J=NEWCLM+I
   74 J=J-1
      NEWCLM=NEWCLM-1
      IF(NEWCLM.LT.KUTBGN)GO TO 75
      LTRADR(J)=LTRADR(NEWCLM)
      GO TO 74
   75 IF(J.LT.KUTBGN)GO TO 76
      LTRADR(J)=' '
      J=J-1
      GO TO 75
   76 MAXTST=KUTBGN-1
      GO TO 54
   77 CONTINUE
   78 CONTINUE
C
C     **********************************************
C     *                                            *
C     *  REPORT OLD AND NEW VERSIONS OF THE LABEL  *
C     *                                            *
C     **********************************************
C
C     DO NOT DESCRIBE COMPACTION IF OUTPUT TO TERMINAL
      IF(IFFILE.EQ.0)GO TO 96
C
C     DETERMINE WIDTHS OF THE OLD AND NEW LABELS
      MAXOLD=0
      DO 79 LINE=1,KNTOLD
      IF(MAXOLD.LT.LNGOLD(LINE))MAXOLD=LNGOLD(LINE)
   79 CONTINUE
      MAXNEW=0
      DO 80 LINE=1,KNTLIN
      IF(MAXNEW.LT.LNGLIN(LINE))MAXNEW=LNGLIN(LINE)
   80 CONTINUE
C
C     REPORT DIMENSIONS OF LABELS, AND MARK IF OLD OR NEW
      WRITE(ITTY,81)KNTTEL,MAXNEW,KNTLIN,MAXOLD,KNTOLD
   81 FORMAT(1X/1X,'LABEL',1I6/
     1' NEW WIDTH',1I3,', NEW LENGTH',1I3/
     2' OLD WIDTH',1I3,', OLD LENGTH',1I3)
      KOLUMN=0
      DO 82 I=1,9
      KOLUMN=KOLUMN+1
      LTRBFR(KOLUMN)=LTRLFT(I)
   82 CONTINUE
   83 IF(KOLUMN.GE.LMTBFR)GO TO 86
      IF(KOLUMN.GE.MAXCLM)GO TO 84
      KOLUMN=KOLUMN+1
      LTRBFR(KOLUMN)=LTRSPA
      GO TO 83
   84 IF(KOLUMN.GE.LMTBFR)GO TO 86
      KOLUMN=KOLUMN+1
      LTRBFR(KOLUMN)=LTRSTA
      DO 85 I=1,9
      IF(KOLUMN.GE.LMTBFR)GO TO 86
      KOLUMN=KOLUMN+1
      LTRBFR(KOLUMN)=LTRRIT(I)
   85 CONTINUE
   86 WRITE(ITTY,87)(LTRBFR(I),I=1,KOLUMN)
   87 FORMAT(1X,100A1)
C
C     REPORT THE TEXT OF THE OLD AND NEW LABELS
      LINLMT=KNTLIN
      IF(LINLMT.LT.KNTOLD)LINLMT=KNTOLD
      MAXOLD=0
      MAXNEW=0
      DO 95 LINE=1,LINLMT
      MINOLD=MAXOLD+1
      MINNEW=MAXNEW+1
      IF(LINE.LE.KNTOLD)MAXOLD=MAXOLD+LNGOLD(LINE)
      IF(LINE.LE.KNTLIN)MAXNEW=MAXNEW+LNGLIN(LINE)
      KOLUMN=0
      MAXPRT=0
   88 IF(KOLUMN.GE.MAXCLM)GO TO 90
      IF(KOLUMN.GE.LMTBFR)GO TO 93
      KOLUMN=KOLUMN+1
      IF(MINNEW.LE.MAXNEW)GO TO 89
      LTRBFR(KOLUMN)=' '
      GO TO 88
   89 LTRBFR(KOLUMN)=LTRADR(MINNEW)
      MAXPRT=KOLUMN
      MINNEW=MINNEW+1
      GO TO 88
   90 IF(KOLUMN.GE.LMTBFR)GO TO 93
      KOLUMN=KOLUMN+1
      LTRBFR(KOLUMN)=LTRSTA
   91 IF(KOLUMN.GE.LMTBFR)GO TO 93
      KOLUMN=KOLUMN+1
      IF(MINOLD.LE.MAXOLD)GO TO 92
      LTRBFR(KOLUMN)=' '
      GO TO 91
   92 LTRBFR(KOLUMN)=LTROLD(MINOLD)
      MAXPRT=KOLUMN
      MINOLD=MINOLD+1
      GO TO 91
   93 IF(MAXPRT.GT.0)WRITE(ITTY,94)(LTRBFR(I),I=1,MAXPRT)
   94 FORMAT(1X,100A1)
   95 CONTINUE
C
C     DONE WITH THIS LABEL
   96 IF(KNTLIN.LE.0)GO TO 115
C
C     MOVE LAST LINE DOWN IF LABEL IS SHORT
      IF(LBLDRP.EQ.0)GO TO 101
      IF(KNTLIN.GE.MAXLIN)GO TO 101
      IF(KNTLIN.LE.1)GO TO 101
      MAXTST=0
      DO 97 LINE=1,KNTLIN
      MINTST=MAXTST+1
      MAXTST=MAXTST+LNGLIN(LINE)
   97 CONTINUE
      LINE=KNTLIN
   98 IF(LINE.LE.1)GO TO 101
      IF(LTRADR(MINTST).NE.LTRSPA)GO TO 99
      LINE=LINE-1
      MINTST=MINTST-LNGLIN(LINE)
      GO TO 98
   99 KNTLIN=KNTLIN+1
      I=KNTLIN
  100 LNGLIN(I)=LNGLIN(I-1)
      I=I-1
      IF(I.GT.LINE)GO TO 100
      LNGLIN(LINE)=0
  101 CONTINUE
C
C     CHECK FOR ZIP CODE ON LAST LINE
      IF(LBLDRP.EQ.0)GO TO 111
      MAXTST=0
      DO 102 LINE=1,KNTLIN
      MINTST=MAXTST+1
      MAXTST=MAXTST+LNGLIN(LINE)
  102 CONTINUE
      KOLUMN=MAXTST
      DO 104 I=1,5
      IF(KOLUMN.LT.MINTST)GO TO 111
      LTRNOW=LTRADR(KOLUMN)
      DO 103 J=1,10
      IF(LTRNOW.EQ.LTRDGT(J))GO TO 104
  103 CONTINUE
      IF(I.NE.5)GO TO 111
      IF(LTRNOW.NE.1H-)GO TO 111
      GO TO 105
  104 KOLUMN=KOLUMN-1
      GO TO 108
  105 KOLUMN=KOLUMN-1
      DO 107 I=1,5
      IF(KOLUMN.LT.MINTST)GO TO 111
      LTRNOW=LTRADR(KOLUMN)
      DO 106 J=1,10
      IF(LTRNOW.EQ.LTRDGT(J))GO TO 107
  106 CONTINUE
      GO TO 111
  107 KOLUMN=KOLUMN-1
C
C     MOVE ZIP CODE TO RIGHT
  108 CONTINUE
      IADD=5
      IF(IADD.GT.(MAXCLM-LNGLIN(KNTLIN)))IADD=MAXCLM-LNGLIN(KNTLIN)
      IF(IADD.GT.(LMTCHR-MAXTST))IADD=LMTCHR-MAXTST
      IF(IADD.LE.0)GO TO 111
      LNGLIN(KNTLIN)=LNGLIN(KNTLIN)+IADD
      I=MAXTST
      MAXTST=MAXTST+IADD
      J=MAXTST
  109 IF(I.LE.KOLUMN)GO TO 110
      LTRADR(J)=LTRADR(I)
      I=I-1
      J=J-1
      GO TO 109
  110 IF(J.LE.KOLUMN)GO TO 111
      LTRADR(J)=' '
      J=J-1
      GO TO 110
  111 CONTINUE
C
C     CENTER TEXT VERTICALLY ON LABEL
      IADD=(MAXLIN-KNTLIN)/2
      IF(IADD.GT.(MAXLIN-KNTLIN))IADD=MAXLIN-KNTLIN
      IF(IADD.LE.0)GO TO 114
      I=KNTLIN
      KNTLIN=KNTLIN+IADD
      J=KNTLIN
  112 IF(I.LE.0)GO TO 113
      LNGLIN(J)=LNGLIN(I)
      I=I-1
      J=J-1
      GO TO 112
  113 IF(J.LE.0)GO TO 114
      LNGLIN(J)=0
      J=J-1
      GO TO 113
  114 GO TO 115
C
C     DONE WITH ALL LABELS
  115 RETURN
      END
      SUBROUTINE LBLHLP(ITTY,MESAGE)
C     RENBR(/HELP MESSAGES FOR LABELS PROGRAM)/M1000
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     THE FORMAT STATEMENTS IN THIS ROUTINE WERE PRODUCED
C     BY THE FORMAT PROGRAM WHICH WAS WRITTEN BY THE
C     CURRENT AUTHOR AND WHICH IS AVAILABLE FROM THE DECUS
C     LIBRARY.
C
C     ******************************************
C     *                                        *
C     *  MENU ITEMS IDENTIFIED BY A THROUGH Z  *
C     *                                        *
C     ******************************************
C
C     ASTERISK
      IF(MESAGE.EQ. 1)WRITE(ITTY,1)
    1 FORMAT(' Type the identification code of any addres',
     1's which is to bear an asterisk (*)  at'/' the uppe',
     2'r right corner.  This option is active only if the',
     3' input file is defined'/' in at sign (@) format.  ',
     4'The identification code is the  sequence  of  char',
     5'acters'/' which  are  defined  on the line startin',
     6'g with an at sign and the letter K.  The'/' label ',
     7'can be marked with an asterisk even if  the  ident',
     8'ification  code  is  not'/' itself copied into the',
     9' label.'/)
      IF(MESAGE.EQ. 1)WRITE(ITTY,2)
    2 FORMAT(' Include either the upper case (capital) or',
     1' the lower case (small) form of one of'/' the  alp',
     2'habetic  letters  A  through  Z where either form ',
     3'of the letter is to be'/' allowed.  Include a perc',
     4'ent sign (%) in the code where any single  charact',
     5'er  is'/' to be allowed.  Include an asterisk at t',
     6'he right end of the code if any sequence'/' of cha',
     7'racters is to be allowed starting at that point.  ',
     8'Typing A%C*  would  mark')
      IF(MESAGE.EQ. 1)WRITE(ITTY,3)
    3 FORMAT(' all labels having codes such as AAC..., AB',
     1'C..., ACC... etc. regardless of case.'//' To desel',
     2'ect a previously selected code, just press the RET',
     3'URN key again.')
C
C     BOXES
      IF(MESAGE.EQ. 2)WRITE(ITTY,4)
    4 FORMAT(' Several rows of label outlines can be gene',
     1'rated before the  first  addresses  in'/' each  ou',
     2'tput  file  to  be  used  for  alignment of the pa',
     3'per in the terminal or'/' printer.  Type the numbe',
     4'r of rows of empty boxes which are desired.')
C
C     COLUMNS
      IF(MESAGE.EQ. 3)WRITE(ITTY,5)
    5 FORMAT(' The addresses can be arranged in a single ',
     1'column, or in 2 to 4 parallel columns.'/' If  3  c',
     2'olumns  of labels are selected here, then the firs',
     3't 3 addresses would be'/' placed on the first row ',
     4'of 3 labels, and the fourth address would be on th',
     5'e left'/' label in the second row.')
C
C     DETACH BOTTOM LINE AND ZIP CODE
      IF(MESAGE.EQ. 4)WRITE(ITTY,6)
    6 FORMAT(' Type'/' Y  to separate the city-state-zip ',
     1'line from the rest of the address by an  extra'/4X,
     2'blank line and to shift the zip code slightly to t',
     3'he right.'/' N  to have the city-state-zip line be',
     4' contiguous with the rest  of  the  address'/4X,'a',
     5'nd to have the zip code be just to the right of th',
     6'e state.')
C
C     EXTRA COPIES
      IF(MESAGE.EQ. 5)WRITE(ITTY,7)
    7 FORMAT(' Type the number of labels onto which each ',
     1'address is to be printed.  If you want'/' each  ad',
     2'dress  to  be  printed  onto  2 labels, then you w',
     3'ould type 2 here.  The'/' duplicate copies of the ',
     4'addresses are printed on adjacent labels.  If you ',
     5'want 1'/' complete  set of labels to be followed b',
     6'y a second complete set, then you should'/' either',
     7' process the input file twice, or run this program',
     8' twice.')
C
C     GUTTERS
      IF(MESAGE.EQ. 7)WRITE(ITTY,8)
    8 FORMAT(' Type the number of columns of characters w',
     1'hich are  to  be  left  blank  between'/' adjacent',
     2'  labels  to allow for horizontal misalignment of ',
     3'the label stock in the'/' terminal or printer.  Yo',
     4'u would type 4 here if you wanted 2 columns to  be',
     5'  left'/' blank at the right edge of each label an',
     6'd 2 more columns to be left blank at the'/' left e',
     7'dge of the adjacent label.  The label width specif',
     8'ied elsewhere in  inches'/' must include these bla',
     9'nk columns.')
C
C     HEIGHT
      IF(MESAGE.EQ. 8)WRITE(ITTY,9)
    9 FORMAT(' Type the distance between the tops of succ',
     1'essive labels.  You would type 1.25 if'/' labels a',
     2're 1 and 1/4 inch high')
C
C     INITIAL CODE LINE
      IF(MESAGE.EQ. 9)WRITE(ITTY,10)
   10 FORMAT(' The code specified in the address file by ',
     1' a  line  starting  with  an  at  sign'/' followed',
     2'  immediately  by the letter K can be typed on a s',
     3'eparate line above the'/' rest of the address.  Th',
     4'is code can be included only if the input file is ',
     5'in  at'/' sign  format.  Inclusion of this code on',
     6' the label is independent of the marking'/' of an ',
     7'asterisk at the upper right corner of addresses ha',
     8'ving  particular  codes.'/' Type'/' Y  to include ',
     9'codes on the top line of each label')
      IF(MESAGE.EQ. 9)WRITE(ITTY,11)
   11 FORMAT(' N  to exclude codes')
C
C     LINES PER INCH
      IF(MESAGE.EQ.12)WRITE(ITTY,12)
   12 FORMAT(' Type'/' 6  if the labels will be typed at ',
     1'the usual 6 lines per inch vertically.'/' 8  if th',
     2'e terminal or printer is adjusted for 8 lines per ',
     3'inch.')
C
C     MAXIMUN NUMBER OF ROWS OF LABELS
      IF(MESAGE.EQ.13)WRITE(ITTY,13)
   13 FORMAT(' Type the maximum number of rows of labels ',
     1'which can appear in  a  single  output'/' file.  A',
     2' new output file will be begun after this many row',
     3's have been written to'/' the current output file.',
     4'  If the file starts with 10 rows of boxes, and if',
     5' there'/' are  3  parallel  columns  of labels, th',
     6'en selecting 1000 rows here would give a'/' maximu',
     7'm of 3*(1000-10) or 2970 labels actually bearing a',
     8'ddresses.')
C
C     OFFSET
      IF(MESAGE.EQ.15)WRITE(ITTY,14)
   14 FORMAT(' Type the number of spaces which are to be ',
     1'inserted to the left of the  addresses'/' in  the ',
     2' leftmost  column  of  labels.   Unlike the spaces',
     3' in the gutter between'/' adjacent labels, the spa',
     4'ces inserted  to  the  left  of  the  addresses  i',
     5'n  the'/' leftmost  column  of  labels  should  no',
     6't be included in the width of the labels'/' stated',
     7' in inches elsewhere.')
C
C     PITCH
      IF(MESAGE.EQ.16)WRITE(ITTY,15)
   15 FORMAT(' Type the number of characters which will b',
     1'e typed per inch.'/' 10 for PICA pitch of 10 chara',
     2'cters per inch horizontally.'/' 12 for ELITE pitch',
     3' of 12 characters per inch horizonally.')
C
C     SEPARATE THE TYPES OF ADDRESSES
      IF(MESAGE.EQ.19)WRITE(ITTY,16)
   16 FORMAT(' Type'/' Y  to scan the input file 3 times,',
     1' producing first the labels which have  CAMPUS'/4X,
     2'MAIL  on  last  line,  then the labels which have ',
     3'neither CAMPUS MAIL nor zip'/4X,'code on the last ',
     4'line, and finally the labels which have a zip  cod',
     5'e  on  the'/4X,'last line'/' N  to produce labels ',
     6'exactly in the order specified in the file')
C
C     TAB CHARACTERS
      IF(MESAGE.EQ.20)WRITE(ITTY,17)
   17 FORMAT(' This program can convert multiple spaces t',
     1'o tab characters to save  transmission'/' time  to',
     2'  the  terminal  or  printer and/or to save disk s',
     3'pace if the labels are'/' being written to an outp',
     4'ut file.  The tab character is a non-printing  cha',
     5'racter'/' which  causes  the  next  printing  char',
     6'acter to appear to the right of the next'/' integr',
     7'al multiple of 8 column positions.  Type'/' Y  if ',
     8'multiple spaces are to be converted to tab charact',
     9'ers.')
      IF(MESAGE.EQ.20)WRITE(ITTY,18)
   18 FORMAT(' N  if multiple spaces are not to be conver',
     1'ted to tab characters.  This should be'/4X,'used i',
     2'f either the operating system or the output device',
     3' does not support the'/4X,'tab character.')
C
C     UPPER CASE CHARACTERS ONLY
      IF(MESAGE.EQ.21)WRITE(ITTY,19)
   19 FORMAT(' Type'/' Y  to produce labels in which  all',
     1'  lower  case  alphabetic  letters  have  been'/4X,
     2'converted to capitals'/' N  to keep all alphabetic',
     3' letters in their original cases')
C
C     WIDTH OF LABELS
      IF(MESAGE.EQ.23)WRITE(ITTY,20)
   20 FORMAT(' Type the distance in  inches  between  lef',
     1't  edges  of  adjacent  labels.   This'/' distance',
     2'  must  include any blank gutter between the label',
     3's.  You would type 3.5'/' if the labels were 3 and',
     4' 1/2 inch wide.')
C
C     ********************
C     *                  *
C     *  OTHER MESSAGES  *
C     *                  *
C     ********************
C
C     IDENTIFY PROGRAM
      IF(MESAGE.EQ.27)WRITE(ITTY,21)
   21 FORMAT(' LABEL (05/83)'/' This program reads an add',
     1'ress file in which each line starts with an at sig',
     2'n (@)'/' or  in which previously formatted address',
     3'es are separated by lines starting with'/' periods',
     4'.  A file is produced containing parallel columns ',
     5'of addresses which  can'/' be typed onto labels on',
     6' fanfold paper.'/)
C
C     ASK FOR DIMENSION DEFAULT
      IF(MESAGE.EQ.28)WRITE(ITTY,22)
   22 FORMAT(' Type one of following numbers to set intia',
     1'l dimensions you then modify'/' 1  for 1 column  o',
     2'f 4     by 1 1/2 labels at 10 pitch and 6 lines/in',
     3'ch'/' 2  for 4 columns of 3 3/8 by 1     labels at',
     4' 12 pitch and 8 lines/inch'/)
      IF(MESAGE.EQ.29)WRITE(ITTY,23)
   23 FORMAT(' Default label dimensions are selected by t',
     1'he following numbers'/' 1  selects single column o',
     2'f labels 4 inches  wide  by  1.5  inches  high  to',
     3'  be'/4X,'printed at 10 characters per inch and 6 ',
     4'lines per inch'/' 2  selects 4 parallel columns of',
     5' labels 3 3/8 inches wide by 1 inch high  to  be'/
     64X,'printed at 12 characters per inch and 8 lines p',
     7'er inch')
C
C     ASK IF MENU ITEMS ARE ALL CORRECT
      IF(MESAGE.EQ.30)WRITE(ITTY,24)
   24 FORMAT(' Type'/' Y  if all of the above items are c',
     1'orrect'/' N  if you still want to change any of th',
     2'ese items')
C
C      UNKNOWN MENU ITEM
      IF(MESAGE.EQ.31)WRITE(ITTY,25)
   25 FORMAT(' To change any item in the above list, type',
     1' the letter which appears to the  left'/' of the i',
     2'tem.  You can type the new value or the YES or NO ',
     3'decision either to the'/' right of the letter or o',
     4'n the next line.  Press ? and then  the  RETURN  k',
     5'ey  to'/' list  all  of the current values.  Press',
     6' only the RETURN key if all of the items'/' shown ',
     7'above are correct.')
C
C     ASK IF BLANK LINE APPEARED AFTER PREVIOUS ANSWER
      IF(MESAGE.EQ.32)WRITE(ITTY,26)
   26 FORMAT(' The answer to this question is used to kee',
     1'p track of the number of  lines  which'/' have bee',
     2'n displayed on the terminal.  Answer'/' Y  if a bl',
     3'ank line appeared between the last answer which  y',
     4'ou  typed  and  this'/4X,'question.   The  dialog ',
     5' between  you  and  the program will have been mos',
     6'tly'/4X,'double spaced.'/' N  if a blank line did ',
     7'not appear between the last answer which  you  typ',
     8'ed  and'/4X,'this  question.  The dialog between y',
     9'ou and the program will have been mostly')
      IF(MESAGE.EQ.32)WRITE(ITTY,27)
   27 FORMAT(4X,'single spaced.')
C
C     ASK IF WORDS CAN BE ABBREVIATED IN LONG LINES
      IF(MESAGE.EQ.33)WRITE(ITTY,28)
   28 FORMAT(' Type'/' Y  if some words in long lines can',
     1' be abbreviated  or  deleted  to  shorten  the'/4X,
     2'lines.   This  program  will  ask  for the name of',
     3' the file which defines the'/4X,'abbreviations or ',
     4'words to be deleted.'/' N  if no words are to be a',
     5'bbreviated or deleted in long lines.')
C
C     TELL USER TO INSERT LABELS INTO TERMINAL
      IF(MESAGE.EQ.34)WRITE(ITTY,29)
   29 FORMAT(' Insert labels on fanfold paper so that bot',
     1'tom  of  a  row  of  labels  is  under'/' printhea',
     2'd.   Press  the  RETURN  key  when  paper is prope',
     3'rly aligned, or type a'/' single letter and press ',
     4'RETURN for a target row of labels, or  type  a  pe',
     5'rson''s'/' name and press RETURN to start at that ',
     6'person.')
C
C     ASK FOR WORD OR PHRASE IN FIRST ADDRESS
      IF(MESAGE.EQ.35)WRITE(ITTY,30)
   30 FORMAT(' Type a word or a phrase which will be foun',
     1'd first in the first address which  is'/' to  be  ',
     2'included  on  the  labels.   Addresses  which  app',
     3'ear  before  the first'/' appearance of this word ',
     4'or phrase will be discarded.  You must  type  more',
     5'  than'/' just  a single character.  Be sure to in',
     6'clude all punctuation marks which appear'/' betwee',
     7'n the words if you type a phrase.  The cases of th',
     8'e alphabetic  letters  A')
      IF(MESAGE.EQ.35)WRITE(ITTY,31)
   31 FORMAT(' through Z are ignored.  Merely press the R',
     1'ETURN key to produce all labels.')
      IF(MESAGE.EQ.37)WRITE(ITTY,32)
   32 FORMAT(' Type a word or a phrase which will be foun',
     1'd first in the first address which  is'/' to  be  ',
     2'included  on  the  labels.   Addresses  which  app',
     3'ear  before  the first'/' appearance of this word ',
     4'or phrase will be discarded.  Be  sure  to  includ',
     5'e  all'/' punctuation  marks  which  appear  betwe',
     6'en  the words if you type a phrase.  The'/' cases ',
     7'of the alphabetic letters A through Z are ignored.',
     8'  You can  type  just  a')
      IF(MESAGE.EQ.37)WRITE(ITTY,33)
   33 FORMAT(' single  printing character to produce a ro',
     1'w of target labels for use in aligning'/' the pape',
     2'r.  Merely press the RETURN key to produce all lab',
     3'els.')
C
C     ASK IF MORE LABELS ARE TO BE PROCESSED
      IF(MESAGE.EQ.36)WRITE(ITTY,34)
   34 FORMAT(' Type'/' Y  to append additional labels to ',
     1'current output file'/' N  to terminate constructio',
     2'n of current output file')
C
C     FILE OUTPUT
      IF(MESAGE.EQ.38)WRITE(ITTY,35)
   35 FORMAT(' This program can type the labels to the co',
     1'ntrolling terminal, or can write these'/' labels t',
     2'o an output file.  Type'/' Y  if the labels are to',
     3' be written to an output file.  The labels  will  ',
     4'not  be'/4X,'written directly to the terminal.'/' ',
     5'N  if the labels are not to be written to an outpu',
     6't file.  The  labels  will  be'/4X,'written direct',
     7'ly to the terminal instead.')
      RETURN
      END