program medlinebib(query, medlinebibp, bibformat, output);
(* medlinebib: convert medline Unix query format to bibtex format

  Thomas D. Schneider, Ph.D.
  toms@alum.mit.edu
  https://alum.mit.edu/www/toms 

 *)

label 1; (* end of program *)

const
(* begin module version *)
   version = 2.22; (* of medlinebib.p 2024 Feb 05
2024 Feb 05, 2.22: handle LID with no [doi]
2024 Jan 07, 2.21: handle arXiv LID format
2022 Nov 22, 2.20: crash with the new eutils query format!!
2022 Oct 13, 2.19: \htmladdnormallink -> \url (and only one argument)
2018 Aug 02, 2.18: Duplicate author names must be removed - pmid = "25999513",
                   see IR
2017 Aug 28, 2.17: clean up proc processdoi to remove unused variables
2017 Aug 02, 2.16: handle 3rd in pmid = "16397293", like jr
2016 Mar 02, 2.15: new doi format:
       http://dx.doi.org/10.3389/fmolb.2016.00080
       to
         https://doi.org/10.3389/fmolb.2016.00080
       shorter and more secure.
2016 Feb 01, 2.14: Handle AID - another source of DOI! (missed 2.13!)
2016 Jan 24, 2.12: debug:
   sed -i.bak 's|1..11|1..datetimearraylength|g'     medlinebib.p
2016 Jan 22, 2.11: add PubMed links
2016 Jan 19, 2.10: handle LID!
2016 Jan 14, 2.09: handle DOI!
2014 May 19, 2.08: user provides string if data is missing
2014 Feb 25, 2.07: cleanup
2014 Feb 25, 2.05: remove dashes given by PubMed from key name, eg 24463509
2014 Feb 19, 2.03: REALLY remove spaces and dashes from key name!
2013 Sep 11, 2.02: remove spaces from key name instead of '-'
2013 Aug 30, 2.01: datecomment uses '_' instead of ' ' (on hold) and ends in ' '.
2013 Aug 27, 2.00: another link to Medline types
2013 Jun 13, 1.99: PMID 15903968 gives two cases of Ingber DE, from AU and IR.
2013 May 13, 1.98: remove quotes from the key!
2012 Apr 19, 1.97: add a comment with the date! new parameter
2012 Apr 09, 1.96: remove double spaces in wrapped title
2011 Oct 21, 1.95: allow no author list from pubmed 2410266
2011 Oct 05, 1.94: Dashes are used in key instead of _
2011 Apr 23, 1.92: link to Belorussian translation
2011 Apr 14, 1.91: fix documentation, add yvp link
2011 Feb 17, 1.90: clean up
2011 Feb 17, 1.89: bus error for PMID 21051339.  Now they have a new type
                   replacing AU called IR.  Using this solved the problem.
2009 Nov 21, 1.88: fix bug: failed on Sun! Forgot to init some strings!
2009 Nov 21, 1.87: fix bug: failed on Mac. needed "if w > 0"
                   when locating previous blank in proc. wraplines.
2008 Jul 24, 1.86: do not put empty pmcid line into bibformat
2008 Jun 17, 1.85: PMCID is 'pmcid' not just 'pmc'
2008 Jun 05, 1.84: report both PMCID and PMID
2008 Apr 19, 1.83: PMCID took over for PMID because the program
                   searched for 'PM' and the PMID is before PMCID
                   in the Medline format.  So all papers that have
                   a PMCID are marked as, for example, PMC390408.
                   Maybe this isn't such a bad thing since the PMCID
                   brings one to the correct PubMed page!
2007 Nov 14, 1.82: replace '%' with '\%' in the final bibliography!
                   example PMID: 10944389
2006 Jun 06, 1.81: clean up
2006 Jun 06, 1.80: loss of secondary authors!
                   it was in prgmod:
                   concatstring must call emptystring not clearstring
2006 Jun 06, 1.79: location of program affects this bug ...
                   solution: upgrade prgmod
2006 Jun 06, 1.78: crashing on PMID 16581903 only in home directory!
2006 Jun 06, 1.77: crashing on PMID 16581903 - removed extra readln
2005 Nov 04, 1.76: special bug documentation for pages like "690-2, 694"
2005 May 11, 1.75: upgrade documentation about query.fcgi.html
                   double dash now works!!
2004 Oct 26, 1.74: read in value for title line wrap width
2004 Jul 29, 1.72: bug: p2c compile fails for letters in fixtitle
                   Looks like this is a p2c compile failure since
                   GPC works just fine.  Recommendation: use GPC!
2004 Apr 22, 1.71: adjust wrap size
2004 Apr 22, 1.70: testing and cleanup, consistency check for wrap
2004 Apr 22, 1.69: check that wrapped title length has not changed. 
2004 Apr 22, 1.68: further wrap algorithm work
2004 Apr 22, 1.67: further wrap algorithm work
2004 Apr 22, 1.66: put flag for user about breaks
2004 Apr 22, 1.65: keep space when at line break, add space as need
2004 Apr 22, 1.64: tidy up
2004 Apr 22, 1.63: wrap is functioning!
2004 Apr 22, 1.62: continue work on wrap
2004 Apr 22, 1.59: remove lines type
2004 Apr 22, 1.58: wrap title lines
2004 Apr 22, 1.57: use E-utils output, functions with current medquery
2004 Apr  7, 1.56: use E-utils output (IN PROGRESS)
2004 Mar 18, 1.55: cleanup, handle no eof on query file
2004 Mar 18, 1.54: add pmid data line to the bibformat
2002 Nov  4, 1.53: Mac Donaill -> Mac_Donaill
2002 Jul  1, 1.52: cleanup
2002 Jul  1, 1.51: PMID 12077324 caused bomb: preprint with no page number!
                   => gpc needed page string to be cleared before use ...
2002 May  4, 1.49: PMID 11985779 caused long (infinite?) hang and bomb
                   => allow pages to be *one* digit
2001 Mar 28, 1.47: double dash parameter; automatic parameter upgrade
2000 Aug 17, 1.45: page bug fixed "9242-7" -> "9242-9247" now works again
2000 Jul 27, 1.44: upgrade documentation to new pubmed, gpc ready!
1999 Sep  5: upgrade documentation to mention medquery
1999 Sep  3: upgrade documentation to mention atchange
1998 Jun  29: upgrade parseauthor to handle names with Jr in them
1997 May 23: Page numbers reported as "74-6" are changed to "74-76".
1997 Apr 20: Suddenly the MRI form appeared in medline - allow for it.
1997 Apr  7: handle "AU  - de Ruyter van Steveninck RR"
origin 1997 March 15 *)
updateversion = 2.08; (* defines lowest acceptable current parameter file *)
(* end module version *)

(* begin module describe.medlinebib *)
(*
name
   medlinebib: convert medline Unix query format to bibtex format

synopsis
   medlinebib(query: in, medlinebibp: inout, bibformat: out, output: out)

files
   query:  The Medline format query file in Unix format created by Entrez.

   bibformat:  The reference in the query rendered in bibtex format.
      The title is wrapped according to variable titlelinesize.

   medlinebibp:  parameters to control the program.  The file must contain the
        following parameters, one per line:

      1. The version number of the program.  This allows the user to be
         warned if an old parameter file is used.

      2. If the first character of the second line is 'd' then the program
         runs in debugging mode.  This means that it will show the parts
         of the reference as it parses them.

      3. If the first character of the third line is 'e' then the program
         will create additional non-standard bibtex parts for the Medline
         components.  This will make a bulky entry, but it will contain
         all of the medline data.  Any cases of double quotes (") are
         converted to single quotes to protect the bibtex file.

      4. If the first character of the fourth line is 'f' then the program
         use the final author to make the bibtex key.  Otherwise
         the second author is used (or none when there is only one author).

      5. If the first character of the fifth line is 'd' then the program
         will double dash page numbers: 1--5, otherwise it will single dash.

      6. The title line size, titlelinesize.  This is the number of
         characters that the lines will be wrapped to.

      7. If the first character is blank ' ', no date is written.
         If the first character is       'f', then the full
         date and time is written in the format "2012/04/19 19:26:08"
         into a 'comment' just before the finaly year of a bibiliography
         entry.  This way one can automatically keep track of when one
         found a particular paper.

      8. If the query is missing some data such as volume or pages in
         an early publication, then this line contains the string
         give instead.

         Suggestion:

         1. Define this LaTeX command in your papers as:
         \newcommand{\todo}{\rule{0.5em}{1ex}}
         then use the string:
         \todo

         2. Define this LaTeX command in your papers as:
         \newcommand{\todobf}[1]{{\rule{0.5em}{1ex}\textbf{ #1}}}
         then use the string:
         \todobf{MISSING}

      Note:  as of version 1.47, medlinebibp will be automatically upgraded
      to include parameter 5 and any later parameters.  This means that
      medlinebib will read in the medlinbibp and write it out again.

   output: messages to the user

description

   Convert Medline format to bibtex format.

   The program takes a medline format in file 'query' and creates a bibtex
   file, 'bibformat'.

   While you can go to the trouble of downloading the medline format,
   I have revised the script (now called medquery) so that if one
   saves a page directly from pubmed it will be automatically
   converted.  When one saves a page it comes out as a 'query.fcgi'
   file (query.fcgi.html on my mac).  The medquery script searches
   through this and plucks out the PMID identifier.  Then it reaches
   across the internet using wget to obtain the medline format.  The
   medline format is then converted to bibtex.  This all happens so
   fast that the complexity doesn't matter.

   Note:  Spaces in names were originally converted to underscores for
   the key, but LaTeX/BibTeX objects (since an underscore means
   mathematics) so spaces are now (2011 Oct 05) converted to dashes.
   New rule 2013 Sep 11: spaces removed to make cut/paste easier.
   New rule 2014 Feb 25: ALL dashes are removed from the key names.

   To use the program:

   1. Set up atchange and wget on your computer.

   2. Set up atchange running in your home directory on an 'automate'
      file containing:

query.fcgi
  medquery

/tmp/query.fcgi
 echo moving query.fcgi to home for processing
 mv /tmp/query.fcgi ~

   2. Start at the PubMed web page

http://www.ncbi.nlm.nih.gov/entrez/query.fcgi

   and retrieve a paper abstract.

   3.  Save the abstract.  This will create a query.fcgi file in your
   home directory.

   2005 May 11 Note:  Because pubmed keeps changing the format of
   their save mechanism, just save the page directly using your
   browser save mechanism.  It may be called query.fcgi.html or
   query.fcgi.  The medquery script will extract the PMID (PubMed ID)
   from the saved html page (using the name query.fcgi).  Hopefully
   this will be more stable, and it is certainly faster to save the
   page directly.

   4.  Creating the query.fcgi file will trigger atchange to run the
   medquery script, which converts from medline to BiBTeX format.  The
   bibformat file will appear in your home directory.  Successive
   references are also stored in a 'bib' file in your home directory. 
   The medlinebibp file is automatically created.  (The medquery will
   clean up after itself by putting the medline format file into
   /tmp.)

   5.  Down in the directory where you keep your reference directory
   you can have a pointer to the resulting bib file.  Of course there
   are other ways of automating this, but for me it makes the
   conversion rather rapid.  I just go to my reference directory, edit
   my bib file and read in the new entry.

   Note: medlinebib changes page numbers in the form 507-10 to the
   form 507--510.

   Note: To generate the BibTex key, medlinebib will convert spaces to
   '-' in author names and removes single (') and double (") quotes
   from the names.  This allows one to use the names on the command
   line without having to type the othe kind of quote mark.  The names
   of the authors in the reference are not affected.
   As of 2014 Feb 19 the spaces will be removed.

   6.  PubMed now supplies the DOI link, so medlinebib creates a note:

   note = "\url
   {https://doi.org/10.1038/ncomms8486}",

   To use this in LaTeX, one must \usepackage{html} in the preamble.

   Note that the key for these lines in medline format is 'LID' or
   'AID' and there can be several at the same time:

LID - 10.1016/j.jtbi.2015.01.042 [doi]
LID - S0022-5193(15)00059-4 [pii]
LID - arXiv:2301.00783v2

   So the program needs to extract only the doi.

   In the case of arXiv the format to use instead of a doi is:
https://arxiv.org/abs/2301.00783v2
or better:
https://doi.org/10.48550/arXiv.2301.00783

examples

   Try searching for

      Schneider TD

documentation

see also

   {Unix csh script:} medquery

   {atchange is described at:}
   https://alum.mit.edu/www/toms/atchange.html

   {wget information:}
   https://alum.mit.edu/www/toms/wget.html
   http://www.gnu.org/software/wget/

   {Sort the bibtex file alphabetically:} sortbibtex.p

   {To find a reference quickly from the Year, Volume and Page,
   you can identify it in PubMed using the yvp script:}
   https://alum.mit.edu/www/toms/yvp.html

   {---------}

   {Pubmed link:}
   http://www.ncbi.nlm.nih.gov/entrez/query.fcgi

   {PubMed Help:}
   http://www.ncbi.nlm.nih.gov/books/NBK3830/

   {Changes to PubMed are announced in the NLM Technical Bulletin:}
   https://www.nlm.nih.gov/pubs/techbull/tb.html

   {PubMed modification are also delineated in the PubMed New/Noteworthy
    RSS Feed:}
   http://www.ncbi.nlm.nih.gov/feed/rss.cgi?ChanKey=PubMedNews

   {MEDLINE/PubMed Data Element (Field) Descriptions - full description:}
   http://www.nlm.nih.gov/bsd/mms/medlineelements.html

   {---------}

   {Parameter file:} medlinebibp

   {Belorussian translation of this page by Bohdan Zograf:}
   http://www.designcontest.com/show/medlinebib-program-be

author

   Thomas Dana Schneider

bugs

********************************************************************************
   If there are too many names, Entrez says "et al" for the
   last name.  This gets represented as:

 and a. l. et",

   Who is Al L. Et?  :-)

   It should be recognized and made:

 and {\em et al}",

********************************************************************************

 Authors with names like:

    La Branche H

 should be processed to "LaBranch".
 The only way to recognize this is the small case letters in
 the second part of the last name - rather subtle.

********************************************************************************

If you make the medlinebib program smart enough to re-format the
reference titles to less than 80 characters per line in the
output bibformat file, then the sortbibtex program will run flawlessly
using it as the input file. Otherwise, it gets hung on the title lines
that are greater than 80 chars/line.

********************************************************************************

   1998 Jan 11
   Bielinsky.Gerbi1998 is a case in which [In Process Citation] goes from one
   line to the next; the program does not handle this yet

********************************************************************************

2000 Aug 17

The program does not fix page numbers if there is more material:

pages = "233-44; discussion 244-50",

2005 Nov 04.  A special case of this occurs in Biotechniques because
they often have advertisements in the middle of the paper.  For
example:

@article{Rong.McAllister1999,
author = "M. Rong
 and R. Castagna
 and W. T. McAllister",
title = "{Cloning and purification of bacteriophage K11 RNA polymerase}",
journal = "Biotechniques",
volume = "27",
pages = "690--2, 694",
pmid = "10524308",
year = "1999"}

Such cases are too complex for this pea brain program to handle so it
does nothing and thereby avoids messing up the page numbers.  Note:
the original page number string at pubmed, '690-2, 694' is incorrect. 
It removes 693 (which is an ad) but not 691 (which is also an ad).

********************************************************************************

technical notes

   The entire title is surrounded by {} to protect capitalized words.  (Done
   1997 March 20)

   Medline insists on inserting " [In Process Citation]" into the tile of new
   partially completed (?) references.  The program removes this string when
   it is found at the end of the title. (Done 1997 June 14)
   See bug note above.

   1998 June 30: The program now handles Jr cases such as
      AU  - Kazazian HH Jr
   by combining the Jr with the last name in the bibliography (as HH
   {Kazazian Jr} and by dropping it from the keyname.

   1999 Sep 5:  I upgraded mq to the medquery script.  This script uses wget
   to grab the medline format.  This means that you can get a pubmed
   reference and just save it.  Medquery doesn't care whether you save it as
   mac, pc or unix, and it will get the medline format by wget.  Then it
   converts to bibtex format.  So you only have to click on save twice - it's
   much faster!

   2000 July 27: The old medline linK

http://www4.ncbi.nlm.nih.gov/Entrez/medline.html

   is no longer active.  It produced a "query" file.  This automatically
   takes one to the new location:

http://www4.ncbi.nlm.nih.gov/entrez/query.fcgi

   This produces a "query.fcgi" file.

   2011 Oct 21:  No author list can be legitimate, see: PubMed 2410266
   http://www.ncbi.nlm.nih.gov/pubmed/2410266
   Eur J Biochem. 1985 Jul 1;150(1):1-5.
   Nomenclature Committee of the International Union of Biochemistry
   (NC-IUB). Nomenclature for incompletely specified bases in nucleic
   acid sequences. Recommendations 1984.
   [No authors listed]

2013 Jun 13, 1.99: PMID 15903968 gives two cases of
Ingber DE.  Previous use of IR for PMID 21051339 crashed.
google: medline IR
http://www.nlm.nih.gov/bsd/mms/medlineelements.html
MEDLINE\textsuperscript{\textregistered}/
PubMed\textsuperscript{\textregistered}
Data Element (Field) Descriptions
IR, FIR = Investigator Name and Full Investigator Name
Au, FAU = Author, Full Author
So IR is not appropriate for a reference.
BUT PMID 21051339 has no authors!
To keep cases with no authors, no change to code.  There will be duplicates
when there is an AU and an IR for the same person.  CODE COULD BE WRITTEN
TO LOOK FOR THIS using equalstring.

*)
(* end module describe.medlinebib *)

(* Old link removed from documentation  2013 Aug 27.  It was dead at
one time with notation"{probably a dead link}" but today is ok. 
However, it's old.  ftp://gnjilux.cc.fer.hr/pub/unix/util/wget/ *)

(* fixed bugs:
 Authors with Jr:
AU  - Kazazian HH Jr
 are processsed incorrectly to:
  and J. r. {Kazazian HH}",
*)

(* begin module const.medlinebib *)
   titleindent = 10; (* number of characters in 'title = "{',
      the title wrap needs to account for these. *)
   maxtitlelinesize = 78; (* the maximum characters per title line *)
{ 2013 Sep 11: changed to '.'
   spacereplace = '-'; (* character to replace space in names for key *)
}
   spacereplace = '.'; (* character to replace space in names for key *)
(* end module const.medlinebib *)

(* begin module string.const *)
      maxstring = 2000; (* the maximum string *)
(* end module string.const version = 5.29; (@ of prgmod.p 2006 Jun 06 *)

(* begin module datetime.const *)
   datetimearraylength = 19; (* length of dataarray for dates,
       It is just long enough to include the 4 digit year - solving the
       year 2000 problem:
1980/06/09 18:49:11
123456789 123456789 
         1         2
*)
(* end module datetime.const version = 1.33; (@ of timep2c.p 2017 Feb 21 *)

type
(* begin module string.type *)
   stringptr = ^string; (* pointer to a string *)
   string = record (* a string of characters *)
      letters: array[1..maxstring] of char; (* the letters in the string *)
      length: integer; (* the number of characters in the string *)
      current: integer; (* the letter we are working on *)
      next: stringptr; (* the next string in a series *)
   end;
(* end module string.type version = 5.29; (@ of prgmod.p 2006 Jun 06 *)

   identifier = packed array[1..4] of char;
   (* identifier in medline formation - left edge of the file *)
   (* 2008 Jun 05:  I increased the array size from 2 to
      4 characers long to account for the longer size *)

(* begin module datetime.type *)
   (* array for dates *)
   datetimearray = packed array[1..datetimearraylength] of char;
(* end module datetime.type version = 1.33; (@ of timep2c.p 2017 Feb 21 *)

var
   query, (* file used by this program *)
   medlinebibp, (* file used by this program *)
   bibformat: text; (* file used by this program *)
   debugging: boolean; (* are we debugging the program? *)

   numbers: set of '0'..'9';

(* begin module halt *)
procedure halt;
(* stop the program.  the procedure performs a goto to the end of the
   program.  you must have a label:
      label 1;
   declared, and also the end of the program must have this label:
      1: end.
   examples are in the module libraries.
   this is the only goto in the delila system. *)
begin
      writeln(output,' program halt.');
      goto 1
end;
(* end module halt version = 1.17; (@ of timegpc.p 2002 Oct 9 *)

(* begin module copyaline *)
procedure copyaline(var fin, fout: text);
(* copy a line from file fin to file fout *)
begin (* copyaline *)
      while not eoln(fin) do begin
         fout^ := fin^;
         put(fout);
         get(fin)
      end;
      readln(fin);
      writeln(fout);
end; (* copyaline *)
(* end module copyaline version = 5.29; (@ of prgmod.p 2006 Jun 06 *)

(* begin module clearstring *)
(* These modules clear strings in various ways *)
(* ---- *)
procedure emptystring(var ribbon: string);
(* empty the contents of the string but do NOT
remove the pointer.  This is useful for clearing
one string within a linked list of them. *)
var   index: integer; (* to the ribbon *)
begin (* clearstring *)
   with ribbon do begin
      for index := 1 to maxstring do letters[index] := ' ';
      length := 0;
      current := 0;
   end
end; (* emptystring *)
(* ---- *)
procedure clearstring(var ribbon: string);
(* empty the string and remove the pointer *)
begin (* clearstring *)
   with ribbon do begin
      emptystring(ribbon);
      next := nil;
   end
end; (* clearstring *)
(* ---- *)
procedure initializestring(var ribbon: string);
(* start the string with a nil pointer.   This routine
should be called before doing linked list work.  This allows
the standard string routines to clear the string without
killing the pointer.  This is now deprecated, do not use it
since clearstring still clears the next pointer. *)
begin (* initializestring *)
   writeln(output,'remove initializestring routine!');
   writeln(output,'replace it with clearstring routine!');
   halt; (* to force deprecation *)
   clearstring(ribbon);
   ribbon.next := nil;
end; (* initializestring *)
(* end module clearstring version = 5.29; (@ of prgmod.p 2006 Jun 06 *)

procedure writestring(var tofile: text; var s: string);
(* write the string s to file tofile, no writeln *)
var   i: integer; (* index to s *)
begin (* writestring *)
      with s do for i := 1 to length do write(tofile, letters[i])
end; (* writestring *)

(* begin module interact.getstring *)
procedure getstring(var afile: text; var buffer: string;
                    var gotten: boolean);
(* get a line (as a string) from a file not using string calls.  this lets
one obtain lines from a file without interactive prompts *)
var   index: integer; (* of buffer *)
begin (* getstring *)
      clearstring(buffer);
      if eof(afile)
      then gotten := false
      else begin
         index := 0;
         while (not eoln(afile)) and (index < maxstring) do begin
            index := succ(index);
            read(afile, buffer.letters[index])
         end;
         if not eoln(afile) then begin
            writeln(output, ' getstring: a line exceeds maximum string size (',
                            maxstring:1,')');
            halt
         end;
         buffer.length := index;
         buffer.current := 1;
         readln(afile);
         gotten := true
      end
end; (* getstring *)
(* end module interact.getstring version = 5.29; (@ of prgmod.p 2006 Jun 06 *)

(* begin module concatstring *)
procedure concatstring(var a, b: string; var c: string);
(* concatenate a and b and put in c *)
var   abindex: integer; (* index to both strings *)
      cindex: integer; (* index to both strings *)
begin (* concatstring *)
   emptystring(c);
   c.length := a.length + b.length;
   if c.length > maxstring then begin
      writeln(output,'string too long in concatstring');
      halt
   end;

   cindex := 0;
   for abindex := 1 to a.length do begin
      cindex := succ(cindex);
      c.letters[abindex] := a.letters[abindex]
   end;

   for abindex := a.length+1 to a.length+b.length do begin
      cindex := succ(cindex);
      c.letters[abindex] := b.letters[abindex-a.length]
   end;
end; (* concatstring *)
(* end module concatstring version = 5.29; (@ of prgmod.p 2006 Jun 06 *)

(* begin module copystring *)
procedure copystring(a: string; var b: string);
(* copy string a to b.  The length, characters and
where the string points to are all copied. *)
var l: integer; (* index to the string *)
begin
   b.length := a.length;
   for l := 1 to a.length do b.letters[l] := a.letters[l];
   b.current := a.current;
   b.next := a.next;
end;
(* end module copystring version = 5.29; (@ of prgmod.p 2006 Jun 06 *)

(* begin module attachstring *)
procedure attachstring(var a: string; b: string);
(* attach the string b onto the end of a *)
var
   hold: string; (* intermediate for doing the attachment *)
begin
   copystring(a, hold);
   concatstring(hold,b,a)
end;
(* end module attachstring version = 5.29; (@ of prgmod.p 2006 Jun 06 *)

(* begin module equalstring *)
function equalstring(a, b: string): boolean;
(* Test for equality between two strings at current positions.
NOTE:  A compiler bug results if one directly tests this way:
   if thedefinition^.nametag = aname
The reason is completely not clear!  I showed that the parts of the
strings were identical, but the whole was not by this test.
For this reason it is *critical to test strings with equalstring.
*)
var   index: integer; (* index to both strings *)
      equal: boolean; (* are letters in a and b the same? *)
begin (* equalstring *)
      if a.length = b.length
      then begin
         index := 1;
         repeat
            equal := (a.letters[index] = b.letters[index]);
            index := succ(index)
         until (not equal) or (index > a.length);
         equalstring := equal
      end
      else equalstring := false
end; (* equalstring *)
(* from version = 5.67; * of prgmod.p 2017 Sep 29 by hand *)
(* end module equalstring *)

(* begin module getdatetime *)
procedure getdatetime(var adatetime: datetimearray);
(* Get the date and time into a single array from the system clock.
   adatetime contains the date: 
       1980/06/09 18:49:11
         ye mo da ho mi se
(year, month, day, hour, minute, second)
This version works after translation of the pascal by p2c
to C and then compiling with gcc. *) 
var 
   adate, atime: packed array[1..datetimearraylength] of char;
{
   adate, atime: alfa; (* ie, packed array[1..10] of char; *)
This old method won't work, since the last digit gets cut off!
}
   month: packed array[1..3] of char;
   index: integer; (* index for times *) 
begin 
(*
                1 
      12345678901
adate[13-DEC-1999]
atime[17:39:44.00]
*)

   date(adate);
   time(atime);

{
writeln(output,'br: adate[',adate,'] atime[',atime,']');
}

   (* transfer the year *)
   for index:=1 to 4 do adatetime[index]:=adate[index+7];
   adatetime[5]:='/';
   for index:=4 to 6 do month[index-3]:=adate[index];
        if month='JAN' then begin adatetime[6]:='0'; adatetime[7]:='1' end 
   else if month='FEB' then begin adatetime[6]:='0'; adatetime[7]:='2' end 
   else if month='MAR' then begin adatetime[6]:='0'; adatetime[7]:='3' end 
   else if month='APR' then begin adatetime[6]:='0'; adatetime[7]:='4' end 
   else if month='MAY' then begin adatetime[6]:='0'; adatetime[7]:='5' end 
   else if month='JUN' then begin adatetime[6]:='0'; adatetime[7]:='6' end 
   else if month='JUL' then begin adatetime[6]:='0'; adatetime[7]:='7' end 
   else if month='AUG' then begin adatetime[6]:='0'; adatetime[7]:='8' end 
   else if month='SEP' then begin adatetime[6]:='0'; adatetime[7]:='9' end 
   else if month='OCT' then begin adatetime[6]:='1'; adatetime[7]:='0' end 
   else if month='NOV' then begin adatetime[6]:='1'; adatetime[7]:='1' end 
   else if month='DEC' then begin adatetime[6]:='1'; adatetime[7]:='2' end;
   adatetime[8]:='/';
   for index:=7 to 8 do adatetime[index+2]:=adate[index-6];

   (* replace blanks with spaces in dates *)
   if adatetime[6]=' ' then adatetime[6]:='0';
   if adatetime[9]=' ' then adatetime[9]:='0';

   adatetime[9+2]:=' ';
   for index:=10 to 17 do adatetime[index+2]:=atime[index-9];
end;
(* end module getdatetime version = 1.33; (@ of timep2c.p 2017 Feb 21 *)

(* begin module writedatetime *)
procedure writedatetime(var thefile: text; adatetime: datetimearray);
(* expand the date and time out and print in the file *)
var
      index: integer; (* index of datetime *)
begin
      for index:=1 to datetimearraylength do write(thefile,adatetime[index])
end;
(* end module writedatetime version = 1.33; (@ of timep2c.p 2017 Feb 21 *)

(******************************************************************************)

procedure upgradeparameters(var medlinebibp: text);
(* upgrade medlinebibp parameters from parameterversion to current version *)
var
   parameterversion: real; (* current version of the parameters *)
   hold: text; (* hold the contents of medlinebibp *)
begin
   (* read this in here to make the routine independent *)
   reset(medlinebibp);
   readln(medlinebibp, parameterversion);

{
writeln(output, 'parameterversion = ', parameterversion:20:19);
}

   if round(100*parameterversion) < round(100*1.47) then begin
      (* upgrade to 1.47 *)
      writeln(output,'upgrading medlinebibp to version 1.47');

      (* store the parameters in the hold file *)
      rewrite(hold);
      while not eof(medlinebibp) do begin
         copyaline(medlinebibp, hold);
      end;

      (* rebuild the medlinebibp file *)
      reset(hold);
      rewrite(medlinebibp);
      writeln(medlinebibp, updateversion:4:2,
      '  version of medlinebibp that this parameter file is designed for.');

      (* put the held parameters into medlinebibp *)
      while not eof(hold) do begin
         copyaline(hold, medlinebibp);
      end;

      (* add the new parameter to medlinebibp *)
      writeln(medlinebibp,
      'd     ''d'' = double dash page numbers: 1--5, otherwise single dash.');

   end;

   if round(100*parameterversion) < round(100*1.74) then begin
      (* upgrade to 1.74 *)
      writeln(output,'upgrading medlinebibp to version 1.74');

      reset(medlinebibp);
      readln(medlinebibp, parameterversion);

      (* store the parameters in the hold file *)
      rewrite(hold);
      while not eof(medlinebibp) do begin
         copyaline(medlinebibp, hold);
      end;

      (* rebuild the medlinebibp file *)
      reset(hold);
      rewrite(medlinebibp);
      writeln(medlinebibp, updateversion:4:2,
      '  version of medlinebibp that this parameter file is designed for.');

      (* put the held parameters into medlinebibp *)
      while not eof(hold) do begin
         copyaline(hold, medlinebibp);
      end;

      (* add the new parameter to medlinebibp *)
      writeln(medlinebibp,
      '70    The title line size, in characters.');

   end;

   if round(100*parameterversion) < round(100*1.97) then begin
      (* upgrade to 1.97 *)
      writeln(output,'upgrading medlinebibp to version 1.97');

      reset(medlinebibp);
      readln(medlinebibp, parameterversion);

      (* store the parameters in the hold file *)
      rewrite(hold);
      while not eof(medlinebibp) do begin
         copyaline(medlinebibp, hold);
      end;

      (* rebuild the medlinebibp file *)
      reset(hold);
      rewrite(medlinebibp);
      writeln(medlinebibp, updateversion:4:2,
      '  version of medlinebibp that this parameter file is designed for.');

      (* put the held parameters into medlinebibp *)
      while not eof(hold) do begin
         copyaline(hold, medlinebibp);
      end;

      (* add the new parameter to medlinebibp *)
      writeln(medlinebibp,
      'f     date in a comment: '' '': none; f: full');

   end;

   if round(100*parameterversion) < round(100*2.97) then begin
      (* upgrade to 2.08 *)
      writeln(output,'upgrading medlinebibp to version 2.08');

      reset(medlinebibp);
      readln(medlinebibp, parameterversion);

      (* store the parameters in the hold file *)
      rewrite(hold);
      while not eof(medlinebibp) do begin
         copyaline(medlinebibp, hold);
      end;

      (* rebuild the medlinebibp file *)
      reset(hold);
      rewrite(medlinebibp);
      writeln(medlinebibp, updateversion:4:2,
      '  version of medlinebibp that this parameter file is designed for.');

      (* put the held parameters into medlinebibp *)
      while not eof(hold) do begin
         copyaline(hold, medlinebibp);
      end;

      (* add the new parameter to medlinebibp *)
      writeln(medlinebibp,
      '\todobf{MISSING}');
{zq}

   end;

end; (* upgradeparameters *)

(******************************************************************************)

procedure writelines(var f: text; aline: stringptr);
(* write the lines to file f *)
var
   t: stringptr; (* pointer to lines *)
begin
   t := aline;
   while t <> nil do begin
      writestring(f,t^);
      t := t^.next;
      if t <> nil then writeln(f);
   end;
end;

procedure linkend(l: stringptr; var e: stringptr);
(* locate the end of the lines *)
begin
{
writeln(output,'linkend');
}
   if l <> nil then begin
      e := l;
      while e^.next <> nil
      do e := e^.next;
   end
   else e := nil
end;

procedure putawayline(var l, big: stringptr);
(* put away all links of l into the end of the big list *)
var
   theend: stringptr; (* the end of big *)
begin
{
writeln(output,'putawayline');
}
   if l <> nil then begin
      linkend(big, theend);

      if theend = nil
      then big := l
      else theend^.next := l;

      l := nil
   end
end;

procedure getline(var l, spare: stringptr);
(* get a line l for use from the spare or make it new *)
begin
{
writeln(output,'getline');
}
   putawayline(l, spare); (* first make sure it is cleared out *)

   if spare <> nil then begin
      l := spare;
      spare := spare^.next;
      l^.next := nil;
   end
   else begin
     new(l);
     clearstring(l^);
   end;

   l^.next := nil;
end;

procedure addotherdataline(var query: text;
                  id: identifier;
                  var thelines, spare: stringptr);
(* add a string from file query
to thelines, with id in front.
use the spare list if any are available *)
var
   gotten: boolean; (* got a string from query *)
   t: stringptr; (* pointer to lines *)
   idstring: string; (* a string corresponding to id *)
   otherstuff: string; (* a string corresponding to the other data *)
begin
{
writeln(output,'addotherdataline');
}
   t := nil;  (* be sure t starts out cleanly *)
   getline(t, spare);
   getstring(query,otherstuff,gotten);

   (* convert id to string *)
   clearstring(idstring);
   idstring.letters[1] := id[1];
   idstring.letters[2] := id[2];
   idstring.letters[3] := ' ';
   idstring.length := 3;

   concatstring(idstring,otherstuff,t^);
   putawayline(t,thelines);
end;

procedure addline(var query: text;
                  var thelines, spare: stringptr);
(* add a string from file query
to thelines, use the spare list if any are available *)
var
   gotten: boolean; (* got a string from query *)
   t: stringptr; (* pointer to lines *)
   (* variable for finding duplicates: *)
   aline: stringptr; (* a line in thelines that might be duplicated by t *)
   done: boolean; (* done searching for duplicates *)
   duplidatefound: boolean; (* a duplicate name was found *)
begin
{
writeln(output,'addline');
}
   t := nil;  (* be sure t starts out cleanly *)
   getline(t, spare);
   getstring(query,t^,gotten);

{
write(output,'"');
writestring(output,t^);
writeln(output,'" t^ in addline');
}

   (* 2018 Aug 02 Find out if t exists in thelines.
      If it does, don't add - to solve the IR duplicate problem.
      This is caused by PubMed duplicating collaborators:
      IR, FIR = Investigator Name and Full Investigator Name
      Au, FAU = Author, Full Author
   *)
   if thelines <> nil then begin
      done := false;
      duplidatefound := false;
      aline := thelines;
      while not done do begin
         if aline = nil
         then done := true
         else begin
{zzzqqq}
            if equalstring(t^, aline^) then begin
               done := true;
               duplidatefound := true;
            end
         end;
         if not done then aline := aline^.next;
      end;
   end;
   if duplidatefound then begin
      write(output,'DUPLICATE AUTHOR NAME: "');
      writestring(output,t^);
      writeln(output,'" removed');
   end
   else begin
      putawayline(t,thelines);
   end;

{
writeln(output,'---- spare:');
writelines(output,spare); writeln(output);
writeln(output,'---- thelines:');
writelines(output,thelines); writeln(output);
writeln(output,'---- end addlines');
}

end;

procedure trimyear(var year: string);
(* change the year format from "1997 Jan 7" to "1997" *)
begin
{
write(output,'trimyear: "');
writestring(output,year);
writeln(output,'"');
}
   with year do begin
      current := 1;
      while (letters[current] in numbers) and (current <= length)
      do current := succ(current);
      length := pred(current);
      if length <> 4 then begin
         writeln(output, 'The year should have 4 characters.');
         write(output, 'Instead, "');
         writestring(output,year);
         writeln(output, '" was found');
         halt
      end;
   end
end;

procedure parseauthor(author: string; var first, last: string;
                      var multipart: boolean;
                      var       jr: boolean;
                      var       threerd: boolean);
(* parse the the author into first and last name
for      "Borgstahl GEO"
last is  "Borgstahl"
first is "GEO"
and
for      "de Ruyter van Steveninck RR"
last is  "de Ruyter van Steveninck"
first is "RR"
The rule is that all continuous letters at the end are
the first name parts.
If the name has more than one part, multipart is set to true.
When a Jr is at the end of the name, variable jr is set to true.
When a 3rd is at the end of the name, variable threerd is set to true.
*)
var
   a: integer; (* index to author *)
   split: integer; (* the space that splits the name in two *)
   startpoint: integer; (* where to start working backwords on the last name *)
begin
   clearstring(first);
   clearstring(last);
   multipart := false;

   (* detect Jr at end and kill it: *)
   with author do begin
      if (letters[length-2] = ' ') and
         (letters[length-1] = 'J') and
         (letters[length  ] = 'r')
      then begin
         startpoint := length - 3;
         multipart := true;
         jr := true;
{writeln(output,'JR DETECTED');}
      end
      else begin
         jr := false;
         startpoint := length
      end
   end;

   (* detect 3rd at end and kill it: *)
   with author do begin
      if (letters[length-3] = ' ') and
         (letters[length-2] = '3') and
         (letters[length-1] = 'r') and
         (letters[length  ] = 'd')
      then begin
         startpoint := length - 4;
         multipart := true;
         threerd := true;
{writeln(output,'3rd DETECTED');}
      end
      else begin
         threerd := false;
         startpoint := length
      end
   end;

{
write(output,'author: '); writestring(output,author); writeln(output);
}

   (* locate the space between last and first names *)
   split := startpoint;
   while (split > 1) and (author.letters[split] <> ' ')
   do split := pred(split);

   (* extract last name from start of author string *)
   for a := 1 to split-1 do begin
      last.length := succ(last.length);
      last.letters[last.length] := author.letters[a];
      if last.letters[last.length] = ' ' then multipart := true
   end;

   (* gently place Jr back at the end of the last name: *)
   if jr then begin
      last.letters[last.length+1] := ' ';
      last.letters[last.length+2] := 'J';
      last.letters[last.length+3] := 'r';
      last.length := last.length+3;
   end;

   (* gently place 3rd back at the end of the last name: *)
   if threerd then begin
      last.letters[last.length+1] := ' ';
      last.letters[last.length+2] := '3';
      last.letters[last.length+3] := 'r';
      last.letters[last.length+4] := 'd';
      last.length := last.length+4;
   end;

   (* extract first name from end of author string *)
   for a := split+1 to startpoint do begin
      first.length := succ(first.length);
      first.letters[first.length] := author.letters[a];
   end;

{
write(output,'first:  '); writestring(output,first); writeln(output);
write(output,'last:   '); writestring(output,last); writeln(output);
}
end;

procedure dejunior(var s: string);
(* remove the last three characters (ie " Jr") of string s *)
begin
   with s do begin
      length := length - 3
   end;
end;

procedure dethreerd(var s: string);
(* remove the last four characters (ie " 3rd") of string s *)
begin
   with s do begin
      length := length - 4
   end;
end;

procedure dotize(var s: string; dots: char; var sresult: string);
(* replace spaces with dots in string s *)
var
   i: integer; (* index to s *)
begin
{
writeln(output,'dotize: "');
writestring(output,s);
writeln(output);
}
   with s do begin
      for i := 1 to length
      do if letters[i] = ' ' then letters[i] := dots
   end;
{
writestring(output,s);
writeln(output);
}
   sresult := s
end;

procedure nospacenodash(var s: string; var sresult: string);
(* Remove spaces and dashes from string s
2014 Feb 19: this routine replaces dotize. *)
var
   i: integer; (* index to s current location in input s *)
begin
{
writeln(output,'nospacenodash: "');
writestring(output,s);
writeln(output);
}
   clearstring(sresult);
{zzz}
{writeln(output,'sresult.length = ',sresult.length:1);}
   for i := 1 to s.length do begin
{write(output,'i=',i:2,' ',s.letters[i]);}
      if not (s.letters[i] in [' ','-']) then begin
{write(output,' NOT DASH');}
         sresult.length := sresult.length + 1;
         sresult.letters[sresult.length] := s.letters[i];
{
write(output,'; sr=',sresult.letters[sresult.length]);
sresult.letters[sresult.length] := 'x';
}
      end;
{writeln(output);}
   end;
{
write(output,'s      : "');
writestring(output,s);
writeln(output,'"');
write(output,'sresult: "');
writestring(output,sresult);
writeln(output,'"');
}
end;

procedure noquotes(var s: string);
(* remove quote marks from string s *)
var
   i: integer; (* index to s *)
   j: integer; (* index to s *)
begin
{
writeln(output,'*** noquotes:');
writestring(output,s);
writeln(output);
}
   with s do begin
      i := 1;
      while i <= length do begin
        if (letters[i] = '"') or
           (letters[i] = '''')
        then begin
           for j := i to length - 1
           do letters[j] := letters[j+1];
           length := length -1;
        end;
        i := succ(i)
      end
   end;
{
writestring(output,s);
writeln(output);
}
end;

procedure makekey(var thekey: string;
                  authors: stringptr; finalauthor: boolean;
                  year: string);
(* create a key from the years and the author *)
var
   authorkey: string; (* intermediate string 'last1' or 'last1.last2' *)
   dot: string; (* '.' *)
   dummy: string; (* a throwaway variable to keep dotize happy *)
   first1, last1: string; (* first and last names of first author *)
   first2, last2: string; (* first and last names of second author *)
   jr: boolean; (* true if a last name has a jr *)
   threerd: boolean; (* true if a last name has a 3rd *)
   multipart: boolean; (* true if a last name is multipart *)
   theend: stringptr; (* the end of authors *)
begin
{
   writeln(output,'makekey');
}
   clearstring(thekey);
   if authors = nil then begin
      writeln(output,'Makekey: author list is nil');
      halt;
   end;
   parseauthor(authors^,first1,last1,multipart,jr,threerd);
   if jr then dejunior(last1);
   if threerd then dethreerd(last1);

   if authors^.next <> nil
   then begin (* form last1.last2 *)

      if finalauthor
      then begin
         linkend(authors,theend);
         parseauthor(theend^,first2,last2,multipart,jr,threerd);
      end
      else parseauthor(authors^.next^,first2,last2,multipart,jr,threerd);
      if jr then dejunior(last2);
      if threerd then dethreerd(last1);

      clearstring(dot);
      dot.length := 1;
      dot.letters[dot.length] := '.';
      clearstring(authorkey);

      (* remove quotes from the key names: *)
      noquotes(last1);
      noquotes(last2);

      (* OLD: blanks are converted to underscores in multipart author names: *)
      (* 2014 Feb 19: blanks are REMOVED in multipart author names: *)
{
      dotize(last1,spacereplace,dummy);
zzz
}
      nospacenodash(last1,dummy);
      attachstring(authorkey,dummy);
      attachstring(authorkey,dot);
{
      dotize(last2,spacereplace,dummy);
}
      nospacenodash(last2,dummy);
      attachstring(authorkey,dummy);
   end
   else begin (* form last1 *)
      {copystring(last1,authorkey); OLD METHOD}
      nospacenodash(last1,dummy);
      clearstring(authorkey);
      attachstring(authorkey,dummy);
   end;

   (* space inside a single author name is converted to underscores...
   no dash ... no remove it! *)
{
   dotize(authorkey,spacereplace,dummy);
}
   nospacenodash(authorkey,dummy);

   concatstring(authorkey,year,thekey);
end;

procedure fixauthors(var authors: stringptr);
(* put authors into bibtex format,
starting from: Borgstahl GEO
      produce: G. E. O. Borgstahl
with 'and ' proceeding the second to last cases *)
var
   a: stringptr; (* pointer to author list *)
   andstring: string; (* string with ' and ' *)
   dotspace: string; (* string with '. ' *)
   i: integer; (* index to initial string *)
   initial: string; (* string with one initial *)
   first, last: string; (* first and last names of an author *)
   firstauthor: boolean; (* only true when at first author *)
   jr: boolean; (* true if a last name has a jr *)
   threerd: boolean; (* true if a last name has a 3rd *)
   leftcurlie: string; (* string with '{' *)
   multipart: boolean; (* true if a last name is multipart *)
   rightcurlie: string; (* string with '}' *)
begin
{
   writeln(output,'fixauthors');
}
   clearstring(andstring);
   with andstring do begin
      letters[1] := ' ';
      letters[2] := 'a';
      letters[3] := 'n';
      letters[4] := 'd';
      letters[5] := ' ';
      length := 5;
   end;

   clearstring(dotspace);
   with dotspace do begin
      letters[1] := '.';
      letters[2] := ' ';
      length := 2;
   end;

   clearstring(leftcurlie);
   with leftcurlie do begin
      letters[1] := '{';
      length := 1;
   end;

   clearstring(rightcurlie);
   with rightcurlie do begin
      letters[1] := '}';
      length := 1;
   end;

   clearstring(initial);
   with initial do begin
      letters[1] := ' ';
      length := 1;
   end;

   firstauthor := true;
   a := authors;

   while a <> nil do begin
      parseauthor(a^,first,last,multipart,jr,threerd);
      emptystring(a^);

      if not firstauthor
      then attachstring(a^,andstring)
      else firstauthor := not firstauthor;

      for i := 1 to first.length do begin
         initial.letters[1] := first.letters[i];
         attachstring(a^,initial);
         attachstring(a^,dotspace);
      end;

      (* put curlies around author name if multipart *)
      if multipart then attachstring(a^,leftcurlie);
      attachstring(a^,last);
      if multipart then attachstring(a^,rightcurlie);
      a := a^.next
   end;
end;

procedure fixtitle(var title: stringptr);
(* Correct titles:
* Remove periods from the ends of titles.
* Remove " [In Process Citation]" (ipc) from titles.
* Replace '%' with '\%'.
*)
const
   ipclength = 22; (* length of ipc array *)
{new version will be:
   ipclength = 19; (* length of ipc array *)
}
var
   aline: stringptr; (* a line of the title *)
   done: boolean; (* done looking for ipc *)
   fixpercent: boolean; (* fix percentage mark *)
   foundipc: boolean; (* ipc was found *)
   ipc: packed array[1..ipclength] of char; (* string to delete *)
   i: integer; (* index to ipc *)
   t: integer; (* index to title *)
   theend: stringptr; (* the last line of the title *)
begin
   linkend(title,theend);

{

The code does not yet handle multi line cases:

UI  - 98079171
AU  - Bielinsky AK
AU  - Gerbi SA
TI  - Discrete start sites for DNA synthesis in the yeast ARS1 origin [In
      Process Citation]
LA  - Eng
DA  - 19980108
DP  - 1998 Jan 2
IS  - 0036-8075
TA  - Science
PG  - 95-8
SB  - M
SB  - X
CY  - UNITED STATES
IP  - 5347
VI  - 279
JC  - UJ7
AA  - AUTHOR
AB  - Sites of DNA synthesis initiation have been detected at the nucleotide
      level in a yeast origin of bidirectional replication with the use of
      replication initiation point mapping. The ARS1 origin of Saccharomyces
      cerevisiae showed a transition from discontinuous to continuous DNA
      synthesis in an 18-base pair region (nucleotides 828 to 845) from
      within element B1 toward B2, adjacent to the binding site for the
      origin recognition complex, the putative initiator protein.
AD  - Department of Molecular Biology, Cell Biology and Biochemistry,
      Division of Biology and Medicine, Brown University, Providence, RI
      02912, USA.
RO  - O:099
PMID- 0009417033
SO  - Science 1998 Jan 2;279(5347):95-8

   write(output, 'title end line: "');
   writestring(output, theend^.s);
   writeln(output,'"');
   with theend^.s do begin
      (* remove period from end of title *)
      if letters[length] = '.' then length := pred(length);
   end;

   (* See if ipc exists.  It can go over several lines *)
(*         123456789 123456789 123456789  *)
(*                  1         2         3 *)
   ipc := '[InProcessCitation]';
   aline := title;
   done := false;
   foundipc := false;
   i := 0;
   while not done do begin
      if aline = nil
      then done := true
      else begin (* look at current aline *)
         if i = aline^.length then begin
            i := 0;
            aline := aline^.next;
         end
         else begin
            i := i+1;
            if ipc[i] <> letters[t]
         end
      end;
   end;

   if foundipc then begin
      length := t;
   end: 
}

   with theend^ do begin
      (* remove period from end of title *)
      if letters[length] = '.' then length := pred(length);
      (* remove "[In Process Citation]" from end of title *)
(*        %23456789 123456789 123456789  *)
(*        %        1         2         3 *)
      ipc := ' [In Process Citation]';
      done := false;
      foundipc := false;
      i := ipclength;
      t := length;
      while not done do begin
         if i < 1 then done := true
         else if t < 1 then done := true
         else begin
            if ipc[i] <> letters[t]
            then done := true
            else if i = 1 then foundipc := true;
            t := pred(t);
            i := pred(i);
         end
      end;
      if foundipc then length := t;
   end;

   (* Search throught the title and add '\' in front of % *)
   aline := title;
   done := false;
   fixpercent := false;
{
   writestring(output,title^);
   writeln(output);
}
   while aline <> nil do begin
      with aline^ do begin
         i := length;
         while not done do begin
            if i < 1 then done := true
            else begin
               if aline^.letters[i] = '%'
               then begin
                  aline^.length := aline^.length + 1;
                  if aline^.length > maxstring then begin
                     writeln(output,'fixtitle failed: aline^.length too big');
                     halt
                  end;
                  (* move the rest of the line one space right *)
                  for t := aline^.length downto i do begin
                      aline^.letters[t] := aline^.letters[t-1]
                  end;
                  aline^.letters[i] := '\';
                  fixpercent := true;
               end;
               i := pred(i);
            end;
{write(output,' ',i:1);}
         end;
      end;
      aline := aline ^.next;
   end;
   if fixpercent then begin
      writeln(output,'==== added "\" in front of percent: ====');
      writestring(output,title^);
      writeln(output);
   end;

end;

procedure fixotherdata(var otherdata: stringptr);
(* remove double quotes from the otherdata to avoid conflict. *)
var
   i: integer; (* index to other data *)
   t: stringptr; (* a line of other data *)
begin
{
writeln(output,'fixotherdata');
}
   t := otherdata;
   while t <> nil do begin
      with t^ do begin
         for i := 1 to length
         do if letters[i] = '"' then letters[i] := '''';
{
         do if letters[i] = 'c' then letters[i] := '!';
}
      end;
      t := t^.next
   end
end;

(* begin module linesize *)
function linesize(line: stringptr): integer;
(* compute the size of the line, not including spaces.
This allows wrapped lines to be compared for length. *)
var
   c: integer; (* the count *)
   l: integer; (* the position in a line *)
   p: stringptr; (* the position in a line *)
begin
   c := 0;
   p := line;
   while p <> nil do begin
      with p^ do begin
         for l := 1 to length
         do if letters[l] <> ' '
            then c := c + 1 
      end;
      p := p^.next
   end;
   linesize := c;
end;
(* end module linesize *)

(* begin module wraplines *)
procedure wraplines(var unwrapped, wrapped: stringptr;
                    indent: integer;
                    width: integer);
(* Wrap lines in the set of lines, unwrapped.
Start the first line with indent characters already given,
and wrap lines to width characters wide.

An example is this title from pmid 15001582:

title = "{Laron syndrome (primary growth hormone resistance or
insensitivity): the personal experience 1958-2003}",

The portion 'title = "{' is the indent, 10 characters.
The width in this case is 62 characters wide.

If width < 0 then report the wrap progress. and use
abs(width) for the width.

*)
var
   done: boolean; (* done wrapping *)
   lu: stringptr; (* a line of the unwrapped *)
   lw: stringptr; (* a line of the   wrapped *)
   u: integer; (* index to unwrapped lines *)
   w: integer; (* index to   wrapped lines *)
   wcount: integer; (* count of the wrapped line *)
   lastblank: integer; (* location of the last blank in theline *)
   reporting: boolean; (* report wrap progress *)

begin

   if width < 0
   then reporting := true
   else reporting := false;

   width := abs(width);

   if width > maxstring then begin
      write  (output,'wraplines:  cannot wrap lines to be longer than');
      writeln(output,' maxstring = ', maxstring:1,' characters.');
      halt;
   end;

   if reporting then begin
      writeln(output,'---');
      writeln(output,'Wrap text details:');
      writeln(output,'The wrapping width is ',width:1, ' characters.');
      writeln(output,'Key to marked line:');
      writeln(output,'  Original line ends are indicated by "$".');
      writeln(output,'  New breakpoints are indicated by "|" and');
      writeln(output,'  the algorithm backs up to the previous space.');
      writeln(output,'  "%" - end of line found here before backing up.');
      writeln(output,'Repeated text indicates how far it backed up.');
      writeln(output,'--- unwrapped:');
      writelines(output,unwrapped);
      writeln(output);
      writeln(output,'--- wrapping process marked:');
   end;
   lu := unwrapped;
   lw :=   wrapped;
   clearstring(lw^);

   (* read through unwrapped and copy to outlines *)
   done := false;
   wcount := indent;
   indent := 0; (* reset local copy *)
   lastblank := 0;
   w := 0;
   u := 0;
   while not done do begin
      u := u + 1;
      if u > lu^.length then begin
         lu := lu^.next;
         u := 1;

         (* 2012 Apr 09: this was the cause of an extra space. *)
         (* if there is not already a space in the wrapped line,
            possibly add one *)
         if w > 1 then if lw^.letters[w] <> ' ' then begin
            (* There won't be a blank between the end of that unwrapped
            line and the next, so we had better supply one into the
            wrapped line! *)
            if (lu <> nil) then begin
               if reporting then begin
                  write(output,'[w: ',w:1,']');
                  write(output,'[u: ',u:1,']');
               end;
               w := w + 1;
               lw^.letters[w] := ' ';
               lw^.length := w;
               wcount := wcount + 1;
            end;
         end;

         if reporting then begin
            write(output, '$');
         end;
      end;
      if lu = nil
      then done := true
      else begin

{
write(output, '[',w:1,']');
write(output, '(',u:1,')');
writeln(output);
}

{
write(output,'lu^ = ');
writestring(output,lu^);
writeln(output);
write(output,'lw^ = ');
writestring(output,lw^);
writeln(output);
}

         if reporting then begin
            write(output, lu^.letters[u]);
         end;

         (* Locate the blank on the WRAP line!! *)
         if w > 0 (* fix of 2009 Nov 21 bug *)
         then if lw^.letters[w] = ' ' then lastblank := w;

         if wcount >= width then begin
            (* break to a new line *)

            if lastblank > 1 then begin
               lw^.length := lastblank - 1;

               (* The unwrapped line cannot know anything about the
               wrapped line.  But it has to back up equivalently: *)

               u := u-(w-(lastblank-1));

               if u < 0 then begin
                  writeln(output);
                  writeln(output,'wraplines: unable to wrap, u < 1');
                  writeln(output,'u = ',u:1);
                  halt
               end;

               if reporting then write(output,'%');
            end
            else begin
               (* there were no blanks to back up to! *)
               if wcount > maxstring then begin
                  writeln(output);
                  writeln(output,'wraplines: unable to wrap:');
                  writeln(output,'line exceeds maxstring, ', maxstring:1);
                  halt
               end;
write(output,'@');
writeln(output);
write(output,'can not wrap line');
halt; (* freeze program if this case happens *)
               lw^.length := w;
            end;

            new(lw^.next);
            lw := lw^.next;
            clearstring(lw^);
            wcount := indent;
            w := 0;
            lastblank := 0;
            if reporting then begin
               write(output, '|');
            end;
         end
         else begin
            w := w + 1;
            lw^.letters[w] := lu^.letters[u];
            lw^.length := w;
            wcount := wcount + 1;
         end;
      end;
   end;

   if reporting then begin
      writeln(output);
      writeln(output,'--- wrapped:');
      writelines(output,wrapped);
      writeln(output);
      writeln(output,'--- length consistency check:');
      writeln(output,'        line without spaces: ',linesize(unwrapped):1,
                     ' characters');
      writeln(output,'wrapped line without spaces: ',linesize(  wrapped):1,
                     ' characters');
      if linesize(unwrapped) <> linesize(wrapped) then begin
         writeln(output,'LINE DID NOT WRAP PROPERLY');
         writeln(output,'IT WILL NOT BE WRAPPED');
         (* overwrite the wrap: *)
         wrapped := unwrapped;
      end
      else begin
         writeln(output,'SUCCESSFUL WRAP');
      end;
      writeln(output);
   end;

end;
(* end module wraplines *)

(* begin module changepagenumbers *)
(* changes a string of numbers in the form 507-10 to a string in the form
   507-510 *)

function scanpages(pages: string): boolean;
(* scans the "pages" string (that contains the original page numbers) for any
characters other than numbers or dashes.  The only characters in the string are
the normal ones, 0..9 and - *)
{
const
   chset=['0'..'9']+['-']; (* allowable characters in the string *)
This is not allowed in standard Pascal ...
GPC says: 'ISO 7185 Pascal allows only simple constants'
}
var
   index: integer; (* index of position in array *)
begin
   scanpages := true;
   for index := 1 to pages.length
{
      do if not (pages.letters[index] in chset)
}
      do if not (pages.letters[index] in ['0'..'9','-'])
         then scanpages := false;
end;

procedure determinedigits( var digits1, digits2, (* number of digits in first
                                                    and second numbers *)
                               dash: integer;    (* position of dash in pages
                                                    string *)
                               pages: string);   (* string of original page
                                                    numbers *)
(* determines the number of digits in the first and second numbers.
If there is only one page number, dash is set to zero. *)
begin
{
   pages.current:=1; original bug!
writeln(output,'pages.length = ', pages.length:1);
}
   pages.current:=0;
   repeat pages.current:=succ(pages.current)
   until (pages.letters[pages.current]='-') or
         (pages.current = pages.length);
   if  pages.current = pages.length
   then begin
      dash := 0;
      digits1:=pages.current;
      digits2:=0;
{
writeln(output,'only one page number');
}
   end
   else begin
      dash:=pages.current;
      digits1:=pages.current-1;
      repeat pages.current:=succ(pages.current)
      until pages.current = pages.length;
      digits2:=pages.current-dash;
   end;
{
writeln(output,'determinedigits: digits1: ',digits1:1);
writeln(output,'determinedigits: digits2: ',digits2:1);
}
end;

procedure writeover(var pages: string; (* string of original page numbers to
                                          be modified *)
                    digits1, digits2: integer); (* number of digits in first
                                                   and second numbers *)
(* replaces last characters of first number with second number *)
var
   replace: integer; (* number of digits to replace *)
   index: integer; (* index of location in array during replacement *) 
begin
   replace:=digits2;
   index:=0;
   while replace > 0 do begin
      pages.letters[digits1-index]:=pages.letters[pages.length-index];
      index:=index+1;
      replace:=replace-1;
   end; 
end;

procedure changepages(pages: string; var newpages: string);
(* changes the page numbers in 'pages' to their expanded form if the only
characters in the string are the normal ones, 0..9 and -.  For example:
 input pages: "507-10"
output pages: "507-510"

 input pages: "902-4"
output pages: "902-904"

 input pages: "902-14"
output pages: "902-914"

 input pages: "902-914"
output pages: "902-914"

special case:  One page number.  Then no change.
Variable newpages is the new page numbers.
 *)
var
   dash: integer; (* location of dash in array *)
   digits1, digits2: integer; (* number of digits in first and second
                                 numbers *)
   index: integer; (* index for writing pages to changepages *)
begin 
   if scanpages(pages) then begin
      determinedigits(digits1, digits2, dash, pages);
      if dash = 0 then begin (* only one page number *)
         newpages := pages
      end
      else if digits2 < digits1 then begin
{
writeln(output,'changepagenumbers: dash: ',dash:1);
writeln(output,'changepagenumbers: digits2 < digits1');
writeln(output,'changepagenumbers: digits1: ',digits1:1);
writeln(output,'changepagenumbers: digits2: ',digits2:1);
write(output,'changepagenumbers: pages: "');
writestring(output,pages); writeln(output,'"');
}
         clearstring(newpages);
         copystring(pages, newpages);
         newpages.length:=2*digits1+1;
         for index:= 1 to dash
            do newpages.letters[index]:=pages.letters[index];
{
write(output,'changepagenumbers: newpages: "');
writestring(output,newpages); writeln(output,'"');
}
         writeover(pages, digits1, digits2);
{
write(output,'changepagenumbers: newpages: "');
writestring(output,newpages); writeln(output,'"');
}
         for index:= 1 to digits1
            do newpages.letters[dash+index]:=pages.letters[index];
{
write(output,'changepagenumbers: newpages: "');
writestring(output,newpages); writeln(output,'"');
}
{
old code objected to by gpc:
         newpages.length:=2*digits1+1;
         for index:= 1 to dash
            do newpages.letters[index]:=pages.letters[index];
         writeover(pages, digits1, digits2);
         for index:= 1 to digits1
            do newpages.letters[dash+index]:=pages.letters[index];
}

      end
      else newpages := pages
   end
   else newpages := pages
end;

procedure makedoubledash(pages: string; var newpages: string);
(* convert page numbers of the form 1-2 into 1--2.
If there is no dash, don't do anything.
Variable newpages is the new page numbers. *)
var
   isdash: boolean; (* is there a dash? *)
   index: integer; (* index for the strings *)
begin
{
   writeln(output,'makedoubledash');
}
   copystring(pages, newpages);
{
   writestring(output, pages); writeln(output);
}

   (* find out if there is a dash *)
   isdash := false;
   for index := 1 to pages.length do begin
      if pages.letters[index] = '-' then begin
         isdash := true;
         newpages.letters[index+1] := '-';
         newpages.length := newpages.length+1;
      end;
      if isdash then begin
         newpages.letters[index+1] := pages.letters[index];
      end;
   end;
{
   writestring(output, newpages); writeln(output);
}

end;

(* end module changepagenumbers *)

(* begin module medlinebib.themain *)
procedure themain(var query, medlinebibp, bibformat: text);
(* the main procedure of the program *)
var

   authors: stringptr; (* a set of strings for the authors *)
   otherdata: stringptr; (* other data *)
   entryin: boolean; (* we have an entry in the program at the moment *)
   everything: boolean; (* show everything in the medline entry? *)
   finalauthor: boolean; (* if true, use final author for bibtex key *)
   doubledash: boolean; (* if true, doubledash the page numbers *)
   gotten: boolean; (* got a string from query *)
   id: identifier; (* identifier characters for a line *)
   journal: string; (* a substring from the query *)
   pages: string; (* a substring from the query *)
   pmid: string; (* a substring from the query, the PMID identifier *)
   pmcid: string; (* a substring from the query, the PMC identifier *)
   doi: string; (* a substring from the query, the DOI identifier *)
   maybedoi: string; (* potentially the doi string *)
   isadoi: boolean; (* whether the maybedoi is a doi or not *)
   parameterversion: real; (* parameter version number *)
   spare: stringptr; (* extra lines *)
   title: stringptr; (* a set of strings for the title *)
   titlewrap: stringptr; (* the title, wrapped *)
   volume: string; (* a substring from the query *)
   year: string; (* a substring from the query *)
   s: string; (* string for debugging *)
   thekey: string; (* key for locating the reference *)
   titlelinesize: integer; (* requested maximum characters per title line *)

   adatetime: datetimearray; (* current date and time *)

   datecomment: boolean; (* if true, write the current date and time  
                            into a comment *)
   {datefile: text; (* text file for making the datetime have '_'
      instead of ' ' *) hold for now}
   emptystring: string; (* an empty string *)
{zq}

procedure processdoi(var id: identifier; var doi: string; var isadoi: boolean);
(* Process the DOI string.  id is either LID or AID in the query.
isadoi is whether it is a doi.
The format is:
LID - 10.1038/ncomms8486 [doi]
so the string looks like:
'10.1038/ncomms8486 [doi]'
Remove the ' [doi]' and add the http part.
This is to be done ONLY if the string ends on '[doi]'
since there are three possibilities:
LID - 10.1016/j.jtbi.2015.01.042 [doi]
LID - S0022-5193(15)00059-4 [pii]
---
In the case of arXiv, handle that:
LID - arXiv:2301.00783v2
 becomes:	
https://doi.org/10.48550/arXiv.2301.00783
*)
var
   currentlength: integer; (* initial length of the doi string *)
   i: integer; (* index to the doi string *)
   shift: integer; (* amount to shift the string for arXiv *)
   vcount: integer; (* Count the v's in the url.  one is in 'arXiv' *)
begin
   isadoi := false; (* presume guilty until proven innocent and valid DOI!! *)
   with doi do begin
      write(output,'"',id[1],id[2],id[3],' - '); (* it is either AID or LID *)
      writestring(output,doi);
      if (letters[length-4] = '[') and
         (letters[length-0] = ']') then begin
         if (letters[length-3] = 'd') and
            (letters[length-2] = 'o') and
            (letters[length-1] = 'i') then begin
            writeln(output,'" is doi');
            while (length > 0) and (letters[length] <> ' ')
            do begin
               letters[length] := 'x';
               length := length - 1;
            end;
            length := length - 1;
            isadoi := true;
         end
         else begin
            writeln(output,'" is not doi');
            clearstring(doi);
            isadoi := false;
         end
      end
      else begin
{
         writeln(output,'" this LID does not have [] IGNORING');
         writeln(output,'" this LID does not have []');
}
         writeln(output,'" this ',ID,'does not have []');
         (* 2022 Nov 22 apparently LID without [] is now a thing in eutils.
            The simple solution is to ignore it instead of halting. *)
         (* 2024 Jan 07 the format can now be arxiv:
            LID - arXiv:2301.00783v2
            for that, construct:
            https://arxiv.org/abs/2301.00783v2
         *)
         writeln(output,'Is it an arXiv preprint?');
         if (letters[1] = 'a') and
            (letters[2] = 'r') and
            (letters[3] = 'X') and
            (letters[4] = 'i') and
            (letters[5] = 'v') and
            (letters[6] = ':') then begin
            writeln(output,'Yes it is an arXiv preprint!!');
            isadoi := true;
            (* notes on the format:
            LID - arXiv:2301.00783v2
             becomes:	
            https://doi.org/10.48550/arXiv.2301.00783
            ---
            The string changes like this:
            arXiv:2301.00783v2
            to
            10.48550/arXiv.2301.00783
            more length:      1234567
            123456789
            *)

            currentlength := length;
            shift := 9; (* amount to shift the data to the right *)
            length := length + shift;
            (* move it over: *)
            vcount := 0; (* Count the v's *)

{
            for i := currentlength downto 1 do begin
               if letters[i] = 'v' then vcount := succ(vcount);
               (* a second v is the version - remove it!!! *)
               if vcount <= 1
               then letters[i + shift] := letters[i];
            end;
}

            for i := currentlength downto 1 do begin
               if letters[i] = 'v' then vcount := succ(vcount);
               letters[i + shift] := letters[i];
            end;

            letters[1] := '1';
            letters[2] := '0';
            letters[3] := '.';
            letters[4] := '4';
            letters[5] := '8';
            letters[6] := '5';
            letters[7] := '5';
            letters[8] := '0';
            letters[9] := '/';
            letters[15] := '.'; (* replace the ':' from pubmed with a '.' *)

            (* Now remove the version if it exists since doi.org
               cannot handle it! *)
            if vcount > 1 then begin
               writeln(output,'removing version number');
               i := length;
{
write(output,'"<'); writestring(output,doi); writeln(output,'>"');
}
               while letters[i] <> 'v' do begin
{
writeln(output,'letters[',i:1,'] = ',letters[i]);
}
                   letters[i] := '!';
                   length := pred(length);
                   i := pred(i);
               end;
               if letters[i] <> 'v' then begin
                  writeln(output,'error in finding version letter "v"');
                  halt;
               end;
               letters[length] := '!';
               length := pred(length); (* remove the final 'v' *)
            end;
{
writeln(output,'RESULT========');
write(output,'                ');
writestring(output,letters);
writeln(output);
writeln(output,'==============');
writeln(output,'https://doi.org/10.48550/arXiv.2301.00783 <-- target result')
}
         end
         else begin
            writeln(output, 'No it''s not an arXiv - ignoring this LID');
            isadoi := false;
         end;
      end;
   end;
end;

procedure readentry(var query: text; var entryin: boolean);
(* read the entry data *)
var
   c: char; (* a character read from the query *)
   newid: identifier; (* identifier characters for a line *)
   startover: boolean; (* for bad entries, start over *)
   done: boolean; (* done skipping to next entry *)
   newpages: string; (* new page numbers *)
procedure checkformat(x: char);
(* make sure that the identifier is followed by '  x ' *)
var a: char; (* a character in the query *)
procedure die(n: integer);
begin
   writeln(output);
   writeln(output, 'WARNING');
   writeln(output, 'query format does not have "  - "');
   writeln(output, 'letter "',a,'" found at position ',n:1);
   writeln(output, 'newid: "',newid[1],newid[2],
                              newid[3],newid[4]);
   writeln(output);
   startover := true;
end;
begin
   (* the (suddenly appearing on 1997 April 20) MRI has "I" in
      third position - allow for it by ignoring it.
      1997 May 14: PMID- appeared.
      The code was:
      if newid <> 'MR' then begin
      2008 Jun 05: MR no longer is in the file, drop that code.
   *)
   read(query,a); if a <>  x  then die(3);
   read(query,a); if a <> ' ' then die(4);
end;
begin
   if debugging then writeln(output,'readentry');

   (* skip blank lines *)
   done := false;
   while not done do begin
      if eof(query) then begin
         done := true;
         entryin := false;
      end
      else if eoln(query)
           then readln(query)
           else done := true
   end;

   if not eof(query) then begin

      (* 2004 Mar 18.  The entry now starts like this:
      <pre>PMID- 14602927
      OWN - NLM
      so to get the PMID we have do do something special.
      *)
      if query^ = '<' then begin
         read(query, c);
         while (c <> '>') and (not eoln(query)) and
               (not eof(query)) do begin
            read(query,c);
         end;
         if eof(query) then begin
            writeln(output,'WARNING: incomplete last line of query file!');
            writeln(output,'Write to pubmed about this.');
            halt
         end;
         if c <> '>' then begin
            writeln(output,'WARNING: <pre> has changed in query!');
            readln(query);  (* drop out and try to continue *)
         end
      {ppp}
         (* presumably we are ready to read PM for PMID *)
      end;

      startover := false;
      read(query,newid[1], newid[2], newid[3],newid[4]);
      if debugging then writeln(output,'readentry: newid=',newid);
      if newid = '    ' then begin
         (* default to previous id *)
         checkformat(' ');
      end
      else begin
         id := newid;
         checkformat('-');
      end;
   end;

{ppp}
{
(* 2004 Mar 18.  The entry starts like this:
<pre>PMID- 14602927
OWN - NLM
so to get the PMID we have do do something special.
*)
   if (newid[1] = '<') and
      (newid[1] = 'p')
   then begin
      read(query,c,c,c);
      if c <> '>' then begin
         writeln(output,'WARNING: <pre> has changed in query!')
      end
      else begin
         read(query,newid[1], newid[2], newid[3],newid[4]);
         (* presumably this is PM for PMID *)
      end
   end;
}

   if (not startover) and (not eof(query)) then begin
{writeln(output,'id = ',id); (* show the id strings that are found *) }
      gotten := true;

           if id = 'TA  ' then getstring(query, journal, gotten)
(* Note: JT would give full title, maybe better? *)
      else if id = 'PG  ' then begin
              getstring(query, pages, gotten);
              changepages(pages, newpages);
              copystring(newpages, pages);
              if doubledash then begin
                 makedoubledash(pages, newpages);
                 copystring(newpages, pages)
              end
           end
      else if id = 'VI  ' then getstring(query, volume, gotten)
      else if id = 'PMID' then getstring(query, pmid, gotten)
      else if id = 'PMC ' then getstring(query, pmcid , gotten)
      else if (id = 'LID ') or (id = 'AID ')
           then begin
              getstring(query, maybedoi , gotten);
              processdoi(id, maybedoi, isadoi);
              (* if maybedoi is not a doi, the string will be cleared *)
{
              if maybedoi.length > 0 then begin
}
              if (maybedoi.length > 0) and isadoi then begin
                 copystring(maybedoi, doi);
              end
           end
{ppp}
      else if id = 'DP  ' then getstring(query, year, gotten)

      else if (id = 'AU  ') OR
              (id = 'IR  ')
              (* This can cause duplications 2013 Jun 17 *)
           then begin
              (* add author to author list *)
              addline(query, authors, spare)
           end

      else if id = 'TI  ' then begin
              (* add author to author list *)
              addline(query, title, spare)
           end

      else if everything
            (* tricky tricky tricky: use newid instead of id
               so that blanks will be transferred over! *)
         then addotherdataline(query, newid, otherdata, spare)
         else readln(query); (* ignore all other cases *)

      if not gotten then begin
         writeln(output,'missing part of ',id);
         halt
      end;
      entryin := true;
   end
   else begin (* start over *)
      (* find a blank line or eof *)
      writeln(output,'Skipping to next reference');
      done := false;
      while not done do begin
         if eof(query)
         then done := true
         else begin
            if eoln(query)
            then done := true
            else readln(query);
         end
      end;
      entryin := false;
   end;
   if debugging then writeln(output,'readentry: DONE');

end;

procedure closeentry(var f: text;
                     var titlelinesize: integer);
(* Complete the entry.  Wrap title lines to titlelinesize. *)

{
var
  j: integer; (* variable for multiple wrap testing *)
}

begin

   trimyear(year);

   if authors = nil then begin
      writeln(output,'No author list found!');
      new(authors);
      authors^.next := nil;
      authors^.letters[ 1] := 'N';
      authors^.letters[ 2] := 'o';
      authors^.letters[ 3] := '_';
      authors^.letters[ 4] := 'A';
      authors^.letters[ 5] := 'u';
      authors^.letters[ 6] := 't';
      authors^.letters[ 7] := 'h';
      authors^.letters[ 8] := 'o';
      authors^.letters[ 9] := 'r';
      authors^.letters[10] := ' ';
      authors^.letters[11] := '!';
      authors^.length := 11;
      write(output,'Using: ');
      writestring(output,authors^);
      writeln(output);
{
   stringptr = ^string; (* pointer to a string *)
   string = record (* a string of characters *)
      letters: array[1..maxstring] of char; (* the letters in the string *)
      length: integer; (* the number of characters in the string *)
      current: integer; (* the letter we are working on *)
      next: stringptr; (* the next string in a series *)
   end;
}
      (* halt; it can be legitimate! see PubMed 2410266 *)
   end;

   makekey(thekey, authors, finalauthor, year);
   fixauthors(authors);
   fixtitle(title);
   fixotherdata(otherdata);

   new(titlewrap);

{ For multiple wrap testing:
   j := 70;
   for j := 30 to 180 do begin
      wraplines(title, titlewrap, titleindent, -j);
      writeln(output,j:1);
   end;
writeln(output,'DONE');
halt;
}

   wraplines(title, titlewrap, titleindent, -titlelinesize);

   write(f,'@article{');
   writestring(f,thekey);
   writeln(f,',');

   write(f,'author = "');
   writelines(f, authors);
   writeln(f,'",');

   write(f,'title = "{'); (* note brace to protect capitals *)
   writelines(f, titlewrap);
   writeln(f,'}",'); (* note brace to protect capitals *)

   write(f,'journal = "');
   writestring(f,journal);
   writeln(f,'",');

   write(f,'volume = "');
   writestring(f,volume);
   writeln(f,'",');

   write(f,'pages = "');
   writestring(f,pages);
   writeln(f,'",');

   if pmid.length > 0 then begin
      write(f,'pmid = "');
      writestring(f,pmid);
      writeln(f,'",');
   end;

   if pmcid.length > 0 then begin
      write(f,'pmcid = "');
      writestring(f,pmcid);
      writeln(f,'",');
   end;

   if doi.length > 0 then begin
      if doi.length > 0 then begin
         (* 2017 Mar 02 Note: switch to a more secure shorter format:
          http://dx.doi.org/10.3389/fmolb.2016.00080
            https://doi.org/10.3389/fmolb.2016.00080
         *)
         writeln(f,'note = "\url');
         write(f,'{https://doi.org/'); writestring(f,doi); writeln(f,'}",');
      end
   end;

   if datecomment then begin
      getdatetime(adatetime);
      write(output,'datetime: =======');
      writedatetime(output,adatetime);
      writeln(output,'=======');
      write(f,'comment = "');
      writedatetime(f,adatetime);
      writeln(f,' ",'); (* space after date for user to use *)
   end;

   write(f,'year = "');
   writestring(f,year);

   if not everything
   then writeln(f,'"}') (* end entire entry *)
   else begin
      writeln(f,'",'); (* end year with comma *)
      writeln(f,'otherdata = "');
      writelines(f, otherdata);
      writeln(f);
      writeln(f,'"}');
   end;

   (* put away the title and author lists to the spare list *)
   putawayline(authors, spare);
   putawayline(title, spare);
   putawayline(otherdata, spare);

{
   writeln(output,'************************');
}
   writestring(output,thekey);
   writeln(output);
{
   writeln(output,'************************');
}

end;

begin
   writeln(output,'medlinebib ',version:4:2);

   (* read parameters *)
   reset(medlinebibp);
   readln(medlinebibp, parameterversion);
   if round(100*parameterversion) < round(100*updateversion) then begin
      writeln(output, 'You have an old parameter file!');
      upgradeparameters(medlinebibp);
   end;

   reset(medlinebibp);
   readln(medlinebibp); (* skip the version *)

   if medlinebibp^ = 'd'
   then debugging := true
   else debugging := false;
   readln(medlinebibp);

   if medlinebibp^ = 'e'
   then everything := true
   else everything := false;
   readln(medlinebibp);

   if medlinebibp^ = 'f'
   then finalauthor := true
   else finalauthor := false;
   readln(medlinebibp);

   if medlinebibp^ = 'd'
   then doubledash := true
   else doubledash := false;
   readln(medlinebibp);

   readln(medlinebibp, titlelinesize);
   if titlelinesize > maxtitlelinesize then begin
      writeln(output,'* WARNING: since you set',
                     ' titlelinesize to be ',titlelinesize:1,',');
      writeln(output,'* Your title lines may be wider',
                     ' than ',maxtitlelinesize:1,'.');
      writeln(output,'* The recommended maximum line width is',
                     ' ',maxtitlelinesize:1,' characters.');
   end;

   if medlinebibp^ = 'f'
   then datecomment := true
   else datecomment := false;
   readln(medlinebibp);

(* zq *)
   getstring(medlinebibp, emptystring, gotten);

   (* be sure ALL defined strings are empty if they are not found: *)
   clearstring(journal);
   clearstring(pages);
   clearstring(pmid);
   clearstring(pmcid);
   clearstring(doi);
   clearstring(volume);
   clearstring(year);
   clearstring(s);
   clearstring(thekey);

(* zq *)
   (* insert empty string flag *)
   copystring(emptystring, journal);
   copystring(emptystring, pages);
   copystring(emptystring, pmid);
   copystring(emptystring, pmcid);
   copystring(emptystring, doi);
   copystring(emptystring, volume);
   copystring(emptystring, year);
   copystring(emptystring, s);
   copystring(emptystring, thekey);

   (* set variables up *)
   numbers:=['0','1','2','3','4','5','6','7','8','9'];
   authors := nil;
   title := nil;
   otherdata := nil;
   titlewrap := nil;
   spare := nil;

   rewrite(bibformat);

   if debugging then begin
      writeln(output,'QUERY FILE:');
      reset(query);
      while not eof(query) do begin
         getstring(query, s, gotten);
         writestring(output, s);
         writeln(output);
      end;
      writeln(output,'END OF QUERY FILE');
   end;

   entryin := false;
   reset(query);
   while not eof(query) do begin
      if eoln(query) and entryin
      then begin
         readln(query); (* move away from the blank line *)
         writeln(bibformat);
         closeentry(bibformat, titlelinesize);
         entryin := false;
      end
      else begin
         readentry(query, entryin);
      end
   end;

   if entryin then begin
      writeln(bibformat);
      closeentry(bibformat, titlelinesize);
   end;

end;
(* end module medlinebib.themain *)

begin
   themain(query, medlinebibp, bibformat);
1: end.
