Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-11 - 43,50541/splice.for
There is 1 other file named splice.for in the archive. Click here to see a list.
C     RENBR(SPLICE/CONVERT ADDRESS FILE TO FROFF SPLICE FILE)
C
C     Donald Barth, Yale School of Management
C
C     This program  processes  a  file  which  specifies  a
C     series  of  addresses, and generates a file which can
C     be used later by the FROFF word processor  to  insert
C     these addresses and salutations into form letters.
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     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     THE  DOT  FORMAT  FILE  SHOWN  ABOVE  IS ACTUALLY THE
C     RESULT OBTAINED  BY  PROCESSING  THE  AT  SIGN FORMAT
C     FILE SHOWN EARLIER.   EITHER OF THESE FORMS, HOWEVER,
C     COULD BE PROCESSED TO OBTAIN THE SAME RESULT.
C
      DIMENSION LTRBFR(72),LTRTTL(30),
     1ISTART(26),ICHAIN(30),LENGTH(30),LOCATN(30),LTRSTR(2000),
     2LTRKND(26),LTRADR(1500),LNGLIN(12),LTRID(2),LWRID(2),
     3LTRDER(4),LWRDER(4)
C
C     DIGITS 0 - 9 AND ALPHABET A - Z
      DIMENSION LTRDGT(10),LTRABC(26),LWRABC(26)
C
C     ARRAYS USED TO STORE WORD TO BE SEARCHED FOR
C     LTRNXT(LMTNXT),LWRNXT(LMTNXT)
C
      DIMENSION LTRNXT(40),LWRNXT(40)
      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 LTRID/1HI,1HD/
      DATA LWRID/1Hi,1Hd/
      DATA LMTKND,LMTSEC,LMTONE,LMTTWO,LMTBFR,LMTSTR,
     1LMTCHR,LMTLIN,LMTDER,LMTMSK,LMTTTL/
     226,30,70,50,72,2000,1500,12,4,4,30/
C
C     DIMENSION OF WORD TO BE IN FIRST ADDRESS
      DATA LMTNXT/40/
      DATA IDISK,JDISK,ITTY,JTTY/1,20,5,5/
      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 LTRDER/1HD,1HE,1HA,1HR/
      DATA LWRDER/1Hd,1He,1Ha,1Hr/
      DATA LTRMIN,LTRATS,LTRDOT,LTRCOL,LTRCOM,LTRSPA,LTRQUE/
     11H-,1H@,1H.,1H:,1H,,1H ,1H?/
      DATA IFCODE/0/
C
C     COUNTS THAT ACCUMULATE DURING ENTIRE RUN
      KNTROW=0
      KNTONE=0
      KNTTWO=0
      KNTTHR=0
C
C     TELL USER WHAT PROGRAM THIS IS
      CALL SPLHLP(ITTY,1)
C
C     ASK TYPE OF SALUTATION IF ONE MUST BE CONSTRUCTED
    1 WRITE(ITTY,2)
    2 FORMAT(' Business, Personal or No salutations (B, P or N)? ',$)
      CALL ANSWER(JTTY,KIND,LETTER,IVALUE,AVALUE)
      GO TO(1,4,4,3,4,4,6,3),KIND
    3 IFDEAR=-1
      IF(LETTER.EQ.14)IFDEAR=0
      IF(LETTER.EQ.2)IFDEAR=1
      IF(LETTER.EQ.16)IFDEAR=2
      IF(IFDEAR.GE.0)GO TO 7
    4 WRITE(ITTY,5)
    5 FORMAT(' Unknown response')
    6 CALL SPLHLP(ITTY,3)
      GO TO 1
    7 CONTINUE
C
C     ASK ABOUT SALUTATIONS IF NOT IN INPUT FILE
      IF(IFDEAR.NE.1)GO TO 13
    8 WRITE(ITTY,9)
    9 FORMAT(
     1' Default title if salutation is missing? ',$)
      READ(JTTY,10)LTRTTL
   10 FORMAT(30A1)
      MINTTL=0
   11 MINTTL=MINTTL+1
      IF(MINTTL.GT.LMTTTL)GO TO 13
      IF(LTRTTL(MINTTL).EQ.LTRSPA)GO TO 11
      MAXTTL=LMTTTL+1
   12 MAXTTL=MAXTTL-1
      IF(MAXTTL.LE.0)GO TO 13
      IF(LTRTTL(MAXTTL).EQ.LTRSPA)GO TO 12
      IF(MINTTL.LT.MAXTTL)GO TO 14
      IF(LTRTTL(MINTTL).NE.LTRQUE)GO TO 14
      CALL SPLHLP(ITTY,4)
      GO TO 8
   13 MINTTL=1
      MAXTTL=0
   14 CONTINUE
C
C     ASK IF INCLUDE LINES STARTING WITH AT SIGN AND X
   15 WRITE(ITTY,16)
   16 FORMAT(' Include lines to be merged into body of le',
     1'tter (Y or N)? ',$)
      CALL ANSWER(JTTY,KIND,LETTER,IVALUE,AVALUE)
      GO TO(15,18,18,17,18,18,20,17),KIND
   17 ISINGL=-1
      IF(LETTER.EQ.25)ISINGL=1
      IF(LETTER.EQ.14)ISINGL=0
      IF(ISINGL.GE.0)GO TO 21
   18 WRITE(ITTY,19)
   19 FORMAT(' Unknown response')
   20 CALL SPLHLP(ITTY,5)
      GO TO 15
   21 CONTINUE
C
C     OPEN INPUT FILE
   22 WRITE(ITTY,23)
   23 FORMAT(' Input address file? ',$)
      ISTORE=1
      IWRITE=0
      CALL FILOPN(ISTORE,IDISK,ITTY,JTTY,IWRITE,IFOPEN)
      IF(IFOPEN.LT.0)GO TO 22
      IF(IFOPEN.EQ.0)GO TO 148
C
C     ASK USER TO SPECIFY UNIQUE PHRASE IN FIRST LABEL
   24 WRITE(ITTY,25)
   25 FORMAT(' Word or phrase unique to first address? ',$)
      READ(JTTY,26)LTRNXT
   26 FORMAT(40A1)
      MINNXT=0
      MAXNXT=0
   27 MINNXT=MINNXT+1
      IF(MINNXT.GT.LMTNXT)GO TO 34
      IF(LTRNXT(MINNXT).EQ.LTRSPA)GO TO 27
      MAXNXT=LMTNXT+1
   28 MAXNXT=MAXNXT-1
      IF(LTRNXT(MAXNXT).EQ.LTRSPA)GO TO 28
      IF(MINNXT.EQ.MAXNXT)GO TO 33
      DO 32 I=MINNXT,MAXNXT
      LTRNOW=LTRNXT(I)
      LWRNXT(I)=LTRNOW
      DO 31 J=1,26
      IF(LTRNOW.EQ.LTRABC(J))GO TO 29
      IF(LTRNOW.EQ.LWRABC(J))GO TO 30
      GO TO 31
   29 LWRNXT(I)=LWRABC(J)
      GO TO 32
   30 LTRNXT(I)=LTRABC(J)
      GO TO 32
   31 CONTINUE
   32 CONTINUE
      GO TO 34
   33 CALL SPLHLP(ITTY,2)
      GO TO 24
   34 CONTINUE
C
C     *******************************
C     *                             *
C     *  PREPARE FOR FIRST ADDRESS  *
C     *                             *
C     *******************************
C
      KNTADR=0
      IEOF=0
      KNTINP=0
      INFORM=1
      IAUTHR=-1
      KNTOUT=0
      KNTSAL=0
C
C     *************************************
C     *                                   *
C     *  READ NEXT ADDRESS IN DOT FORMAT  *
C     *                                   *
C     *************************************
C
C     GET THE NEXT ADDRESS
   35 IF(IAUTHR.GT.0)GO TO 54
      KNTLIN=0
      KNTCHR=0
      KNTSKP=0
      GO TO 37
   36 IF(KNTLIN.NE.0)KNTSKP=KNTSKP+1
   37 IF(IEOF.NE.0)GO TO 135
      READ(IDISK,38,END=45)LTRBFR
   38 FORMAT(72A1)
      KNTINP=KNTINP+1
      IF(IAUTHR.EQ.0)GO TO 39
      IF(LTRBFR(1).EQ.LTRATS)GO TO 53
      IAUTHR=0
C
C     STORE THE LINE IF NOT A DOT COMMAND
   39 MAXPRT=LMTBFR+1
   40 MAXPRT=MAXPRT-1
      IF(MAXPRT.LE.0)GO TO 36
      IF(LTRBFR(MAXPRT).EQ.LTRSPA)GO TO 40
      IF(LTRBFR(1).EQ.LTRDOT)GO TO 46
      IF(KNTLIN.GE.LMTLIN)GO TO 37
   41 IF(KNTSKP.LE.0)GO TO 42
      KNTSKP=KNTSKP-1
      KNTLIN=KNTLIN+1
      LNGLIN(KNTLIN)=0
      IF(KNTLIN.GE.LMTLIN)GO TO 37
      GO TO 41
   42 I=0
   43 IF(I.GE.MAXPRT)GO TO 44
      IF(KNTCHR.GE.LMTCHR)GO TO 44
      I=I+1
      KNTCHR=KNTCHR+1
      LTRADR(KNTCHR)=LTRBFR(I)
      GO TO 43
   44 KNTLIN=KNTLIN+1
      LNGLIN(KNTLIN)=I
      GO TO 37
C
C     END OF ADDRESS FOUND
   45 IEOF=1
   46 IF(KNTLIN.LE.0)GO TO 35
      KNTADR=KNTADR+1
C
C     *******************************************
C     *                                         *
C     *  CHECK IF ADDRESS ENDS WITH SALUTATION  *
C     *                                         *
C     *******************************************
C
      KNTADD=0
      IF(LTRADR(KNTCHR).EQ.LTRCOL)GO TO 47
      IF(LTRADR(KNTCHR).EQ.LTRCOM)GO TO 47
      GO TO 51
   47 MINTST=KNTCHR-LNGLIN(KNTLIN)
      DO 48 I=1,LMTDER
      MINTST=MINTST+1
      IF(MINTST.GT.KNTCHR)GO TO 51
      IF(LTRADR(MINTST).EQ.LTRDER(I))GO TO 48
      IF(LTRADR(MINTST).EQ.LWRDER(I))GO TO 48
      GO TO 51
   48 CONTINUE
      IF(IFDEAR.NE.0)GO TO 50
      KNTCHR=KNTCHR-LNGLIN(KNTLIN)
   49 KNTLIN=KNTLIN-1
      IF(KNTLIN.LE.0)GO TO 50
      IF(LNGLIN(KNTLIN).EQ.0)GO TO 49
   50 IF(IFDEAR.EQ.1)LTRADR(KNTCHR)=LTRCOL
      IF(IFDEAR.EQ.2)LTRADR(KNTCHR)=LTRCOM
      GO TO 52
   51 IF(IFDEAR.EQ.0)GO TO 52
      KNTADD=1
   52 CONTINUE
      GO TO 55
C
C     *****************************************
C     *                                       *
C     *  READ NEXT ADDRESS IN AT SIGN FORMAT  *
C     *                                       *
C     *****************************************
C
C     MARK THAT FILE IS IN AT SIGN FORMAT
   53 IAUTHR=1
      KNTINP=-2
C
C     GET NEXT ADDRESS
   54 CALL GETADR(ITTY,IDISK,LMTKND,LMTSEC,
     1LTRKND,ISTART,ICHAIN,LENGTH,LTRSTR,KNTINP,LOCATN,
     2LMTSTR,INFORM,LTRBFR,LMTBFR)
      IF(KNTINP.EQ.0)GO TO 135
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 35
      KNTADR=KNTADR+1
C
C     *************************************************
C     *                                               *
C     *  CHECK IF PHRASE TYPED BY USER IS IN ADDRESS  *
C     *                                               *
C     *************************************************
C
C     CHECK IF THIS ADDRESS HAS BEEN SPECIFIED BY USER
   55 IF(KNTLIN.LE.0)GO TO 35
      IF(MAXNXT.LE.0)GO TO 66
      MAXTST=0
      DO 65 LINE=1,KNTLIN
      MINTST=MAXTST+1
      MAXTST=MAXTST+LNGLIN(LINE)
      IF(MINTST.GT.MAXTST)GO TO 65
      DO 64 KOLUMN=MINTST,MAXTST
      MATCH=KOLUMN
      IF(KOLUMN.EQ.MINTST)GO TO 57
      IF(LTRADR(KOLUMN).EQ.LTRSPA)GO TO 56
      IF(LTRADR(KOLUMN).EQ.LTRCOM)GO TO 56
      GO TO 64
   56 MATCH=KOLUMN+1
   57 INNER=MINNXT
   58 IF(MATCH.GT.MAXTST)GO TO 65
      IF(LTRADR(MATCH).NE.LTRSPA)GO TO 59
      IF(LTRNXT(INNER).NE.LTRSPA)GO TO 64
      MATCH=MATCH+1
      GO TO 58
   59 IF(LTRNXT(INNER).NE.LTRSPA)GO TO 60
      IF(INNER.GE.MAXNXT)GO TO 60
      INNER=INNER+1
      GO TO 59
   60 IF(LTRADR(MATCH).EQ.LTRNXT(INNER))GO TO 61
      IF(LTRADR(MATCH).EQ.LWRNXT(INNER))GO TO 61
      GO TO 64
   61 INNER=INNER+1
      MATCH=MATCH+1
      IF(INNER.LE.MAXNXT)GO TO 58
      IF(MATCH.GT.MAXTST)GO TO 66
      LTRNOW=LTRADR(MATCH)
      IF(LTRNOW.EQ.LTRSPA)GO TO 66
      IF(LTRNOW.EQ.LTRCOM)GO TO 66
      DO 62 I=1,26
      IF(LTRNOW.EQ.LTRABC(I))GO TO 64
      IF(LTRNOW.EQ.LWRABC(I))GO TO 64
   62 CONTINUE
      DO 63 I=1,10
      IF(LTRNOW.EQ.LTRDGT(I))GO TO 64
   63 CONTINUE
      GO TO 66
   64 CONTINUE
   65 CONTINUE
      GO TO 35
   66 MINNXT=1
      MAXNXT=0
C
C     *******************************************
C     *                                         *
C     *  WRITE THE NEXT ADDRESS TO OUTPUT FILE  *
C     *                                         *
C     *******************************************
C
      IF(KNTROW.GT.0)GO TO 73
      IF(KNTROW.LT.0)GO TO 71
C
C     OPEN OUTPUT FILE
   67 WRITE(ITTY,68)
   68 FORMAT(' Output splice file? ',$)
      ISTORE=2
      IWRITE=1
      CALL FILOPN(ISTORE,JDISK,ITTY,JTTY,IWRITE,IFOPEN)
      IF(IFOPEN.LT.0)GO TO 67
      IF(IFOPEN.GT.0)GO TO 70
      WRITE(ITTY,69)
   69 FORMAT(' File must be specified')
      GO TO 67
   70 CONTINUE
      GO TO 73
C
C     CONTINUE PREVIOUS OUTPUT FILE
   71 KNTROW=-KNTROW
      WRITE(ITTY,72)
   72 FORMAT(' Continuing output file')
C
C     PREPARE TO WRITE ADDRESS
   73 KNTROW=KNTROW+1
      KNTOUT=KNTOUT+1
      WRITE(JDISK,74)
   74 FORMAT('.LITERAL')
C
C     WRITE INSIDE ADDRESS
      MAXCHR=0
      DO 77 LINE=1,KNTLIN
      MINCHR=MAXCHR+1
      MAXCHR=MAXCHR+LNGLIN(LINE)
      IF(MINCHR.GT.MAXCHR)WRITE(JDISK,75)
   75 FORMAT(1X)
      IF(MINCHR.LE.MAXCHR)WRITE(JDISK,76)(LTRADR(I),I=MINCHR,MAXCHR)
   76 FORMAT(100A1)
   77 CONTINUE
C
C     WRITE SALUTATION SALUTATION SPECIFIED FOR AT SIGN ADDRESS
      IF(IFDEAR.EQ.0)GO TO 130
      IF(IAUTHR.LE.0)GO TO 80
      IPOINT=7
      IPOINT=ISTART(IPOINT)
      IF(IPOINT.EQ.0)GO TO 110
      IF(LENGTH(IPOINT).EQ.0)GO TO 110
      J=LOCATN(IPOINT)
      K=J+LENGTH(IPOINT)-1
      WRITE(JDISK,78)
   78 FORMAT(1X)
      IF(IFDEAR.EQ.1)WRITE(JDISK,79)LTRSPA,(LTRSTR(I),I=J,K),LTRCOL
      IF(IFDEAR.EQ.2)WRITE(JDISK,79)LTRSPA,(LTRSTR(I),I=J,K),LTRCOM
   79 FORMAT('Dear',100A1)
      GO TO 130
C
C     *************************************************
C     *                                               *
C     *  CONSTRUCT SALUTATION FOR DOT FORMAT ADDRESS  *
C     *                                               *
C     *************************************************
C
C     PREPARE TO ADD SALUTATION
   80 IF(KNTADD.EQ.0)GO TO 130
      KNTSAL=KNTSAL+1
      MAXBFR=0
      IF(LNGLIN(1).EQ.0)GO TO 109
      MINTST=1
      MAXTST=LNGLIN(1)
C
C     SEARCH FOR END OF LINE OR TERMINATING COMMA
   81 IF(MINTST.GT.MAXTST)GO TO 109
      IF(LTRADR(MINTST).NE.LTRSPA)GO TO 82
      MINTST=MINTST+1
      GO TO 81
   82 I=MINTST
   83 IF(I.GT.MAXTST)GO TO 85
      IF(LTRADR(I).EQ.LTRCOM)GO TO 84
      I=I+1
      GO TO 83
   84 MAXTST=I-1
   85 IF(MINTST.GT.MAXTST)GO TO 109
      IF(LTRADR(MAXTST).NE.LTRSPA)GO TO 86
      MAXTST=MAXTST-1
      GO TO 85
   86 CONTINUE
C
C     SEARCH FOR PREFIX
      IBEGIN=MINTST
      IEND=IBEGIN-1
   87 IEND=IEND+1
      IF(IEND.GT.MAXTST)GO TO 88
      IF(LTRADR(IEND).EQ.LTRSPA)GO TO 88
      IF(LTRADR(IEND).NE.LTRDOT)GO TO 87
      IF(IBEGIN.GE.(IEND-1))GO TO 88
      MINTST=IEND+1
      GO TO 89
   88 IEND=IBEGIN-1
   89 CONTINUE
C
C     SEARCH FOR PERSON'S LAST NAME
      JEND=MAXTST
      JBEGIN=JEND+1
   90 IF(JBEGIN.LE.MINTST)GO TO 92
      JBEGIN=JBEGIN-1
      IF(LTRADR(JBEGIN).EQ.LTRDOT)GO TO 91
      IF(LTRADR(JBEGIN).EQ.LTRSPA)GO TO 91
      GO TO 90
   91 JBEGIN=JBEGIN+1
   92 MAXTST=JBEGIN-1
C
C     SEARCH FOR PERSON'S FIRST NAME
      LONGER=0
      KBEGIN=MINTST
      KEND=KBEGIN-1
      LBEGIN=MINTST-1
   93 IF(LBEGIN.GE.MAXTST)GO TO 99
      LBEGIN=LBEGIN+1
      IF(LTRADR(LBEGIN).EQ.LTRSPA)GO TO 93
      LEND=LBEGIN-1
   94 IF(LEND.GE.MAXTST)GO TO 96
      LEND=LEND+1
      IF(LTRADR(LEND).EQ.LTRDOT)GO TO 97
      IF(LTRADR(LEND).EQ.LTRSPA)GO TO 95
      GO TO 94
   95 LEND=LEND-1
   96 KOMPAR=LEND-LBEGIN+1
      GO TO 98
   97 KOMPAR=LEND-LBEGIN
   98 IF(KOMPAR.LE.LONGER)GO TO 93
      LONGER=KOMPAR
      KBEGIN=LBEGIN
      KEND=LEND
      IF(LONGER.EQ.1)GO TO 93
   99 CONTINUE
C
C     DETERMINE WHICH PREFIX IS TO BE INSERTED
      IF(IFDEAR.EQ.1)GO TO 100
      IF(KBEGIN.LE.KEND)GO TO 104
      IF(IBEGIN.LE.IEND)GO TO 102
      GO TO 104
  100 IF(IBEGIN.LE.IEND)GO TO 102
      IF(MAXTTL.LE.0)GO TO 104
C
C     INSERT DEFAULT PREFIX
      IF(MAXBFR.GE.LMTBFR)GO TO 108
      MAXBFR=MAXBFR+1
      LTRBFR(MAXBFR)=LTRSPA
      DO 101 I=MINTTL,MAXTTL
      IF(MAXBFR.GE.LMTBFR)GO TO 108
      MAXBFR=MAXBFR+1
      LTRBFR(MAXBFR)=LTRTTL(I)
  101 CONTINUE
      GO TO 104
C
C     INSERT PREFIX FROM INPUT FILE
  102 IF(MAXBFR.GE.LMTBFR)GO TO 108
      MAXBFR=MAXBFR+1
      LTRBFR(MAXBFR)=LTRSPA
      DO 103 I=IBEGIN,IEND
      IF(MAXBFR.GE.LMTBFR)GO TO 108
      MAXBFR=MAXBFR+1
      LTRBFR(MAXBFR)=LTRADR(I)
  103 CONTINUE
  104 CONTINUE
C
C     PREPARE TO INSERT EITHER FIRST OR LAST NAME
      IF(IFDEAR.EQ.1)GO TO 105
      IF(KBEGIN.GT.KEND)GO TO 105
      JBEGIN=KBEGIN
      JEND=KEND
  105 CONTINUE
C
C     INSERT PERSON'S NAME
      IF(JBEGIN.GT.JEND)GO TO 107
      IF(MAXBFR.GE.LMTBFR)GO TO 108
      MAXBFR=MAXBFR+1
      LTRBFR(MAXBFR)=LTRSPA
      DO 106 I=JBEGIN,JEND
      IF(MAXBFR.GE.LMTBFR)GO TO 108
      MAXBFR=MAXBFR+1
      LTRBFR(MAXBFR)=LTRADR(I)
  106 CONTINUE
  107 CONTINUE
C
C     INSERT TERMINAL PUNCTUATION MARK
      IF(MAXBFR.GE.LMTBFR)GO TO 108
      MAXBFR=MAXBFR+1
      IF(IFDEAR.EQ.1)LTRBFR(MAXBFR)=LTRCOL
      IF(IFDEAR.EQ.2)LTRBFR(MAXBFR)=LTRCOM
  108 WRITE(JDISK,78)
      WRITE(JDISK,79)(LTRBFR(I),I=1,MAXBFR)
  109 CONTINUE
      GO TO 130
C
C     **********************************************
C     *                                            *
C     *  CONSTRUCT SALUTATION FOR AT SIGN ADDRESS  *
C     *                                            *
C     **********************************************
C
  110 KNTSAL=KNTSAL+1
      MAXBFR=0
C
C     NAME PREFIX
      IPOINT=16
      IPOINT=ISTART(IPOINT)
      IBEGIN=1
      IEND=0
      IF(IPOINT.EQ.0)GO TO 111
      IF(LENGTH(IPOINT).EQ.0)GO TO 111
      IBEGIN=LOCATN(IPOINT)
      IEND=IBEGIN+LENGTH(IPOINT)-1
C
C     FIRST NAME
  111 IPOINT=6
      IPOINT=ISTART(IPOINT)
      KBEGIN=1
      KEND=0
      IF(IPOINT.EQ.0)GO TO 112
      IF(LENGTH(IPOINT).EQ.0)GO TO 112
      KBEGIN=LOCATN(IPOINT)
      KEND=KBEGIN+LENGTH(IPOINT)-1
C
C     MIDLE NAME
  112 IPOINT=13
      IPOINT=ISTART(IPOINT)
      LBEGIN=1
      LEND=0
      IF(IPOINT.EQ.0)GO TO 113
      IF(LENGTH(IPOINT).EQ.0)GO TO 113
      LBEGIN=LOCATN(IPOINT)
      LEND=LBEGIN+LENGTH(IPOINT)-1
C
C     LAST NAME
  113 IPOINT=12
      IPOINT=ISTART(IPOINT)
      JBEGIN=1
      JEND=0
      IF(IPOINT.EQ.0)GO TO 114
      IF(LENGTH(IPOINT).EQ.0)GO TO 114
      JBEGIN=LOCATN(IPOINT)
      JEND=JBEGIN+LENGTH(IPOINT)-1
C
C     DECIDE IF USE FIRST OR MIDDLE NAME
  114 IF(KBEGIN.LE.KEND)GO TO 115
      IF(LBEGIN.LE.LEND)GO TO 115
      GO TO 118
  115 K=KEND-KBEGIN
      L=LEND-LBEGIN
      IF(K.LT.0)GO TO 116
      IF(LTRSTR(KEND).EQ.LTRDOT)K=K-1
  116 IF(L.LT.0)GO TO 117
      IF(LTRSTR(LEND).EQ.LTRDOT)L=L-1
  117 IF(K.GT.L)GO TO 118
      KBEGIN=LBEGIN
      KEND=LEND
  118 CONTINUE
C
C     DECIDE IF USE FIRST OR LAST NAME
      IF(IFDEAR.EQ.1)GO TO 119
      IF(KBEGIN.GT.KEND)GO TO 119
      JBEGIN=KBEGIN
      JEND=KEND
  119 CONTINUE
C
C     DETERMINE WHICH PREFIX IS TO BE INSERTED
      IF(IFDEAR.EQ.1)GO TO 120
      IF(KBEGIN.LE.KEND)GO TO 124
      IF(IBEGIN.LE.IEND)GO TO 122
      GO TO 124
  120 IF(IBEGIN.LE.IEND)GO TO 122
      IF(MAXTTL.LE.0)GO TO 124
C
C     INSERT DEFAULT PREFIX
      IF(MAXBFR.GE.LMTBFR)GO TO 128
      MAXBFR=MAXBFR+1
      LTRBFR(MAXBFR)=LTRSPA
      DO 121 I=1,MAXTTL
      IF(MAXBFR.GE.LMTBFR)GO TO 128
      MAXBFR=MAXBFR+1
      LTRBFR(MAXBFR)=LTRTTL(I)
  121 CONTINUE
      GO TO 124
C
C     INSERT PREFIX FROM INPUT FILE
  122 IF(MAXBFR.GE.LMTBFR)GO TO 128
      MAXBFR=MAXBFR+1
      LTRBFR(MAXBFR)=LTRSPA
      DO 123 I=IBEGIN,IEND
      IF(MAXBFR.GE.LMTBFR)GO TO 128
      MAXBFR=MAXBFR+1
      LTRBFR(MAXBFR)=LTRSTR(I)
  123 CONTINUE
  124 CONTINUE
C
C     PREPARE TO INSERT EITHER FIRST OR LAST NAME
      IF(IFDEAR.EQ.1)GO TO 125
      IF(KBEGIN.GT.KEND)GO TO 125
      JBEGIN=KBEGIN
      JEND=KEND
  125 CONTINUE
C
C     INSERT PERSON'S NAME
      IF(JBEGIN.GT.JEND)GO TO 127
      IF(MAXBFR.GE.LMTBFR)GO TO 128
      MAXBFR=MAXBFR+1
      LTRBFR(MAXBFR)=LTRSPA
      DO 126 I=JBEGIN,JEND
      IF(MAXBFR.GE.LMTBFR)GO TO 128
      MAXBFR=MAXBFR+1
      LTRBFR(MAXBFR)=LTRSTR(I)
  126 CONTINUE
  127 CONTINUE
C
C     INSERT TERMINAL PUNCTUATION MARK
      IF(MAXBFR.GE.LMTBFR)GO TO 128
      MAXBFR=MAXBFR+1
      IF(IFDEAR.EQ.1)LTRBFR(MAXBFR)=LTRCOL
      IF(IFDEAR.EQ.2)LTRBFR(MAXBFR)=LTRCOM
      GO TO 129
  128 CONTINUE
  129 WRITE(JDISK,78)
      WRITE(JDISK,79)(LTRBFR(I),I=1,MAXBFR)
C
C     *********************************************
C     *                                           *
C     *  DONE WITH INSIDE ADDRESS AND SALUTATION  *
C     *                                           *
C     *********************************************
C
  130 WRITE(JDISK,131)
  131 FORMAT('.END LITERAL.END SPLICE')
C
C     WRITE SINGLE LINES MERGED BY .SPLICE 1 IN FORM LETTER
      IF(IAUTHR.LE.0)GO TO 134
      IF(ISINGL.LE.0)GO TO 134
      IPOINT=24
      IPOINT=ISTART(IPOINT)
      GO TO 133
  132 IPOINT=ICHAIN(IPOINT)
  133 IF(IPOINT.EQ.0)GO TO 134
      IF(LENGTH(IPOINT).EQ.0)GO TO 132
      J=LOCATN(IPOINT)
      K=J+LENGTH(IPOINT)-1
      WRITE(JDISK,76)(LTRSTR(I),I=J,K)
      GO TO 132
  134 CONTINUE
      GO TO 35
C
C     *****************************************
C     *                                       *
C     *  ALL DONE PROCESSING THIS INPUT FILE  *
C     *                                       *
C     *****************************************
C
C     REPORT IF COULD NOT LOCATE SPECIFIC PERSON
  135 IF(MINNXT.GT.MAXNXT)GO TO 137
      WRITE(ITTY,136)(LTRNXT(I),I=MINNXT,MAXNXT)
  136 FORMAT(' Could not locate ',40A1)
  137 CONTINUE
C
C     REPORT HOW MANY ADDRESSES WERE COPIED
      IF(KNTADR.EQ.0)WRITE(ITTY,138)
  138 FORMAT('    Number of addresses read:  NONE')
      IF(KNTADR.GT.0)WRITE(ITTY,139)KNTADR
  139 FORMAT('    Number of addresses read:',1I6)
      IF(KNTOUT.GT.0)GO TO 141
      WRITE(ITTY,140)
  140 FORMAT('  Number of addresses copied:  NONE')
      GO TO 144
  141 IF(KNTOUT.LT.KNTADR)WRITE(ITTY,142)KNTOUT
  142 FORMAT('  Number of addresses copied:',1I6)
      IF(KNTOUT.EQ.KNTADR)WRITE(ITTY,143)
  143 FORMAT('  Number of addresses copied:   ALL')
  144 IF(KNTSAL.GT.0)WRITE(ITTY,145)KNTSAL
  145 FORMAT(' Number of added Salutations:',1I6)
C
C     ADJUST COUNTS THAT ACCUMULATE DURING ENTIRE RUN
      KNTONE=KNTONE+KNTADR
      KNTTWO=KNTTWO+KNTOUT
      KNTTHR=KNTTHR+KNTSAL
C
C     CLOSE THE INPUT FILE
      ISTORE=1
      CALL FILEND(ISTORE,IDISK)
C
C     CLOSE AND REOPEN OUTPUT FILE IN APPEND MODE
      IF(KNTROW.LE.0)GO TO 147
      ISTORE=2
      CALL FILCUT(ISTORE,JDISK)
      IF(KNTOUT.LT.KNTROW)WRITE(ITTY,146)KNTROW
  146 FORMAT('  Number of addresses copied:',1I6,' (total)')
      KNTROW=-KNTROW
  147 CONTINUE
C
C     ASK USER IF ADDITIONAL LABELS ARE TO BE PROCESSED
  148 WRITE(ITTY,149)
  149 FORMAT(' Process additional addresses (Y or N)? ',$)
      CALL ANSWER(JTTY,KIND,LETTER,IVALUE,AVALUE)
      GO TO(148,151,151,150,151,151,152,150),KIND
  150 IF(LETTER.EQ.25)GO TO 22
      IF(LETTER.EQ.14)GO TO 153
  151 WRITE(ITTY,19)
  152 CALL SPLHLP(ITTY,6)
      GO TO 148
C
C     ALL DONE WITH ALL ADDRESSES
  153 IF(KNTROW.EQ.0)GO TO 154
      ISTORE=2
      CALL FILEND(ISTORE,JDISK)
  154 GO TO 155
C
C     REPORT HOW MANY ADDRESSES WERE COPIED
  155 IF(KNTONE.EQ.0)WRITE(ITTY,156)
  156 FORMAT('    Number of addresses read:  NONE')
      IF(KNTONE.GT.0)WRITE(ITTY,157)KNTONE
  157 FORMAT('    Number of addresses read:',1I6)
      IF(KNTTWO.GT.0)GO TO 159
      WRITE(ITTY,158)
  158 FORMAT('  Number of addresses copied:  NONE')
      GO TO 162
  159 IF(KNTTWO.LT.KNTONE)WRITE(ITTY,160)KNTTWO
  160 FORMAT('  Number of addresses copied:',1I6)
      IF(KNTTWO.EQ.KNTONE)WRITE(ITTY,161)
  161 FORMAT('  Number of addresses copied:   ALL')
  162 IF(KNTTHR.GT.0)WRITE(ITTY,163)KNTTHR
  163 FORMAT(' Number of added Salutations:',1I6)
C
C     ALL DONE WITH ALL ADDRESSES
C     LEAVE ROUTINE EXITS WITHOUT TIME STAMP
      CALL LEAVE
      STOP
      END
      SUBROUTINE SPLHLP(ITTY,MESAGE)
C     RENBR(/HELP MESSAGES FOR SPLICE 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     IDENTIFY PROGRAM
      IF(MESAGE.EQ. 1)WRITE(ITTY,1)
    1 FORMAT(' SPLICE (05/83)'/' Reads an address file in',
     1' which each line starts with an at sign (@) or in ',
     2' which'/' addresses  are  separated by lines start',
     3'ing with periods.  Produces a file which'/' FROFF ',
     4'can use to insert addresses into letters.'/)
C
C     WORD OR PHRASE IN FIRST ADDRESS
      IF(MESAGE.EQ. 2)WRITE(ITTY,2)
    2 FORMAT(' Type a word or a phrase which will be foun',
     1'd first in the first address which  is'/' to  be  ',
     2'included  in  the  output file.  Addresses which a',
     3'ppear 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. 2)WRITE(ITTY,3)
    3 FORMAT(' through Z are ignored.  If the input file ',
     1'is in at sign format, then the word or'/' phrase, ',
     2'in order to  be  matched,  must  appear  in  the  ',
     3'address,  not  in  the'/' salutation  or  in an ex',
     4'tra line after the salutation which is to be merge',
     5'd into'/' the body of the letter.'//' Merely press',
     6' the RETURN key to start with the first address.')
C
C     PERSONAL OR BUSINESS SALUTATION
      IF(MESAGE.EQ. 3)WRITE(ITTY,4)
    4 FORMAT(' The answer to this question determines whe',
     1'ther a colon  or  a  comma  is  to  be'/' attached',
     2'  to  the  right  end  of  each  salutation.  If t',
     3'he input file does not'/' specify a salutation for',
     4' a particular address, then the answer to this  qu',
     5'estion'/' also specifies whether the person''s fir',
     6'st name or last name is to be used in the'/' salut',
     7'ation.   Salutations  which  are  constructed  in ',
     8' this  manner  should  be'/' carefully verified by',
     9' the user.'//' Type one of the following letters')
      IF(MESAGE.EQ. 3)WRITE(ITTY,5)
    5 FORMAT(' B  (for Business) to place a colon at the ',
     1' right  end  of  each  salutation.   A'/4X,'saluta',
     2'tion  will be constructed using the person''s last',
     3' name for each address'/4X,'for which a salutation',
     4' is not defined by the input file.'/' P  (for Pers',
     5'onal) to place a comma at the  right  end  of  eac',
     6'h  salutation.   A'/4X,'salutation will be constru',
     7'cted using the person''s first name for each addre',
     8'ss'/4X,'for which a salutation is not defined by t',
     9'he input file.')
      IF(MESAGE.EQ. 3)WRITE(ITTY,6)
    6 FORMAT(' N  (for  No)  if  no  salutations  are  to',
     1'  be  copied  into  the  output  file.'/4X,'Saluta',
     2'tions  will  not be copied even if salutations are',
     3' defined by the input'/4X,'file.  Salutations will',
     4' not be constructed  for  those  addresses  for  w',
     5'hich'/4X,'salutations are not defined by the input',
     6' file.')
C
C     DEFAULT TITLE
      IF(MESAGE.EQ. 4)WRITE(ITTY,7)
    7 FORMAT(' You can specify a title such as Professor ',
     1'or Doctor or Dr. which is to  be  used'/' in  cons',
     2'tructing the salutation for each address which doe',
     3's not already end with'/' a salutation.  Such a sa',
     4'lutation would be constructed from  the  informati',
     5'on  in'/' the  first  line  of the address.  If th',
     6'e first line starts with an abbreviation'/' such a',
     7's Ms. or Mr. which ends with a period, then this a',
     8'bbreviation will be used'/' instead of the title w',
     9'hich you specify here.'/)
      IF(MESAGE.EQ. 4)WRITE(ITTY,8)
    8 FORMAT(' Merely press the RETURN key if all of the ',
     1'addresses already contain  salutations'/' or if a ',
     2'default title is not to be included in salutations',
     3' which are constructed'/' by this program.')
C
C     INCLUDE INSERTION INTO BODY OF LETTER
      IF(MESAGE.EQ. 5)WRITE(ITTY,9)
    9 FORMAT(' If the input file specifies the components',
     1' of the addresses, then  the  contents'/' of  line',
     2's  which  start  with  an  @X  character  pair  ca',
     3'n  be copied after the'/' salutation for insertion',
     4' into the body of the letter.'//' Type'/' Y  if li',
     5'nes starting with an @X character pair are to be c',
     6'opied into the  output'/4X,'file after the .END SP',
     7'LICE command'/' N  if lines starting with an @X ch',
     8'aracter pair are not to  be  copied  into  the'/4X,
     9'output file'/)
      IF(MESAGE.EQ. 5)WRITE(ITTY,10)
   10 FORMAT(' This question must still be answered, but ',
     1'the answer is  ignored,  even  if  the'/' input  f',
     2'ile  specifies  previously  formatted addresses se',
     3'parated by lines which'/' start with periods.')
C
C     ASK IF MORE ADDRESSES ARE TO BE PROCESSED
      IF(MESAGE.EQ. 6)WRITE(ITTY,11)
   11 FORMAT(' Type'/' Y  to append additional addresses ',
     1'to current output file'/' N  to terminate construc',
     2'tion of current output file')
      RETURN
      END