Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0169/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