Trailing-Edge
-
PDP-10 Archives
-
decuslib10-11
-
43,50541/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