


{  16/3/87 09:27   newletts}

%begin

%include "sm:consts.inc"
%include "sm:persons.inc"
%include "sm:utils.inc"
! If APM.
%include "inc:fs.imp"
%include "inc:fsutil.imp"
%include "inc:util.imp"
%include "inc:dict.imp"
%include "ie:ie.inc"
%externalroutinespec reset terminal %alias "IE_RESET_TERMINAL"
%externalroutinespec run program(%string(255) file)
%include "inc:run.imp"
%externalroutinespec set up terminal %alias "IE_SET_UP_TERMINAL"
%integer start line,start position
%externalbytespec Terminal Model %alias "IE_TT_MODEL"
%constinteger WY 75=6
!

%recordformat addresseef(%record(addresseef)%name next,prev,
%record(personf) b,
%string(31) dear,
%string(80) name,
%string(31) yours,yourrefce)
%recordformat addresseelistf(%record(addresseef)%name head,tail)
%integer addresseeno
%record(addresseelistf) addressees
%record(personlistf) bcc
%record(personlistf) cc
%constreal chperinch=12     ;!  Characters per inch for font Times10.
{!  If Vax.}
{%ownstring(63) command      ;!  Name of command file to be created.}
!
%integer control
%integer controlp           ;!  Stream bearing heading and details of sender.
{!  If Vax.}
{%conststring(31) defaulthead="U0:[sm.head]department.lay"}
{%recordformat df(%integer l, a)}
{%record(df) d}
{%externalroutinespec spawn %alias "LIB$SPAWN"(%record(df)%name d)}
{%externalstring(255)%fnspec translate(%string(*)%name s)}
!
!  If APM.
%conststring(31) defaulthead="office:department"
!
%integer create labels
%record(line80listf) editors
%conststring(255) edmess= %c
"Only VECCE and IE are currently known to Letters.
Please assign one of these to LETTER_EDITOR in your login.com file."
%string(15) edt
%string(63) email
%string(255) enc
!  If APM.
%externalpredicatespec exists(%string(255) s)
!
%string(255) ext
%string(7) flcpy
%integerarray first time(0:31)
%record(line80listf) heading
%owninteger horizlabels=2    ;!  Maximum number of labels across the page.
%constreal indent=0.2        ;!  Left-hand margin on each label in inches.
%constreal labeldepth=1.575  ;!  Depth of a label in inches.
%string(31) labels
%conststring(13) lett="letters_"
%integerarray m(0:31)
%integer labelstolaser
%constreal labelwidth=3.741  ;!  Width of a label in inches.
%constreal left=0.342        ;!  Margin at left of page of labels.
%constreal leftmargin=0.2    ;!  Margin at left of a label.
%string(31) letterhead
%string(31) letters
%ownreal linewidth
%constreal linesperinch=6    ;!  Lines per inch for Times10.
%integer menu
%constinteger menu0=16_ff0dfe00    ;!  Initial menu.
%constinteger menu1=16_ff15fe00    ;!  Menu for changes.
%constinteger menu2=16_83e40000    ;!  Menu for addressees.
%string(31) myrefce
!  If APM.
%conststring(15) namelist="sm:persdata"
!
{!  If Vax.}
{%conststring(31) namelist="u0:[sm.office]persdata.imp"}
!
%integer newrun
%record(line80listf) nillist
%string(255) outname
%record(line80f)%name p
%ownreal printdepth
%ownstring(15) printer
%ownrecord(line80listf) printerlist
%ownstring(255) printmess= %c
"Newletts knows about  lp2 and lp3. Please assign one of these
to LETTERS_PRINTER."
%record(line80listf) star
%record(line80listf) sent by
%integer stage
%string(15) telephone number
%string(31) telex
%integer tolaser
%constreal top=0.342         ;!  Margin at top of page of labels.
%constreal topmargin=0.2     ;!  Margin at top of label.
%string(31)%array val(0:31)
%ownstring(19)%array var(0:31)=
"quit menu",            {0}
"heading",              {1}
"telex",                {2}
"telephone_number",     {3}
"extension",            {4}
"email",                {5}
"my_reference",         {6}
"addressees",           {7}
"name",                 {8}
"address",              {9}
"dear",                 {10}
"your_reference",       {11}
"editor",               {12}
"letter_file",          {13}
"yours",                {14}
"sent_by",              {15}
"cc",                   {16}
"bcc",                  {17}
"enclosure",            {18}
"file_copy",            {19}
"print_letters",        {20}
"create_labels",        {21}
"print_labels",         {22}
"printer",               {23}
"",                     {24}
"",                     {25}
"",                     {26}
"",                     {27}
"",                     {28}
"",                     {29}
"",                     {30}
""                      {31}
%string(31)%array value(0:31)
{!  If Vax.}
{%externalstring(12)%fnspec username}
!
%owninteger vertlabels=7     ;!  Maximum number of labels down the page.
%string(255) x,y
%record(line80listf) yesnostar
%string(80) yesnomess= %c
"Only  y  and  n  and  *  and  .end  are legitimate responses."
%string(63) yours

{!  If Vax.}
! This was found in CS_STAFF[AJS]tview.imp

%routine h(%string(255) topic)
!  If APM.
%include "inc:vtlib.imp"
!
{!  If Vax.}
{%include "U0:[HMD]VTI"}
!
%externalroutinespec view(%string(255) file,topic)
  define video(-1)
  set video mode(screen mode)
  view("letterhelp",topic)
  set video mode(0)
%end
!

!  This looks for a command variable whose name is in Var. If it finds
!  it, a is set to the value of the variable, otherwise a is set to "".
!  If the value of a is not in the list of Values, Errmess is printed
!  and the program stops.

%routine set up(%string(*)%name a,%string(31) lvar,%string(255) errmess,
%record(line80listf)%name values,%integername stage)
%string(255) x
  a=""
  %return %if lvar=""
{!  If Vax.}
{  upper(lvar)}
{  a=translate(lvar)}
!
!  If APM.
  a=translate command symbol(lvar)
!
  x=a
  lower(x); lower(lvar)
  a="" %and %return %if x=lvar
  %if values_head##nil %and errmess#"" %and %not belongs(x,values) %thenstart
    errmess="Inappropriate value from command variable ".lvar %if errmess=""
    message("Collecting ".var(stage)."=".a.snl." ".errmess,"stop")
  %finish
%end

%routine remove(%record(*)%name p,l)
  excise cell(p,l)
  dispose(p)
%end

%routine destroy(%string(63) file)
%string(63) x,z
%record(df) d
  file=file.".imp" %unless file->x.(".").z
  file=file.";*" %unless file->x.(";").z
{!  If Vax.}
{  file="delete ".file}
{  d_a=addr(file)+1; d_l=length(file)}
{  spawn(d)}
!
!  If APM.
{  delete(y)}
!
%end

%routine copy address(%record(line80listf)%name a,b)
%record(line80f)%name p,q
  b_head==nil; b_tail==nil
  p==a_head
  %while p##nil %cycle
    q==newline80
    q_line=p_line
    append cell(q,b)
    p==p_next
  %repeat
%end

%routine clear recipient(%record(addresseef)%name r)
  r_next==nil; r_prev==nil
  r_dear=""; r_name=""; r_yours=""; r_yourrefce=""
  clear person(r_b)
%end

%record(addresseef)%map newrecipient
%record(addresseef) recippattern
%record(addresseef)%name p
  p==new(recippattern)
  clear recipient(p)
  %result==p
%end

%string(255)%fn full name of(%record(personf)%name a)
%string(255) x,y
  %if a##nil %thenstart
    %if "*"#a_surname#"" %thenstart
      x=a_surname %unless a_surname->x.(",").y %and y=""
      %if "*"#a_style#"" %then y=a_style." " %else y=""
      y=y.a_initials %if "*"#a_initials#""
      x=y.x
    %finishelse x=""
    x=a_id %if x=""
  %finishelse x=""
  %result=x
%end

!  This discards leading blank lines and spaces.
!  It returns ".end" if '.end' or <EOF> is encountered.

%routine read line(%string(*)%name a)
%integer j
  skip symbol %while next symbol=sp
  a=""
  %while next symbol#nl %cycle
    read symbol(j)
    a=a.tostring(j)
  %repeat
%end

%routine read word(%string(*)%name a)
%integer j
%string(255) x
  %on %event 9 %start
    a=end
    %return
  %finish
  skip symbol %while next symbol=sp %or next symbol=nl
  a=""
  read symbol(j) %and a=a.tostring(j) %while sp#next symbol#nl
  x=a
  lower(x)
  a=x %if x=end
%end

!  This uses input stream 3.

%routine append text(%string(255) s)
%integer i,oldin
  %on %event 9 %start
    close input
    select input(oldin)
    %return
  %finish
  oldin=instream
  open input(3,s)
  select input(3)
  %cycle
    read symbol(i)
    print symbol(i)
  %repeat
%end

%routine print recipient(%record(addresseef)%name r,%string(255) s)
  print string(snl.s.snl) %unless s=""
  print string("Id=".r_b_id.snl)
  %return %if r_b_id=end
  print string(r_name.",".snl)
  print address(r_b_officeaddr,":tt")
  print string("Dear ".r_dear.snl)
  print string("Yours ".r_yours.snl)
%end

%routine print style
  print string("$D #='$K163'".snl)
  print string("$D.var pageno,top".snl)
  print string("$D.format pages".snl)
  print string("=$Q(1-pageno)$O0.2"",Y,6.85"",H-Y-1""[]".snl)
  print string("=$Q(pageno)$O0.2"",0.5"",6.85"",H-1""[]".snl)
  print string("=$pageno=pageno+1".snl)
  print string("=$Q(pageno-1)$B0.1""$v(pageno)$B^0".snl)
  print string("=$C".snl)
  print string("=$pages".snl)
  print string("$Z.include office:crest".snl)
  print string("$S*.letter".snl)
%end

%routine print form(%record(personf)%name bcc,%string(7) file)
%string(255) x
  print string("$M0.5"",0,7.2"",11""".snl)
  print string("$X0$Y0".snl)
  print string("$T=0.5"",1"",1.5"",2"",2.5"",". %c
  "3"",3.5"",4"",4.5"",5"",5.5"",6"",6.5"",7"",7.5"",8""".snl)
  print string("$L=0.2""?$G=2$I=3$J0".snl)
  print string("$pageno=0".snl)
  %if file="file" %then x="FILE COPY" %else %c
  %if file="bcc" %then x="Copy for ".full name of(bcc) %else x="$B(A+B)"
  print string("$B0$Times12$H{".x."}$B^0".snl)
  print string("$top=Y".snl)
  print address(heading,"")
  print string("$B0.05""$I{Telex: }".telex."$X>7""".snl) %if "*"#telex#""
  %if "*"#telephone number#"" %thenstart
    print string("$B0.05""$I{Telephone:} ".telephone number)
    print string(" $I{Ext: }".ext ) %if "*"#ext#""
  %finish
  print string(snl."$T0$I{Email: }".email."$X>7""") %if "*"#email#"*"
  print string("$B0") %and newline %if "*"#telephone number#"" %or "*"#email#""
  print string("$Times12".snl)
  print string("$pages".snl)
%end

%routine print head(%record(addresseef)%name r,%record(personf)%name bcc,
%string(7) file)
%string(255) x,y
  print form(bcc,file)
  %if r##nil %thenstart
    print string("$B0")
    print string("$I{My reference: }".myrefce) %if "*"#myrefce#""
    print string("$B0$I{Your reference: }".r_yourrefce) %c
    %if "*"#r_yourrefce#""
    newline %if "*"#myrefce#"" %or "*"#r_yourrefce#""
    print string("$B1 ".r_name.",$T0 ".ddate."$B>0".snl)
    print address(r_b_officeaddr,"layout")
    print string("$B0")
    %if "*"#r_dear#"" %thenstart
      print string("Dear ".r_dear)
      print string(",") %unless r_dear->x.(",").y %and y=""
      newline
      print string("$B0")
    %finish
  %finishelse print string("$B0.3""$T0 ".ddate."$X>7""".snl."$B0.25""".snl)
  print string("$L1$J1".snl)    ;!  Set line-filling ON and Justification ON.
%end

%routine print copy list(%record(personlistf)%name copy,%string(31) c,
%integer arrow)
%record(personf)%name a
%string(80) x
%integer p
  %if copy##nil %and copy_head##nil %thenstart
    print string("$B0".snl)
    p=1
    a==copy_head
    print string("$B1") %if a##nil
    %while a##nil %cycle
      print string("$B0")
      print string(c) %if p=1
      x=full name of(a)
      %if p=arrow %then x="$T0 ->$T>1 ".x %else x="$T1 ".x
      print string(x.snl)
      p=p+1
      a==a_next
    %repeat
  %finish
%end

%routine print tail(%record(addresseef)%name r,
%record(personlistf)%name copy,bcopy,%integer arrow,%string(7) file)
  print string("$Times12".snl)
  print string("$T*0".snl)
  %if r##nil %and "*"#r_yours#"" %thenstart
    print string("$B0.2"",1.2""".snl)
    print string("Yours ".r_yours)
    print string(",") %unless r_yours->x.(",").y %and y=""
    print string("$B^0".snl)
  %finish
  %if sent by_head##nil %thenstart
    print string("$B0.75""")
    print address(sent by,"centre")
  %finish
  %if addresseeno=1 %thenstart
    print copy list(copy,"cc:",arrow)
    print copy list(bcopy,"bcc:",arrow) %if file="file"
  %finishelse %c
  %if file="file" %then print copy list(copy,"Also sent to:-$B0",0)
  print string("$B1 Encl:- ".enc.snl) %if "*"#enc#""
  print string("$E*".snl)
%end

%routine done(%integer stage)
%string(80) x
  %if first time(stage)=yes %then x="inputting" %else x="changing"
  message("stopped while ".x." ".var(stage),"stop")
%end

%routine xedit(%string(63) y)
%string(63) x,z
  y=y.".imp" %unless y->x.(".").z
{!  If Vax.}
{%record(df) d}
{  x=edt." ".y." ".y}
{  d_a=addr(x)+1; d_l=length(x)}
{  spawn(d)}
!
!  If APM.
  %if edt="vecce" %thenstart
    x=y."/".y
    memed(x)
  %finishelse %c
  %if edt="ie" %thenstart
    start line=1; start position=1
    terminal model=WY 75
    set up terminal
    ie editor(y,y,0,20,start line,start position,
    Default  Profile,Default Keyboard,Confirm!Silent!Reset Heap)
    reset terminal
  %finishelse message(edmess,"stop")
!
%end

%routine collect(%string(*)%name a,%integer n,%string(63) lvar,
%string(255) errmess,%record(line80listf)%name values,%integername stage)
%integer flag
%string(63) x
  %if first time(stage)=yes %thenstart
    a=""
    set up(a,lvar,errmess,values,stage)
    %if a="" %then flag=yes %else flag=no
  %finishelse flag=yes
  prompt(prt(n))
  %if flag=yes %thenstart
    skip symbol %if first time(stage)=no %and next symbol=nl
    get(a,n)
  %finish
  x=a; lower(x); done(stage) %if x=end
%end

%routine get addressee(%record(addresseef)%name r,%integername stage)
%integer n,oldstage
%string(63) x,y

  %on %event 9,15 %start
    done(stage) %if event_event=15 %and event_sub=1
    close input %and select input(control) %if event_event=9 %and instream#0
    clear recipient(r)
    %return
  %finish

  r_b_id=""    ;!  Clear recipient sets r_b_id to end.
  oldstage=stage
!  Input name of addressee
  n=1; stage=8
  input(x,1)
  prune(x)
  r_b_id=x; r_name=x
  y=x; lower(y)
  %signal %event 15,2 %if y="*"
  done(stage) %if y=end
  %return %if charno(x,1)='@'    ;!  File name.
!  Get address of addressee.
  n=0; stage=9
  get address(r_b_officeaddr,n)
  %if r_b_officeaddr_head##nil %thenstart
    y=r_b_officeaddr_tail_line; lower(y)
    done(stage) %if y=end
  %finish
!  Dear.
  n=4; stage=10
  get(r_dear,n)
  y=r_dear; lower(y)
  done(stage) %if y=end
!  Yours.
  n=26; stage=14
  collect(r_yours,n,lett.var(stage),"",nillist,stage)
  y=r_yours; lower(y)
  done(stage) %if y=end
  stage=oldstage
%end

%routine get more addressees(%integer n,%integername stage)
%record(addresseef)%name r
  %cycle
    r==newrecipient
    get addressee(r,stage)
    %exit %if r_b_id=end
    append cell(r,addressees)
    addresseeno=addresseeno+1
  %repeat
  dispose(r)
%end

%routine expand address files(%integer n)
%record(addresseef)%name p,q,r
%string(255) x
  select input(control)
!  Expand any filenames into addressees.
  p==addressees_head
  %while p##nil %cycle
    %if p_name->("@").x %thenstart
!  Read file-name until it ="" or exists.
      %while x#"" %and %not exists(x) %cycle
        message(x." does not exist.","")
        get(x,17)
        p_name="@".x
      %repeat
      %if x#"" %thenstart
        open input(3,x)
        select input(3)
!  Note the end of the insertion.
        q==p_next
!  This inserts the new addressees after p in the list of addressees
        %cycle
          r==newrecipient
          get addressee(r,stage)
          %exit %if r_b_id=end
          insert cell before(r,q,addressees)
          addresseeno=addresseeno+1
        %repeat
        dispose(r)
        close input
        select input(control)
        q==p; p==p_next
        excise cell(q,addressees)
        addresseeno=addresseeno-1
      %finishelsestart
        message("File of addressees does not exist","")
        q==p; p==p_next
        excise cell(q,addressees)
        addresseeno=addresseeno-1
      %finish
    %finishelse p==p_next
  %repeat
%end

%routine get addressees(%integer n,%integername stage)
  addresseeno=0
  addressees_head==nil; addressees_tail==nil
  get more addressees(n,stage)
  expand address files(n)
%end

%routine get body of letter(%string(*)%name outname)
%integer oldin
%string(255) x,y,z
  %on %event 15 %start
    message("Stopped from input in 'Get body of letter'","stop")
  %finish
  outname=""; x=""; y=""; z=""
  oldin=instream
  select input(control)
  %cycle
    input(outname,15)
    lower(outname)
!  Resolve outname.
    y="" %unless (edt="vecce" %and outname->y.("/").outname) %c
    %or (edt="ie" %and outname->y.(" ").outname)
    outname->(" ").outname %while charno(outname,1)=' '
    %signal %event 15 %if outname=end
    %unless "*"#outname#"" %then message("No output name provided","") %c
    %elsestart
!  Extend outname.
      outname=outname.".lay" %unless outname->x.(".")
!  Resolve input about ','.
      z="" %unless y->y.(",").z
      %signal %event 15 %unless y#end#z
!  Extend input.
      y=y.".lay" %unless y="" %or y->x.(".")
      z=z.".lay" %unless z="" %or z->x.(".")
      %if y="" %thenstart
        y=outname %if exists(outname)
        %exit
      %finish
    %finish
{!  If Vax.}
{    outname=fixfile(outname,defaultdir,defaultext)}
{    y=fixfile(y,defaultdir,defaultext)}
{    z=fixfile(z,defaultdir,defaultext)}
!
    %exit %if exists(y)
    message(y." does not exist","")
  %repeat
  select input(0)  ;!  To control the editor.
{!  If Vax.}
{  z=",".z %unless z=""}
{  %if edt="vecce" %then z=y.z."/".outname %else %c}
{  %if edt="ie" %then z=y." ".outname %else %c}
{  message(edt." is an unknown editor. Please set Letter_editor.","stop")}
{  z=edt." ".z}
{  d_a=addr(z)+1; d_l=length(z)}
{  spawn(d)}
!
!  If APM.
  %if edt="vecce" %thenstart
    z=",".z %unless z=""
    memed(y.z."/".outname)
  %finishelse %c
  %if edt="ie" %thenstart
    start line=1; start position=1
    terminal model=WY 75
    set up terminal
    ie editor(y,outname,0,20,start line,start position,
    Default  Profile,Default Keyboard,Confirm!Silent!Reset Heap)
    reset terminal
  %finishelse message( %c
  edt." is an unknown editor. Please set Letter_editor to one".snl. %c
  "of VECCE or IE.","stop")
!
  select input(oldin)
%end

%routine  print letter(%record(addresseef)%name r,%record(personf)%name bcc,
%record(personlistf)%name copy,bcopy,%integer arrow,%string(31) outname,
%string(7) file)
  select output(2)
  print head(r,bcc,file)
  append text(outname)
  print tail(r,copy,bcopy,arrow,file)
  select input(control)
  select output(2)
%end

%routine p label(%record(personf)%name a)
%record(line80f)%name p
%record(line80listf) b
  select output(3)
  b_head==nil; b_tail==nil
  %if "*"#a_surname#"" %thenstart
    copy address(a_officeaddr,b)
    %if "*"#a_department_line#"" %thenstart
      p==newline80
      p_line=a_department_line
      prefix cell(p,b)
    %finish
    %if a_style="" %or a_style="*" %then x="" %else x=a_style." "
    x=x.a_initials.a_surname
    x=x." ".a_degrees %if "*"#a_degrees#""
    prune(x)
    p==newline80
    p_line=x
    prefix cell(p,b)
  %finishelsestart
    %if "*"#a_id#"" %then x=a_id %else x=""
    x=x.", Room".a_room %if ""#a_room#"*"
    %if x#"" %thenstart
      p==newline80
      p_line=x
      append cell(p,b)
    %finish
  %finish
  print label(b)
%end

%routine print letters(%record(addresseelistf)%name recips,
%record(personlistf)%name copy,bcopy)
%integer i
%record(personf)%name a
%record(line80listf) b
%record(line80f)%name p
%record(addresseef)%name r
  open output(2,letters)
  open output(3,labels) %if labelstolaser=yes
  %if addresseeno>1 %thenstart
!  Several addressees, make up a copy list for use in print tail.
    copy_head==nil; copy_tail==nil
    r==recips_head_next
    %while r##nil %cycle
      a==newperson
      a_id=""; a_surname=r_name
      append cell(a,copy)
      r==r_next
    %repeat
    a==nil
  %finish
  r==recips_head
  select output(2)
  message("Letters will be created in ".letters,"")
  print style
  %if create labels=yes %thenstart
    select output(3)
    print label style
  %finish
  %while r##nil %cycle
    select output(2)
    print letter(r,nil,copy,bcopy,0,outname,"")
    select output(0)
    print string("Letter created for ".r_name.snl)
!  Create label.
    %if create labels=yes %thenstart
      select output(3)
      copy address(r_b_officeaddr,b)
      p==newline80
      p_line=r_name
      prefix cell(p,b)
      print label(b)
      delete list(b)
    %finish
    r==r_next
  %repeat
  select output(2)
  r==recips_head
  print letter(r,nil,copy,bcopy,-1,outname,"file") %and %c
  select output(0) %and %c
  print string("Copy created for FILE".snl) %if flcpy="yes"
  i=1
  %unless copy==nil %or copy_head==nil %or addresseeno>1 %thenstart
!  One addressee and there is a list for cc:.
    r==recips_head
    a==copy_head
    %while a##nil %cycle
      select output(2)
      print letter(r,nil,copy,bcopy,i,outname,"copy")
      select output(0)
      print string("Copy created for ".full name of(a).snl)
      select output(3) %and p label(a) %if create labels=yes
      i=i+1
      a==a_next
    %repeat
  %finish
  %unless bcopy==nil %or bcopy_head==nil %or addresseeno>1 %thenstart
!  One addressee and there is a list for bcc:.
    r==recips_head
    a==bcopy_head
    %while a##nil %cycle
      select output(2)
      print letter(r,a,copy,bcopy,0,outname,"bcc")
      select output(0)
      print string("Copy created for ".full name of(a).snl)
      select output(3) %and p label(a) %if create labels=yes
      a==a_next
    %repeat
  %finish
  select output(2)
  print string("$E*.letter".snl."$E*".snl)
  close output
  %if create labels=yes %thenstart
    select output(3)
    print string(snl."$E*".snl)
    close output
    message("Names and addresses for labels are in ".labels,"")
  %finish
  select output(0)
%end

%routine reset ids(%record(personlistf)%name noname)
%record(personf)%name p
  p==noname_head
  %while p##nil %cycle
    p_id=p_extra_head_line %if p_extra_head##nil %and "*"#p_extra_head_line#""
    length(p_id)=length(p_id)-1 %while length(p_id)>0 %and %c
    charno(p_id,length(p_id))=sp
    p==p_next
  %repeat
%end

%routine clear surnames(%record(personlistf)%name noname)
%record(personf)%name p
  p==noname_head
  %while p##nil %cycle
    p_surname=""
    p==p_next
  %repeat
%end

%routine reset idlist(%record(personlistf)%name x)
%record(personf)%name p
  p==x_head
  %while p##nil %cycle
    p_id=p_extra_head_line
    prune and lower(p_id)
    p_surname=""
    p==p_next
  %repeat
%end

%routine get to(%record(personlistf)%name noname,%integer n,control)
!  This uses stream 3 if "@" appears in any list of recipients.
  %on %event 15 %start
    message("Stopped from input in 'get to'","stop")
  %finish
  get recipients(noname,n,control)
  identify(noname,namelist,control)
  select input(control); select output(0)
  reset ids(noname)
%end

%routine collect lines(%record(line80listf)%name a,%integer n,%string(63) lvar,
%string(255) errmess,%integername stage)
%integer flag,i
%string(63) x,y,z
%record(line80f)%name p
  select input(control)
  %if first time(stage)=yes %thenstart
    a_head==nil; a_tail==nil
    %if lvar#"" %thenstart
      i=1
      %cycle
        p==newline80
        set up(p_line,lvar.itod(i),"",nillist,stage)
        x=p_line; lower(x); done(stage) %if x=end
        %exit %if x="*" %or x=""
        append cell(p,a)
        i=i+1
      %repeat
    %finish
    %if a_head==nil %then flag=yes %else flag=no
  %finishelse flag=yes
  %if flag=yes %thenstart
    y=var(stage)
    open output(3,y); select output(3)
    p==a_head
    %while p##nil %cycle
      print string(p_line.snl)
      p==p_next
    %repeat
    print string("*".snl)
    close output
    select input(0); select output(0)
    delete list(a)
    xedit(y)
    open input(3,y); select input(3)
    get lines(a,n)
    %unless a_head==nil %thenstart
      x=a_tail_line
      lower(x)
      done(stage) %if x=end
    %finish
    close input
    select input(control)
    destroy(y)
  %finish
%end

%routine collect addressee(%record(addresseef)%name r,%integername stage)
%integer n,oldstage
%string(63) x,y

  %on %event 9,15 %start
    done(stage) %if event_event=15 %and event_sub=1
    close input %and select input(control) %if event_event=9 %and instream#0
    clear recipient(r)
    %return
  %finish

  r_b_id=""    ;!  Clear recipient sets r_b_id to end.
  oldstage=stage
!  Input name of addressee
  n=1; stage=8
  collect(x,n,lett.var(8),"",nillist,stage)
  prune(x)
  r_b_id=x; r_name=x
  y=x; lower(y)
  %signal %event 15,2 %if y="*"
  done(stage) %if y=end
  %return %if charno(x,1)='@'    ;!  File name.
!  Get address of addressee.
  n=0; stage=9
  collect lines(r_b_officeaddr,n,lett.var(9),"",stage)
  %if r_b_officeaddr_head##nil %thenstart
    y=r_b_officeaddr_tail_line; lower(y)
    done(stage) %if y=end
  %finish
!  Dear.
  n=4; stage=10
  collect(r_dear,n,"letters_".var(stage),"",nillist,stage)
  y=r_dear; lower(y)
  done(stage) %if y=end
!  Yours.
  n=26; stage=14
  collect(r_yours,n,"letters_".var(stage),"",nillist,stage)
  y=r_yours; lower(y)
  done(stage) %if y=end
  stage=oldstage
%end

%routine collect addressees(%integer n,%integername stage)
%record(addresseef)%name r
  addresseeno=0
  addressees_head==nil; addressees_tail==nil
    %cycle
    r==newrecipient
    collect addressee(r,stage)
    %exit %if r_b_id=end
    append cell(r,addressees)
    addresseeno=addresseeno+1
  %repeat
  dispose(r)
  expand address files(n)
%end

%routine collect recipients(%record(personlistf)%name x,%integer n, %c
%string(63) lvar,%string(15) namelist,%integername stage)
%integer flag,source
%string(15) y,z
%record(personf)%name p
  source=control
  %if first time(stage)=yes %thenstart
    x_head==nil; x_tail==nil; y=""
    %if lvar#"" %thenstart
      set up(z,lett.var(stage),yesnomess,yesnostar,stage)
      lower(z); done(stage) %if z=end
    %finish
    %if z="" %then flag=yes %else %c
    %if z="*" %then flag=no %else flag=charno(y,1)
  %finishelsestart
    y=var(stage)
    open output(3,y)
    select output(3)
    p==x_head
    %while p##nil %cycle
      print string(p_id) %and newline %if p_id#""
      p==p_next
    %repeat
    print string("*".snl)
    close output
    select input(0); select output(0)
    delete list(x)
    xedit(y)
    open input(3,y); select input(3)
    flag=yes
    source=3
  %finish
  %if flag=yes %thenstart
    prompt(prt(n))
    skip symbol %if first time(stage)=no %and next symbol=nl
!  The program is stopped within Get Recipients if .end is read.
    get recipients(x,n,source)
    close input %if instream#control
    select input(control); select output(0)
  %finish
  reset idlist(x)
  identify(x,namelist,control)
  reset ids(x)
%end

%integerfn write menu
%integer i,j,k
  select output(0)
  m(i)=-1 %for i=0,1,31
  k=-1
  %for i=0,1,31 %cycle
    k=k+1 %and m(k)=i %if menu&(1<<(31-i))#0
  %repeat
  j=k
  %for i=0,1,j %cycle
    k=m(i)
    write(i,2)
    space
    print string(var(k))
    spaces(20-length(var(k)))
    print string(val(k))
    newline
  %repeat
  %result=j
%end

%routine reedit
%integer j,n
%record(addresseef)%name q,r,s
%string(255) x,y,z
%switch case(0:31)

  %on %event 9,15 %start
    done(stage)
  %finish

  stage=0
  select input(control); select output(0)
  %cycle
    select input(control); select output(0)
    %if newrun=yes %thenstart
      stage=stage+1
      %if stage<31 %thenstart
       %if menu&(1<<(31-stage))=0 %then %c
         %continue %else %c
         ->case(stage) 
      %finishelse %c
        newrun=no %and  %continue
    %finishelsestart
      n=53
      menu=menu1
      j=write menu; stage=31
      %cycle
        message( %c
        "Type the number of the item you wish to change, or 0 to".snl. %c
        "to create and send the letters and the labels to the printer.".snl. %c
        "Type .end to abandon the program.","")
        prompt("Item number: ")
        input(x,n)
        lower(x); done(stage) %if x=end
      %repeat %until '0'<=charno(x,1)<='9'
      n=dtoi(x)
      message("The index (".itod(n). %c
      ") does not lie in the range 0 to ".itod(j),"") %c
      %and %continue %unless 0<=n<=j
      stage=m(n)
      ->case(stage)
    %finish

case(1):
!  Read name of file containing heading.
    controlp=control+1
    n=39
    collect(letterhead,n,lett.var(stage),"",nillist,stage)
    val(stage)=letterhead
    %while %not exists(letterhead) %cycle
      message(letterhead." does not exist or no access.","")
      prompt(prt(n))
      input(letterhead,n)
      val(stage)=letterhead
    %repeat
!  Read heading.
    n=40
    open input(controlp,letterhead)
    select input(controlp)
    input lines(heading,n)
    close input %if instream#control
    select input(control)
    select output(0)
    x=heading_head_line; lower(x); done(stage) %if x=end
    x=heading_tail_line; lower(x); done(stage) %if x=end
    first time(stage)=no
    %continue
case(2):
!  Telex.
    n=23
    collect(telex,n,lett.var(stage),"",nillist,stage)
    val(stage)=telex
    first time(stage)=no
    %continue
case(3):
!  Telephone number.
    n=19
    collect(telephonenumber,n,lett.var(stage),"",nillist,stage)
    val(stage)=telephone number
    first time(stage)=no
    %continue
case(4):
!  Extension.
    n=7
    collect(ext,n,lett.var(stage),"",nillist,stage) %unless telephonenumber=""
    val(stage)=ext
    first time(stage)=no
    %continue
case(5):
!  Email address.
    n=47
    collect(email,n,lett.var(stage),"",nillist,stage)
    val(stage)=email
    first time(stage)=no
    %continue
case(6):
! My reference.
    n=16
    collect(myrefce,n,lett.var(stage),"",nillist,stage)
    val(stage)=myrefce
    first time(stage)=no
    %continue
case(7):
!  Addressees.
    n=37
    %if newrun=yes %thenstart
      get addressees(n,stage)
      first time(stage)=no
      first time(8)=no; first time(9)=no;first time(10)=no; first time(14)=no
    %finishelsestart
!  Create file of addressees for editing.
      y=var(stage)
      open output(3,y); select output(3)
      q==addressees_head
      %while q##nil %cycle
        print string(snl.q_name.snl)
        print lines(q_b_officeaddr)
        print string("*".snl)
        %if q_dear#"" %then print string(q_dear.snl) %else print string("*".snl)
        %if q_yours#"" %then print string(q_yours.snl) %c
        %else print string("*".snl)
        q==q_next
      %repeat
      print string(snl."*".snl)
      close output
      select input(0); select output(0)
!  Edit the file of addressees.
      xedit(y)
      delete list(addressees)
!  Read addressees from edited file.
      q==newrecipient
      q_b_id="@".y; q_name=q_b_id
      append cell(q,addressees)
      expand address files(n)
      first time(stage)=no
      destroy(y)
    %finish
    %continue
case(11):
!  Your reference.
    n=25
    %continue %unless addresseeno=1
    q==addressees_head
    collect(q_yourrefce,n,lett.var(stage),"",nillist,stage)
    val(stage)=q_yourrefce
    first time(stage)=no
    %continue
case(12):
!  Editor.
    set up(edt,lett.var(stage),edmess,editors,stage)
    lower(edt)
    edt="vecce" %if edt=""
    val(stage)=edt
    first time(stage)=no
    %continue
case(13):
!  Outname.
    n=15
    prompt(prt(n))
    skip symbol %if first time(stage)=no %and next symbol=nl
    get body of letter(outname)
    val(stage)=outname
    x=outname; lower(x); done(stage) %if x=end
    first time(stage)=no
    %continue
case(14):
!  Yours.
    n=26
    q==addressees_head
    collect(q_yours,n,lett.var(stage),"",nillist,stage)
    val(stage)=q_yours
    first time(stage)=no
    %continue
case(15):
!  Sent by.
    n=50
    collect lines(sentby,n,lett.var(stage),"",stage)
    x=sentby_head_line; lower(x); val(stage)=x %and done(stage) %if x=end
    x=sentby_tail_line; lower(x); val(stage)=x %and done(stage) %if x=end
    val(stage)=sentby_head_line
    first time(stage)=no
    %continue
case(16):
!  Cc:.
    n=2
    collect recipients(cc,n,lett.var(stage),namelist,stage)
    %if cc_head##nil %thenstart
      x=cc_head_id; lower(x); val(stage)=x %and done(stage) %if x=end
      x=cc_tail_id; lower(x); val(stage)=x %and done(stage) %if x=end
      val(stage)=cc_head_id
    %finish
    first time(stage)=no
    %continue
case(17):
!  Bcc:.
    n=44
    collect recipients(bcc,n,lett.var(stage),namelist,stage)
    %if bcc_head##nil %thenstart
      x=bcc_head_id; lower(x); val(stage)=x %and done(stage) %if x=end
      x=bcc_tail_id; lower(x); val(stage)=x %and done(stage) %if x=end;
      val(stage)=bcc_head_id
    %finish
    first time(stage)=no
    %continue
case(18):
!  Enclosures.
    n=34
    collect(enc,n,lett.var(stage),"",nillist,stage)
    val(stage)=enc
    first time(stage)=no
    %continue
case(19):
!  File copy.
    n=51
    collect(flcpy,n,lett.var(stage),yesnomess,yesnostar,stage)
    lower(flcpy)
    val(stage)=flcpy
    first time(stage)=no
    %continue
case(20):
!  Tolaser.
    n=30
    x=tostring(tolaser)
    collect(x,n,lett.var(stage),yesnomess,yesnostar,stage)
    lower(x)
    tolaser=charno(x,1)
    val(stage)=x
    first time(stage)=no
    %continue
case(21):
!  Createlabels.
    n=52
    collect(x,n,lett.var(stage),yesnomess,yesnostar,stage)
    lower(x)
    createlabels=charno(x,1)
    val(stage)=x
    first time(stage)=no
    %continue
case(22):
!  Labelstolaser.
    n=48
    collect(x,n,lett.var(stage),yesnomess,yesnostar,stage)
    lower(x)
    labelstolaser=charno(x,1)
    val(stage)=x
    first time(stage)=no
  %repeat
case(0):
case(31):
%end

%routine initial settings
%integer i
  addresseeno=0; addressees_head==nil; addressees_tail==nil
  bcc_head==nil; bcc_tail==nil
  cc_head==nil; cc_tail==nil
  control=0
  editors_head==nil; editors_tail==nil
  p==newline80; p_line="vecce"; append cell(p,editors)
  p==newline80; p_line="ie"; append cell(p,editors)
  stage=12
  set up(edt,lett.var(stage),edmess,editors,stage)
  enc="*"; ext="*"
  first time(i)=yes %for i=0,1,31
  flcpy=""
  heading_head==nil; heading_tail==nil
  labelstolaser=no
  linewidth=labelwidth-2*leftmargin
  m(i)=-1 %for i=0,1,31
  menu=menu0
  newrun=yes
  nillist_head==nil; nillist_tail==nil
  printdepth=labeldepth-2*topmargin
  printerlist_head==nil; printerlist_tail==nil
  p==newline80; p_line="lp2"; append cell(p,printerlist)
  p==newline80; p_line="lp3"; append cell(p,printerlist)
  p==newline80; p_line=end; append cell(p,printerlist)
  stage=23
  set up(printer,lett.var(stage),printmess,printerlist,stage)
  printer="lp2" %if printer=""
  sent by_head==nil; sent by_tail==nil
  stage=0
  star_head==nil; star_tail==nil
  p==newline80; p_line="*"; append cell (p,star)
  tolaser=yes
  val(i)="" %for i=0,1,31
  yesnostar_head==nil; yesnostar_tail==nil
  p==newline80; p_line="yes"; append cell(p,yesnostar)
  p==newline80; p_line="no"; append cell(p,yesnostar)
  p==newline80; p_line="*"; append cell(p,yesnostar)
  p==newline80; p_line=end; append cell(p,yesnostar)
%end

{  Main Program}

!  Seqno uses input and output streams 1.

  %on %event 9,15 %start
    %signal %event 9,event_sub,stage %if event_event=9
    message(""".end"" or ""@"" read.","stop")
  %finish

  select input(0); select output(0)
  print string("Type ""?"" for HELP, "".end"" to abandon.")
  newline
  initial settings
  controlp=control
  select input(control)
  reedit
  labels=""; letters=""
!  If APM.
  labels=printer.":"  %if labelstolaser=yes
  letters=printer.":" %if tolaser=yes
!
  letters=letters."x".seqno.".lay"
  labels=labels."x".seqno.".lay" 
  print letters(addressees,cc,bcc)
{!  If Vax.}
{  %if tolaser=yes %or labelstolaser=yes %thenstart}
{    command="comm".seqno.".com"}
{    open output(3,command)}
{    select output(3)}
{    %if tolaser=yes %thenstart}
{      print string("$@u0:[sm.office]las ".letters.snl)}
{      print string("$delete ".letters.";*".snl)}
{    %finish}
{    %if labelstolaser=yes %thenstart}
{      print string("$@u0:[sm.office]las ".labels.snl)}
{      print string("$delete ".labels.";*".snl)}
{    %finish}
{    close output}
{    select output(0)}
{    x="@".command}
{    d_a=addr(x)+1; d_l=length(x)}
{    spawn(d)}
{    destroy(command)}
{  %finish}
!
!  If APM.
  message("Letters sent to laser printer.","") %if tolaser=yes
  message("Labels sent to laser printer.","") %if labelstolaser=yes
!


%endofprogram
