* --- ENGLISH MEDICAL INFORMATION FORMAT COMPONENT Version 0.04 2004.06.03
* --- 2001 May 18, change H-TMPER to H-TMDUR, H-DEVICE to H-DEVMED
*     change S-S to INDIC
* --- 2001 April 10, change SEM-HOST to SEM-CORE
*                    and all transformation and function names
*                    Delete OFSTG
* --- 2001 April 9, add PHRASE-ATT TIME-POST-PHRASE
* --- 2000 October 26
*     add FORMAT5-MISC and FORMAT13-MED
* --- 2001 January 9
*     replace MALE and FEMALE under GENDER by NON-EMPTY
*     pointing to GRAM-NODE = '[MALE]' and '[FEMALE]'
* --- 2001 February 20
*     add EKG nodes and attributes and FORMAT5-EKG
*COMPILE()
*LKED()
*OBJSW=T
*BNF
<ASOBJBE>     ::= NULL.
<ADJN>        ::= NULL.
<ANDORSTG>    ::= NULL.
<ASTGP>       ::= NULL.
<ASWELLASSTG> ::= NULL.
<MED-DEVICE>  ::= NULL.
<DP1PN>       ::= NULL.
<DP1P>        ::= NULL.
<DP2PN>       ::= NULL.
<DP3PN>       ::= NULL.
<DP4PN>       ::= NULL.
<DSTG>        ::= NULL.
<DPSN>        ::= NULL.
<FORTOVO>     ::= NULL.
<NASOBJBE>    ::= NULL.
<ND>          ::= NULL.
<NINRN>       ::= NULL.
<NN>          ::= NULL.
<NGEV>        ::= NULL.
<NPVINGO>     ::= NULL.
<NPVINGSTG>   ::= NULL.
<NSTGP>       ::= NULL.
<NSVINGO>     ::= NULL.
<NTOBE>       ::= NULL.
<NTOVO>       ::= NULL.
<NPSNWH>      ::= NULL.
<NTHATS>      ::= NULL.
<PSNWH>       ::= NULL.
<PSVINGO>     ::= NULL.
<SECTION>     ::= NULL.
<SECT-NAME>   ::= NULL.
<SOBJBE>      ::= NULL.
<C1SHOULD>    ::= NULL.
<NPSVINGO>    ::= NULL.
<NSNWH>       ::= NULL.
<PNHOWS>      ::= NULL.
<PNSNWH>      ::= NULL.
<PNTHATSVO>   ::= NULL.
<PNVINGSTG>   ::= NULL.
<PSTG>        ::= NULL.
<TOBE>        ::= NULL.
<VINGSTGPN>   ::= NULL.
<PNN>         ::= NULL.
<PNTHATS>     ::= NULL.
<PVINGO>      ::= NULL.
<PVINGSTG>    ::= NULL.
<QUOTESTG>    ::= NULL.
<SASOBJBE>    ::= NULL.
<SNWH>        ::= NULL.
<INFO-SOURCE> ::= NULL.
<SVEN>        ::= NULL.
<SVO>         ::= NULL.
<SVINGO>      ::= NULL.
<VINGOFN>     ::= NULL.
<VINGSTG>     ::= NULL.
<WHETHS>      ::= NULL.
<TANTSTG>     ::= NULL.
<VSUBJ>       ::= NULL.
<WITHSTG>     ::= NULL.
* ATOMIC SYMBOLS NOT YET IN USE
<UNUSED>      ::= <*CS0> / <*CS2> / <*CS3> / <*CS4> / <*CS5> / <*CS6> /
                  <*CS7> / <*CS8> / <*CS9> / <*CS10> / <*NG> / <*DT> /
                  <*DUMMY> / <*GRAM-NODE> /
                  <*NULLPRO1> / <*NULLPRO2> / <*NULLC> / <*NULLN> .
<AINSIQUESTG>    ::= NULL.
<AND-ORSTG>      ::= NULL.
<AS-WELL-AS-STG> ::= NULL.
<ASSTG>          ::= NULL.
<BEINGO>         ::= NULL.
<BOTHSTG>        ::= NULL.
<C1SHOULD>       ::= NULL.
<COLONSTG>       ::= NULL.
<CPDNUMBR>       ::= NULL.
<CSSTG>          ::= NULL.
<DASHSTG>        ::= NULL.
<DAYYEAR>        ::= NULL.
<DMQSTG>         ::= NULL.
<DOSE-OF-N>      ::= NULL.
<EGSTG>          ::= NULL.
<EITHERSTG>      ::= NULL.
<ENVINGO>        ::= NULL.
<ESPECIALLY-STG> ::= NULL.
<ETCSTG>         ::= NULL.
<FORTOVO-N>      ::= NULL.
<FORMAT13-MED>   ::= NULL.
<FORMAT5-MISC>   ::= NULL.
<FRACTION>       ::= NULL.
<FTIME>          ::= NULL.
<GENDER>         ::= NULL.
<HOWQASTG>       ::= NULL.
<HOWQSTG>        ::= NULL.
<IMPERATIVE>     ::= NULL.
<INADDITIONTOSTG> ::= NULL.
<INTRO-PHRASE>   ::= NULL.
<INTSTG>         ::= NULL.
<LAR1>           ::= NULL.
<LCDA>           ::= NULL.
<LCDN>           ::= NULL.
<LCDVA>          ::= NULL.
<LCS>            ::= NULL.
<LDATE>          ::= NULL.
<LDATER>         ::= NULL.
<LNAME>          ::= NULL.
<LNAMER>         ::= NULL.
<LNSR>           ::= NULL.
<LPRO>           ::= NULL.
<LQNR>           ::= NULL.
<LTVR>           ::= NULL.
<LVSA>           ::= NULL.
<MEDDOSE>        ::= NULL.
<MOREDATE>       ::= NULL.
<NAMESTG>        ::= NULL.
<NEG>            ::= NULL.
<NEGV>           ::= NULL.
<NEITHERSTG>     ::= NULL.
<NINRN>          ::= NULL.
<NISTG>          ::= NULL.
<NORSTG>         ::= NULL.
<NOTOPT>         ::= NULL.
<NPDOSE>         ::= NULL.
<NPSNWH>         ::= NULL.
<NPSVINGO>       ::= NULL.
<NPVO>           ::= NULL.
<NPWHS>          ::= NULL.
<NQ>             ::= NULL.
<NSNWH>          ::= NULL.
<NSPOS>          ::= NULL.
<NTHATS>         ::= NULL.
<NUMBRSTG>       ::= NULL.
<NVINGO>         ::= NULL.
<NVSA>           ::= NULL.
<NWHSTG>         ::= NULL.
<OBJBESA>        ::= NULL.
<ORNOT>          ::= NULL.
<PA>             ::= NULL.
<PAREN-FRAG>     ::= NULL.
<PAREN-RV>       ::= NULL.
<PARENSTG>       ::= NULL.
<PART>           ::= NULL.
<PARTICULARLY-STG> ::= NULL.
<PNPVO>          ::= NULL.
<PNSNWH>         ::= NULL.
<PNTHATSVO>      ::= NULL.
<PNVINGSTG>      ::= NULL.
<PNVO>           ::= NULL.
<PROPOS>         ::= NULL.
<PROSENT>        ::= NULL.
<PSNWH>          ::= NULL.
<PSVINGO>        ::= NULL.
<PTIME>          ::= NULL.
<PUISSTG>        ::= NULL.
<PVO-N>          ::= NULL.
<PVO>            ::= NULL.
<PWHNQ-PN>       ::= NULL.
<PWHNQ>          ::= NULL.
<PWHNS-PN>       ::= NULL.
<PWHNS>          ::= NULL.
<PWHQ-PN>        ::= NULL.
<PWHQ>           ::= NULL.
<PWHS-PN>        ::= NULL.
<PWHS>           ::= NULL.
<Q10S>           ::= NULL.
<Q-ASSERT>       ::= NULL.
<Q-INVERT>       ::= NULL.
<Q-OF>           ::= NULL.
<Q-PHRASE>       ::= NULL.
<QN-TIME>        ::= NULL.
<QNREP>          ::= NULL.
<QNS>            ::= NULL.
<QUAL>           ::= NULL.
<QUECOMP>        ::= NULL.
<QUISEG>         ::= NULL.
<QUOTESTG>       ::= NULL.
<RA1>            ::= NULL.
<RDATE>          ::= NULL.
<RNAME>          ::= NULL.
<RNWH>           ::= NULL.
<RSUBJ>          ::= NULL.
<RXMODE>         ::= NULL.
<S-N>            ::= NULL.
<SAWH>           ::= NULL.
<SAWHICHSTG>     ::= NULL.
<SEGADJ>         ::= NULL.
<SN>             ::= NULL.
<SOBJBE>         ::= NULL.
<SOBJBESA>       ::= NULL.
<STOVO-N>        ::= NULL.
<SUB10>          ::= NULL.
<SUB11>          ::= NULL.
<SUB12>          ::= NULL.
<SUB13>          ::= NULL.
<SUB2>           ::= NULL.
<SUB3>           ::= NULL.
<SUB4>           ::= NULL.
<SUB5>           ::= NULL.
<SUB6>           ::= NULL.
<SUB7>           ::= NULL.
<SUB9>           ::= NULL.
<THANSTG>        ::= NULL.
<THATS-N>        ::= NULL.
<TITLE>          ::= NULL.
<TOBE>           ::= NULL.
<TOSTG>          ::= NULL.
<TSUBJVO>        ::= NULL.
<VERB1>          ::= NULL.
<VERB2>          ::= NULL.
<VERSUSSTG>      ::= NULL.
<VINGSTG>        ::= NULL.
<VINGSTGPN>      ::= NULL.
<VOIRESTG>       ::= NULL.
<WH-PHRASE>      ::= NULL.
<TM-PHRASE>      ::= NULL.
<WHATS-N>        ::= NULL.
<WHERES>         ::= NULL.
<WHETHS>         ::= NULL.
<WHETHTOVO>      ::= NULL.
<WHEVERS-N>      ::= NULL.
<WHN>            ::= NULL.
<WHNQ-N>         ::= NULL.
<WHNS-N>         ::= NULL.
<WHQ-N>          ::= NULL.
<WHQ>            ::= NULL.
<YESNOQ>         ::= NULL.
* SNOPATH BNF
<PATH-I-F>       ::= NULL.
<SPECIMEN>       ::= NULL.
<FINDING>        ::= NULL.
<SPEC>           ::= NULL.
<SHOW-CONN>      ::= NULL.
<PATHRES>        ::= NULL.
* DEFINITION
* BNF
*
* 1. SENTENCE
<SENTENCE>    ::= <TEXTLET> .
<TEXTLET>     ::= <ONESENT> <MORESENT> .
<ONESENT>     ::= <SECTION> <INTRODUCER> <CENTER> <ENDMARK> .
<SECTION>     ::= <SECT-NAME> .
<MORESENT>    ::= <*NULL> / <TEXTLET> .
<INTRODUCER>  ::= (<*N> / <*ADJ>) ':' / <*NULL> .
<CENTER>       ::= (<ASSERTION> / <SEGADJ> / <QUISEG> / <FRAGMENT>)
                   <PAREN-FRAG> .
<PAREN-FRAG>   ::= '(' <FRAGMENT> ')' / '(' <ASSERTION> ')' / <*NULL> .
<SEGADJ>       ::= <NSTGT> / <PDATE> / <LDR> / <PN> .
<QUISEG>       ::= WHO <VERB> <SA> <OBJECT> <SA> .
<ENDMARK>      ::= '.' / ';' / '#' .
* 2. CENTER STRINGS
<ASSERTION>   ::= <SA> <SUBJECT> <SA> <TENSE> <SA> <VERB> <SA>
                  <OBJECT> <SA> .
<FRAGMENT>    ::= <SA> (<TOVO> / <TVO> / <VO> / <BESHOW> /
                  <NSTGF> / <ASTGF> / <PN> / <VENPASS>) <SA> .
<NSTGF>       ::= <NSTG> .
<ASTGF>       ::= <ASTG> .
<BESHOW>      ::= <PROC> <BESUBJ> [':'] <BEDATE> <OBJBE> <SA> .
<PROC>        ::= <NSTG> [':'] / <*NULL> .
<BESUBJ>      ::= <NSTG> / <*NULL> .
<BEDATE>      ::= <DATE> / <*NULL> .
<OBES>        ::= <ASTG> <SA> <TENSE> <SA> <VERB> <SA> <SUBJECT>
                  <SA> .
* 5. SUBJECT STRINGS
<SUBJECT>     ::= THERE / <EKGSTG> / <NSTG> / <*NULLWH> / <*NULLC> / <WHATS-N> .
<EKGSTG>      ::= <LWVR>.
<LWVR>        ::= <LN> <WVVAR> <RWV>.
<WVVAR>       ::= <*N>.
<RWV>         ::= <RWVOPTS> <RWV> / <*NULL>.
<RWVOPTS>     ::= <IN-LEADS> / <PN>.
<IN-LEADS>    ::= (<*P> / - <*NULL>) <LLEADR>.
<LDATER>      ::= <LDATE> <DATEVAR> <RDATE> .
<DATEVAR>     ::= <*DT> '-' <*DT> / <*DT> / <T-DATE> .
<T-DATE>      ::= THE <*Q>.
<LLEADR>      ::= <LN> <LEADVAR> <RLEAD>.
<LEADVAR>     ::= <*EKGLEAD> '-' <*EKGLEAD> /
                  <*EKGLEAD> THROUGH <*EKGLEAD> /
                  <*EKGLEAD> '-' <*Q> /
                  <*EKGLEAD> THROUGH <*Q> / <*EKGLEAD> .
<RLEAD>       ::= <*D> / <*NULL>.
<NSTG>        ::= <LNR> .
<LNR>         ::= <LN> <NVAR> <RN> .
<NVAR>         ::= <*N> / <*PRO> / <*VING> / <*DS> / <QN>.
* 7. VERB AND VERBAL OBJECT STRINGS
<VERB>        ::= <*NULLFRAG> / <*NULLC> / <LV> <VVAR> <RV> .
<VVAR>        ::= <*TV> / <*V> .
<TENSE>       ::= <LW> <*W> <RW> / <*NULL> .
<LVR>         ::= <LV> <*V> <RV>.
<VENO>        ::= <LVENR> <SA> <OBJECT> <SA> .
<LVENR>       ::= <LV> <*VEN> <RV> .
<VENPASS>     ::= <LVENR> <SA> <PASSOBJ> <SA> .
<VINGO>       ::= <LVINGR> <SA> <OBJECT> <SA> .
<LVINGR>      ::= <LV> <*VING> <RV> .
* 8. OBJECT STRINGS
<OBJECT>       ::= <*NULLFRAG> / <*NULLC> / <NSTGO> / <DP1> /
                   <NPDOSE> /
                   <DP2> / <DP3> / <PN> / <NPN> / <VO> / <TOVO> /
                   <ADVOBJ> / <THATS> / <VINGO> / <NTOVO> / <VENO> /
                   <OBJECTBE> / <OBJBE> / <NA> / <VENPASS> / <NTHATS> /
                   <ASSERTION> / <*NULLOBJ> .
<PASSOBJ>      ::= <ASTG> / <PN> / <PDOSE> / <NSTGO> / <TOVO> /
                   <*NULLOBJ> .
<OBJECTBE>    ::= <VINGO> / <VENPASS> / <OBJBE> .
<OBJBE>        ::= <ASTG> / <QUANT> / <NSTG> / <PN> / <PQUANT> /
                   <PDATE> / <LDR> .
<QUANT>        ::= <QN> / <QPERUNIT>.
<QPERUNIT>     ::= <LQR> <PERUNIT> <REG-ADJ>.
<PERUNIT>      ::= '/' <*N> / '%' / PER <*N> / <*NULL> .
<REG-ADJ>      ::= <*ADJ> / <*NULL>.
<QN>           ::= <LQR> <*N> <PERUNIT> <SCALESTG> .
<SCALESTG>     ::= <*ADJ> / <IN-DIM> / <*NULL> .
<IN-DIM>       ::= IN <*N> .
<PQUANT>       ::= <*P> <QUANT>.
<ASTG>        ::= <LAR> .
<NSTGO>        ::= <NSTG> / <QUANT> / <*NULLC> / <*NULLWH> .
<ADVOBJ>      ::= <LDR> .
<LDR>          ::= <LD> <*D> <RD> .
<NTOVO>       ::= <NSTGO> <TOVO> .
<TOVO>          ::= TO <LVR> <SA> <OBJECT> <SA> .
<THATS>       ::= THAT <ASSERTION> .
<NTHATS>       ::= <NSTGO> <THATS> .
<TVO>         ::= <TENSE> <SA> <VERB> <SA> <OBJECT> <SA> .
<VO>          ::= <TENSE> <SA> <LVR> <SA> <OBJECT> <SA> .
* 8A. P STRINGS
<PD>          ::= <*P> <LDR> .
<PN>           ::= <LP> <*P> <NSTGO> .
<NPN>         ::= <NSTGO> <PN> .
<NPDOSE>       ::= <NSTGO> <*P> <*DS> [<*P> <*DS>] .
<PDOSE>        ::= <*P> <*DS> [<*P> <*DS>] .
<P1>          ::= <*P> .
* 8B. DP STRINGS
<DP1>         ::= <*DP> .
<DP2>         ::= <*DP> <NSTGO> .
<DP3>         ::= <NSTGO> <*DP> .
<DP4>         ::= NULL .
* 8D. NOMINALIZATION WITH ZEROED VERB BE
<NA>          ::= <NSTG> <ASTG> .
* 9. SENTENCE ADJUNCT STRINGS
<SA>          ::= <*NULL> / <SAOPTS> <SA> .
<SAOPTS>       ::= <PDATE> / <*INT> / <LDR> / <PN> / <PD> /
                   <VINGO> / <NSTGT> / <RNSUBJ> / <SUB1> /
                   <SUB0> / <SUB2> / <SUB3> / <SUB8> /
                   <TOVO> / -<VENPASS> .
<PDATE>       ::= (<*P> / <*NULL>) <DATE> .
<DATE>        ::= <DATEQ> / <DATEWD> .
<DATEQ>       ::= <*Q> '/' <*Q> '/' <*Q> [':'] .
<DATEWD>      ::= <*N> <*Q> [':'] .
<NSTGT>       ::= <LTIME> <NSTG> .
<RNSUBJ>      ::= <WHS-N> .
<SACONJ>      ::= <SA> .
* 10. SUBORDINATE CONJUNCTION STRINGS
<SUB1>        ::= <*CS1> <ASSERTION> .
<SUB0>         ::= <*CS0> (<PN> / <*ADJ>) .
<SUB2>         ::= <*CS2> <VENPASS> .
<SUB3>         ::= <*CS3> <VINGO> .
<SUB8>         ::= AS (WAS / WERE) <SUBJECT> .
* 11. RN RIGHT ADJUNCTS OF N
<RN>          ::= <RNOPTS> <RN> / <*NULL> .
<RNOPTS>      ::= <PAREN-RN> /<PDATE> / <BPART> / <VENPASS> / <ADJINRN>
                  / <QUANT> / <LDR> / <PQUANT> / <PN> / <TOVO>
                  / <VINGO> / <WHS-N> / <PWHS> / <THATS>
                  / <TOVO-N> / <*DS> / <WHENS> / <WHOSES>
                  / <PERUNIT> / <PAREN-NSTG>  / - <APPOS>.
<PAREN-RN>    ::= '(' <RNOPTS> <RN> ')' .
<PAREN-NSTG>  ::= <NSTG> .
<ADJINRN>     ::= <LAR> .
<BPART>       ::= <LNR> .
<TOVO-N>      ::= <TOVO> .
<APPOS>       ::= [','] <LNR> .
* 12. LN LEFT ADJUNCTS OF N
<LN>          ::= <TPOS> <QPOS> <APOS> <NPOS> .
<TPOS>        ::= <LTR> / <*NULL> / <LNS>.
<LTR>         ::= <LT> <*T> <RT> .
<LNS>         ::= <TPOS> <*NS> .
<QPOS>        ::= <LQR> / <*NULL> .
<LQR>         ::= <LQ> <QVAR> <RQ> .
<QVAR>        ::= <*Q> / <*Q> X <*Q> / <RATIO> / <QPER>
                  / <*Q> '-' <*Q> /  <*Q> TO  <*Q>
                  / <*Q> OVER <*Q> .
<QPER>        ::= <*Q> '/' <*N> .
<RATIO>        ::= <*Q> '/' <*Q> .
<APOS>         ::= <ADJADJ> / <*NULL>.
<ADJADJ>       ::= <LAR> / <QN> / <ADJADJ> (<LAR> / <QN>).
<LAR>         ::= <LA> <AVAR> <RA> .
<AVAR>         ::= <*ADJ> / <*VEN> /<*VING> .
<NPOS>         ::= <NNN> / <*NULL> .
<NNN>          ::= <*N> / <*DS> / <NNN> (<*N> / <*DS>).
* 13. RIGHT ADJUNCTS - OTHER THAN RN
<RT>          ::= <*NULL> .
<RQ>           ::= <*D> / <REG-ADJ> / <*NULL> .
<RA>           ::= <PN> / <PQUANT> / <TOVO> / <*NULL> .
<RD>           ::= <*NULL> .
<RV>           ::= <PDATE> / <PN> / <PQUANT> / <LDR> / <THATS>
                   / <TOVO> / <NSTGT> / <*NULL>.
<RW>          ::= <LDR> / <*NULL> .
* 14. LEFT ADJUNCTS - OTHER THAN LN
<LT>          ::= <*NULL> / <*Q> /<*D> .
<LA>          ::= <*NULL> / <LDR> .
<LQ>          ::= <*NULL> / <*D> / <*ADJ> .
<LV>          ::= <LDR> / <*NULL>.
<LW>          ::= <*D> / <*NULL> .
<LD>          ::= <*NULL> / <*D> .
<LP>           ::= <LDR> / <*NULL> .
<LTIME>       ::= <*NULL> / <*D> .
* 15. WH-STRINGS
<WHS-N>       ::= (WHO / WHICH / THAT) <ASSERTION>.
<PWHS>         ::= <*P> WHICH <ASSERTION>.
<WHENS>       ::= WHEN <ASSERTION> .
<WHOSES>       ::= WHOSE <ASSERTION>.
* 16. CONJUNCTION STRINGS
<ANDSTG>      ::= (AND / '&') <SACONJ> <Q-CONJ> (EACH / <*NULL>) .
<ORSTG>       ::= OR <Q-CONJ> .
<NORSTG>       ::= NOR <Q-CONJ> .
<INCLUDINGSTG> ::= INCLUDING <Q-CONJ> .
<BUTSTG>      ::= BUT <Q-CONJ> .
<PLUSSTG>      ::= PLUS <Q-CONJ> .
<COMMASTG>    ::= ',' (<Q-CONJ> / <*NULL>) .
<Q-CONJ>      ::= <*NULL> .
<LAUX>           ::= NULL.
* TRANSFORMATIONAL DUMMIES
<AGENT>          ::= NULL.
<PNX2>           ::= (<PN> / <PVINGSTG>) <SA> (<PN> / <PVINGSTG>).
* DUMMY NODE FOR WRITING FORMAT
<STOP>           ::= NULL.
* FORMAT NODES
<MODAL>          ::= NULL.
<TM-PER>         ::= NULL.
* REGULARIZATION MARKERS:
*      DUMMY BNF DEFINITIONS
<AREA-MOD>        ::= NULL.
<CHANGE-OF-STATE> ::= NULL.
<EMBEDDED>        ::= NULL.
<HEADCONN>        ::= NULL.
<LCONN>           ::= NULL.
<LCONNR>          ::= NULL.
<LPR>             ::= NULL.
<PARSE-CONN>      ::= NULL.
<RCONN>           ::= NULL.
<REL-CLAUSE>      ::= NULL.
<RP>              ::= NULL.
<SUB-CONJ>        ::= NULL.
<TIME>            ::= NULL.
* FORMATTING BNF MARKERS
<CONNECTIVE>  ::= <CONN> <MODS> <TIME>.
<CONN>        ::= <CONJOINED>/<RELATION>/<PREP-CONN>/
                  <REL-CLAUSE>/<TIME-CONJ>/<SUB-CONJ>/<EMBEDDED>.
<FORMAT00>    ::= <PARAGR><SENT-OP><PT-DEMOG><SUBJECT><OBJECT><VERB>.
<FORMAT0>     ::= <PARAGR><PT-DEMOG><INST><PT><VERB>.
<FORMAT1>     ::= <PARAGR><PT-DEMOG><INST><PT><VERB-MD><VERB>.
<FORMAT2>     ::= <PARAGR><PT-DEMOG><INST><PT><VERB-TR><VERB>.
<FORMAT3>     ::= <PARAGR><PT-DEMOG><INST><PT><MED-TR><VERB>.
<FORMAT4>     ::= <PARAGR><PT-DEMOG><INST><PT><TEST-INFO><VERB><TEST-ENV>.
<FORMAT5>     ::= <PARAGR><PT-DEMOG><METHOD><SUBJECT><VERB>
                  <PSTATE-DATA><PSTATE-SUBJ><PRECISIONS><INST>.
<FORMAT5-EKG> ::= <PARAGR><PT-DEMOG><METHOD><SUBJECT><VERB>
                  <EKG-SUBJ><EKG-DATA><IN-LEADS><PRECISIONS><INST>.
<EKG-SUBJ>    ::= <WAVE> <INTERVAL> <AXIS> .
<EKG-DATA>    ::= <QUANT> <EKG-MORPH> <NORMAL> .
<WAVE>        ::= NULL.
<INTERVAL>    ::= NULL.
<AXIS>        ::= NULL.
<ALLIFE>      ::= NULL.
<EKG-MORPH>   ::= NULL.
<FORMAT5F>    ::= <PARAGR><PT-DEMOG><METHOD><SUBJECT><VERB>
                  <PSTATE-DATA><PSTATE-SUBJ><PRECISIONS>
                  <INST>.
<FORMAT5-ALG> ::= <PARAGR><PT-DEMOG><AGENTS><SUBJECT><VERB>
                  <PSTATE-DATA><PSTATE-SUBJ><PRECISIONS><INST>.
<FORMAT1-3>   ::= <PARAGR><PT-DEMOG><TREATMENT><SUBJECT><VERB>
                  <PSTATE-DATA><PSTATE-SUBJ><PRECISIONS>
                  <INST>.
<FORMAT6>     ::= <PARAGR><PT-DEMOG><PT><VERB><OBJECT>.
<AGENTS>      ::= <TT-NEG><TT-MODAL><MED><ORGANISM><ALLIFE>.
<METHOD>      ::= <PROCEDURE><EXAMTEST><MED-DEVICE>.
<TREATMENT>   ::= <TT-NEG><TT-MODAL><GEN><SURG><MED><COMP><MED-DEVICE> .
<PT-DEMOG>    ::= <AGE> <RACE> <GENDER><FAMILY>.
<AGE>         ::= <AGE-MK><Q-N>.
<PSTATE-SUBJ> ::= <PTMEAS>/<PTFUNC>/<PTPART>/<PT>/
                  <SUBJ-OTHER>.
<TEST-INFO>   ::= <TXSPEC> <TXVAR> <SPEC-ACCESS> <PTPART> <RESULT>.
<RESULT>      ::= <ORGANISM><DIAG><INDIC><TESTRES><QUALIFIERS><QUANT>.
<PSTATE-DATA> ::= <DIAG><INDIC><TXRES><QUALIFIERS><INFLUENCE>
                  <QUANT><NORMAL>.
<MED-TR>      ::= <MED><RXDATA><VERB-TR>.
<PRECISIONS>  ::= <MORE-PREDS>.
<MORE-PREDS>  ::= <REPT> / NULL . [<TIMEPER> /]
<RXDATA>      ::= <RXDOSE><RXMODE>.
<RXMODE>      ::= <RXMANNER><RXFREQUENCY>.
<GENDER>      ::= NULL.
<QUANT>       ::= <Q-N> [(<BETW> <Q-N2>) / <Q-N2>] .
<Q-N>         ::= <NUM> <NON-NUM> <UNIT> <PERUNIT> [<NUM> <UNIT>].
<Q-N2>        ::= <NUM> <UNIT> [<NUM> <UNIT>].
<MODS>        ::= <NEG> <MODAL> . [<FACTUAL><MODS-OTHER>]
<TIME-ASP>    ::= <CHANGE-MK> <BEG> <END>.
<BP-MOD>      ::= <PTPART>.
<QUANTITY>    ::= <NUM> <NON-NUM> <UNIT> <PERUNIT>.
<EVENT-TIME>  ::= <TPREP1> <Q-N> <TPREP2> <REF-PT>.
* BOTTOM NODES OF THE FORMAT
* <ANTECDNT>, <AREA-MOD>, <CHANGE-OF-STATE>, <INTRO-NSTG>,
* <PAREN>, <SPECIMEN> ARE NOT MENTIONED OR USED.
* <UNIT-MOD>
<ACTIVITY>        ::= NULL.
<AGE-MK>          ::= NULL.
<BEG>             ::= NULL.
<BETW>            ::= NULL.
<CHANGE>          ::= NULL.
<CHANGE-MK>       ::= NULL.
<SURG>            ::= NULL.
<COMP>            ::= NULL.
<CONJOINED>       ::= NULL.
<DESCR>           ::= NULL.
<DIAG>            ::= NULL.
<DOUBLE-NEG>      ::= NULL.
<END>             ::= NULL.
<EXAM-FUNC>       ::= NULL [TO BE REMOVED WHEN READY].
<EXAMTEST>        ::= NULL.
<FACTUAL>         ::= NULL.
<EXPAND-REFPT>    ::= NULL.
<FAMILY>          ::= NULL.
<GEN>             ::= NULL.
<INFLUENCE>       ::= NULL.
<INST>            ::= NULL.
<MANY-TIMES>      ::= NULL.
<MED>             ::= NULL.
<MODS-OTHER>      ::= NULL.
<NON-EMPTY>       ::= NULL.
<NON-NUM>         ::= NULL.
<NORMAL>          ::= NULL.
<NUM>             ::= NULL.
<ORGANISM>        ::= NULL.
<PARAGR>          ::= NULL.
<PREP>            ::= NULL.
<PREP-CONN>       ::= NULL.
<PROCEDURE>       ::= NULL.
<PRT>             ::= NULL.
<PT>              ::= NULL.
<PTFUNC>          ::= NULL.
<PTMEAS>          ::= NULL.
<PTPART>          ::= NULL.
<PTSTATE-OTHER>   ::= NULL.
<QUALIFIERS>      ::= NULL.
<RACE>            ::= NULL.
<REF-PT>          ::= NULL.
<REGX>            ::= NULL.
<RELATION>        ::= NULL.
<REPT>            ::= NULL.
<RESPONSE>        ::= NULL.
<RXFREQUENCY>     ::= NULL.
<RXMANNER>        ::= NULL.
<RXDOSE>          ::= NULL.
<SENT-OP>         ::= NULL.
<SPEC-ACCESS>     ::= NULL.
<STATUS>          ::= NULL.
<SUBJ-OTHER>      ::= NULL.
<INDIC>             ::= NULL.
<SUB-CONJ>        ::= NULL.
<SUBUNIT>         ::= NULL.
<TESTRES>         ::= NULL.
<TEST-ENV>        ::= NULL.
<TIME-CONJ>       ::= NULL.
<TIME-UNIT>       ::= NULL.
<TIMELOC>         ::= NULL.
<TIMEPER>         ::= NULL.
<TIME-QUAL>       ::= NULL. [*GRI*]
<TM-PERIOD>       ::= NULL. [*GRI*]
<TM-REPETITION>   ::= NULL. [*GRI*]
<TM-UNIT0>        ::= NULL.
<TPREP0>          ::= NULL.
<TPREP1>          ::= NULL.
<TPREP2>          ::= NULL.
<TT-NEG>          ::= NULL.
<TT-MODAL>        ::= NULL.
<TTRES>           ::= NULL.
<TXRES>           ::= NULL.
<TXSPEC>          ::= NULL.
<TXVAR>           ::= NULL.
<VERB-TR>         ::= NULL.
<VERB-MD>         ::= NULL.
* CT STRUCTURE
<FORMAT-CT>       ::= NULL.
<TIME-LOCS>       ::= NULL.
<TIME-QUALS>      ::= NULL.
<UNIT>            ::= NULL.
<Y-OF>            ::= NULL.
*LISTS
* ATTRIBUTE LISTS
*    1. BASE ATTRIBUTES USED IN DICTIONARY AND PARSING GRAMMAR.
*       MISSING DIDOMPN. UNUSED PT1.
*    2. SELECTION COMPONENT ADDS: PASS-SEL, LINKC, N-OMITSTG,
*       START-HGRAPH, STAY-HGRAPH, TRY-ATT.
*    3. TRANSFORMATION COMPONENT ADDS:
*       PREFX, DEL-ATT, INDEX, TENSE-ATT, TFORM-ATT,
*       [** ATTRIBUTES ASSIGNED TO TENSE-ATT **]
*       CONDITIONNEL, FUTURE, IMPARFAIT, IMPERTVE, PERF, PRESNT, PROG,
*       [** ATTRIBUTES ASSIGNED TO TFORM-ATT **]
*       TFORTOVO, TNPVINGO, TNPVO, TNSVINGO, TPVO, TRNFILLIN,
*       TRNWH, TSASOBJBE, TSOBJBE, TSVINGO, TTHATS, TWHATSN,
*       TWHETHS.
*    4. REGULARIZATION COMPONENT ADDS: FORMAT-ATT, EMBED-OBJ,
*       EMBED-SUBJ, REFPT-ATT, TYPE-ATT, PT2, SEM-CORE,
*       [** ATTRIBUTES ASSIGNED TO FORMAT-ATT **]
*       FRMT-UNIT, FRMT00, FRMT0, FRMT1, FRMT2, FRMT3, FRMT4,
*       FRMT1-3, FRMT13-MED, FRMT5-MISC, FRMT5-EKG,
*       FRMT4-5, FRMT5, FRMT5F, FRMT5-ALG, FRMT5-PTFAM, FRMT6, NOFRMT.
*    5. FORMAT COMPONENT ADDS:
*       FILLED-PT, FORMAT-PT, TRANSFORM-ATT, UNIT-ATT [NOT USED].
* WD-ATTRIBUTES USED IN DICTIONARY
ATTRIBUTE =
        [* ATTRIBUTES CURRENTLY USED *]
      AASP, ACCUSATIVE, ACT, AFORTO, APREQ, ASENT1,
      ASENT3, ATHAT,
      C, COLLECTIVE, COND,
      DATIVE, DEF, DEM, DEVAL, DLA, DLD, DLP, DLQ, DLTIME, DLV,
      DRA, DRD, DRQ, DRV, DSA,
      F, FUT,
      IMP, INDEF, INDEFINITE,
      INSTR,
      INV,
      LESS,
      M, MODAL-AFFIX, MORE, MORPH, H-POST,
      NCOUNT1, NEG-MEAN, NEG-PREFIX, NEGATIVE, NHUMAN,
      NMONTH, NO-REP, NOMINATIVE, NSCALE, NSENT1, NSENT4,
      NVN, PLACE-HOLDER [for non pronoun it],
      PAST, PERS1, PERS2, PERS3, PLURAL, POST, PRESNT, PREV, PVAL,
      QAGE, QALL, QDATE, QNUMBER, QROVING, QTENS, QTESTVAL,
      SAME, SCOPE, SINGULAR, SUBJONCTIF [French],
      TDEM, TIMETAG, TPOSS, TRANSITIVE,
      VBE, VETRE, VHAVE, VMIDDLE, VSE, VVERYVING,
        [* ATTRIBUTES CURRENTLY UNUSED *]
      ACOMPOUND, AGGREGATE, AINPA, AINRN, ARG, ARGPTR, ARGUMENT,
      ASCALE, ASENT2, ASHOULD, AWH,
      CATEGORIES, COMPARATIVE,
      CS0AS, CS1INNER,
      DLCOMP, DLCS, DLOC1, DLOC2, DLOC3, DLT, DLTPRO, DLW,
      DMANNER, DMIDDLE, DMOBILE, DPERM, DPRED, DRN,
      DRW, DSA1, DUNIV, DVERY,
      EACHEVRY,
      NAME, NCLASSIFIER1, NCLASSIFIER2, NCOUNT2, NCOUNT3,
      NCOUNT4, NEGADJ, NEO, NLETTER, NONHUMAN, NONTRANSITIVE,
      NPREQ, NSENT2, NSENT3, NSENTP, NTH, NTITLE,
      POS, PRE, PREFX, PROPOSS, PROSELF,
      QHALF, QMANY,
      REFLEXIVE,
      SUPERLATIVE,
      TQUAN,
      VASP, VCOLLECTIVE, VDO, VENDADJ, VEVENT, VEXP,
      VMANNER, VMOD, VMOTION, VRARE, VRECIP,
      VSENT1, VSENT2, VSENT3, VSENT4,
      W7WORD.
* GR-ATTRIBUTES USED IN GRAMMAR
ATTRIBUTE =
        [* ATTRIBUTES CURRENTLY USED *]
      ANYTHING [DVC1, DVC2],
      CONDITIONNEL,
      CONJ-LIKE,
      FRMT-UNIT, FRMT0, FRMT00, FRMT1, FRMT2, FRMT3, FRMT13-MED,
      FRMT5-MISC, FRMT5-EKG, FRMT4, FRMT4-5, FRMT5, FRMT5-ALG, FRMT5F,
      FRMT5-PTFAM, FRMT6,
      FUTURE, IMPARFAIT, IMPERTVE,
      NOFRMT,
      OBJECTPRO, OBJLIST,
      POBJLIST, PROG,
      PASS-SEL [CLASS FOR SELECTION LISTS- ALWAYS PASS],
      PATHIF [* snopath *],
      TFORTOVO, TNPVINGO, TNTOVO, TNSVINGO, TTOVO,
      TRNFILLIN, TRNWH, TSASOBJBE, TSOBJBE, TSVINGO,
      TTHATS, TWHATSN, TWHETHS,
        [* ATTRIBUTES CURRENTLY UNUSED *]
      BVAL,
      DECIMAL, DPVAL,
      NOTNOBJ, NOTNSUBJ, NPNPN,
      OVAL,
      P-ITIS, PERF, PNPN, POBJECT, PVAL1, PVAL2,
      SENTOBJ, SUB, SVAL,
      TOBJLIST.
* SUBLANGUAGE-ATTRBS
ATTRIBUTE = [FRENCH H-CHANGE SUBCLASSES] ME3ME, MOINS, PLUS.
ATTRIBUTE =
        [* LIST TYPE DECLARATIONS *]
      ADJUNCT-TYPE,
      BODYFUNC-PN, BODYLOC-PN, CONN-PN,
      CONN-TYPE,
      INSTR-TYPE,
      NULLNCLASS,
      QUANT-ADVERBIAL,
      TIME-ADVERBIAL,
      TIME-CLASS [USED TO MARK TIME CLASS LIST],
      VHAVE-TYPE,
        [* ATTRIBUTES CURRENTLY USED *]
      BEREP,
      EMPTY-SET,
      FAIL-SEL,
      FEM,
      GENERIC,
      H-AGE, H-ALLERGY, H-AMT,
      H-BECONN, H-BEH,
      H-CELLTYPE, H-CHANGEMK,
      H-CHANGE, H-CHANGE-MORE, H-CHANGE-LESS, H-CHANGE-SAME,
      H-CHEM [*S*], H-CONN,
      H-DESCR, H-DEVMED, H-DIAG,
      H-ETHNIC, H-EVID,
      H-FAMILY,
      H-GEOGR,
      H-INDIC, H-INST,
      H-MODAL,
      H-NEG, H-NORMAL, H-NOCLASS [*S*], H-NULL,
      H-OBSERVE, H-ORG,
      H-PT, H-PTAREA, H-PTDESCR, H-PTFUNC, H-PTLOC, H-PTMEAS,
      H-PTPALP, H-PTPART, H-PTSPEC, H-PTVERB,
      H-RECORD, H-DIET [formerly, H-REPAS], H-RESP, H-RESULT,
      H-SHOW,
      H-TMBEG, H-TMEND, H-TMLOC, H-TMDUR, H-TMPREP, H-TMREP,
      H-TRANSP, H-TRIGGER [* weak causative *],
      H-TTSURG, H-TTCOMP, H-TTFREQ, H-TTGEN, H-TTMED, H-TTMODE,
      H-TXCLIN, H-TXPROC, H-TXRES, H-TXSPEC, H-TXVAR,
      H-UNDEF [undefined word],
      MASC,
      NO-TYPE, NTIME1, NUNIT,
      PAST,
      TIME-PREFIX, TRANSP,
        [* ATTRIBUTES CURRENTLY UNUSED *]
      G-VRELFAC,
      H-ADJSPINE,
      H-DIMENSION, H-DOCTOR,
      H-ERROR, H-EVENT,
      H-GENERIC, H-GROW,
      H-HOSP,
      H-INGEST, H-INTOX,
      H-LABRES,
      H-MULT,
      H-NORM,
      H-OCCASION,
      H-PART, H-PSYCH, 
      H-SET, H-SHAPE, H-STATUS,
      H-TESTVIEW, H-TIMEQUAL, H-TYPE,
      H-VRX, H-VTEST,
      H-VTENSE,
      NTIME2,
      V-HEAL.
* NODE-ATTRIBUTES
ATTRIBUTE = FRMT1-3 [NEW COMBINED F1+F2+F3+F5],
            FRMT345 [AMBIGUOUS FRMT1-3, FORMAT4 AND FRMT5/FRMT5x],
            FRMT3-5 [AMBIGUOUS FRMT1-3 AND FRMT5/FRMT5x],
            SEM-CORE [NEW NAME FOR HOST-ASP].
ATTRIBUTE =
      AMBIG [* ambiguous expansion *],
      ADVERBIAL-TYPE, ASSIGN-ATT,
      COMMA-NULLFRAG, COMPUTED-ATT,
      DEFERRED, DEL-ATT, DIDOMIT, DIDOMPN, DIRECT,
      EMBED-OBJ, EMBED-SUBJ,
      FILLED-PT, FORMAT-ATT, FORMAT-PT,
      HGRAPH-ATT,
      INDIRECT, INDEX,
      ANTECEDENT, ANALINK, [* anaphora lists *]
      LAST-NODE, LINKC, LN-TO-N-ATT,
      MATCHED, MED-ATT,
      N-OMITSTG, N-TO-LN-ATT, N-TO-RN-ATT,
      NO-RN-ATT, NOT-DISTR-LN-ATT, NOT-DISTR-RN-ATT, NOT-FREE,
      POSTCONJELEM, PRECONJELEM, PVAL-ATT, PT1, PT2,
      REFPT-ATT [identifies PN with REFPT in it], RN-TO-N-ATT,
      SE, SELECT-ATT, [SEM-CORE,] SHARED-CONNECTIVE,
      START-HGRAPH, STAY-HGRAPH,
      TENSE-ATT, TFORM-ATT, TRANSFORM-ATT, TRY-ATT, TYPE-ATT,
      WORD-POS, UNIT-ATT.
* PHRASE-ATTRIBUTES
ATTRIBUTE = PHRASE-ATT,
     AGE-PHRASE, DATE-PHRASE, DOSE-PHRASE, INFLUENCE-PHRASE,
     PTPART-PHRASE, QUANT-PHRASE, RADIATE-PHRASE, SOURCE-ATT,
     SOURCE-PHRASE, TIME-PHRASE, TIME-POST-PHRASE, TESTENV-PHRASE.
ATTRIBUTE = [* EKG ATTRIBUTES *]
            E-AX [axis], E-EKGPROC [EKG test], E-LEAD [EKG leads],
            E-INTVL [interval], E-WV [EKG wave].
ATTRIBUTE = ASSN-SELS [* all SELECT-ATTS of ASSN/FRAGMENT *].
ATTRIBUTE = SUPPORT-ATT [* SUPPORT-CLASS for major class *].
ATTRIBUTE =
     CONNSTK
       [* NODE ATTRIBUTE USED BY T-RECORD-CONJ TO THREAD *]
       [* CONJUNCTION NODE IN THE PROCESS OF LINKING *]
       [* CONJUNCTION WORDS TO ITS SECOND CONJUNCT *],
     CT-CONJ
       [* NODE ATTRIBUTE USE BY T-WRITE-CT.  NODE ATTRIBUTE *]
       [* OF A SECOND CONJUNCT POINTING TO THE CONJUNCTION *]
       [* WORDS (REGULARIZED TREE HAS PREORDER PARSE-CONN *]
       [* STRUCTURE, THE EFFECT OF THIS IS TO TURN INTO AN *]
       [* INORDER STRUCTURE, REQUIRED BY CT). *],
     CT-WRITTEN [* Mark T-WRITE-CT nodes that have been written *].
ATTRIBUTE =
     CONJ-LINK
       [* MARKS LINK BETWEEN CONJUNCTION AND ITS ARGUMENTS VIA *]
       [* NODE ATTRIBUTE CONJ-LINK WITH THE SAME NUMERIC VALUE *].
ATTRIBUTE =
     C01, C02, C03, C04, C05, C06, C07, C08, C09, C10,
     C11, C12, C13, C14, C15, C16, C17, C18, C19, C20.
* WORD POSITION ATTRIBUTES
ATTRIBUTE = W001, W002, W003, W004, W005, W006, W007, W008, W009,
      W010, W011, W012, W013, W014, W015, W016, W017, W018, W019,
      W020, W021, W022, W023, W024, W025, W026, W027, W028, W029,
      W030, W031, W032, W033, W034, W035, W036, W037, W038, W039,
      W040, W041, W042, W043, W044, W045, W046, W047, W048, W049,
      W050, W051, W052, W053, W054, W055, W056, W057, W058, W059,
      W060, W061, W062, W063, W064, W065, W066, W067, W068, W069,
      W070, W071, W072, W073, W074, W075, W076, W077, W078, W079,
      W080, W081, W082, W083, W084, W085, W086, W087, W088, W089,
      W090, W091, W092, W093, W094, W095, W096, W097, W098, W099,
      W100, W101, W102, W103, W104, W105, W106, W107, W108, W109,
      W110, W111, W112, W113, W114, W115, W116, W117, W118, W119,
      W120, W121, W122, W123, W124, W125, W126, W127, W128, W129,
      W130, W131, W132, W133, W134, W135, W136, W137, W138, W139,
      W140, W141, W142, W143, W144, W145, W146, W147, W148, W149.
* GLOBAL LISTS
GLOBAL = $ASCNT [ROUTINE L(X)],
         $ASSIGN-PRE-AND-POST [PRE-POST-CONJELEM],
         $AT-LADJ [HOST-, HOST],
         $AT-RADJ [HOST-, HOST],
         $ATRNSUBJ [HOST-, HOST],
         $CORE-PATH [CORE-],
         $NHUMAN-CHK [CORE-ATT, CORE-SELATT],
         $PRECONJ [COEL1],
         $POSTCONJ [CORE, DOWN1, STACK-FOR-LEFT],
         $RIGHT-TO-HOST [FOLLOWING-ELEMENT, HOST-ELEMENT],
         $STACK-TEST [DOWN1],
         $TO-PRECONJUNCTION-Y [COEL1],
         $UP-CONJ [LEFT-ADJUNCT, RIGHT-ADJUNCT].
GLOBAL = $ASPECTUAL [DEEPEST-COVERB],
         $UP-THROUGH-Q [IMMEDIATE, PRESENT-STRING].
* FORMAT-GLOBALS
GLOBAL = $EMPTY [WRITE-WORDS, T-WRITE-FORMAT],
         $ERR-END [PUTIN-SLOT, T-FORMAT-SLOT, T-MOD],
         $ERR-SIGNAL [PUTIN-SLOT, T-FORMAT-SLOT, T-MOD],
         $SET-POINTERS [T-FORMAT-SLOT, T-MOD, T-TIMEUNIT, T-AGE,]
                       [PUTIN-SLOT].
GLOBAL = $BUILD-BP-MOD [T-BUILD-FORMAT, T-FORMAT-SLOT],
         $BUILD-MODS [T-BUILD-FORMAT, T-MOD],
         $BUILD-Q-N [T-BUILD-FORMAT, T-AGE, T-QUANT],
         $BUILD-RXDOSE [T-BUILD-FORMAT, T-MEDDOSE],
         $BUILD-TENSE [T-BUILD-FORMAT, T-MOD],
         $BUILD-TIME-ASP [T-BUILD-FORMAT, T-MOD, T-TIMEUNIT,]
                         [T-REFPT-PN, T-QN-TIME],
         $BUILD-TIME-QUAL [T-BUILD-FORMAT, T-TIME-QUAL] [*GRI*],
         $BUILD-EVENT-TIME [T-BUILD-FORMAT, T-MOD, T-TIMEUNIT,]
                           [T-REFPT-PN, T-QN-TIME],
         $BUILD-QUANT [T-BUILD-FORMAT],
         $BUILD-UNIT [T-BUILD-FORMAT],
         $BUILD-Y-OF [T-BUILD-FORMAT],
         $BUILD-QUANTITY [T-BUILD-FORMAT, T-MOD],
         $CORE-FAIL-SEL [T-FORMAT-SLOT, T-MOD],
         $CORE-ADJUNCT-ATT [T-FORMAT-SLOT, T-MOD],
         $CHK-DOSE [T-MEDDOSE, T-FORMAT-SLOT],
         $CHK-FOR-PERUNIT [T-PERUNIT, T-QUANT, T-MEDDOSE],
         $FIND-FORMAT [T-FORMAT-SLOT, T-AGE, T-TIMEUNIT, T-REFPT-PN,]
                    [T-REFPT-PDATE, T-QUANT, T-MEDDOSE, T-QN-TIME],
         $FIND-HOST-SLOT [T-MOD, T-TIMEUNIT, T-REFPT-PN,]
                         [T-REFPT-PDATE, T-QN-TIME],
         $FIND-EVENT-TIME [T-MOD, T-TIMEUNIT, T-REFPT-PN,]
                          [T-REFPT-DATE, T-NPOS-REFPT,T-QN-TIME],
         $FIND-TIME [T-MOD, T-TIMEUNIT, T-REFPT-PN, T-QN-TIME],
         $GET-SLOT [T-FORMAT-SLOT],
         $HAS-FAIL-SEL [T-FORMAT-SLOT],
         $HAS-ADJUNCT-ATT [T-FORMAT-SLOT],
         $IMM-LXR [T-FORMAT-SLOT, T-TIMEUNIT],
         $IS-LCONNR [T-FORMAT-SLOT, T-MOD],
         $IS-LQR-LQNR [T-FORMAT-SLOT, T-MOD],
         $IS-MINOR-CLASS [T-COMP-ATT, T-FORMAT-SLOT],
         $IS-NEG-MODAL [T-COMP-ATT, T-FORMAT-SLOT],
         $NEXT-SLOT-FOR-HOST [T-MOD, T-TIMEUNIT, T-REFPT-PN,]
                    [T-REFPT-DATE, T-NPOS-REFPT, T-QN-TIME],
         $NO-SUBCLASS [T-FORMAT-SLOT, T-MOD],
         $NOT-FORMATED [T-AGE,T-TIMEUNIT,T-REFPT-PN,T-REFPT-PDATE,]
                       [T-QUANT, T-MEDDOSE, T-QN-TIME],
         $PRE-TO-TIME-PTR [T-TIMEUNIT, T-REFPT-PN, T-REFPT-PDATE,]
                          [T-QN-TIME],
         $PRE-TO-QUANT-PTR [T-QUANT, T-PERUNIT],
         $PUTIN-NUM [T-AGE, T-TIMEUNIT, T-REFPT-PN, T-QUANT],
         $PUTIN-Q-N [T-AGE, T-TIMEUNIT, T-REFPT-PN, T-QUANT],
         $PUTIN-UNIT [T-AGE, T-REFPT-PN],
         $QNREP-TEST [T-AGE, T-REFPT-PN, T-QUANT],
         $SET-FORMAT-REG [T-FORMAT-SLOT, T-MOD],
         $SET-PARSE-REG [T-FORMAT-SLOT, T-MOD],
         $SETUP-REFPT [T-REFPT-PN, T-REFPT-PDATE],
         $SUBCLASS-CHK [T-FORMAT-SLOT, T-PARAGR],
         $SYNTAX-CHK [T-FORMAT-SLOT, T-PARAGR],
         $WARNING-SIG [T-MOD, T-FORMAT-SLOT].
GLOBAL = $DESCENT-TYPE [TSEQ-STRING, TSEQ-ADJUNCT, TSEQ-OBJ],
         $LXR-TYPE [TSEQ-STRING, TSEQ-ADJUNCT],
         $STRING-TYPE [TSEQ-STRING, TSEQ-ADJUNCT].
* SUBLANGUAGE SELECTION LISTS
*  THE FOLLOWING LISTS ARE USED BY SUBLANGUAGE SELECTION AND
*  CONJUNCTION RESTRICTIONS
*
* SUBLANGUAGE-ATTS
*     LIST OF ALL ATTRIBUTES INVOLVED IN SELECTION; THIS INCLUDES ALL
*     SUBLANGUAGE CLASSES AND THOSE ENGLISH CLASSES WHICH PARTICIPATE
*     IN SELECTION (GIVEN AT BEGINNING OF THE LIST).
*     ANY CLASS ON THIS LIST WILL BE REQUIRED TO CONJOIN TO WORDS OF
*     THE SAME CLASS, UNLESS THE CLASS ALSO APPEARS ON THE LIST
*     EQUIV-CLASSES, WHICH DEFINES AN EQUIVALENCE CLASS FOR CONJUNCTION.
LIST SUBLANGUAGE-ATTS =
        [* ENGLISH CLASSES     *]
     [ASENT1, ASENT2, AASP,]
     [BEREP,]
     [CONJ-LIKE, EMPTY-SET,] FEM,
     [INSTR,] MASC,
     [NSENT1, NSENT2, NSENT3, NSENTP,]
      NTIME1, NTIME2, [NULLNCLASS,] NUNIT,
      QNUMBER,
      VBE, VDO, VHAVE,
        [* SUBLANGUAGE CLASSES *]
      E-AX, E-EKGPROC, E-LEAD, E-INTVL, E-WV [EKGSTG],
      H-AGE, H-ALLERGY, H-AMT,
      H-BECONN, [H-BEH,]
     [H-CELLTYPE,] H-CHANGE, H-CHANGE-MORE, H-CHANGE-LESS, H-CHANGE-SAME,
      H-CONN, H-CHEM [*S*],
      H-DESCR, H-DEVMED, H-DIAG, [H-DIMENSION, H-DOCTOR,]
      H-ETHNIC, [H-EVENT,] H-EVID,
      H-FAMILY,
      H-GEOGR, [H-GROW, H-HOSP,]
      H-INDIC, H-INST, [H-INTOX,]
     [H-LABRES,]
      H-MODAL,
      H-NEG, [H-NOCLASS,] H-NORMAL, H-NULL,
      H-OBSERVE, [H-OCCASION,] H-ORG,
      H-PT, H-PTAREA, H-PTDESCR, H-PTFUNC, H-PTLOC, H-PTMEAS,
     [H-PTPALP,] H-PTPART, H-PTSPEC, H-PTVERB,
      H-RECORD, H-RESP, H-RESULT,
      H-SHOW, [H-STATUS,]
      H-TMBEG, H-TMEND, H-TMLOC, H-TMDUR, H-TMPREP, H-TMREP,
      H-TTSURG, H-TTCOMP, [H-TTFREQ,] H-TTGEN, H-TTMED, H-TTMODE,
      H-TXCLIN, H-TXPROC, H-TXRES, H-TXSPEC, H-TXVAR,
      H-TESTVIEW, H-TRANSP, [H-TRIGGER,]
      H-VTENSE, H-VTEST.
*  SPECIAL-LISTS NEEDED FOR CONJUNCTION AND SELECTION RETSTRICTIONS
*
* HUMAN-LIST
*     USED IN $NHUMAN-CHK; CONTAINS LIST OF HUMAN SUBCLASSES FOR
*     THE SUBLANGUAGE, ADDED ONTO WORDS WHICH ARE ONLY NHUMAN, AND
*     NOT OTHERWISE SUBCLASSIFIED (E.G., 'PERSON', OR 'SHE').
LIST HUMAN-LIST =
     H-FAMILY, [H-DOCTOR,] H-PT.
* NEG-LIST
*     CONTAINS NEGATIVE ATTRIBUTE H-NEG FOR COMPUTED-ATTRIBUTE.
LIST NEG-LIST = H-NEG.
* NO-REP-LIST
*     CONTAINS 'NO-REP' TO DETERMINE IF QNUMBER SHOULD CAUSE COMPUTED
*     ATTRIBUTE FOR CERTAIN WORDS.
LIST NO-REP-LIST = NO-REP.
LIST VSENT-LIST = VSENT1,VSENT2,VSENT3.
LIST NONHUMAN-LIST = NONHUMAN.
LIST NUNIT-LIST = NUNIT.
LIST QNUMBER-LIST = QNUMBER.
LIST H-AGE-LIST = H-AGE.
LIST DOCTOR-LIST = H-INST [H-DOCTOR].
LIST PT-GENDER = FEM, MASC.
LIST PT-FAM = H-PT, H-FAMILY.
LIST CHANGEMK-LIST = H-CHANGEMK.
LIST REPT-LIST =
     H-TTGEN, H-PTVERB, H-TTCOMP, H-TXPROC, H-TTSURG.
*include emifstbl_100.txt
* MOD-CLASS
*    LIST OF MODIFIER SUBCLASSES - WORDS WITH THESE SUBCLASSES MAP
*    INTO MODIFIER FIELDS IN THE FORMATS.
LIST MOD-CLASS =
       H-AMT, H-TMBEG, H-TMEND, H-MODAL, H-EVID, H-NEG, H-TMREP,
       H-TMDUR, H-CHANGE, H-CHANGE-MORE, H-CHANGE-LESS, H-CHANGE-SAME,
       H-TRANSP, NUNIT, H-PTAREA, H-PTPART, H-PTLOC,
       H-CHANGEMK, QNUMBER, NTIME1, NTIME2, H-VTENSE, H-TMLOC.
* TIME-MOD-CLASSES
*      LIST OF SUBCLASSES WHICH FORMAT INTO TIME OR MODIFIER SLOTS.
*
LIST TIME-MOD-CLASSES =
     H-TMBEG, H-CHANGE, H-CHANGE-MORE, H-CHANGE-LESS, H-CHANGE-SAME,
     H-TMEND, H-EVID, H-MODAL,
     H-NEG, H-OBSERVE, H-TMDUR, H-TRANSP,
     H-TMLOC, NTIME1.
LIST TIME-MODS-LIST =
     NTIME1, NTIME2, H-TMBEG, H-TMEND, H-TMLOC, H-TMDUR, H-TMREP.
LIST PTPART-SLOT =
     H-PTPART, H-PTAREA, H-PTLOC.
LIST PTPART-F4-SLOT =
     H-PTPART, H-PTAREA, H-PTLOC, H-PTSPEC, H-PTFUNC.
*include emregtbl_100.txt
LIST OPERATOR-LIST = NSENT1,NSENT2,NSENT3,ASENT1,ASENT3,VSENT1,
                     VSENT2,VSENT3,VSENT4.
LIST TRANSP-LIST =
     H-AMT, H-TMBEG, H-CHANGE, H-CHANGE-MORE, H-CHANGE-LESS,
     H-CHANGE-SAME, H-TMEND, H-EVID,
     H-MODAL, H-NEG, H-OBSERVE, H-TMDUR, H-TMREP, H-TRANSP.
LIST TIME-ADVERB-LIST = TIME-ADVERBIAL.
* MULTI-ENTRY
*     LIST OF FORMAT SLOTS WHICH CAN CORRESPOND TO MORE THAN
*     ONE PARSE TREE NODE - I.E. MORE THAN ONE NON-EMPTY ELEMENT
*     EACH ONE POINTING TO A DIFFERENT PARSE TREE NODE.
LIST MULTI-ENTRY =
      INST, REPT, REF-PT, NON-NUM, RXFREQUENCY,
      TIME-QUALS, TIMEPER, TENSE, VERB, VERB-MD,
        [* New Additions *]
      EXAMTEST, TXRES, TXSPEC, DIAG, INDIC, NORMAL, PROCEDURE,
      GEN, SURG, MED-DEVICE, PTFUNC, PTPART, QUANT, SUBJECT,
      COMP, MED, TXVAR [Level 5], SPEC-ACCESS, ORGANISM, INFO-SOURCE,
      ALLIFE,
      IN-LEADS [EKG], EVENT-TIME [for TIME-PHRASE's].
* MOD-LIST: LIST OF SLOTS IN MOD MODIFIER.
LIST MOD-LIST = NEG, MODAL, FACTUAL, MODS-OTHER.
* FORMAT-TYPES: THE NAMES OF THE DIFFERENT FORMATS, INCLUDING CONNECTIVE.
LIST FORMAT-TYPES =
     PATH-I-F, FORMAT00, FORMAT0, FORMAT1, FORMAT2, FORMAT3,
     FORMAT13-MED, FORMAT5-MISC, FORMAT5-EKG,
     FORMAT1-3, FORMAT4, FORMAT5, FORMAT5F, FORMAT5-ALG, FORMAT6, CONNECTIVE.
* ONE-ELEMENT: THESE NODES HAVE SEVERAL ELEMENTS BUT ONLY ONE OF THESE
*             ELEMENTS CAN BE 'FILLED' (CAN CORRESPOND TO A PARSE TREE NODE)
*         FOR EX. PSTATE-DATA HAS INDIC + DIAG + NORMAL +... BUT ONLY ONE OF
*         THOSE NODES CAN CORRESPOND TO A PARSE TREE NODE.
LIST ONE-ELEMENT = [PSTATE-DATA, PSTATE-SUBJ,] SUBJECT, OBJECT.
* CONJ-NUMBERS
*     USED TO LINK CONJUNCTION WITH ITS ARGUMENT VIA CONJ-LINK.
LIST CONJ-NUMBERS =
   C01, C02, C03, C04, C05, C06, C07, C08, C09, C10,
   C11, C12, C13, C14, C15, C16, C17, C18, C19, C20.
* MODAL-LIST
*    CONTAINS MODAL ATTRIBUTE H-MODAL FOR CONSTRUCTION OF SELECT-ATT.
LIST MODAL-LIST = H-MODAL.
* END OF LISTS USED BY SUBLANGUAGE SELECTION RESTRICTIONS
*
* TYPE LISTS
*
TYPE ADJSET  =
     LA, LCDA, LCDN, LCDVA, LCS, LDATE, LN, LNAME, LP, LPRO, LQ,
     LT, LV, LVSA, LW, LAUX,
     RA, RA1, RD, RDATE, RN, RNAME, RQ, RV, RW,
     SA,
         [** CONN GRAMMAR NODES **]
     LCONN, LD, LTIME, RCONN, RP, QUAL.
TYPE ADJSET1 =
     AND-ORSTG, ANDSTG, ASSTG, [AS-WELL-AS-STG,] BOTHSTG, BUTSTG,
     COLONSTG, COMMASTG, DASHSTG, EGSTG, EITHERSTG, ESPECIALLY-STG,
     LA, LCDA, LCDN, LCDVA, LCS, LD, LDATE, LN, LNAME, LP, LPRO, LQ,
     LT, LV, LVSA, LW, LAUX,
     NEITHERSTG, NORSTG, ORSTG, PARENSTG, PARTICULARLY-STG,
     QNREP, QUOTESTG,
     RA, RA1, RD, RDATE, RN, RNAME, RQ, RV, RW, RWV,
     SA,
     THANSTG, TOSTG, VERSUSSTG,
        [** CONN GRAMMAR NODES **]
     LCONN, RCONN, RP.
        [* TYPE RNOPTSET IS REMOVED *]
TYPE CONJ-NODE  = ANDSTG, ANDORSTG, ASWELLASSTG, BUTSTG, COMMASTG,
                  INADDITIONTOSTG, INCLUDINGSTG, ORSTG, NORSTG,
                  PARTICULARLY-STG, PLUSSTG, WITHSTG, THANSTG,
                  [FRENCH] DMQSTG, NISTG, PUISSTG, AINSIQUESTG.
TYPE SCOPE-NODE = BOTHSTG, EITHERSTG, NEITHERSTG, NISTG.
TYPE SP-NODE    = ANDSTG, ANDORSTG, ASWELLASSTG, BUTSTG, COMMASTG,
                  INADDITIONTOSTG, INCLUDINGSTG, ORSTG, NORSTG,
                  PARTICULARLY-STG, PLUSSTG, WITHSTG, THANSTG,
                  [FRENCH] DMQSTG, NISTG, PUISSTG, INTSTG, AINSIQUESTG.
TYPE LADJSET =
     LA, LCDA, LCDN, LCDVA, LCS, LDATE, LN, LNAME, LP, LPRO, LQ,
     LT, LV, LVSA, LW, LAUX,
         [** CONN GRAMMAR NODES **]
     LCONN, LD, LTIME.
TYPE LXR =
     LAR, LAR1, LDATER, LDR, LNAMER, LNR, LNSR, LQR, LQNR, LTR,
     LTVR, LVENR, LVINGR, LVR, TENSE, VERB, LLEADR [ekg], LWVR [ekg],
        [** CONN GRAMMAR NODES **]
     LCONNR, LPR.
TYPE MINLIST    = PN, D, SUB1, NSTGT, INT, PDATE, TOVO, PVO.
* MODIFIERS: NAME OF FORMAT SLOT MODIFIERS.
TYPE MODIFIERS = TIME-ASP, MODS, BP-MOD, QUANTITY, EVENT-TIME,
                 TENSE, Y-OF, TIME-QUAL [*GRI*].
TYPE N-OBJ-IN-STR = [N OR PN OBJECTS OF TYPE STRING]
     ADJN, DP2, DP3, DP4, DP1PN, DP2PN, DP3PN, DP4PN, NA, NASOBJBE,
     ND, NN, NPDOSE, NPN, NPSNWH, NPSVINGO, NPVINGO, NPVINGSTG,
     NSNWH, NTHATS, PN, PNN, PNSNWH, PNTHATS, PNTHATSVO, PNVINGSTG,
     VINGSTGPN, PNX2.
TYPE PSTRING =
     PD, PN, PQUANT, PVINGSTG, PSVINGO, PSNWH, PVINGO.
* MED TYPES.
TYPE ADJAUX = RNWH, NSTGT, CSSTG, RSUBJ, RNSUBJ, SAWH, SN, SNWH.
TYPE N-OMITTING-WH-STRING =
     FORTOVO-N, SAWHICHSTG, S-N, THATS-N, TOVO-N, WHATS-N, WHEVERS-N,
     WHNQ-N, WHNS-N, WHQ-N, WHS-N.
* MED UPDATE
TYPE PDPOBJECT =
     DP1, DP2, DP3, DP4, DPSN,
     DP1PN, DP2PN, DP3PN, DP4PN, DP1P,
     NPN, NPSNWH, NPSVINGO, NPVINGO, NPVINGSTG,
     P1, PN, PNN, PNX2, PNTHATS, PNTHATSVO, PNSNWH, PNVINGSTG,
     PSNWH, PSVINGO, PVINGO, PVINGSTG,
     VINGSTGPN.
TYPE PN-OMITTING-WH-STG =
     PWHNQ-PN, PWHNS-PN, PWHQ-PN, PWHS-PN.
TYPE RADJSET=
     RA, RA1, RD, RDATE, RN, RNAME, RNOPTS, RQ, RT, RV, RW,
     RWV [ekg], RWVOPTS [ekg], RLEAD [ekg],
        [** CONN GRAMMAR NODES **]
     RCONN, RP.
TYPE RECURSIVE  = TPOS, ADJADJ, NNN, RN, SA, LDR.
TYPE REPETITIVE = RN, RV.
TYPE STGSEG     = ASSERTION, TOVO, VINGO, QN, PVO, SVO.
* MED UPDATE IN LAST 6 DEFINITIONS
TYPE STRING =
     ADJINRN, ADJN, APPOS, ASOBJBE, ASSERTION,
     BEINGO, BPART, C1SHOULD, CPDNUMBR,
     DP1, DP2, DP3, DP4, DP1P, DP1PN, DP2PN, DP3PN, DP4PN, DPSN,
     [ETCSTG,] FORTOVO, FORTOVO-N,
     HOWQASTG, HOWQSTG,
     IMPERATIVE,
     LN,
     NA, NASOBJBE, ND, NN, NPN, NPSNWH, NPSVINGO, NPVINGO, NPVINGSTG,
     NQ, NSNWH, NSTGT, NSVINGO, NTHATS, NTOBE, NUMBRSTG, NVSA, NTOVO,
     OBES, OBJBESA, PTIME [* 09/13/2001 *],
     P1, PA, PD, PDATE, PN, PNN, PNSNWH, PNTHATS, PNTHATSVO, PNVINGSTG,
     PROSENT, PQUANT, PSNWH, PSVINGO, PVINGO, PVINGSTG, PWHNQ,
     PWHNQ-PN, PWHNS, PWHNS-PN, PWHQ, PWHQ-PN, PWHS-PN, PARENSTG,
     Q-ASSERT, Q-CONJ, Q-INVERT, Q-PHRASE, QN, QNS, Q-OF, QPERUNIT,
     S-N, SASOBJBE, SAWHICHSTG, SENTENCE, SOBJBE, SOBJBESA, STOVO-N,
     SUB0, SUB1, SUB2, SUB3, SUB4, SUB5, SUB6, SUB7, SUB8, SUB9, SUB11,
     SUB12, SUB13, SVEN, SVINGO, SVO,
     THATS, THATS-N, TOBE, TOVO, TOVO-N, TSUBJVO,
     VENO, VENPASS, VINGO, VINGOFN, VINGSTGPN, VO,
     WHATS-N, WHENS, WHERES, WHETHS, WHETHTOVO, WHEVERS-N, WHNQ-N,
     WHNS-N, WHQ, WHQ-N, WHS-N,
     YESNOQ,
          [*** FRAGMENT GRAMMAR NODES ***]
     ASTGF, ASTGP, NSTGP, [* snopath *]
     BESHOW, FRAGMENT, MEDDOSE, NSTGF, NPDOSE, ONESENT, PDOSE,
     TVO, NPVO, PVO,
     PWHS, WHOSES, PNX2
          [*** FRENCH ***]
     [ENVINGO, FTIME, NPWHS, NVINGO, PNPVO, PNVO, PVO-N, SUB10].
TYPE TRANSMITTING-OBJ-STG =
      ASSERTION, C1SHOULD, DP2, FORTOVO-N, NA, ND, NN, NPN, NPSNWH,
      NPSVINGO, NPVINGO, NPVINGSTG, NTHATS, PN, PNTHATSVO,
      PSVINGO, PVINGO, PVINGSTG, TOVO, SASOBJBE, SOBJBE, SVEN, SVO,
      THATS, VENO, VENPASS, VINGO, WHETHS,
      PVO.
TYPE VERBAL    = LVR, LVENR, LVINGR, VERB.
* CT-DB-FIELDS CONTAINS NODES THAT CORRESPOND TO
*    INGRES/INFORMIX FIELD NAMES.
TYPE CT-DB-FIELDS =
     PROCEDURE, EXAMTEST, GEN, SURG, MED, COMP, SUBJECT,
     VERB, NEG, MODAL, DIAG, INDIC, TXRES, QUANT, NORMAL,
     PTPART, PTFUNC, PRECISIONS [MORE-PREDS], TIME-QUALS, TIME-LOCS,
     TESTRES, TTRES, [TXVAR, TXSPEC,] ORGANISM, INFLUENCE,
     ALLIFE,
    [SPEC-ACCESS,] QUALIFIERS, AGE, GENDER, INFO-SOURCE.
* TRANFORMATION TYPES.
TYPE EXPAND-STR =
     TOBE, PVO, TOVO, VENO, VENPASS, VINGO, VO.
TYPE STRING-TO-ASSERT =
     ASSERTION, FORTOVO, FRAGMENT, IMPERATIVE, NSVINGO,
     NPVO, SASOBJBE, SOBJBE, SVINGO, NTOBE, NTOVO.
TYPE STATEMENT-EQV-NODES =
       [* Nodes which are equivalent to a format statement *]
     NPWHS, PVO, PVO-N, PWHS, QUANT, VINGO, WHENS, WHS-N.
*RESTR
* ********** **************************************** **********
*                                                                *
*                          ROUTINES                              *
*                                                                *
* ********** **************************************** **********
*
ROUTINE COEL1-(X) =
  [* GIVEN THAT X AND Y ARE ELEMENTS OF SOME STRING. COEL1- ]
  [* STARTS AT Y AND GOES LEFT OR RIGHT TO X. HOWEVER IF X ]
  [* IS IN A STRING SEGMENT COEL1- WILL NOT GO TO X (COELEMENT ]
  [* ROUTINE DOES IT).IN A SITUATION X1Y1 CONJ X2Y2, COEL1 ]
  [* STARTING AT Y2 WILL GO TO X2. AND IN A SITUATION XY1 CONJ ]
  [* Y2 COEL1- STARTING AT Y2 WILL GO TO X.]
    EITHER $LEFT-OR-RIGHT
    OR ITERATE $TO-PRECONJUNCTION-Y UNTIL $LEFT-OR-RIGHT SUCCEEDS.
 $LEFT-OR-RIGHT =
    EITHER DO L (X) OR DO R (X).
 $TO-PRECONJUNCTION-Y =
    EITHER $PRECONJ OR $ASSIGN-PRECONJELEM.                      (GLOBAL)
 $PRECONJ =
    THE PRESENT-ELEMENT- HAS NODE ATTRIBUTE PRECONJELEM.         (GLOBAL)
 $ASSIGN-PRECONJELEM =
    VERIFY $LOCATE-CONJNODE;
    VERIFY $ASSIGN-PRE-AND-POST [PRE-POST-CONJELEM];
    DO $PRECONJ.
 $LOCATE-CONJNODE =
    ASCEND TO Q-CONJ; GO UP; STORE IN X100.
ROUTINE COEL1(X) =
  [* COEL1(X) IS THE STACKING COUNTERPART OF COEL1-. IN A   ]
  [* SITUATION (X1 CONJ X2)Y , STARTING AT Y COEL1 GOES TO  ]
  [* X1 AND STACKS X2. IN A SITUATION X1Y1 CONJ X2Y2, COEL1 ]
  [* STARTING AT Y1 WILL GO TO X1 AND WILL NOT STACK X2. IF ]
  [* THE PARSE TREE IS X(Y1 CONJ Y2), STARTING AT EITHER Y1 ]
  [* OR Y2 COEL1 GOES TO X.]
    STORE IN X200;
    EITHER $LEFT-OR-RIGHT
    OR ITERATE $TO-PRECONJUNCTION-Y UNTIL $LEFT-OR-RIGHT SUCCEEDS.
 $LEFT-OR-RIGHT =
    EITHER $LEFT-TO-X OR $RIGHT-TO-X.
 $LEFT-TO-X =
    DO L (X); DO STACK-FOR-LEFT.
 $RIGHT-TO-X =
    DO R (X); DO STACK-FOR-RIGHT.
ROUTINE COELEMENT-(X) =
  [* GIVEN THAT X AND Y ARE ELEMENTS OF SOME STRING COELEMENT- ]
  [* STARTS AT Y AND GOES TO X.  IF X IS IN A STRING SEGMENT   ]
  [* COELEMENT- WILL GO ONE LEVEL BELOW THE STRING SEGMENT TO  ]
  [* FIND X.]
    EITHER DO COEL1-(X) OR $STRING-SEGMENT.
 $STRING-SEGMENT = DO COEL1-(STGSEG); DO ELEMENT-(X).
ROUTINE COELEMENT(X) =
  [* THE STACKING COUNTERPART OF COELEMENT-. IF X IS IN A ]
  [* STRING SEGMENT SEG,COELEMENT WILL FIRST GO TO SEG AND ]
  [* STACK THE CONJUNCTS OF SEG IF THERE ARE ANY. COELEMENT ]
  [* WILL THEN GO TO X ONE LEVEL BELOW SEG.  IF X HAS ANY ]
  [* CONJUNCTS THEY WILL BE STACKED. IF X IS NOT IN A STRING ]
  [* SEGMENT THEN COELEMENT IS THE SAME AS COEL1.]
    EITHER DO COEL1(X) OR $STRING-SEGMENT.
 $STRING-SEGMENT = DO COEL1(STGSEG); DO ELEMENT(X).
ROUTINE CORE- =
  [* LOOKS FOR AN ATOMIC NODE OR STRING NODE WHICH IS EITHER ]
  [* THE NODE CURRENTLY BEING 'LOOKED AT' OR ONE THAT LIES ]
  [* BELOW THIS NODE. THE DESCENT DOES NOT PASS THROUGH NODES ]
  [* ON THE LIST ADJSET1.]
    DO $CORE-PATH.                                   (GLOBAL)
 $CORE-PATH =
    ONE OF $AT-ATOM,
           $DESCEND-TO-ATOM,
           $DESCEND-TO-STRING IS TRUE.
 $AT-ATOM = TEST FOR ATOM.
 $DESCEND-TO-ATOM =
    IF PRESENT-ELEMENT- IS APOS OR NPOS
    THEN GO DOWN;
    DESCEND TO ATOM NOT PASSING THROUGH ADJSET1.
 $DESCEND-TO-STRING =
    DESCEND TO STRING NOT PASSING THROUGH ADJSET1;
    IF TEST FOR LN
    THEN $RIGHT-TO-CORE
   [IF TEST FOR QN]
   [THEN $QN-CORE].
 $RIGHT-TO-CORE =
    ITERATE GO RIGHT UNTIL TEST FOR CONJ-NODE FAILS;
    DO CORE- .
 $QN-CORE =
    GO DOWN;
    ITERATE GO RIGHT UNTIL TEST FOR N SUCCEEDS.
ROUTINE CORE =
  [* THE CORE ROUTINE IS THE STACKING COUNTERPART OF CORE-. ]
  [* THE CORE MAY HAVE SEVERAL VALUES BECAUSE OF CONJUNCTION. ]
  [* IF AN ELEMENT X1 OF AN LXR TYPE STRING HAS CONJUNCTS X2, ]
  [* X3, THEN THE CORE OF X2, X3, ETC. IS STACKED.]
    DO $CORE-PATH;
    VERIFY $TO-X-POS-IN-LXR.
 $TO-X-POS-IN-LXR =
    EITHER $ASCNT OR TRUE;
    DO $STACK-CORE-TEST.
  $ASCNT = GO UP;
           TEST FOR AVAR OR NVAR OR QVAR OR VVAR OR WVVAR OR
                    LEADVAR OR DATEVAR OR HEADCONN OR LNAMER OR NQ;
           IF PRESENT-ELEMENT- IS LNAMER OR NQ
           THEN IMMEDIATE-NODE OF IMMEDIATE-NODE IS NVAR.
 $STACK-CORE-TEST = IF $POSTCONJ THEN $STACK-CONJUNCTS.
 $POSTCONJ = THE PRESENT-ELEMENT- HAS NODE ATTRIBUTE POSTCONJELEM.
 $STACK-CONJUNCTS = VERIFY ITERATE $STACK-CORES.
 $STACK-CORES = DO $POSTCONJ;
                STORE IN XX-CORE;
                DO $CORE-PATH;
                STACK;
                GO TO XX-CORE.
ROUTINE DOWN1-(X) =
  [* TESTS WHETHER X IS AN ELEMENT WHICH IS ONE LEVEL BELOW THE ]
  [* NODE THE PROGRAM IS CURRENTLY 'LOOKING AT'.]
    GO DOWN;
    ITERATET GO RIGHT UNTIL TEST FOR X SUCCEEDS.
ROUTINE DOWN1(X) =
  [* DOWN1 IS THE STACKING COUNTERPART OF DOWN1-. IF X HAS ]
  [* CONJUNCTS THEY ARE PLACED ON A RE-EXECUTION STACK.]
    DO DOWN1-(X); DO $STACK-TEST.
 $STACK-TEST = IF $POSTCONJ THEN $STACK-CONJUNCTS.
 $STACK-CONJUNCTS = VERIFY ITERATE $STACK-X.
 $STACK-X = DO $POSTCONJ; STACK.
ROUTINE ELEMENT-(X) =
  [* TESTS WHETHER X IS AN ELEMENT ONE LEVEL BELOW THE NODE THE ]
  [* PROGRAM IS CURRENTLY 'LOOKING AT'. IF NOT, AND A STRING ]
  [* SEGMENT IS ONE LEVEL BELOW THE CURRENT NODE THE SEARCH ]
  [* CONTINUES ONE LEVEL BELOW THE STRING SEGMENT NODE.]
    EITHER DO DOWN1-(X) OR $STRING-SEGMENT.
 $STRING-SEGMENT = DO DOWN1-(STGSEG); DO DOWN1-(X).
ROUTINE ELEMENT(X) =
  [* ELEMENT(X) IS THE STACKING COUNTERPART OF ELEMENT-(X). IF ]
  [* ELEMENT X GOES TO X1 AND X1 HAS CONJUNCTS X2,X3,ETC THEN X2, ]
  [* X3, ETC ARE PLACED ON THE RE-EXECUTION STACK.IF X1 IS ]
  [* IN A STRING SEGMENT S AND S HAS CONJUNCTS THEN THEY   ]
  [* ARE PLACED IN THE RE-EXECUTION STACK.]
    EITHER DO DOWN1(X) OR $STRING-SEGMENT.
 $STRING-SEGMENT = DO DOWN1(STGSEG); DO DOWN1(X).
ROUTINE FOLLOWING-ELEMENT- =
  [* GOES RIGHT TO THE FIRST NODE WHICH IS NOT SP-NODE.]
    DO $RIGHT-TO-HOST [HOST-ELEMENT].
ROUTINE FOLLOWING-ELEMENT =
  [* FOLLOWING-ELEMENT IS THE STACKING COUNTERPART OF ]
  [* FOLLOWING-ELEMENT-.  IT GOES TO THE ]
  [* FOLLOWING-ELEMENT- AND STACKS IT'S CONJUNCTS.]
    STORE IN X200;
    DO $RIGHT-TO-HOST [HOST-ELEMENT];
    DO STACK-FOR-RIGHT.
ROUTINE HOST- =
  [* GOES TO THE CORE OF HOST-ELEMENT ]
    CORE- OF HOST-ELEMENT EXISTS.
ROUTINE HOST =
    EITHER TEST FOR ADJSET OR ASCEND TO ADJSET;
    ONE OF $IN-LADJSET, $IN-RADJSET, $IN-RNSUBJ;
    DO $CORE-PATH .
 $IN-LADJSET =
    DO $AT-LADJ [HOST-ELEMENT];
    DO STACK-FOR-RIGHT.
 $IN-RADJSET =
    DO $AT-RADJ [HOST-ELEMENT];
    DO STACK-FOR-LEFT.
 $IN-RNSUBJ =
    DO $ATRNSUBJ[HOST-ELEMENT];
    DO $STACK-TEST [STARTAT].
ROUTINE HOST-ELEMENT =
  [* STARTS AT OR ASCENDS TO LADJSET OR RADJSET OR RNSUBJ Y. ]
  [* IF Y IS OF TYPE RADJSET OR LADJSET IT GOES TO THE CORE ]
  [* ELEMENT X (TO X IN AN LXR TYPE NODE). IF Y IS RNSUBJ IT ]
  [* ASCENDS TO SA AND THEN GOES TO COELEMENT SUBJECT. ]
  [* ** FRENCH CHANGE IN $AT-RADJ ** *]
    EITHER TEST FOR ADJSET OR ASCEND TO ADJSET PASSING THROUGH ADJINRN;
    ONE OF $AT-LADJ, $AT-RADJ, $ATRNSUBJ IS TRUE.
 $AT-LADJ =
    TEST FOR LADJSET;
    STORE IN X200;
    DO $RIGHT-TO-HOST .
 $RIGHT-TO-HOST =
    EITHER $GO-RIGHT-PAST-C
    OR ITERATE $TO-PRECONJUNCTION-Y [COEL1-]
       UNTIL $GO-RIGHT-PAST-C SUCCEEDS.
 $GO-RIGHT-PAST-C = ITERATE GO RIGHT UNTIL TEST FOR SP-NODE FAILS.
 $AT-RADJ =
    EITHER $IN-RN OR $IN-OTHERS;
    STORE IN X200;
    EITHER $RV-TEST OR $LEFT-TO-HOST.
 $IN-RN =
    TEST FOR RN;
    STORE IN X100;
    GO LEFT;
    IF PRESENT-ELEMENT- IS RNOPTS THEN DO $1;
    GO TO X100.
 $1 = GO UP; DO $IN-RN.
 $IN-OTHERS = TEST FOR RADJSET.
 $RV-TEST =
    TEST FOR RV;
    STORE IN X100;
    ONE OF $L-VVAR, $L-V, $L-VING, $L-VEN.
 $L-VVAR = DO L(VVAR).
 $L-V = DO L(V).
 $L-VING = DO L(VING).
 $L-VEN = DO L(VEN).
 $LEFT-TO-HOST =
    EITHER $LEFT-PAST-C
    OR ITERATE $TO-PRECONJUNCTION-Y [COEL1]
       UNTIL $LEFT-PAST-C SUCCEEDS.
 $LEFT-PAST-C = ITERATE GO LEFT UNTIL TEST FOR SP-NODE FAILS.
 $ATRNSUBJ =
    BOTH VALUE OF SA IS RNSUBJ
    AND PRESENT-ELEMENT- HAS COELEMENT- SUBJECT OR BESUBJ.
* IMMEDIATE(X) ASCENDS TO X. NODES ON THE STRING LIST ARE NOT
*      PASSED THROUGH.IF THIS ROUTINE STARTS AT Q-CONJ IT WILL GO
*       TO THE HOST NODE(UP TWICE FROM TOP OF Q NEST).
ROUTINE IMMEDIATE (X) =
       DO $UP-THROUGH-Q;
       ASCEND TO X PASSING THROUGH Q-CONJ.
 $UP-THROUGH-Q = ITERATET $GO-UP-TWICE UNTIL
                 TEST FOR Q-CONJ FAILS.                         (GLOBAL)
 $GO-UP-TWICE = GO UP; GO UP.
ROUTINE IMMEDIATE-NODE- = GO UP.
ROUTINE IMMEDIATE-NODE  =
       EITHER ITERATE $UP-CONJ [IN LEFT-ADJUNCT ROUTINE] OR TRUE ;
       GO UP.
ROUTINE IMMEDIATE-STRING = ASCEND TO STRING ;
       IF PRESENT-ELEMENT- IS Q-CONJ THEN DO IMMEDIATE-STRING.
ROUTINE INITIALRT =
    [* TESTS THAT THERE IS NO NODE TO THE LEFT OF THE ]
    [* NODE THE PROGRAM IS CURRENTLY 'LOOKING AT'.]
    VERIFY NOT DO PREVIOUS-ELEMENT-.
ROUTINE L (X) = ITERATE GO LEFT UNTIL TEST FOR X SUCCEEDS.
ROUTINE LAST-COELEMENT = EITHER ITERATE GO RIGHT OR TRUE.
ROUTINE LAST-ELEMENT- =
  [* GOES TO LEVEL BELOW THE NODE THE PROGRAM IS CURRENTLY      ]
  [* 'LOOKING AT' AND GOES TO THE RIGHTMOST NODE ON THAT LEVEL. ]
    GO DOWN;
    EITHER ITERATE GO RIGHT OR TRUE.
ROUTINE LAST-ELEMENT =
  [* LAST-ELEMENT IS THE STACKING COUNTERPART OF LAST-ELEMENT-. ]
  [* IT GOES TO THE LAST-ELEMENT- AND STACKS IT'S CONJUNCTS.]
    DO LAST-ELEMENT-;
    DO $STACK-TEST [STARTAT].
ROUTINE LEFT-ADJUNCT =
    EITHER $ASCNT [IN CORE] OR TRUE;
    EITHER $LEFT-TO-LADJ OR $UP-AND-LEFT.
 $LEFT-TO-LADJ =
    DO L (LADJSET); EITHER TEST FOR LN OR DO CORE.
 $UP-AND-LEFT =
    ITERATET $UP-CONJ UNTIL $LEFT-TO-LADJ SUCCEEDS
    [GO UP TO CONJUNCTION AND TRY TO GO LEFT].
 $UP-CONJ =
    IMMEDIATE-NODE- IS Q-CONJ; GO UP [WILL BE AT CONJ-NODE].
ROUTINE LEFT-ADJUNCT-POS =
  [* STARTS AT A CORE NODE Y WHERE Y IS AN ELEMENT OF AN LXR ]
  [* TYPE NODE OR FROM THE CORE ASCENDS TO Y IF Y = AVAR, QVAR ]
  [* OR NVAR. IT THEN GOES LEFT UNTIL IT FINDS A NODE WHICH IS ]
  [* ON THE LADJSET LIST. IF IT FINDS LNAME IN NVAR, IT WILL GO ]
  [* FROM LNAME TO LN.]
    EITHER $ASCNT [CORE] OR TRUE;
    STORE IN X200;
    EITHER DO L(LADJSET) OR ITERATE $TO-PRECONJUNCTION-Y [COEL1-]
                               UNTIL DO L(LADJSET) SUCCEEDS.
ROUTINE LOOKAHEAD(X) =
    GO TO THE CURRENT WORD;
    ITERATET GO TO THE NEXT WORD UNTIL DO X SUCCEEDS.
ROUTINE NELEMRT =
  [* CALLED AFTER AN OPERATOR HAS GONE TO THE NTH ELEMENT OF ]
  [* A STRING (IGNORING SPECIAL PROCESS NODES). IT STACKS THE ]
  [* CONJUNCTS OF THAT ELEMENT.]
    DO $STACK-TEST [STARTAT].
ROUTINE NONSEG-IMMSTG =
    DO IMMEDIATE-STRING;
    EITHER $UP-THRU-SEG OR TRUE.
 $UP-THRU-SEG = TEST FOR STGSEG; DO IMMEDIATE-NODE; TEST FOR STRING.
ROUTINE PRESENT-ELEMENT =
    ITERATET $HOST-OF-CONJ UNTIL TEST FOR Q-CONJ FAILS.
  $HOST-OF-CONJ =
       GO UP [TO CONJ-NODE];
       GO UP [TO HOST OF CONJ-NODE].
ROUTINE PRESENT-ELEMENT- = TRUE.
ROUTINE PREVIOUS-ELEMENT- =
  [* PREVIOUS-ELEMENT- SIMPLIFIED THE PREVIOUS-ELEMENT- IN MDPAR6]
    GO LEFT.
ROUTINE R (X) = ITERATE GO RIGHT UNTIL TEST FOR X SUCCEEDS.
ROUTINE RIGHT-ADJUNCT =
    EITHER $ASCNT OR TRUE;
    EITHER $RIGHT-TO-RADJ OR $UP-AND-RIGHT.
 $RIGHT-TO-RADJ=
    DO R(RADJSET); DO CORE.
 $UP-AND-RIGHT  =
    ITERATE $UP-CONJ [IN LEFT-ADJUNCT ] UNTIL $RIGHT-TO-RADJ SUCCEEDS.
ROUTINE RIGHT-ADJUNCT-POS =
      EITHER $ASCNT [CORE] OR TRUE;
      STORE IN X200;
      EITHER DO R(RADJSET)
      OR ITERATE $TO-PRECONJUNCTION-Y [ COEL1- ]
         UNTIL DO R(RADJSET) SUCCEEDS;
      IF PRESENT-ELEMENT- IS RNAME
      THEN AT IMMEDIATE NVAR DO RIGHT-ADJUNCT-POS.
ROUTINE STACK-FOR-LEFT =
  [* STACK-FOR-LEFT ROUTINES WHICH GO FROM ONE ELEMENT OF A ]
  [* STRING TO ANOTHER ELEMENT OF THE STRING BY GOING LEFT CALL ]
  [* STACK-FOR-LEFT TO HANDLE STACKING. GIVEN THAT X AND Y ARE ]
  [* ELEMENTS OF A STRING, STACK-FOR-LEFT IS ASSUMED TO START AT ]
  [* X AFTER THE ROUTINE WHICH CALLED IT GOES FROM Y TO X.  ]
  [* IN STRUCTURE (X1 CONJ X2) Y, STACK-FOR-LEFT WILL STACK X2. ]
  [* IN STRUCTURE X1 Y1 CONJ X2 Y2, STACK-FOR-LEFT WILL NOT STACK X2.]
    IF $POSTCONJ THEN VERIFY $STACK-IF-NO-Y-RGHT.
 $STACK-IF-NO-Y-RGHT =
    IF $POSTCONJ
    @THEN EITHER ALL OF $NO-Y-TO-RIGHT,
                        $DO-STACK,
                        $STACK-IF-NO-Y-RGHT
          OR TRUE.
 $NO-Y-TO-RIGHT =
    NOT ITERATE GO RIGHT UNTIL TEST FOR X200 SUCCEEDS.
 $DO-STACK = STACK.
ROUTINE STACK-FOR-RIGHT =
  [* STACK-FOR-RIGHT ROUTINES WHICH GO FROM ONE ELEMENT OF A ]
  [* STRING TO ANOTHER ELEMENT OF THE STRING BY GOING RIGHT ]
  [* CALL STACK-FOR-RIGHT TO HANDLE STACKING. GIVEN THAT X AND ]
  [* Y ARE ELEMENTS OF A STRING, STACK-FOR-RIGHT IS ASSUMED TO ]
  [* START AT Y AFTER THE ROUTINE WHICH CALLED IT GOES FROM X ]
  [* TO Y.  IN A SITUATION X1 Y1 CONJ Y2, STACK-FOR-RIGHT ]
  [* STARTING AT Y1 WILL STACK Y2. IN A SITUATION X1 Y1 CONJ X2 ]
  [* Y2, STACK-FOR-RIGHT STARTING AT Y1 WILL NOT STACK Y2.]
    IF $POSTCONJ THEN VERIFY $STACK-IF-NO-Y-LEFT.
 $STACK-IF-NO-Y-LEFT =
    IF $POSTCONJ
    @THEN EITHER ALL OF $NO-Y-TO-LEFT,
                        $DO-STACK,
                        $STACK-IF-NO-Y-LEFT
          OR TRUE.
 $NO-Y-TO-LEFT =
    NOT ITERATE GO LEFT  UNTIL TEST FOR X200 SUCCEEDS.
 $DO-STACK = STACK.
ROUTINE STARTAT (X) = EITHER TEST FOR X OR DO DOWN1-(X).
ROUTINE SUBSUMERT(X) =
  [* SEARCHES FOR A WORD OF GIVEN CLASS (AND SUBCLASS) WHICH ]
  [* IS MATCHED TO ANY ATOMIC NODE ON THE SUBTREE BELOW THE ]
  [* NODE THAT THE PROGRAM IS CURRENTLY 'LOOKING AT', I. E. ]
  [* WHICH IS SUBSUMED BY THE CURRENT NODE.]
    VERIFY $2;
    GO TO THE WORD STARTING THE PRESENT NODE;
    NOT TEST FOR X150;
    ITERATET $1 UNTIL DO X SUCCEEDS.
  $1 = GO TO THE NEXT WORD; NOT TEST FOR X150.
  $2 = GO TO THE WORD FOLLOWING THE PRESENT NODE; STORE IN X150.
* ********** **************************************** **********
*                                                                *
*                  EXTENDED SCOPE ROUTINES                       *
*                                                                *
* ********** **************************************** **********
*
ROUTINE EXTENDED-CORE- =
    [* goes to the core. If the core is NULLWH, this routine ]
    [* goes up to the RN and from there to the host noun. ]
    [* Simplify the same routine in the MDPAR6]
    DO CORE-;
    IF BOTH PRESENT-ELEMENT- IS NULLWH
       AND $PATH1 [WWH1; X5=WHS-N]
    THEN AT X5 DO HOST-.
 $PATH1 = EITHER NONSEG-IMMSTG X5 IS WHS-N
          OR $NESTED.                                        (GLOBAL)
 $NESTED = NONSEG-IMMSTG IS THATS OR TOVO OR PVO OR ASSERTION
           OR VENO OR VENPASS; DO $PATH1.
ROUTINE EXTENDED-CORE =
      DO CORE;
      IF BOTH PRESENT-ELEMENT- IS NULLWH
         AND PRESENT-ELEMENT- HAS NODE ATTRIBUTE N-OMITSTG
             [* go to WH-stg *]
     @THEN IF PRESENT-ELEMENT- IS WHNS-N OR WHNQ-N
           THEN CORE OF WHN EXISTS
           ELSE IF PRESENT-ELEMENT- IS WHQ-N
                THEN FIRST ELEMENT EXISTS
           ELSE HOST EXISTS
      ELSE IF PRESENT-ELEMENT- IS NULLC
           THEN IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE LINKC @
                THEN EXTENDED-CORE EXISTS.
* ROUTINE NONSEGWH IS A VERSION OF NONSEG-IMMEDSTG USED IN WH
* RESTRICTIONS.
*
ROUTINE NONSEGWH = ASCEND TO STRING; EITHER $1 OR TRUE .
  $1 = TEST FOR STGSEG;
       GO UP;
       TEST FOR STRING;
       EITHER $1 OR TRUE.
* PRESENT-STRING -SAME AS PRESENT-ELEMENT
*
ROUTINE PRESENT-STRING = DO $UP-THROUGH-Q [IMMEDIATE(X)] .
* DEEPEST-COVERB
*      STARTS AT ANY ELEMENT EXCEPT THE VERB OF A
*      VERB-CONTAINING STRING (USUALLY AT THE SUBJECT) AND GOES FIRST
*      TO THE VERB IN THE STRING;IF THAT VERB HAS A VERB-CONTAINING
*      OBJECT (OR A PREDICATE CONSISTING OF AN AASP+TOVO) THEN IT
*      GOES TO THE VERB IN THAT OBJECT (OR TOVO), WHERE IT REPEATS
*      THE TEST FOR A VERB-CONTAINING OBJECT. THE ITERATION ENDS ON THE
*      VERB WHICH DOESN'T HAVE A VERB-CONTAINING OBJECT (OR PREDICATE).
*      NOTE RE SN IN $VERBAL: THIS TEST MAKES 'IS' NOT 'SUFFER' THE
*      DEEPEST-COVERB IN 'TO LIVE IS TO SUFFER' AND 'HIS AIM IS NOT TO
*      SUFFER'(1 OF 2 READINGS).
*      USER BEWARE: SHIFT OF SUBJECT-OBJECT RELATION IN THE KERNEL DUE
*      TO PASSIVE MUST BE HANDLED BY THE RESTRICTION USING THE ROUTINE.
ROUTINE DEEPEST-COVERB- = ITERATE $NEXT-VERB- UNTIL $OBJ-HAS-VERB FAILS.
  $NEXT-VERB- = DO $1; DO $2 .                               (GLOBAL)
  $1 = THE PRESENT-ELEMENT- HAS COELEMENT- VERB OR LVINGR OR LVENR OR
       LVR OR VERB1 X7 .
  $2 = IF X7 IS VERB1 WHERE VALUE IS NOT LTVR THEN PRESENT-ELEMENT-
       HAS COELEMENT- VERB2 X7 .
  $OBJ-HAS-VERB =
       BOTH $VERBAL-
     @ AND PRESENT-STRING HAS ELEMENT- OBJECT OR PASSOBJ .
  $VERBAL- =
       IF PRESENT-ELEMENT- HAS COELEMENT- OBJECT OR PASSOBJ@
       THEN EITHER CORE- XX-COVERB IS VO OR VINGO OR TOVO OR TOBE
                   OR VENO OR VENPASS OR PVO
                   WHERE XX-COVERB IS NOT OCCURRING IN SN,
            OR $ASPECTUAL IS TRUE.
  $ASPECTUAL = BOTH XX-COVERB IS ADJ:AASP
               AND RIGHT-ADJUNCT OF XX-COVERB IS TOVO OR PVO.     (GLOBAL)
ROUTINE DEEPEST-COVERB = ITERATE $NEXT-VERB UNTIL $OBJ-HAS-VERB FAILS.
  $NEXT-VERB = DO $1; DO $2.                               (GLOBAL)
  $1 = PRESENT-ELEMENT- HAS COELEMENT VERB OR LVINGR OR LVENR OR LVR
          OR VERB1 X7.
  $2 = IF X7 IS VERB1 WHERE VALUE IS NOT LTVR
       THEN PRESENT-ELEMENT- HAS COELEMENT VERB2  X7.
  $OBJ-HAS-VERB =
       BOTH $VERBAL
     @ AND PRESENT-STRING HAS ELEMENT OBJECT OR PASSOBJ.
  $VERBAL =
       IF PRESENT-ELEMENT HAS COELEMENT OBJECT OR PASSOBJ@
       THEN EITHER CORE- XX-COVERB IS VO OR VINGO OR VENO OR TOVO
                    OR TOBE OR VENPASS OR PVO
                    WHERE XX-COVERB IS NOT OCCURRING IN SN,
            OR $ASPECTUAL [DEEPEST-COVERB-] IS TRUE.
ROUTINE ULTIMATE-HOST = ITERATE $HOSTJUMP UNTIL $PNADJ FAILS.
  $HOSTJUMP = DO HOST; STORE IN X3 .
  $PNADJ = X3 IS OCCURRING IN PN WHERE PN IS OCCURRING AS RN.   (GLOBAL)
ROUTINE ULTIMATE-OBJECT =
    EITHER ITERATE $ASCEND OR TEST FOR OBJECT
    OR PASSOBJ; EITHER $ADJUNCT OR TRUE .
  $ASCEND = ASCEND TO OBJECT OR PASSOBJ PASSING THROUGH
        TRANSMITTING-OBJ-STG   NOT PASSING THROUGH ADJSET .
  $ADJUNCT = ONE OF $ASP, $SNRA, $SNRN, $SN-IN-RV IS TRUE;
             DO $UPAGAIN.
  $SN-IN-RV = BOTH X6 IS OCCURRING AS SN @ AND SN IS OCCURRING AS
              RV WHERE PREVIOUS-ELEMENT- IS OBJECT OR PASSOBJ X40.
  $ASP= EITHER NONSEGWH X6 IS TOVO WHERE TOVO IS OCCURRING AS RA X40
        OR NONSEGWH X6 IS PVO WHERE PVO IS OCCURRING AS RA X40 .
  $SNRA = X6 IS OCCURRING AS SN X8 WHERE X8 IS OCCURRING AS RA X40.
  $SNRN =
    BOTH X6 IS OCCURRING AS SN X8 WHERE X8 IS OCCURRING AS RN X40
    AND IF X40 IS OCCURRING IN PN @ THEN PN IS OCCURRING AS RN OR
          OBJBE X40.
  $UPAGAIN = GO TO X40; DO ULTIMATE-OBJECT .
ROUTINE ULTIMATE-SUBJECT =
  [* ITERATIVELY ASCENDS TO OBJECT OR PASSOBJ PASSING THROUGH ]
  [* VERB-CONTAINING OBJECT STRINGS UNTIL IT FINDS AN OBJECT ]
  [* THAT HAS A COELEMENT SUBJECT. IT ALSO ASCENDS THROUGH ]
  [* PREDICATE NOUNS AND ADJECTIVES AND THEIR ADJUNCTS AS LONG ]
  [* AS THE ADJUNCTS DO NOT CONTAIN THE NODE SUBJECT.  THUS THE ]
  [* ULTIMATE SUBJECT OF X ASCENDS TO THE FIRST NODE SUBJECT ON ]
  [* ANY LEVEL ABOVE X IN THE PARSE TREE. NOTE THAT THE DEEPEST- ]
  [* COVERB DESCENDS MORE NARROWLY, PASSING THROUGH VERB-CONTAINING ]
  [* OBJECT STRINGS AND TOVO AS ADJUNCT OF AASP, BUT NOT THROUGH ]
  [* OTHER PREDICATES OR ADJUNCTS. USE DEEPEST-COVERB (NOT ]
  [* ULTIMATE-SUBJECT) IN SELECTIONAL RESTRICTIONS BECAUSE ]
  [* 'IT' IS THE ULTIMATE SUBJECT OF 'SWIM' IN BOTH        ]
  [*       'IT LIKES TO SWIM' AND 'IT IS FUN TO SWIM' ]
  [* USE ULTIMATE SUBJECT FOR 'IT' PERMUTATIONS.]
    ITERATET $UP-TO-OBJ UNTIL $COELSUBJ SUCCEEDS.
 $UP-TO-OBJ =
    EITHER ASCEND TO OBJECT OR PASSOBJ PASSING THROUGH VENO OR
        VENPASS OR VINGO OR TOVO OR PVO OR VO OR Q-CONJ,
    OR ASCEND TO OBJBE PASSING THROUGH VENO OR VENPASS OR TOVO OR
        PVO OR VINGO OR VO OR Q-CONJ.
 $COELSUBJ = PRESENT-ELEMENT HAS COELEMENT SUBJECT OR BESUBJ OR TPOS.
ROUTINE VERB-COELEMENT- = DO $NEXT-VERB- .
 $NEXT-VERB- = DO $1.                                           (GLOBAL)
 $1 = THE PRESENT-ELEMENT- HAS COELEMENT- VERB OR LVINGR OR
       LVENR OR LVR.
ROUTINE VERB-COELEMENT = DO $NEXT-VERB.
 $NEXT-VERB =  DO $1.                                       (GLOBAL)
 $1 = THE PRESENT-ELEMENT- HAS COELEMENT VERB OR LVINGR OR
      LVENR OR LVR.
* FIRST-FILLED-ATOM
*    AT THE PRESENT LOCATION, LOOK DOWN THE SUBSTREE TO FIND THE
*    FIRST ATOM THAT IS LEXICALLY FILLED.
ROUTINE FIRST-FILLED-ATOM =
    ITERATET $GO-TO-NEXT-NODE
    UNTIL BOTH PRESENT-ELEMENT- IS OF TYPE ATOM
          AND PRESENT-ELEMENT- IS NOT EMPTY SUCCEEDS.
  $GO-TO-NEXT-NODE =
    EITHER GO DOWN
    OR ITERATET GO UP
       UNTIL GO RIGHT SUCCEEDS.
* LAST-FILLED-ATOM
*    AT THE PRESENT LOCATION, LOOK DOWN THE SUBTREE TO FIND THE
*    LAST ATOM THAT IS LEXICALLY FILLED.
ROUTINE LAST-FILLED-ATOM =
    ITERATET $GO-TO-NEXT-NODE
    UNTIL BOTH PRESENT-ELEMENT- IS OF TYPE ATOM
          AND PRESENT-ELEMENT- IS NOT EMPTY SUCCEEDS.
  $GO-TO-NEXT-NODE =
    EITHER DO $LAST-NODE
    OR ITERATET GO UP
       UNTIL GO LEFT SUCCEEDS.
  $LAST-NODE =
    GO DOWN;
    EITHER ITERATE GO RIGHT OR TRUE.
* ********** **************************************** **********
*                                                                *
*                    CONJUNCTION ROUTINES                        *
*                                                                *
* ********** **************************************** **********
*
ROUTINE CO-CONJ(X)=
    STORE IN X200;
    EITHER $COELEMENT OR $STRING-SEGMENT.
 $COELEMENT = DO COEL1-(X); DO $NOT-XY-CONJ-XY.
 $NOT-XY-CONJ-XY =
    ITERATE BOTH PRESENT-STRING- HAS NODE ATTRIBUTE POSTCONJELEM
            @AND NEITHER $Y-TO-RIGHT NOR $Y-TO-LEFT.
 $Y-TO-RIGHT= ITERATE GO RIGHT UNTIL TEST FOR X200 SUCCEEDS.
 $Y-TO-LEFT= ITERATE GO LEFT UNTIL TEST FOR X200 SUCCEEDS.
 $STRING-SEGMENT =
    BOTH $GO-THRU-SEG-TO-X
    @AND EITHER PRESENT-ELEMENT HAS NODE ATTRIBUTE POSTCONJELEM
         OR AT X300 $NOT-XY-CONJ-XY IS TRUE.
 $GO-THRU-SEG-TO-X =
    DO COEL1-(STGSEG);
    STORE IN X300;
    DO ELEMENT-(X).
ROUTINE CONJELEM- =
  [* SIMILAR TO CONJELEM EXCEPT STARTING NODE MUST BE DIRECTLY ]
  [* BELOW Q-CONJ.]
    STORE IN X200;
    ITERATE $UP-2-IF-CONJ UNTIL $FIND-X200 SUCCEEDS.
 $UP-2-IF-CONJ = IMMEDIATE-NODE- IS Q-CONJ; GO UP.
 $FIND-X200 = ITERATE GO LEFT UNTIL TEST FOR X200 SUCCEEDS.
ROUTINE CONJELEM =
  [* CONJELEM: INVERSE OF CORE-CONJUNCT.]
  [* STARTS AT THE CONJUNCT OF X AND GOES TO X. IN A SITUATION ]
  [* X1Y1 CONJ X2Y2, STARTING AT X2 CONJELEM WILL GO TO X1. ]
  [* GIVEN THAT Z2 IS SEVERAL LEVELS BELOW X2,STARTING AT Z2 ]
  [* CONJELEM WILL GO TO Z1,SEVERAL LEVELS BELOW X1. ]
    EITHER $ATQ OR $UPQ;
    DO $TO-PRECONJUNCTION-Y [COEL1-];
    EITHER TEST FOR X600 OR DESCEND TO X600.
 $ATQ =
    TEST FOR Q-CONJ;
    GO DOWN;
    STORE IN X600;
    STORE IN X200.
 $UPQ =
    STORE IN X600;
    STORE IN X200;
    GO UP;
    ITERATET $UPQ1 UNTIL TEST FOR Q-CONJ SUCCEEDS;
    GO TO X200.
 $UPQ1 =
    STORE IN X200;
    NOT TEST FOR STRING;
    GO UP.
ROUTINE CORE-CONJUNCT =
  [* STARTING AT THE GIVEN NODE, CORE-CONJUNCT DESCENDS TO ]
  [* THE CORE AND THEN GOES TO ITS CONJUNCT.]
    DO $CORE-PATH [CORE-];
    EITHER $ASCNT [CORE] OR TRUE;
    DO $POSTCONJ [STARTAT];
    DO $CORE-PATH.
* GOVERNING-CONJ
*    STARTS IN A Q STRING AND FINDS HEAD CONJUNCTION OF C-Q
*    COMPLEX.
*
ROUTINE GOVERNING-CONJ =
     EITHER TEST FOR Q-CONJ OR ASCEND TO Q-CONJ;
     GO UP [TO CONJ-NODE]; GO DOWN.
ROUTINE PRE-POST-CONJELEM  =
  [* GIVEN THAT STRING Q-CONJ HAS ELEMENTS F1 F2 ... FN ]
  [* WHICH ARE CONJUNCTS OF E1 E2 ... EN, I.E. THE NODES TO ]
  [* THE LEFT OF THE SPECIAL PROCESS NODE ONE LEVEL ABOVE ]
  [* Q-CONJ, THEN TO EACH FI THIS ROUTINE ASSIGNS THE NODE ]
  [* ATTRIBUTE PRECONJELEM WITH VALUE EI AND TO EACH EI ]
  [* THE NODE ATTRIBUTE POSTCONJELEM WITH VALUE FI.]
    STORE IN X100;
    DO ELEMENT- (Q-CONJ);  DO LAST-ELEMENT-;
    ITERATE VERIFY $ASSIGN-TEST UNTIL GO LEFT FAILS.
$ASSIGN-TEST =
    EITHER TEST FOR SP-NODE
    OR EITHER $PRECONJ OR
              $ASSIGN-PRE-AND-POST.                             (GLOBAL)
 $ASSIGN-PRE-AND-POST =
    STORE IN X500; STORE IN X0; GO TO X100;
    ITERATE $GO-LEFT UNTIL TEST FOR X500 SUCCEEDS;
    EITHER ITERATE $POSTCONJ OR TRUE;
    DO $ASSIGN-POSTCONJELEM; STORE IN X0; GO TO X500;
    DO $ASSIGN-PRECONJELEM.                                      (GLOBAL)
 $GO-LEFT =
    ITERATET $UPCONJ UNTIL GO LEFT SUCCEEDS;
    STORE IN X100.
 $UPCONJ = GO UP; TEST FOR Q-CONJ; GO UP.
 $ASSIGN-POSTCONJELEM =
    ASSIGN THE PRESENT ELEMENT NODE ATTRIBUTE POSTCONJELEM.
 $ASSIGN-PRECONJELEM =
    ASSIGN THE PRESENT ELEMENT NODE ATTRIBUTE PRECONJELEM.
* ********** **************************************** **********
*                                                                *
*                   ROUTINES FOR SELECTION                       *
*                                                                *
* ********** **************************************** **********
*
ROUTINE COMPLEMENT =
  [* TAKES THE COMPLEMENT OF LIST STORED IN REGISTER X-SUBLIST. ]
  [* THE COMPLETE LIST IS ASSUMED TO BE PRESENT LOCATION. ]
  [* COMPLEMENT CREATES A LIST STORED IN X-COMPLEMENT WHICH ]
  [* CONSISTS OF ALL THOSE ELEMENTS ON CURRENT LIST THAT ARE ]
  [* NOT ON X-SUBLIST. ]
    X-CURRENTLIST:= PRESENT-ELEMENT-;
    X-COMPLEMENT:= NIL;
    ITERATE BOTH X-HEAD2:= HEAD OF X-CURRENTLIST
            AND IF X-SUBLIST DOES NOT HAVE MEMBER X-HEAD2
                THEN $ADD-TO-COMP
    UNTIL X-CURRENTLIST:= SUCCESSORS OF X-CURRENTLIST WHERE
          X-CURRENTLIST IS NIL SUCCEEDS;
    GO TO X-COMPLEMENT.
 $ADD-TO-COMP =
    IF X-ATTL := ATTRIBUTE-LIST OF X-CURRENTLIST
    THEN PREFIX X-HEAD2:X-ATTL TO X-COMPLEMENT
    ELSE PREFIX X-HEAD2 TO X-COMPLEMENT.
ROUTINE CORE-ATT =
  [* RETURNS AN ATTRIBUTE LIST FOR ITS PRESENT LOCATION, ]
  [* LOOKING FOR  AN ATTRIBUTE LIST IN THE FOLLOWING ORDER  ]
  [* 1.  COMPUTED ATTRIBUTE LIST, STORED AS VALUE OF NODE ]
  [*     ATTRIBUTE 'COMPUTED-ATT';                          ]
  [* 2.  SELECTIONAL ATTRIBUTE LIST, STORED AS VALUE OF ]
  [*     NODE ATTRIBUTE 'SELECT-ATT';                       ]
  [* 3.  ATTRIBUTE LIST OF WORD, PRUNED TO CONTAIN ONLY ]
  [*     SELECTIONALLY RELEVANT CLASSES, AS DEFINED BY THE ]
  [*     LIST SUBLANGUAGE-ATTS (USES INTERSECT, TO OBTAIN ]
  [*     INTERSECTION OF SUBLANGUAGE-ATTS AND ATTRIBUTE LIST). ]
  [* 4.  IF INTERSECTION IS NIL AND WORD HAS ATTRIBUTE NHUMAN ]
  [*     OR NAME, LIST HUMAN-LIST IS RETURNED. ]
    EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE COMPUTED-ATT
    OR EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE SELECT-ATT
       OR EITHER ATTRIBUTE-LIST X-NEWLIST EXISTS
           WHERE BOTH X-SUBLANGUAGE-ATTS := LIST SUBLANGUAGE-ATTS
                 AND INTERSECT OF X-SUBLANGUAGE-ATTS IS NOT NIL
          OR $NHUMAN-CHK.
 $NHUMAN-CHK =
    BOTH PRESENT-ELEMENT- HAS ATTRIBUTE NHUMAN OR NAME
    AND X-INTERSECT := LIST HUMAN-LIST.
ROUTINE CORE-SELATT =
  [* RETURNS AN ATTRIBUTE LIST FOR ITS PRESENT LOCATION, LOOKING ]
  [* FOR AN ATTRIBUTE LIST IN THE FOLLOWING ORDER                ]
  [*  1. SELECT ATTRIBUTE LIST, STORE AS VALUE OF NODE ATTRIBUTE ]
  [*  'SELECT-ATT'.                                              ]
  [*  2.  ATTRIBUTE LIST OF WORD, PRUNED TO CONTAIN ONLY ]
  [*  SELECTIONALLY RELEVANT CLASSES, AS DEFINED BY THE LIST ]
  [*  SUBLANGUAGE-ATTS (USES ROUTINE INTERSECT TO OBTAIN) ]
  [*  INTERSECTION OF SUBLANGUAGE-ATTS AND ATTRIBUTE LIST.   ]
  [*  3. IF WORD HAS NO ATTRIBUTES ON SUBLANGUAGE-ATTS, AND ]
  [*  HAS CLASS NHUMAN, THEN LIST HUMAN-LIST IS RETURN AS VALUE ]
  [*  OF CORE-SELATT.  ]
     EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE SELECT-ATT
     OR EITHER ATTRIBUTE-LIST X-NEWLIST EXISTS WHERE
               BOTH X-SUBLANGUAGE-ATTS:= LIST SUBLANGUAGE-ATTS
               AND INTERSECT OF X-SUBLANGUAGE-ATTS IS NOT NIL
        OR $NHUMAN-CHK [CORE-ATT].                     (GLOBAL)
ROUTINE INTERSECT =
  [* TAKES INTERSECTION OF LIST IN CURRENT LOCATION WITH LIST ]
  [* STORED IN REGISTER X-NEWLIST, AND CREATES THE LIST REPRE-]
  [* SENTING THE INTERSECTION (INCLUDING ATTRIBUTE LISTS OF THE ]
  [* INTERSECTING ELEMENTS). THE NEW LIST REPRESENTING THE ]
  [* INTERSECTION IS STORED IN REGISTER X-INTERSECTION; THE ]
  [* ROUTINE FINISHES LOCATED AT THIS LIST (X-INTERSECTION). ]
  [*  ** NOTE THAT IT IS THE LIST STORED IN X-NEWLIST WHOSE ]
  [*  ** MEMBERS (AND POSSIBLE ATTRIBUTE LISTS) ARE COPIED. ]
  [*                                                        ]
  [*** WARNING                                              ]
  [*   IF REGISTER X-NEWLIST DOES NOT POINT TO A LIST, THE ]
  [*   ROUTINE WILL FAIL; IF THE ROUTINE DOES NOT START AT ]
  [*   AN ATOM OR A LIST, THE INTERSECTION WILL BE EMPTY.  ]
    X-CURRENTLIST:= PRESENT-ELEMENT-;
    X-INTERSECTION:= NIL ;
    X-2NDLIST:= X-NEWLIST;
    ITERATE IF X-2NDLIST HAS MEMBER X-CURRENTLIST X-2NDLIST
            THEN $ADD
            ELSE X-2NDLIST:= NIL  [END INTERSECTION]
    UNTIL EITHER X-2NDLIST IS NIL
          OR X-2NDLIST:= SUCCESSORS OF X-2NDLIST
             WHERE X-2NDLIST IS NIL SUCCEEDS;
    GO TO X-INTERSECTION.
 $ADD =
    X-HEAD2:= HEAD OF X-2NDLIST;
    IF X-ATTL:= ATTRIBUTE-LIST OF X-2NDLIST
    THEN PREFIX X-HEAD2:X-ATTL TO X-INTERSECTION
    ELSE PREFIX X-HEAD2 TO X-INTERSECTION.
ROUTINE UNION =
  [* COMPUTES THE SET-THEORETIC UNION OF TWO SETS; ONE SET       ]
  [* IS PASSED IN STORED IN THE REGISTER X-UNION; THE ROUTINE    ]
  [* MUST BEGIN FROM THE SECOND LIST (SET); IT CHECKS THAT EACH  ]
  [* ELEMENT FROM THE PCURRENT LIST (STORED IN X-ADD-TO-UNION)   ]
  [* IS EITHER ALREADY ON LIST X-UNION OR IF NOT, IT IS PREFIXED ]
  [* TO X-UNION.  THE UNION IS RETURNED IN REGISTER X-UNION,     ]
  [* WHICH IS ALSO WHERE THE ROUTINE LEAVES YOU. IF THE INITIAL  ]
  [* LIST IS NIL (EMPTY), UNION WILL RETURN WHATEVER LIST IS     ]
  [* STORED IN X-UNION.  ]
    IF PRESENT-ELEMENT- IS NOT NIL
    THEN $ADD-TO-UNION
    ELSE GO TO X-UNION.
 $ADD-TO-UNION =
    X-ADD-TO-UNION := PRESENT-ELEMENT-;
    ITERATE BOTH X-ADD-EL-TO-UNION := HEAD OF X-ADD-TO-UNION
            AND IF X-UNION DOES NOT HAVE MEMBER X-ADD-EL-TO-UNION
                THEN IF ATTRIBUTE-LIST X-ATTRB-UNION
                        OF X-ADD-TO-UNION EXISTS
                     THEN PREFIX X-ADD-EL-TO-UNION: X-ATTRB-UNION
                          TO X-UNION
                     ELSE PREFIX X-ADD-EL-TO-UNION TO X-UNION
    UNTIL SUCCESSORS X-ADD-TO-UNION OF X-ADD-TO-UNION IS NIL SUCCEEDS;
    GO TO X-UNION.
* FIND-SLOT(X):   LOCATES X IN FORMAT TREE.
*  1. FIND-SLOT FIRST TRIES TO DESCEND TO X FROM PRESENT LOCATION.
*  2. IF THAT FAILS, IT TRIES TO DESCEND TO X FROM X-FORMAT.
*
ROUTINE FIND-SLOT(X) =
       IF X-SIGNAL IS NOT NIL
       THEN $FIND-XSLOT
       ELSE EITHER TEST FOR X
            OR EITHER DESCEND TO X
               OR AT X-FORMAT DESCEND TO X;
       VERIFY X-SIGNAL:= NIL.
  $FIND-XSLOT =
       EITHER TEST FOR X-SLOT
       OR EITHER DESCEND TO X-SLOT
          OR AT X-FORMAT DESCEND TO X-SLOT.
* FILLED-SLOT(X): LOCATES X IN FORMAT TREE AND FROM X TRIES TO
*                 DESCEND TO NODE NON-EMPTY.  IF IT CAN, THAT MEANS
*                 FORMAT SLOT X HAS BEEN FILLED.
ROUTINE FILLED-SLOT(X) = DO FIND-SLOT(X);
                         DESCEND TO NON-EMPTY.
* PUTIN-SLOT(X): LOCATES X IN FORMAT TREE AND ASSIGNS CONTENTS OF X-PUTIN
*         TO THAT FORMAT SLOT. A FORMAT SLOT IS 'FILLED' OR ASSIGNED TO
*         A NODE IN THE PARSE TREE AS FOLLOWS:
*            IF FORMAT SLOT FS IS EMPTY ITS VALUE IS REPLACED BY A NODE
*         CALLED NON-EMPTY WHICH IS ASSIGNED A NODE ATTRIBUTE FILLED-PT
*         WITH VALUE SAME AS X-PUTIN (LOCATION IN PARSE TREE). THE NODE
*         IN X-PUTIN IS ASSIGNED A NODE ATTRIBUTE FORMAT-PT WITH VALUE
*         POINTING TO NON-EMPTY. THEREFORE THE CORRESPONDENCE BETWEEN
*         FORMAT NODES AND PARSE TREE NODES IS MADE VIA VALUE OF NODE
*         ATTRIBUTE FILLED-PT AND THE CORRESPONDENCE BETWEEN PARSE TREE
*         NODES AND FORMAT NODES IS MADE VIA VALUE OF NODE ATTRIBUTE
*         FORMAT-PT. IF FORMAT SLOT FS ALREADY HAS A VALUE NON-EMPTY,
*         THEN IT MAY HAVE ANOTHER NON-EMPTY ELEMENT ( AND THEREFORE
*         CORRESPOND TO MORE THAN ONE PARSE TREE NODE) IF IT IS ON LIST
*         MULTI-ENTRY.
*      IT IS ASSUMED THAT REG X-PUTIN POINTS TO LOCATION IN PARSE
*      TREE WHICH FORMAT SLOT X IS TO CORRESPOND TO.
*    1. IF X DOES NOT HAVE VALUE EMPTY, IT CHECKS IF X IS ON LIST
*       MULTI-ENTRY. IF IT IS NOT- IT FAILS WITH ERROR MESSAGE.
*                    IF IT IS, IT ADDS A SISTER NODE NON-EMPTY TO
*                    THE OTHER NON-EMPTY. THE NEW  NODE IS IN X-FRMT-SLOT.
*    2. IF X DOES HAVE VALUE EMPTY[OR VALUE DOES NOT EXIST], THEN IT
*        REPLACES EMPTY BY NON-EMPTY AND STORES IT IN X-FRMT-SLOT.
*    3. SET POINTERS TO AND FROM PARSE TREE AND FORMAT TREE.
*         A. SET NODE ATTRIBUTE FORMAT-PT FROM NODE IN X-PUTIN IN PARSE
*       TREE TO X-FRMT-SLOT IN FORMAT TREE. FORMAT-PT IS CHAINED
*       SINCE NODES I N PARSE TREE MAY CORRESPOND TO MORE THAN ONE NODE
*       IN FORMAT. THEREFOR IF X-PUTIN ALREADY HAS NODE ATTRIBUTE
*       FORMAT-PT, GO TO VALUE AND ASSIGN IT NODE ATTRIBUTE
*       FORMAT-PT WITH VALUE X-FRMT-SLOT.
*     B. SET POINTER FILLED-PT FROM X-FRMT-SLOT TO X-PUTIN.
*
ROUTINE PUTIN-SLOT(X)=
       IF DO FIND-SLOT(X) @THEN $TEST-AND-SETUP
       ELSE $ERR-MESS3.
  $ERR-SIGNAL =
       WRITE ON DIAG '* <<<<< FATAL ERROR';
       WRITE ON DIAG ' >>>>>';
       WRITE ON DIAG END OF LINE.                                      (GLOBAL)
  $TEST-AND-SETUP =
       STORE IN X-SLOT;
       IF AT X-SLOT DESCEND TO NON-EMPTY
       THEN $TEST-MULTI-ENTRY
       ELSE $IMMED-CHK.
  $IMMED-CHK =
       EITHER AT X-SLOT BOTH TEST FOR MODIFIERS
                        AND $BUILD-XSLOT
       OR $ONE-ELEM-CHK.
  $ONE-ELEM-CHK = [CHECK IF THIS ELEMENT HAS BEEN FILLED ALREADY]
        IF AT IMMEDIATE-NODE- OF X-SLOT TEST FOR ONE-ELEMENT
       @THEN EITHER BOTH NOT DESCEND TO NON-EMPTY [NOT FILLED]
                    AND AT VALUE DO $BUILD-XSLOT
             OR ONE OF $CHK-FOR-EQ, $ERR-MESS4
                       [DO NOT BUILD; BUT DO NOT FAIL]
       ELSE $BUILD-XSLOT.
  $BUILD-XSLOT =
       REPLACE X-SLOT BY X-SLOT (<NON-EMPTY> X-FRMT-SLOT);
       DO $SET-POINTERS.
  $TEST-MULTI-ENTRY =
       IF X-SLOT IS OF TYPE MULTI-ENTRY
       THEN EITHER $IN-LADJSET
            OR BOTH AFTER LAST-ELEMENT OF X-SLOT
                       INSERT <NON-EMPTY> X-FRMT-SLOT
               AND $SET-POINTERS
       ELSE ONE OF $CHK-FOR-PT, $CHK-FOR-EQUIV, $ERR-MESS2.
  $IN-LADJSET =
         [* If node to be formatted is in LADJSET *]
         [*    and host has been formatted at the *]
         [*        same slot                      *]
         [* then put the formatted slot in front  *]
         [*      of formatted slot of host        *]
         [*      TO PRESERVE LINEAR ORDERING.     *]
       AT X-PRE ASCEND TO LADJSET;
       IMMEDIATE-NODE- IS OF TYPE LXR
          WHERE PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT
                X-LXR-FMT;
       IMMEDIATE-NODE- IS IDENTICAL TO X-SLOT;
       BOTH BEFORE X-LXR-FMT INSERT <NON-EMPTY> X-FRMT-SLOT
       AND $SET-POINTERS.
  $CHK-FOR-PT = X-SLOT IS PT;
       DO $ERR-MESS2.
  $CHK-FOR-EQ = DESCEND TO NON-EMPTY;
       DO $CHK-FOR-EQUIV.
  $CHK-FOR-EQUIV =
        [CHECK IF IN LEFT OR RIGHT ADJUNCT IN SAME FORMAT SLOT]
       DO $GET-TREE-POS;
       DO $FRMT-EQUIV-CHK.
  $SET-POINTERS =
       AT X-FRMT-SLOT, ASSIGN NODE ATTRIBUTE FILLED-PT WITH VALUE
                       X-PUTIN;
       AT X-PUTIN EITHER ITERATE PRESENT-ELEMENT- HAS NODE ATTRIBUTE
                                 FORMAT-PT
                  OR TRUE;
       ASSIGN NODE ATTRIBUTE FORMAT-PT WITH VALUE X-FRMT-SLOT.     (GLOBAL)
  $GET-TREE-POS =
       PRESENT-ELEMENT- HAS NODE ATTRIBUTE FILLED-PT
          [* point to parse tree *];
       EITHER TEST FOR LXR
       OR ASCEND TO LXR PASSING THROUGH STRING;
       STORE IN X-TTT [* find LXR that contains it *].
  $FRMT-EQUIV-CHK =
        [* If putting LEFT or RIGHT ADJUNCT in same format *]
        [* slot as the one already formated.  Do not fail  *]
        [* if slot is already filled.                      *]
       EITHER $IN-LADJS OR $IN-RADJS;
       ASCEND TO LXR PASSING THROUGH STRING;
       STORE IN X-TT;
       X-TT IS IDENTICAL TO X-TTT;
       AT X-PUTIN ASSIGN NODE ATTRIBUTE TRANSFORM-ATT
            [* Do not try to format it again *].
  $IN-LADJS = AT X-PUTIN ASCEND TO LADJSET PASSING THROUGH STRING
                         NOT PASSING THROUGH LXR.
  $IN-RADJS = AT X-PUTIN ASCEND TO RADJSET PASSING THROUGH STRING
                         NOT PASSING THROUGH LXR.
  $ERR-MESS1 =
       DO $ERR-SIGNAL;
       WRITE ON DIAG '* More than 1 ';
       WRITE ON DIAG 'alternative under ';
       AT IMMEDIATE-NODE OF X-SLOT WRITE ON DIAG NODE NAME;
       WRITE ON DIAG ' : ';
       AT X-TEMP WRITE ON DIAG NODE NAME;
       AT X-SLOT WRITE ON DIAG NODE NAME;
       DO $ERR-END.
  $ERR-END = WRITE ON DIAG END OF LINE;
             NOT TRUE.                                       (GLOBAL)
  $ERR-MESS2 =
       DO $WARNING-SIG;
       WRITE ON DIAG '* More than 1 ';
       WRITE ON DIAG 'element in slot ';
       AT X-SLOT WRITE ON DIAG NODE NAME;
       WRITE ON DIAG ' = ';
       AT X-SLOT VALUE HAS NODE ATTRIBUTE FILLED-PT;
       WRITE ON DIAG WORDS SUBSUMED;
       WRITE ON DIAG '. It is not';
       WRITE ON DIAG ' MULTI-ENTRY.';
       WRITE ON DIAG END OF LINE.
  $ERR-MESS3 = DO $ERR-SIGNAL;
       WRITE ON DIAG '* Cannot ';
       WRITE ON DIAG 'find FORMAT NODE = ';
       IF X-SIGNAL IS NIL THEN WRITE ON DIAG ' X '
       ELSE AT X-SLOT WRITE ON DIAG LIST ELEMENT;
       X-SIGNAL:= NIL;
       DO $ERR-END.
  $ERR-MESS4 = DO $WARNING-SIG;
       WRITE ON DIAG '* ';
       AT IMMEDIATE-NODE- OF X-SLOT WRITE ON DIAG NODE NAME;
       WRITE ON DIAG ' = ';
       AT IMMEDIATE-NODE OF X-SLOT DESCEND TO NON-EMPTY
             WHERE PRESENT-ELEMENT- HAS NODE ATTRIBUTE FILLED-PT;
       WRITE ON DIAG WORDS SUBSUMED;
       WRITE ON DIAG '. It can have ';
       WRITE ON DIAG 'one slot fileed.';
       WRITE ON DIAG END OF LINE.
* ROUTINE WRITE-WORDS
*     WRITES WORDS UNDER A GIVEN NODE, EXCEPT FOR NON-CONJUNCTION
*     COMMA;  IT THEN RETURNS TO ITS ORIGINAL POSITION (USED IN
*     PLACE OF 'WRITE WORDS SUBSUMED' COMMAND).
ROUTINE WRITE-WORDS =
     BOTH ONE OF $EMPTY, $COMMA, [$DASH,] $EMPTY-BRACKETS, $OTHER
     AND TRUE [Return to start - VERIFY is not working correctly].
  $EMPTY-BRACKETS =
     PRESENT-ELEMENT- IS '[]'.
  $DASH  =
     BOTH PRESENT-ELEMENT- IS '-' OR '--'
     AND WRITE ON INFO WORDS SUBSUMED.
  $EMPTY =
     EITHER PRESENT-ELEMENT- IS NULL OR NULLC OR NULLN OR
            NULLWH OR NULLOBJ,
     OR PRESENT-ELEMENT- IS 'NULLN' [WHERE DO $WRITE-BRKT].
  $WRITE-BRKT = WRITE ON INFO '[ ]'.
  $COMMA = BOTH PRESENT-ELEMENT- IS COMMASTG
           AND IMMEDIATE-NODE- IS NOT CONJOINED.
  $OTHER =
     BOTH IF PRESENT-ELEMENT- IS OF TYPE ATOM
             WHERE NOT $EMPTY
          THEN ASSIGN NODE ATTRIBUTE CT-WRITTEN
          ELSE $MARK-CT-WRITTEN
     AND BOTH WRITE ON INFO WORDS SUBSUMED
         AND WRITE ON INFO ' '.
  $MARK-CT-WRITTEN =
     AT PRESENT-ELEMENT- X-WR-START,
     ITERATE VERIFY $PROCESS-NODE
     UNTIL $GO-TO-NEXT-NODE FAILS.
  $PROCESS-NODE =
     IF PRESENT-ELEMENT- IS OF TYPE ATOM
     THEN ASSIGN NODE ATTRIBUTE CT-WRITTEN.
  $GO-TO-NEXT-NODE =
     EITHER $GO-DOWN-TREE
     OR ITERATET $GO-UP-TREE
        UNTIL GO RIGHT SUCCEEDS.
  $GO-DOWN-TREE = PRESENT-ELEMENT- IS NOT EMPTY; GO DOWN.
  $GO-UP-TREE =
     GO UP;
     PRESENT-ELEMENT- IS NOT IDENTICAL TO X-WR-START
     [* stop at starting position *].
* ROUTINE HAS-MODIFIER(X)
*    TESTS WHETHER CURRENT FORMAT SLOT HAS MODIFIER X TO ITS RIGHT.
*    IF IT REACHES A NON-MODIFIER SLOT BEFORE IT FINDS X, IT FAILS.
ROUTINE HAS-MODIFIER(X) =
     ITERATE $MOVE-RIGHT
     UNTIL TEST FOR X SUCCEEDS.
  $MOVE-RIGHT = GO RIGHT; TEST FOR MODIFIERS.
* T-WRITE7
T-WRITE7 = IN SENTENCE:
      [WRITE ON TAPE7;]
       WRITE ON INFO END OF LINE;
       WRITE ON INFO '********************';
       WRITE ON INFO '********************';
       WRITE ON INFO END OF LINE;
       WRITE ON INFO '********************';
       WRITE ON INFO '********************';
       WRITE ON INFO END OF LINE;
       WRITE ON INFO '*SID='; WRITE ON INFO IDENTIFICATION;
       WRITE ON INFO END OF LINE;
       WRITE ON INFO SENTEXT [SOURCE];
       WRITE ON INFO END OF LINE;
       WRITE ON INFO END OF LINE.
* ***** ****************************************************************
*
*
*                     FORMATTING TRANSFORMATIONS
*
*
* **** ******************************************************************
* T-RECORD-CONJ
*    PUTS CONNECTIVE ON THE SECOND CONJUNCT BY MARKING THE
*    SECOND CONJUNCT WITH NODE ATTRIBUTE CT-CONJ WITH VALUE
*    POINTING TO THE CONNECTIVE.
* **** THE PARSE TREE CONNECTIVES ARE ARRANGED IN POLISH NOTATION.
*      THIS ATTEMPTS TO RESTORE INFIX NOTATION FOR CONNECTIVES: BY
*      ASSOCIATING THE SECOND CONJUNCT WITH ITS SCOPE CONNECTIVE.
T-RECORD-CONJ = IN CENTER:
     BOTH X-CONJ-NUM := LIST CONJ-NUMBERS
     AND AT VALUE OF IMMEDIATE-NODE-
         ITERATET $WHAT-TO-MARK UNTIL $GO-NEXT FAILS.
  $GO-NEXT =
     ITERATE GO RIGHT
     UNTIL TEST FOR CENTER SUCCEEDS.
  $WHAT-TO-MARK =
       [AT CENTER, GO TO FIRST PARSE-CONN AND CONNECT]
       [PARSE-CONN TO ITS SECOND CONJUNCT.]
     AT VALUE ITERATE IF PRESENT-ELEMENT IS PARSE-CONN
                      THEN BOTH BOTH $SET-CONN-STACK
                                AND DO $SET-NEW-LINK
                           AND DO $CONJ-CONFIG
              UNTIL GO RIGHT FAILS.
  $SET-CONN-STACK =
     LCONNR X-PRE OF VALUE OF PRESENT-ELEMENT- EXISTS;
     X-START := X-PRE;
     X-LAST := X-PRE.
  $CONJ-CONFIG =
     BOTH DO $STACK-NODE [PUT PARSE-CONN ON STACK]
     AND GO RIGHT [GO TO FIRST CONJUNCT];
     IF PRESENT-ELEMENT- X-FIRST-ARG IS PARSE-CONN
     THEN BOTH DO $SET-NEW-LINK AND DO $CONJ-CONFIG
     ELSE DO $SET-ARG-LINK;
     DO $NEXT-ARG.
  $NEXT-ARG =
     GO RIGHT [TO SECOND CONJUNCT];
     IF PRESENT-ELEMENT- X-LAST-ARG IS PARSE-CONN
     THEN BOTH BOTH DO $SET-NEW-LINK
               AND DO $CONJ-CONFIG
          AND AT X-FIRST-ARG, BOTH $SET-CONN AND $RESTORE-ARG
     ELSE BOTH $SET-2ND-ARG-LINK AND $SET-CONN.
  $SET-NEW-LINK =
     BOTH BOTH X-CNUM := HEAD OF X-CONJ-NUM
          AND X-CONJ-NUM := SUCCESSORS OF X-CONJ-NUM
     AND AT LCONNR OF VALUE OF PRESENT-ELEMENT-, DO $SET-ARG-LINK.
  $SET-ARG-LINK =
     ASSIGN PRESENT ELEMENT NODE ATTRIBUTE CONJ-LINK WITH VALUE X-CNUM.
  $SET-2ND-ARG-LINK =
     BOTH X-PRE HAS NODE ATTRIBUTE CONJ-LINK X-CLINK
     AND ASSIGN PRESENT ELEMENT NODE ATTRIBUTE CONJ-LINK
         WITH VALUE X-CLINK.
  $STACK-NODE =
     BOTH X-LAST := X-PRE
     AND BOTH LCONNR X-PRE OF VALUE OF PRESENT-ELEMENT- EXISTS
         AND AT X-PRE ASSIGN NODE ATTRIBUTE CONNSTK WITH VALUE X-LAST.
  $SET-CONN =
     AT PRESENT-ELEMENT- X-NODE
     ASSIGN NODE ATTRIBUTE CT-CONJ WITH VALUE X-PRE;
     AT X-PRE ERASE NODE ATTRIBUTE CONNSTK;
     X-PRE := X-LAST;
     EITHER X-PRE HAS NODE ATTRIBUTE CONNSTK X-LAST
     OR X-LAST := NIL;
     GO TO X-NODE.
  $RESTORE-ARG =
       [* RECOVER THE FIRST ARGUMENT OF CONNECTIVE *]
     X-FIRST-ARG HAS NODE ATTRIBUTE CT-CONJ;
     ASCEND TO PARSE-CONN;
     GO RIGHT;
     STORE IN X-FIRST-ARG;
     GO TO X-LAST-ARG [* BACK TO THE LAST NODE ANALYZED *].
* T-BUILD-FORMAT BUILDS FORMAT NODES, TO THE RIGHT OF THE HIGHEST
*   ASSERT OR FRAG OR IMPERATIVE .
*   TARGET STRUCTURE:
*      ASSERT __ FORMAT [__ CONNECT __ ASSERT __ FORMAT]*
*   DIFFERENT FORMATS ARE BUILT DEPENDING ON THE VALUE OF FORMAT-ATT
*   WHICH HAS BEEN ASSIGNED TO FRAGMENT/ASSERTION IN REGULARIZATION
*   COMPONENT. FOR EX. FORMAT1 IS BUILT FOR AN ASSERTION WHOSE
*   FORMAT-ATT HAS A VALUE OF FRMT1.
T-BUILD-FORMAT = IN ASSERTION, FRAGMENT:
     IF PRESENT-ELEMENT- X-PRE DOES NOT HAVE NODE ATTRIBUTE
               PHRASE-ATT [* special phrases, e.g. INFO-SOURCE *]
     THEN BOTH X-PRE HAS NODE ATTRIBUTE FORMAT-ATT X-FMT
          AND ONE OF $IS-F00, $IS-F0, $IS-F13-MED, $IS-F1-3,
                  [* $IS-F2, $IS-F3, *] $IS-F4, $IS-F5-EKG,
                     $IS-F5, $IS-F5F, $IS-F5-ALG, $IS-F5-MISC,
                     $IS-F6, $IS-NOFRMT.
  $IS-F00 = X-FMT HAS MEMBER FRMT00;
      AFTER X-PRE INSERT
          <FORMAT00>X-FORMAT
                     ( <PARAGR>
                     + <SENT-OP>
                     + <PT-DEMOG>
                     + <SUBJECT>
                     + <OBJECT>
                     + <VERB>
                     + <INFO-SOURCE>
                     + <PRECISIONS> (<MORE-PREDS>)
                     + <TIME-QUALS> (<TM-PERIOD>+<TM-REPETITION>)).
  $IS-F0 = X-FMT HAS MEMBER FRMT0;
        AFTER X-PRE INSERT
           <FORMAT0>X-FORMAT
                     ( <PARAGR>
                     + <PT-DEMOG>
                     + <INST>
                     + <PT>
                     + <VERB>
                     + <INFO-SOURCE>
                     + <PRECISIONS> (<MORE-PREDS>)
                     + <TIME-QUALS> (<TM-PERIOD>+<TM-REPETITION>));
        DO $BUILD-VERB;
        DO $BUILD-PT-DEMOG.
  $IS-F1 = X-FMT HAS MEMBER FRMT1;
        AFTER X-PRE INSERT
           <FORMAT1>X-FORMAT
                     ( <PARAGR>
                     + <PT-DEMOG>
                     + <INST>
                     + <PT>
                     + <VERB-MD>
                     + <VERB>
                     + <INFO-SOURCE>
                     + <PRECISIONS> (<MORE-PREDS>)
                     + <TIME-QUALS> (<TM-PERIOD>+<TM-REPETITION>));
        DO $BUILD-VERB;
        DO $BUILD-PT-DEMOG.
  $IS-F2 = X-FMT HAS MEMBER FRMT2;
        AFTER X-PRE INSERT
           <FORMAT2>X-FORMAT (<PARAGR>
                             +<PT-DEMOG>
                             +<INST>
                             +<PT>
                             +<VERB-TR>
                             +<VERB>
                             +<INFO-SOURCE>
                             +<PRECISIONS> (<MORE-PREDS>)
                             +<TIME-QUALS> (<TM-PERIOD>+<TM-REPETITION>));
        DO $BUILD-PT-DEMOG;
        DO $BUILD-VERB.
  $IS-F3 = X-FMT HAS MEMBER FRMT3;
        AFTER X-PRE INSERT
          <FORMAT3> X-FORMAT (<PARAGR>
                             +<PT-DEMOG>
                             +<INST>
                             +<PT>
                             +<MED-TR>
                             +<VERB>
                             +<INFO-SOURCE>
                             +<PRECISIONS> (<MORE-PREDS>)
                             +<TIME-QUALS>
                                 (<TM-PERIOD>+<TM-REPETITION>));
        DO $BUILD-PT-DEMOG;
        DO $BUILD-MED-TR;
        DO $BUILD-RXDATA;
        DO $BUILD-VERB.
  $IS-F4 =
     X-FMT HAS MEMBER FRMT4;
     AFTER X-PRE INSERT
        <FORMAT4>X-FORMAT (<PARAGR>
                          +<PT-DEMOG>
                          +<INST>
                          +<PT>
                          +<TEST-INFO>
                          +<VERB>
                          + <INFO-SOURCE>
                          +<PRECISIONS> (<MORE-PREDS>)
                          +<TIME-QUALS> (<TM-PERIOD>+<TM-REPETITION>));
     DO $BUILD-PT-DEMOG;
     DO $BUILD-TEST-INFO;
     DO $BUILD-VERB.
  $IS-F1-3 = X-FMT HAS MEMBER FRMT1-3;
     AFTER X-PRE INSERT
        <FORMAT1-3>X-FORMAT ( <PARAGR>
                            + <PT-DEMOG>
                            + <TREATMENT> ( <TT-NEG>
                                          + <TT-MODAL>
                                          + <GEN>
                                          + <SURG>
                                          + <MED>
                                          + <COMP>
                                          + <MED-DEVICE> )
                            + <SUBJECT>
                            + <VERB>
                            + <PSTATE-DATA>
                            + <PSTATE-SUBJ>
                            + <INFO-SOURCE>
                            + <PRECISIONS> ( <MORE-PREDS> )
                            + <INST>
                            + <TIME-QUALS> (<TM-PERIOD>
                                          +<TM-REPETITION>));
     DO $BUILD-PT-DEMOG;
     DO $BUILD-PSTATE-SUBJ;
     DO $BUILD-PSTATE-DATA;
     AT ELEMENT- TXRES OF PSTATE-DATA OF X-FORMAT
        REPLACE PRESENT-ELEMENT- BY <TTRES>;
     DO $BUILD-VERB.
  $IS-F13-MED = X-FMT HAS MEMBER FRMT13-MED;
     AFTER X-PRE INSERT
     <FORMAT13-MED>X-FORMAT ( <PARAGR>
                            + <PT-DEMOG>
                            + <TREATMENT> ( <TT-NEG>
                                          + <TT-MODAL>
                                          + <GEN>
                                          + <SURG>
                                          + <MED>
                                          + <COMP>
                                          + <MED-DEVICE> )
                            + <SUBJECT>
                            + <VERB>
                            + <PSTATE-DATA>
                            + <PSTATE-SUBJ>
                            + <INFO-SOURCE>
                            + <PRECISIONS> ( <MORE-PREDS> )
                            + <INST>
                            + <TIME-QUALS> (<TM-PERIOD>
                                          +<TM-REPETITION>));
     DO $BUILD-PT-DEMOG;
     DO $BUILD-PSTATE-SUBJ;
     DO $BUILD-PSTATE-DATA;
     AT ELEMENT- TXRES OF PSTATE-DATA OF X-FORMAT
        REPLACE PRESENT-ELEMENT- BY <TTRES>;
     DO $BUILD-VERB.
  $IS-F5 = X-FMT HAS MEMBER FRMT5 OR FRMT5-PTFAM [* temporary *];
        IF X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PHR-ATT
           WHERE X-PHR-ATT HAS MEMBER SOURCE-PHRASE
        THEN TRUE
        ELSE DO $IS-A-FORMAT5.
  $IS-A-FORMAT5 =
         [* 1/22/97 add TREATMENT:GEN into FORMAT5 *]
        AFTER X-PRE INSERT
          <FORMAT5>X-FORMAT ( <PARAGR>
                            + <PT-DEMOG>
                            + <METHOD> ( <PROCEDURE>
                                       + <EXAMTEST> )
                            + <TREATMENT> ( <TT-NEG>
                                          + <TT-MODAL>
                                          + <GEN>
                                          + <SURG>
                                          + <MED>
                                          + <COMP>
                                          + <MED-DEVICE> )
                            + <SUBJECT>
                            + <VERB>
                            + <PSTATE-DATA>
                            + <PSTATE-SUBJ>
                            + <INFO-SOURCE>
                            + <PRECISIONS> ( <MORE-PREDS> )
                            + <INST>
                            + <TIME-QUALS> (<TM-PERIOD>
                                          +<TM-REPETITION>));
        DO $BUILD-PT-DEMOG;
        DO $BUILD-PSTATE-SUBJ;
        DO $BUILD-PSTATE-DATA;
        DO $BUILD-VERB.
  $IS-F5-EKG = X-FMT HAS MEMBER FRMT5-EKG;
         [* 1/22/97 add TREATMENT:GEN into FORMAT5 *]
        AFTER X-PRE INSERT
     <FORMAT5-EKG> X-FORMAT ( <PARAGR>
                            + <PT-DEMOG>
                            + <METHOD> ( <PROCEDURE>
                                       + <EXAMTEST> )
                            + <TREATMENT> ( <TT-NEG>
                                          + <TT-MODAL>
                                          + <GEN>
                                          + <SURG>
                                          + <MED>
                                          + <COMP>
                                          + <MED-DEVICE> )
                            + <SUBJECT>
                            + <VERB>
                            + <EKG-SUBJ> ( <WAVE>
                                         + <INTERVAL>
                                         + <AXIS> )
                            + <EKG-DATA> ( <QUANT>
                                         + <EKG-MORPH>
                                         + <DIAG>
                                         + <INDIC>
                                         + <NORMAL> )
                            + <IN-LEADS>
                            + <INFO-SOURCE>
                            + <PRECISIONS> ( <MORE-PREDS> )
                            + <INST>
                            + <TIME-QUALS> (<TM-PERIOD>
                                          +<TM-REPETITION>));
        DO $BUILD-PT-DEMOG;
        DO $BUILD-VERB.
  $IS-F5-MISC = X-FMT HAS MEMBER FRMT5-MISC;
         [* 1/22/97 add TREATMENT:GEN into FORMAT5 *]
        AFTER X-PRE INSERT
     <FORMAT5-MISC>X-FORMAT ( <PARAGR>
                            + <PT-DEMOG>
                            + <METHOD> ( <PROCEDURE>
                                       + <EXAMTEST> )
                            + <TREATMENT> ( <TT-NEG>
                                          + <TT-MODAL>
                                          + <GEN>
                                          + <SURG>
                                          + <MED>
                                          + <COMP>
                                          + <MED-DEVICE> )
                            + <SUBJECT>
                            + <VERB>
                            + <PSTATE-DATA>
                            + <PSTATE-SUBJ>
                            + <INFO-SOURCE>
                            + <PRECISIONS> ( <MORE-PREDS> )
                            + <INST>
                            + <TIME-QUALS> (<TM-PERIOD>
                                          +<TM-REPETITION>));
        DO $BUILD-PT-DEMOG;
        DO $BUILD-PSTATE-SUBJ;
        DO $BUILD-PSTATE-DATA;
        DO $BUILD-VERB.
  $IS-F5-ALG = X-FMT HAS MEMBER FRMT5-ALG;
        AFTER X-PRE INSERT
         <FORMAT5-ALG>X-FORMAT ( <PARAGR>
                            + <PT-DEMOG>
                            + <AGENTS> ( <TT-NEG>
                                       + <TT-MODAL>
                                       + <MED>
                                       + <ORGANISM>
                                       + <ALLIFE> )
                            + <SUBJECT>
                            + <VERB>
                            + <PSTATE-DATA>
                            + <PSTATE-SUBJ> ( <PT>
                                            + <PTPART>
                                            + <PTFUNC>
                                            + <PTMEAS> )
                            + <INFO-SOURCE>
                            + <PRECISIONS> ( <MORE-PREDS> )
                            + <INST>
                            + <TIME-QUALS> (<TM-PERIOD>
                                          +<TM-REPETITION>));
        DO $BUILD-PT-DEMOG;
        DELETE ELEMENT- FAMILY OF ELEMENT- PT-DEMOG OF X-FORMAT;
        DO $BUILD-PSTATE-DATA;
        DO $BUILD-VERB.
  $IS-F5F = X-FMT HAS MEMBER FRMT5F;
        AFTER X-PRE INSERT
         <FORMAT5F>X-FORMAT ( <PARAGR>
                            + <PT-DEMOG>
                            + <METHOD> ( <PROCEDURE>
                                       + <EXAMTEST> )
                            + <TREATMENT> ( <TT-NEG>
                                          + <TT-MODAL>
                                          + <GEN>
                                          + <SURG>
                                          + <MED>
                                          + <COMP>
                                          + <MED-DEVICE> )
                            + <SUBJECT>
                            + <VERB>
                            + <PSTATE-DATA>
                            + <PSTATE-SUBJ> ( <FAMILY>
                                            + <PTPART>
                                            + <PTFUNC>
                                            + <PTMEAS> )
                            + <INFO-SOURCE>
                            + <PRECISIONS> ( <MORE-PREDS> )
                            + <INST>
                            + <TIME-QUALS> (<TM-PERIOD>
                                          +<TM-REPETITION>));
        DO $BUILD-PT-DEMOG;
        DELETE ELEMENT- FAMILY OF ELEMENT- PT-DEMOG OF X-FORMAT;
        DO $BUILD-PSTATE-DATA;
        DO $BUILD-VERB.
  $IS-F6 = X-FMT HAS MEMBER FRMT6;
       AFTER X-PRE INSERT
        <FORMAT6> X-FORMAT (<PARAGR> +<PT-DEMOG> + <PT> + <VERB>
                            +<OBJECT>
                            +<INFO-SOURCE>
                            +<PRECISIONS> (<MORE-PREDS>)
                            +<TIME-QUALS> (<TM-PERIOD>
                                         +<TM-REPETITION>));
        DO $BUILD-PT-DEMOG.
  $IS-NOFRMT = X-FMT HAS MEMBER NOFRMT.
  $BUILD-PT-DEMOG =
        REPLACE PT-DEMOG   OF X-FORMAT BY
          <PT-DEMOG> ( <AGE>X-QN
                     + <RACE>
                     + <GENDER>
                     + <FAMILY>)
       [REPLACE X-QN BY]
       [  <Q-N>X-QUANT ( <NUM>]
       [               + <NON-NUM>]
       [               + <UNIT>]
       [               + <PERUNIT>)]
       [DO $BUILD-AGE].
  $BUILD-AGE = REPLACE X-AGE BY
           <AGE> (<AGE-MK>).
  $BUILD-VERB = TRUE.
  $BUILD-SUBJECT =
     REPLACE SUBJECT OF X-FORMAT BY
        <SUBJECT> (<PT> + <INST> + <FAMILY> + <SUBJ-OTHER>).
  $BUILD-MED-TR = REPLACE MED-TR  OF X-FORMAT BY
           <MED-TR>(<MED> + <RXDATA>X-RXDATA  + <VERB-TR>).
  $BUILD-RXDATA = REPLACE X-RXDATA BY
       <RXDATA> (<RXDOSE> (<NULL>) +<RXMODE> (<RXMANNER>
                               +<RXFREQUENCY>)).
  $BUILD-TEST-INFO =
        REPLACE TEST-INFO OF X-FORMAT BY
          <TEST-INFO> ( <TXSPEC>
                      + <TXVAR>
                      + <SPEC-ACCESS>
                      + <PTPART>
                      + <RESULT> X-RESULT
                      + <TEST-ENV>);
        REPLACE X-RESULT BY
          <RESULT> ( <ORGANISM> [* also DIAG *]
                   + <DIAG>
                   + <INDIC>
                   + <TESTRES>
                   + <QUALIFIERS>
                   + <QUANT> (<NULL>)
                   + <NORMAL>).
  $BUILD-PSTATE-SUBJ =
     REPLACE PSTATE-SUBJ OF X-FORMAT BY
       <PSTATE-SUBJ> ( <PT> + <PTPART> + <PTFUNC> + <PTMEAS> ).
  $BUILD-PSTATE-DATA = REPLACE PSTATE-DATA OF X-FORMAT BY
       <PSTATE-DATA> ( <DIAG>
                     + <INDIC>
                     + <TXRES>
                     + <QUALIFIERS>
                     + <INFLUENCE>
                     + <QUANT> (<NULL>)
                     + <NORMAL>
                    [+ <PTSTATE-OTHER>] ).
   [* THE FOLLOWING SUBSTATEMENTS ARE NOT CALLED UNTIL NEEDED, *]
   [* BUT ARE GLOBAL AND ARE INSERTED HERE FOR COMPLETENESS.   *]
  $BUILD-BP-MOD = AFTER PRESENT-ELEMENT- INSERT
        <BP-MOD>X-MOD-SLOT (<PTPART> (<NULL>)).            (GLOBAL)
  $BUILD-MODS = AFTER PRESENT-ELEMENT-
        INSERT <MODS> X-MOD-SLOT
                      (<NEG>+<MODAL> [+<FACTUAL>+<MODS-OTHER>]).
  $BUILD-TIME-ASP =
       AFTER PRESENT-ELEMENT- INSERT
       <TIME-ASP>X-TIME-SLOT
                  ([ <CHANGE> + <CHANGE-MK> +]
                   <BEG>
                  +<END>
                 [+<TIMELOC>]
                 [+<TIMEPER>]
                 [+<REPT>]).     (GLOBAL)
  $BUILD-TIME-QUAL =
       AFTER PRESENT-ELEMENT- INSERT
       <TIME-QUAL>X-TMQUAL-SLOT (<TM-PERIOD> (<NULL>)
                                +<TM-REPETITION> (<NULL>)).   (GLOBAL)
  $BUILD-EVENT-TIME =
       AFTER PRESENT-ELEMENT- INSERT
       <EVENT-TIME>X-EVENT-SLOT (<TPREP1>X-QUANT (<NULL>)
                                +<TPREP2> (<NULL>)
                                +<REF-PT> (<NULL>));
       AT X-QUANT DO $BUILD-Q-N.                              (GLOBAL)
  $BUILD-Q-N =
       AFTER PRESENT-ELEMENT- INSERT
        <Q-N>X-QUANT ( <NUM>
                     + <NON-NUM>
                     + <UNIT>
                     + <PERUNIT>).      (GLOBAL)
  $BUILD-RXDOSE =
        AT X-RXDOSE REPLACE PRESENT-ELEMENT- BY
        <RXDOSE>X-RXDOSE (<RXMODE> (<RXMANNER> (<NULL>)
                                   +<RXFREQUENCY> (<NULL>)));
        VALUE OF X-RXDOSE EXISTS;
        DO $BUILD-Q-N.                                 (GLOBAL)
  $BUILD-TENSE =
        AFTER PRESENT-ELEMENT- INSERT <TENSE>X-TIME-SLOT. (GLOBAL)
  $BUILD-QUANTITY =
        AFTER PRESENT-ELEMENT- INSERT
         <QUANTITY> (<Q-N>X-QUANT ( <NUM>
                                  + <NON-NUM>
                                  + <UNIT>
                                  + <PERUNIT>)).          (GLOBAL)
  $BUILD-Y-OF = AFTER PRESENT-ELEMENT-
        INSERT <Y-OF> X-Y-OF.                                    (GLOBAL)
* T-BUILD-CONNECTIVE
*      BUILDS CORRESPONDING FORMAT CONNECTIVE FOR PARSE PARSE-CONN
*      NODE.
T-BUILD-CONNECTIVE = IN PARSE-CONN:
       PRESENT-ELEMENT- X-PRE EXISTS;
       AFTER PRESENT-ELEMENT- INSERT
           <CONNECTIVE> ( VALUE OF X-PRE
                            ( <CONN> ( <NON-EMPTY> X-FRMT-SLOT)));
       ELEMENT LCONNR X-PUTIN OF VALUE OF X-PRE EXISTS;
       DO $SET-POINTERS [PUTIN-SLOT(X)].
* T-SPECIAL-PHRASES
*   puts ASSERTION or PN SOURCE-PHRASE
*   into SOURCE.
T-SPECIAL-PHRASES = IN SA, LV:
    AT VALUE ITERATE ALL OF $FORMAT-SOURCE, $FORMAT-TIME,
                            $FORMAT-INFLUENCE
             UNTIL GO RIGHT FAILS.
  $FORMAT-SOURCE =
    IF BOTH EITHER PRESENT-ELEMENT- X-PRE IS ASSERTION OR FRAGMENT OR PN
            OR BOTH PRESENT-ELEMENT- IS LCS
               AND FOLLOWING-ELEMENT- IS CSSTG
                   WHERE ELEMENT- SUB1 X-PRE EXISTS
       AND X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PHR-ATT
           WHERE X-PHR-ATT HAS MEMBER SOURCE-PHRASE
    THEN IF ALL OF $NOT-FORMATED, $FIND-FORMAT [T-FORMAT-SLOT]
         THEN BOTH X-PUTIN := X-PRE
              AND AT X-FORMAT DO PUTIN-SLOT(INFO-SOURCE).
  $FORMAT-TIME =
    IF BOTH EITHER PRESENT-ELEMENT- IS ASSERTION OR PN X-PRE
            OR PRESENT-ELEMENT- IS LCS WHERE
               VALUE X-PRE OF COELEMENT- CSSTG EXISTS
       AND X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PHR-ATT
           WHERE X-PHR-ATT HAS MEMBER TIME-PHRASE
    THEN IF ALL OF $NOT-FORMATED, $FIND-FORMAT [T-FORMAT-SLOT],
                   $MAKE-EVENT-TIME
         THEN BOTH X-PUTIN := X-PRE
              AND AT X-FORMAT DO PUTIN-SLOT(EVENT-TIME).
  $MAKE-EVENT-TIME =
    IF X-FORMAT DOES NOT HAVE ELEMENT- EVENT-TIME
    THEN AFTER ELEMENT- VERB OF X-FORMAT
         INSERT <EVENT-TIME>.
  $FORMAT-INFLUENCE =
    IF BOTH EITHER PRESENT-ELEMENT- IS ASSERTION OR PN X-PRE
            OR EITHER PRESENT-ELEMENT- IS SUB0 X-PRE
               OR PRESENT-ELEMENT- IS LCS WHERE
                  VALUE X-PRE OF COELEMENT- CSSTG EXISTS
       AND X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PHR-ATT
           WHERE X-PHR-ATT HAS MEMBER INFLUENCE-PHRASE
    THEN IF ALL OF $NOT-FORMATED, $FIND-FORMAT [T-FORMAT-SLOT]
         THEN BOTH X-PUTIN := X-PRE
              AND AT X-FORMAT DO PUTIN-SLOT(INFLUENCE).
* T-PARAGR
*  puts contents of INTRODUCER under first PARAGR of
*  first FORMAT in ONESENT. IF VALUE IS LNR OR LAR IT
*  TRANSFORMS IT.
T-PARAGR = IN ASSERTION, FRAGMENT:
       IF BOTH PRESENT-ELEMENT- X-ASSERT EXISTS
          AND AT ELEMENT- INTRODUCER X-PUTIN OF IMMEDIATE
              ONESENT OF IMMEDIATE CENTER,
              PRESENT-ELEMENT- IS NOT EMPTY
          [AND $FIRST-ONE] [IT IS FIRST ASSERTION IN ONESENT]
       THEN [BOTH $PUTIN-PARAGR AND] $TRANSFORM-CHK.
  $FIRST-ONE = STORE IN X-ASSERT;
       NEITHER ITERATE GO LEFT UNTIL TEST FOR ASSERTION OR FRAGMENT
               SUCCEEDS
       NOR AT IMMEDIATE-NODE- ITERATE GO LEFT UNTIL TEST FOR CENTER
               SUCCEEDS;
       AT X-ASSERT DO R(FORMAT-TYPES) [GO TO FIRST FORMAT];
       STORE IN X-FORMAT.
  $PUTIN-PARAGR = X-PRE:= X-PUTIN;
                  AT X-FORMAT DO PUTIN-SLOT(PARAGR).
  $TRANSFORM-CHK =
       IF VALUE OF X-PUTIN IS LNR OR LAR
      @THEN [TRANSFORM PRESENT-ELEMENT-]
            BOTH DO $SET-PARSE-REG [T-FORMAT-SLOT]
            AND IF $CORRECT-FORMAT
                THEN BOTH $SUBCLASS-CHK
                     AND $SYNTAX-CHK [T-FORMAT-SLOT]
                ELSE TRUE
       ELSE ALL OF $CORRECT-FORMAT, $PUTIN-PARAGR.
  $CORRECT-FORMAT =
       AT X-ASSERT DO R(FORMAT-TYPES);
       STORE IN X-FORMAT.
* ******************* ******************** ******************** ********
*                                                                      *
*                     SPECIAL TRANSFORMATIONS                          *
*                  PN AND QN TRANSFORMATIONS                           *
*                                                                      *
* ******************* ********************* ********************* ******
*
* T-AGE HANDLES ALL AGE EXPRESSIONS THAT ARE NOT ALSO TIME EXPRESSIONS
*    (PHRASES BEGINNING WITH 'AT' ARE HANDLED BY T-TIMEUNIT + T-REFPT
*    -E.G. AT AGE 2 MONTHS; AT THE AGE OF 2 MONTHS; AT 2 MONTHS OF AGE )
* CO-OCCURRENCE RESTRICTIONS:
*    THE HEAD NOUN (OR SUBJECT) MUST BE N:NHUMAN OR POSSIBLY NULLN;
* CASES:
*    1) PN
*    FOR PN: P = 'OF'; HEAD NOUN = 'AGE' OR NTIME1
*          A)   HEAD NOUN = 'AGE'; RN = QN:   'OF AGE 2 MONTHS'
*          B)   HEAD NOUN : NTIME1            'OF 3 YEARS'
*    2) QUANT-QN
*    FOR QN: N = NTIME1
*          A)   IN ASTG:  'THE CHILD  IS  4 YEARS (OLD/ OF AGE)'
*          B)   IN RN = QN:  'THE CHILD 2 YEARS (OLD/ OF AGE)'
*          C)   IN APOS :    'THE 4 MO OLD CHILD'
*    3) LQR : 'THE CHILD IS 4'.
*    FOR LQR: HOST IS NULLN; SUBJECT IS NHUMAN (EG. 'THE CHILD IS 4')
* TRANSFORMATION:
*    1. THE AGE NODE IS CONSTRUCTED BY $BUILD-AGE;
*    2. THE VALUES FOR NUM (X31), TIME-UNIT (X32), AND AGE-MK (X33)
*       ARE LOCATED FOR EACH OF THE 3 MAJOR CONSTRUCTIONS;
*    3. FIRST LQR (IN X31) IS MOVED TO NUM AND REPLACED BY NULL; ($Q)
*    4. NEXT IF IN A QN WITH SCALESTG, THE SCALESTG IS MOVED TO AGE-MK
*       AND REPLACED BY NULL, LEAVING JUST N= NUNIT IN QN; ($MK1)
*    5. N= NUNIT IS MOVED INTO TIME-UNIT AND REPLACED BY NULL IN THE
*       ORIGINAL (THIS REMOVES QN IN RN OF 'OF AGE 30 YRS'); ($UNIT)
*    6. FINALLY IF X33 STILL HAS AGE-MK (CASE 1A), IT IS MOVED INTO
*       FORMAT; ($MK2)
T-AGE = IN PN, QN, LQR:
       IF ALL OF $NOT-FORMATED, $CHECK-HOST, $SET-PARSE-REG,
                 $FIND-FORMAT [T-FORMAT-SLOT]
       THEN IF $INSERT-AGE THEN $PRE-TO-AGE-PTR.
  $PRE-TO-AGE-PTR =
       IF X-PRE IS NOT LNR THEN $SET-PN-QN-PTR.
  $SET-PN-QN-PTR =
       X-PUTIN:= X-PRE;
       X-FRMT-SLOT:= X-AGE;
       DO $SET-POINTERS [PUTIN-SLOT(X)].
  $NOT-FORMATED = NOT $IS-FORMATED.                 (GLOBAL)
  $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
  $CHECK-HOST =
       EITHER $HOST-CHK OR $IS-PRED;
       IF X-HOST IS NOT EMPTY
       THEN AT CORE-SELATT X-S OF X-HOST DO $PT-FAM-CHK.
  $HOST-CHK = HOST- X-HOST EXISTS;
       IF PRESENT-ELEMENT- IS EMPTY
       THEN IF PRESENT-ELEMENT- IS OCCURRING IN PN
           @THEN $CHECK-HOST ['PATIENT OF 3'].
  $IS-PRED = EITHER IMMEDIATE OBJECT EXISTS
             OR IMMEDIATE OBJECT OF IMMEDIATE LN EXISTS;
             CORE- X-HOST OF COELEMENT- SUBJECT EXISTS.
  $PT-FAM-CHK =
       PRESENT-ELEMENT- HAS MEMBER H-PT OR H-FAMILY OR MASC OR FEM.
  $INSERT-AGE =
     IF X-PRE IS PN OR QN THEN $PN-QN-AGE
     ELSE IF PRESENT-ELEMENT- IS QN THEN $QN-AGE
          ELSE $LQR-CASE.
  $PN-QN-AGE =
     IF X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PHRASE-ATT
        WHERE X-PHRASE-ATT HAS MEMBER AGE-PHRASE
     THEN DO FIND-SLOT(AGE)
          WHERE REPLACE PRESENT-ELEMENT- BY
                <AGE> (<NON-EMPTY> X-AGE)
     ELSE BOTH P IS 'DE' OR 'OF' OR 'IN'
          AND ONE OF $CASE-1A , $CASE-1B, $CASE-1C.
  $CASE-1A =  ['OF AGE 2 MONTHS']
     CORE-SELATT X-S OF CORE- X-CORE OF ELEMENT- LNR X-AGE-MK
        OF NSTG OF NSTGO OF X-PRE HAS MEMBER H-AGE;
     AT X-AGE-MK ELEMENT- RN HAS ELEMENT- QUANT [QN]
                   WHERE DO $QN-AGE.
  $CASE-1B =  ['OF 3 YEARS']
       X-S HAS MEMBER NTIME1;
       X-UNIT:= X-AGE-MK;
       DO $GET-LQR;
       STORE IN X-LQR;
      [DO $SETUP-AGE;]
      [DO $PUTIN-Q-N.]
       DO $PUTIN-AGE.
  $PUTIN-AGE =
       EITHER DO FIND-SLOT(AGE) OR DO FIND-SLOT(AGE);
       STORE IN X-AGE;
       X-PUTIN := X-AGE-MK;
       DO PUTIN-SLOT(AGE).
  $GET-LQR = AT ELEMENT- QPOS OF ELEMENT- LN OF X-AGE-MK,
             DESCEND TO LQR.
  $CASE-1C =  ['OF 3']
       X-CORE IS EMPTY;
       DO $GET-LQR;
       STORE IN X-LQR;
      [DO $SETUP-AGE;]
      [DO $PUTIN-NUM.]
       DO $PUTIN-AGE.
  $SETUP-AGE = EITHER DO FIND-SLOT(AGE)
                   OR DO FIND-SLOT(AGE);
       VERIFY IMMEDIATE-NODE- X-AGE EXISTS;
       STORE IN X-AGE;
       DO $BUILD-Q-N;
       IF ELEMENT- Q-N X-QUANT DOES NOT HAVE ELEMENT- SCALESTG
       THEN AFTER LAST-ELEMENT- OF X-QUANT INSERT <SCALESTG>.
  $PUTIN-Q-N = DO $PUTIN-UNIT;
               DO $PUTIN-NUM.                               (GLOBAL)
  $PUTIN-UNIT = X-PUTIN:= X-UNIT;
                AT X-QUANT DO PUTIN-SLOT(UNIT).
  $PUTIN-NUM = X-PUTIN:= X-LQR;
               AT X-QUANT DO PUTIN-SLOT(NUM).               (GLOBAL)
  $QN-AGE =   ['3 MONTHS OLD/OF AGE']
      EITHER X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PHRASE-ATT
             WHERE BOTH X-PHRASE-ATT HAS MEMBER AGE-PHRASE
                   AND BOTH X-PUTIN := X-PRE AND DO PUTIN-SLOT(AGE)
      OR $OTHER-QN-AGE.
  $OTHER-QN-AGE =
      ELEMENT- QN EXISTS;
      ELEMENT- LQR X-LQR EXISTS;
      IF COELEMENT- SCALESTG IS NOT EMPTY
     @THEN VALUE X-AGE-MK EXISTS;
      CORE-SELATT OF COELEMENT- N X-UNIT OF X-LQR HAS MEMBER NTIME1;
      DO $SETUP-AGE;
      DO $PUTIN-Q-N;
      IF X-AGE-MK EXISTS WHERE X-PUTIN:= X-AGE-MK
      THEN DO PUTIN-SLOT(SCALESTG);
      DO $QNREP-TEST.
  $QNREP-TEST =
       IF COELEMENT- QNREP X-QN OF X-LQR EXISTS
       THEN $QNREP.                               (GLOBAL)
  $QNREP =  ['2 YEARS 3 MONTHS']
       AT X-QUANT DO FIND-SLOT(UNIT);
       AFTER PRESENT-ELEMENT- INSERT <NUM>X-NUM-SLOT
                                     +<UNIT>X-UNIT-SLOT;
       X-PUTIN:= ELEMENT- LQR OF VALUE OF X-QN;
       AT X-NUM-SLOT DO PUTIN-SLOT(NUM);
       X-PUTIN:= ELEMENT- N OF VALUE OF X-QN;
       AT X-UNIT-SLOT DO PUTIN-SLOT(UNIT).                         (GLOBAL)
  $LQR-CASE =   ['CHILD IS 3']
       X-PRE IS LQR X-LQR;
       DO $SETUP-AGE;
       DO $PUTIN-NUM.
* T-TESTENV-PHRASE
*     test environment for sentences such as
*     e.g. blood gases were H+ 32 breathing air on admission
*          gases on air on admission were H+ 36
*     these phrases (PN: on air, VINGO: breathing air) are
*     to be formatted to TEST-INFO.
T-TESTENV-PHRASE = IN PN, VINGO:
    IF BOTH PRESENT-ELEMENT- X-PRE HAS NODE ATTRIBUTE PHRASE-ATT
            WHERE PRESENT-ELEMENT- HAS MEMBER TESTENV-PHRASE
       AND ALL OF $NOT-FORMATED, $FIND-FORMAT [T-FORMAT-SLOT],
                  $A-FORMAT4
    THEN ALL OF $MARK-TEST-INFO, $SET-POINTERS.
  $A-FORMAT4 =
    X-FORMAT IS FORMAT4.
  $MARK-TEST-INFO =
    X-PUTIN := X-PRE;
    AT X-FORMAT, DESCEND TO TEST-ENV;
    IF DESCEND TO NON-EMPTY
    THEN AFTER LAST-ELEMENT- INSERT <NON-EMPTY> X-FRMT-SLOT
    ELSE REPLACE PRESENT-ELEMENT-
         BY <TEST-ENV> (<NON-EMPTY> X-FRMT-SLOT).
* T-P-WITH-NVN
*     deals with P that has PVAL-ATT that has incorrect
*     pointer -- resets pointer and puts the structure
*     in transform stack..
T-P-WITH-NVN = IN PN: DO $P-WITH-NVN-CHK.
  $P-WITH-NVN-CHK =
       IF BOTH ELEMENT- P X-PUTIN OF PRESENT-ELEMENT- X-PRE HAS NODE 
               ATTRIBUTE PVAL-ATT X-PVAL
          [* pointing to NVN which P should be  *]
          [* formatted as a sister to           *]
          AND AT X-PVAL DO $CORRECT-PTR
       THEN AT X-PVAL DO $PUT-WITH-NVN.
  $CORRECT-PTR =
          [* rule out VBE + OBJBE:PN -- 2000-10-06 *]
       BOTH BOTH CORE-ATT OF X-PVAL DOES NOT HAVE MEMBER VBE
            AND IMMEDIATE-NODE- OF X-PRE IS NOT OBJBE
       AND DO $UP-TO-ASSERT WHERE
          STORE IN X-P [* ASSERTION where PVAL-ATT ptr is in *];
       AT X-PRE DO $UP-TO-ASSERT [* ASSERTION of this structure *]
                   WHERE STORE IN X-ASSERT;
       IF X-P IS NOT IDENTICAL TO X-ASSERT
          [* Pointer is incorrect because of effect of EXPAND *]
          [* routine in transformation component of PVAL-ATT  *]
          [* pointer. Pointer points to conjunct instead of   *]
          [* original. To correct, erase PVAL-ATT.  Previous  *]
          [* PVAL-ATT pointer will become current. If that is *]
          [* in the same ASSERTION, it is the correct one.    *]
       THEN BOTH AT ELEMENT- P OF X-PRE ERASE NODE ATTRIBUTE PVAL-ATT
            AND DO $CORRECT-PVAL [* new *]
               [AND AT X-PRE DO $P-WITH-NVN-CHK].
  $CORRECT-PVAL =
       CORE- X-PVAL OF ELEMENT- VERBAL OF X-ASSERT EXISTS
             WHERE PRESENT-ELEMENT- HAS ATTRIBUTE OBJLIST:PN:PVAL;
       AT ELEMENT- P OF X-PRE ASSIGN NODE ATTRIBUTE PVAL-ATT
             WITH VALUE X-PVAL.
  $UP-TO-ASSERT =
       ASCEND TO ASSERTION OR FRAGMENT PASSING THROUGH STRING.
  $PUT-WITH-NVN =
       IF $CHK-IF-FRMTED
       @THEN BOTH AFTER PRESENT-ELEMENT- INSERT <NON-EMPTY>X-FRMT-SLOT
             AND $SET-POINTERS [ROUTINE PUTIN-SLOT]
       ELSE $TRANSFORM-IT-FRST.
  $CHK-IF-FRMTED = EITHER $IS-FORMATED
                   OR EITHER AT IMMEDIATE LXR DO $IS-FORMATED
                      OR AT IMMEDIATE NNN DO $IS-FORMATED.
  $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
  $TRANSFORM-IT-FRST =
       EITHER IMMEDIATE LXR EXISTS
       OR EITHER IMMEDIATE NNN EXISTS
          OR TRUE;
       EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE TRANSFORM-ATT
       OR BOTH ASSIGN NODE ATTRIBUTE TRANSFORM-ATT
          AND $DO-BOTH.
  $DO-BOTH = VERIFY TRANSFORM X-PRE;
       TRANSFORM PRESENT-ELEMENT- [* transform NVN first, then PN *].
* T-INFLUENCE-PN
T-INFLUENCE-PN = IN PN, VENPASS:
     PRESENT-ELEMENT- X-PRE EXISTS;
     EITHER $IS-FORMATED
     OR IF BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE PHRASE-ATT
          @AND PRESENT-ELEMENT- HAS MEMBER INFLUENCE-PHRASE
        THEN ALL OF $FIND-FORMAT, $PUTIN-INFLUENCE, $FURTHER-XFS.
  $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
  $PUTIN-INFLUENCE =
     X-PUTIN := X-PRE;
     AT X-FORMAT DO FIND-SLOT(INFLUENCE);
     DO PUTIN-SLOT(INFLUENCE).
  $FURTHER-XFS = [* Transform right adjunct if not empty *]
    IF RN OF LNR X-LNR OF NSTG OF NSTGO OF X-PRE IS NOT EMPTY
    THEN TRANSFORM X-LNR.
* T-BODYFUNC-PN
*    PUTS LNR INTO ACTIVITY OF EXAM-FUNC IF OCCURRING
*    IN PN WHICH HAS NODE ATTRIBUTE ADVERBIAL-TYPE WITH MEMBER
*    BODYFUNC-PN ( 'ON FLEXION').
* -- adjusted to bring the PN and PVINGO into INFLUENCE 981022.
*    add PVINGO into the housing, and change PRECISIONS to INFLUENCE.
T-BODYFUNC-PN = IN PN, PVINGO:
     PRESENT-ELEMENT- X-PRE EXISTS;
     EITHER $IS-FORMATED
     OR IF BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE ADVERBIAL-TYPE
          @AND PRESENT-ELEMENT- HAS MEMBER BODYFUNC-PN
        THEN ALL OF $FIND-FORMAT, $PUTIN-FUNC, [$MARK-LNR,]
                    $FURTHER-XFS.
  $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
  $PUTIN-FUNC =
     X-PUTIN := X-PRE;
     AT X-FORMAT DO FIND-SLOT(INFLUENCE) [ACTIVITY] [EXAM-FUNC];
     DO PUTIN-SLOT(INFLUENCE) [PRECISIONS] [ACTIVITY].
  $MARK-LNR =
     EITHER X-PUTIN := LNR OF NSTG OF NSTGO OF X-PRE
     OR X-PUTIN := LVINGR OF VINGO OF X-PRE;
     DO $SET-POINTERS [ROUTINE PUTIN-SLOT].
  $FURTHER-XFS = [* Transform right adjunct if not empty *]
    IF EITHER RN OF LNR X-LNR OF NSTG OF NSTGO OF X-PRE IS NOT EMPTY
       OR RV OF LVINGR X-LNR OF VINGO OF X-PRE IS NOT EMPTY
    THEN TRANSFORM X-LNR.
* T-ADJUST-SEM-CORE
*      VERIFIES THAT PRESENT PN IS:
*        . NOT FORMATTED,
*        . HAS CORE NTIME1 AND HAS NODE ATTRIBUTE ADVERBIAL-TYPE
*          WITH VALUE TIME-ADVERBIAL
*        . IS OCCURRING IN ASSERTION/FRAGMENT/PARSE-CONN/INTRODUCER
*          WHICH HAS A FORMAT FRAME BUILT.
*        . FORMAT FRAME IS A FORMAT5
*        . FIND HOST SLOT.
*        . HOST FORMAT SLOT IS NOT IN PSTATE-DATA
*     THEN:
*        . LOOK FOR A FILLED FORMAT SLOT IN PSTATE-DATA
*        . GO TO NON-EMPTY GET FILLED-PT VALUE
*        . ASSIGN PN NODE ATTRIBUTE SEM-CORE WITH VALUE
*          CORE OF FILLED-PT.
T-ADJUST-SEM-CORE = IN PN:
       IF ALL OF $NOT-FORMATED [T-AGE],
                 $CHECK-TIME,
                 $FIND-FORMAT [T-FORMAT-SLOT - X-FORMAT],
                 $IS-FORMAT5,
                 $FIND-HOST-SLOT [T-MOD - X-SEM-CORE, X-HOST-SLOT],
                 $NOT-IN-PSTATE-DATA
       THEN BOTH $LOCATE-PSTATE-DATA
            AND $ADJUST-SEM-CORE.
  $CHECK-TIME =
       AT PRESENT-ELEMENT- X-PRE
       BOTH ELEMENT- LNR X-LNR OF NSTG OF NSTGO EXISTS
       AND ELEMENT- P IS NOT 'PAR' OR 'PER' OR 'PRO';
       CORE-SELATT OF CORE- OF X-LNR HAS MEMBER NTIME1;
       BOTH X-PRE HAS NODE ATTRIBUTE ADVERBIAL-TYPE
      @AND PRESENT-ELEMENT- HAS MEMBER TIME-ADVERBIAL.
  $IS-FORMAT5 =
       X-FORMAT IS FORMAT5 OR FORMAT13-MED OR FORMAT1-3
                OR FORMAT5-EKG OR FORMAT5-MISC OR FORMAT5F.
  $NOT-IN-PSTATE-DATA =
       IMMEDIATE-NODE- OF X-HOST-SLOT IS NOT PSTATE-DATA.
  $LOCATE-PSTATE-DATA =
       BOTH ELEMENT- PSTATE-DATA X-PT OF X-FORMAT EXISTS
       AND AT VALUE OF X-PT,
           ITERATET GO RIGHT
           UNTIL ELEMENT- NON-EMPTY X-HS EXISTS SUCCEEDS.
  $ADJUST-SEM-CORE =
       BOTH X-HS HAS NODE ATTRIBUTE FILLED-PT
            WHERE CORE- X-HA EXISTS
       AND AT X-PRE ASSIGN NODE ATTRIBUTE SEM-CORE WITH VALUE X-HA.
* ********* **********************************************************
*                                                                    *
*                  T I M E   E X P R E S S I O N S                   *
*                                                                    *
* ********* **********************************************************
* *** TREATMENT OF TIME EXPRESSIONS ARE DIVIDED INTO TWO PARTS:
*    1.  A REFERENCE POINT:  E.G. AN EVENT, DATE OR NTIME2 TO WHICH A
*        FIXED TIME POINT CAN BE ASSIGNED;
*    2.  A TIME PERIOD RELATIVE TO THIS FIXED POINT:  E.G.
*        ONE DAY [TIME PERIOD] BEFORE ADMISSION [REFERENCE POINT].
*    REFERENCE POINT EXPRESSIONS ARE HANDLED BY T-REFPT-PN AND
*    T-REFPT-DATE (FOR DATES); T-TIMEUNIT HANDLES TIME-PERIODS.
* *** STRATEGY FOR TIME EXPRESSIONS *****
*    A.  DETERMINE IF WE HAVE REF-PT OR UNIT:
*        1.  IN PN OR NSTGT CORE IS NTIME1 (TIME PERIOD) OR NTIME2 (REFPT)
*        2.  IF HAVE TIME PREP AND NOT NTIME1 THEN HAVE EVENT = REF. PT;
*        3.  OR CORE IS AN EVENT:  A NOMINALIZED VERB OF CERTAIN CLASSES
*                                  OR A TIME-RELATED NOUN: H-CHANGE OR
*                                  H-ASP (REFERENCE POINT)
*        4.  PDATE IS A REF PT.
*    B.  FIND THE HOST OF THE TIME EXPRESSIONS; DONE BY $FIND-HOST.
*        MUST FIND HOST IN ORDER TO PUT TIME EXPRESSION INTO APPROPRIATE
*        TIME SLOT IN FORMAT.
*        1.  IF RV IS ON A VERB, THEN VERB IS HOST.
*        2.  IF IN SA THEN FIND VERB; IF NO VERB, THEN TRY FIRST OBJECT,
*            THEN SUBJECT, AND DO $CHECK-HOST.
*        3.  IF IN RN-- DO $CHECK-HOST.
*    C.  CHECK THE HOST ($CHECK-HOST)
*        1.  ASSUME IF HOST IS VERB THEN DON'T HAVE TO CHECK HOST AT ALL,
*            SINCE ANY VERB CAN SUPPORT A TIME MODIFIER.
*        2.  NTIME1 OK AS HOST
*        3.  OTHER ALLOWABLE HOSTS: H-TTGEN,H-TXVAR AND NODES IN FINDING
*    D.  TRANSFER TIME INFORMATION TO EVENT SLOTS
*        DONE BY $SETUP-REFPT FOR REF-PT, AND $SETUP-TIME FOR TIME PER.
*    E.  WRONG HOST:  (IF CANNOT FIND A HOST THAT SUPPORTS TIME ADJUNCT)
*        .  IF HOST IS IN PN, FIND ITS HOST, AND DO $CHECK-HOST ON IT;
*           (ASSUME THAT NESTED PNS WERE PARSED WRONG, ATTACHED TOO LOW)
*        .  OTHERWISE ASCEND UNTIL FIND A VERBAL ELEMENT AS HOST.
* NTN 1/16/97 add LDR for 'as previously mentioned'
T-TIMEUNIT = IN LNR, LDR, VERB, PN:
       AT PRESENT-ELEMENT- X-PRE,
       IF ALL OF $NOT-LCONN, $NOT-FORMATED [T-AGE], $CHECK-TIME,
                 $FIND-FORMAT [T-FORMAT-SLOT]
       THEN IF DO $FIND-HOST-SLOT [T-MOD]
            THEN AT X-PRE
                 EITHER ONE OF $IN-PN-TIME, $PN-TIME
                 OR ITERATE ALL OF $FIND-EVENT-TIME [T-MOD],
                                   $PUT-IN-TIME [$PRE-TO-TIME-PTR]
                    UNTIL $NEXT-SLOT-FOR-HOST [T-MOD] FAILS
            ELSE IF DO $SEM-CORE
                 THEN TRUE [* pass to get it later *]
                 ELSE IF $NOT-TRANSFORM-ATT
                      THEN BOTH $FIND-VERB
                           AND ONE OF $PN-TIME, $VERB-TIME.
  $SEM-CORE =
    [* since $CHECK-TIME finds that the core of LXR is time *]
    [* this function complements FIND-HOST-SLOT which is up *]
    [* high in PN.                                          *]
       X-CORE HAS NODE ATTRIBUTE SEM-CORE
       WHERE PRESENT-ELEMENT- IS NOT NIL. 
  $NOT-TRANSFORM-ATT = [* Check for assignment of TRANSFORM-ATT *]
       IF X-HOST-LXR EXISTS
       THEN X-HOST-LXR DOES NOT HAVE NODE ATTRIBUTE TRANSFORM-ATT.
  $NOT-LCONN = [* LDR in LCONN does not need to be formatted *]
     IF X-PRE IS LDR
     THEN IMMEDIATE-NODE- IS NOT LCONN.
  $IN-PN-TIME =
     X-PRE IS LNR;
     X-PRE IS OCCURRING IN PN;
     DO $IS-FORMATED.
  $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
  $PN-TIME =
    EITHER X-PRE HAS NODE ATTRIBUTE ADVERBIAL-TYPE X-PHRASE-ATT
           WHERE X-PHRASE-ATT HAS MEMBER TIME-ADVERBIAL
    OR X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PHRASE-ATT
           WHERE X-PHRASE-ATT HAS MEMBER TIME-PHRASE;
    [EITHER AT X-SLOT DO HAS-MODIFIER(EVENT-TIME)]
    [                 WHERE STORE IN X-FRMT-SLOT ]
    [OR] AFTER X-SLOT INSERT <EVENT-TIME> (<NON-EMPTY> X-FRMT-SLOT);
     X-PUTIN := X-PRE;
    [DO PUTIN-SLOT(EVENT-TIME)]
     DO $SET-POINTERS [PUTIN-SLOT].
  $VERB-TIME =
     AFTER X-SLOT INSERT <EVENT-TIME> (<NON-EMPTY> X-FRMT-SLOT);
     X-PUTIN := X-PRE;
     DO $SET-POINTERS [PUTIN-SLOT].
  $FIND-VERB = [* if there's no host, go to verb *]
     ELEMENT- VERB X-SLOT OF X-FORMAT EXISTS.
  $PRE-TO-TIME-PTR =
       IF X-PRE IS NOT LNR THEN $SET-PN-PTR.
  $SET-PN-PTR =
     X-PUTIN:= X-PRE;
     X-FRMT-SLOT:= X-EVENT-SLOT;
     DO $SET-POINTERS [PUTIN-SLOT(X)].                     (GLOBAL)
  $CHECK-TIME =
     EITHER X-PRE HAS NODE ATTRIBUTE ADVERBIAL-TYPE X-PHRASE-ATT
            WHERE X-PHRASE-ATT HAS MEMBER TIME-ADVERBIAL
     OR EITHER X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PHRASE-ATT
               WHERE X-PHRASE-ATT HAS MEMBER TIME-PHRASE
        OR $CHECK-TIME-CONTEXT.
  $CHECK-TIME-CONTEXT =
     IF X-PRE IS PN
     THEN BOTH ELEMENT- LNR X-LNR OF NSTG OF NSTGO EXISTS
          AND ELEMENT- P IS NOT 'PAR' OR 'PER' OR 'PRO'
     ELSE X-PRE IS LNR OR VERB OR LDR X-LNR;
     EITHER CORE-SELATT X-S OF CORE- X-CORE OF X-LNR HAS MEMBER
            NTIME1 OR H-TMLOC
     OR BOTH X-S HAS MEMBER H-TRANSP
        AND BOTH X-CORE HAS NODE ATTRIBUTE COMPUTED-ATT X-S
            AND X-S HAS MEMBER NTIME1 OR H-TMLOC;
     AT X-CORE, DO $NOT-FORMATED;
     X-TYPE-SLOT:= SYMBOL EVENT-TIME.
  $PUT-IN-TIME =
     EITHER $HAS-EVENT-SUBUNIT OR $NO-EVENT-SUBUNIT.
  $HAS-EVENT-SUBJUNIT =
     AT X-EVENT-SLOT IF DO FILLED-SLOT(Q-N)
                     THEN $FORM-SUBUNIT
                     ELSE EITHER X-QUANT EXISTS
                          OR AT X-EVENT-SLOT DO FIND-SLOT(Q-N)
                             WHERE PRESENT-ELEMENT- X-QUANT EXISTS;
     ALL OF $P, $N, $Q, $RN-TIMELOC.
  $NO-EVENT-SUBUNIT =
     AT X-SLOT DO HAS-MODIFIER(EVENT-TIME)
        WHERE AFTER LAST-ELEMENT- INSERT <NON-EMPTY> X-FRMT-SLOT;
     X-PUTIN := X-PRE;
     DO $SET-POINTERS [PUTIN-SLOT].
  $P = IF X-PRE IS PN WHERE P X-PUTIN EXISTS
       THEN AT X-EVENT-SLOT DO PUTIN-SLOT(TPREP1).
  $N = X-LNR IS NOT EMPTY WHERE X-UNIT:= X-LNR.
  $Q = IF ONE OF $LQR, $ADJ, $PLU
       THEN $PUTIN-Q-N [T-AGE]
       ELSE $PUTIN-UNIT [T-AGE].
  $RN-TIMELOC =
       IF CORE-SELATT OF CORE- X-RN OF RN OF X-LNR
                   HAS MEMBER H-TMLOC
       THEN $PUTIN-TPREP2.
  $PUTIN-TPREP2 =
       AT X-RN EITHER $UP-RN
               OR DO $IMM-LXR [T-FORMAT-SLOT];
       X-PUTIN:= PRESENT-ELEMENT- [DSTG OR LXR = H-TMLOC];
       AT X-EVENT-SLOT DO PUTIN-SLOT(TPREP2).
  $UP-RN =  [for RN:D]
       BOTH IMMEDIATE-NODE- IS RN
       AND PRESENT-ELEMENT- EXISTS.
  $LQR = LQR X-LQR OF QPOS OF LN X-LN OF X-LNR IS NOT EMPTY.
  $PLU = CORE- OF X-LNR HAS COELEMENT- N X-LQR WHERE PRESENT-ELEMENT-
         IS 'PLURAL'.
  $ADJ =
       EITHER CORE-SELATT OF CORE- X-CORE OF APOS OF LN OF X-LNR
                HAS MEMBER H-AMT [OR H-TMREP]
       OR X-CORE IS 'FIRST' OR '1ST' OR
                    [* French *] '3E' OR '3E2ME' OR '4E2ME' OR '4E';
       IMMEDIATE LAR [LAR1 FOR NON-MDCG] X-LQR OF X-CORE EXISTS.
  $FORM-SUBUNIT =
       BEFORE FIRST ELEMENT OF X-EVENT-SLOT INSERT
        <SUBUNIT>(<TPREP0>(ALL ELEMENTS OF TPREP1 OF X-EVENT-SLOT)
                 +<TM-UNIT0>(ALL ELEMENTS OF Q-N OF X-EVENT-SLOT));
       AT X-EVENT-SLOT DO FIND-SLOT(TPREP1);
       REPLACE PRESENT-ELEMENT- BY <TPREP1>;
       AT X-EVENT-SLOT DO FIND-SLOT(UNIT);
       REPLACE PRESENT-ELEMENT- BY <UNIT>;
       AT X-EVENT-SLOT DO FIND-SLOT(NUM);
       REPLACE  PRESENT-ELEMENT- BY <NUM>;
       AT X-EVENT-SLOT DO FIND-SLOT(Q-N);
       STORE IN X-QUANT.
* T-TIME-QUAL
*     registering TIME QUALITY
T-TIME-QUAL = IN LXR:
       AT PRESENT-ELEMENT- X-PRE
       IF ALL OF $NOT-FORMATED [T-AGE],
                 $IS-TIME-QUAL,
                 $FIND-FORMAT [T-FORMAT-SLOT]
       THEN IF $FIND-HOST-SLOT [T-MOD]
            THEN AT X-PRE ITERATE ALL OF $FIND-TIME-QUAL,
                                         $PUT-IN-TIME
                          UNTIL $NEXT-SLOT-FOR-HOST [T-MOD] FAILS.
  $IS-TIME-QUAL =
       CORE-ATT X-SEL-CORE OF CORE- OF X-PRE HAS MEMBER H-TMDUR
             OR H-TMREP.
  $FIND-TIME-QUAL =
       AT X-SLOT EITHER DO HAS-MODIFIER(TIME-QUAL)
                        WHERE STORE IN X-TMQUAL-SLOT
                 OR $BUILD-TIME-QUAL [T-BUILD-FORMAT].
  $PUT-IN-TIME =
       AT X-PRE, STORE IN X-PUTIN;
       IF CORE-ATT X-SEL-CORE OF CORE- OF X-PRE HAS MEMBER H-TMDUR
       THEN DO $PUT-IN-PERIOD
       ELSE IF X-SEL-CORE HAS MEMBER H-TMREP
            THEN DO $PUT-IN-REPETITION.
  $PUT-IN-PERIOD =
       AT X-TMQUAL-SLOT
       IF DO FILLED-SLOT(TM-PERIOD)
       THEN AFTER LAST-ELEMENT- OF X-TMQUAL-SLOT
            INSERT <TM-PERIOD> X-SLOT [X-PUTIN]
       ELSE BOTH AT X-TMQUAL-SLOT DO FIND-SLOT(TM-PERIOD)
           @AND STORE IN X-SLOT [X-PUTIN];
       AT X-TMQUAL-SLOT DO PUTIN-SLOT(TM-PERIOD).
  $PUT-IN-REPETITION =
       AT X-TMQUAL-SLOT
       IF DO FILLED-SLOT(TM-REPETITION)
       THEN AFTER LAST-ELEMENT- OF X-TMQUAL-SLOT
            INSERT <TM-REPETITION>X-SLOT [X-PUTIN]
       ELSE BOTH AT X-TMQUAL-SLOT DO FIND-SLOT(TM-REPETITION)
           @AND STORE IN X-SLOT [X-PUTIN];
       AT X-TMQUAL-SLOT DO PUTIN-SLOT(TM-REPETITION).
* T-REFPT-PN
*   formats into EVENT-TIME or REF-PT
*   for PN and SUB2 that are TIME-ADVERBIAL.
T-REFPT-PN = IN PN, SUB2 [92.08.03]:
     IF BOTH ALL OF $NOT-FORMATED [T-AGE], $CHECK-REFPT,
                    $FIND-FORMAT [T-FORMAT-SLOT],
        AND ONE OF $TIME-PHRASE-HOST, $FIND-HOST-SLOT [T-MOD],
                   $LXR-HOST
     THEN AT X-PRE
          ITERATE IF ALL OF $FIND-EVENT-TIME [T-MOD], $NOT-TIMEUNIT,
                            $SETUP-REFPT
                  THEN EITHER ALL OF $PUT-IN-REFPT,
                                     $PRE-TO-TIME-PTR [T-TIMEUNIT]
                       OR DO $PRE-TO-TIME-PTR [T-TIMEUNIT]
                  ELSE DO $PRE-TO-TIME-PTR [T-TIMEUNIT]
          UNTIL $NEXT-SLOT-FOR-HOST [T-MOD] FAILS.
  $LXR-HOST =
    HOST- EXISTS;
    ASCEND TO LXR; STORE IN X-HOST-SLOT;
    PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT X-SLOT.
  $NOT-TIMEUNIT =
      [* Eliminate ambiguous NUNIT NTIME1 *]
      NOT $FORMATTED-TIMEUNIT.
  $FORMATTED-TIMEUNIT =
      EITHER ELEMENT- P OF X-PRE HAS NODE ATTRIBUTE FORMAT-PT
      OR EITHER ELEMENT- LNR OF ELEMENT- NSTG OF ELEMENT- NSTGO OF
                X-PRE HAS NODE ATTRIBUTE FORMAT-PT
         OR ELEMENT- QUANT OF ELEMENT- NSTGO OF
            X-PRE HAS NODE ATTRIBUTE FORMAT-PT;
      IMMEDIATE EVENT-TIME EXISTS
                WHERE PRESENT-ELEMENT- IS IDENTICAL TO X-EVENT-SLOT.
  $CHECK-REFPT =
     [PRESENT-ELEMENT- X-PRE HAS NODE ATTRIBUTE REFPT-ATT;]
    EITHER
       PRESENT-ELEMENT- X-PRE HAS NODE ATTRIBUTE ADVERBIAL-TYPE
           WHERE PRESENT-ELEMENT- HAS MEMBER TIME-ADVERBIAL
    OR PRESENT-ELEMENT- X-PRE HAS NODE ATTRIBUTE PHRASE-ATT
           WHERE PRESENT-ELEMENT- HAS MEMBER TIME-PHRASE;
    X-TYPE-SLOT := SYMBOL EVENT-TIME.
  $TIME-PHRASE-HOST =
    BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE PHRASE-ATT
    AND IMMEDIATE-NODE IS SA X-SA;
    COELEMENT- VERBAL X-VERB OF X-SA EXISTS;
    X-HOST-SLOT := CORE- OF X-VERB;
    AT X-FORMAT DO FIND-SLOT(VERB)
                WHERE STORE IN X-SLOT.
  $SETUP-REFPT = AT X-EVENT-SLOT
      IF DO FILLED-SLOT(EVENT-TIME)
      THEN BOTH NOT DO FILLED-SLOT(REF-PT)
           AND IF DO FIND-SLOT(TPREP2) WHERE VALUE IS NON-EMPTY
              @THEN REPLACE PRESENT-ELEMENT- BY <NULL>
      [* take out TPREP2 for TPREP2 that goes with REFPT *]. [GLOBAL]
  $PUT-IN-REFPT = ALL OF $P, $N.
  $P = ELEMENT- P X-PUTIN OF X-PRE EXISTS;
       IF P IS NOT '[P]'
       THEN AT X-EVENT-SLOT DO PUTIN-SLOT(TPREP2).
  $N = AT X-PRE,
       EITHER ELEMENT- LNR X-LNR OF NSTG OF NSTGO EXISTS
       OR ELEMENT- QN X-LNR OF QUANT OF NSTGO EXISTS;
       X-PUTIN:= X-LNR;
       IF CORE- X-CORE HAS NODE ATTRIBUTE N-TO-LN-ATT
      @THEN PRESENT-ELEMENT- X-PUTIN EXISTS
       ELSE IF X-CORE HAS NODE ATTRIBUTE N-TO-RN-ATT
           @THEN PRESENT-ELEMENT- X-PUTIN EXISTS
                 [* if CORE has COMPUTED-ATT, REF-PT *]
                 [* should be LXR which causes COMPUTED-ATT *];
       AT X-EVENT-SLOT DO PUTIN-SLOT(REF-PT);
       IF X-PUTIN IS NOT IDENTICAL TO X-LNR [WAS THERE A COMPUTED-ATT]
       THEN BOTH X-PUTIN:= X-LNR AND $SET-POINTERS
            [* mark LNR of NSTGO of PN as having been formated *];
       IF CORE- OF X-LNR IS 'A3GE' OR 'AGE'
       THEN $AGE-REFPT.
  $AGE-REFPT =
      IF EITHER RN OF X-LNR HAS ELEMENT- QUANT
                WHERE ELEMENT- QN X-QN EXISTS ['AGE 3 YEARS']
         OR LP OF X-PRE HAS ELEMENT- QN X-QN ['3 YEARS OF AGE']
      THEN $QN
      ELSE IF AT ELEMENT- PN X-PN OF RN OF X-LNR
              BOTH P IS 'DE' OR 'OF'
              AND EITHER CORE-SELATT OF CORE- X-S OF LNR OF NSTG
                         OF NSTGO HAS MEMBER NTIME1
                      ['AT THE AGE OF 3 YEARS']
                  OR CORE-ATT OF X-S HAS MEMBER NUNIT
                      ['AT THE AGE OF 3']
           THEN $PN-IN-PN.
  $QN =
       AT X-QN ELEMENT- LQR X-LQR EXISTS;
       AT X-QN ELEMENT- N X-UNIT EXISTS;
       DO $PUTIN-Q-N [T-AGE];
       DO $QNREP-TEST.
  $PN-IN-PN =
       LQR X-LQR OF QPOS OF LEFT-ADJUNCT OF X-S IS NOT EMPTY;
       AT X-EVENT-SLOT DO $PUTIN-NUM [T-AGE];
       IF CORE-SELATT OF X-S HAS MEMBER NTIME1
       THEN IMMEDIATE LNR X-UNIT OF X-S EXISTS;
       DO $PUTIN-UNIT [T-AGE];
       DO $SET-PN-IN-PN-PTR;
       DO $SWITCH-PREPS.
  $SET-PN-IN-PN-PTR =
       X-PUTIN:= X-PN;
       X-FRMT-SLOT:= X-EVENT-SLOT;
       DO $SET-POINTERS [PUTIN-SLOT(X)].
  $SWITCH-PREPS = AT X-EVENT-SLOT DO FIND-SLOT(TPREP2);
       STORE IN X2;
       AT X-EVENT-SLOT DO FIND-SLOT(TPREP1);
       REPLACE PRESENT-ELEMENT- BY <TPREP1>(ALL ELEMENTS OF X2);
       AT X2 REPLACE PRESENT-ELEMENT- BY <TPREP2>(<NULL>);
       ELEMENT P X-PUTIN OF X-PN EXISTS;
       DO PUTIN-SLOT(TPREP2).
* T-REFPT-DATE
T-REFPT-DATE = IN PDATE, PD:
       AT PRESENT-ELEMENT- X-PRE
       IF ALL OF $NOT-FORMATED [T-MOD],
                 $FIND-FORMAT [T-FORMAT-SLOT],
                 $SET-TYPE-REG
       THEN EITHER $HOSTLESS-TIME
            OR IF $FIND-HOST-SLOT [T-MOD]
               THEN AT X-PRE
                    ITERATE IF ALL OF $FIND-EVENT-TIME [T-MOD],
                                      $SETUP-REFPT [T-REFPT-PN]
                            THEN $PUT-IN-REFPT
                    UNTIL $NEXT-SLOT-FOR-HOST [T-MOD] FAILS.
  $HOSTLESS-TIME =
       EITHER X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PATT
              WHERE X-PATT HAS MEMBER TIME-PHRASE
       OR X-PRE HAS NODE ATTRIBUTE ADVERBIAL-TYPE X-PATT
          WHERE X-PATT HAS MEMBER TIME-ADVERBIAL;
       ELEMENT- VERB X-SLOT OF X-FORMAT EXISTS;
       AFTER X-SLOT INSERT <EVENT-TIME> (<NON-EMPTY> X-FRMT-SLOT);
       X-PUTIN := X-PRE;
       DO $SET-POINTERS [PUTIN-SLOT].
  $SET-TYPE-REG = X-TYPE-SLOT:= SYMBOL EVENT-TIME.
  $PUT-IN-REFPT =
       ALL OF $P, $N, $PRE-TO-TIME-PTR [T-TIMEUNIT].
  $N = ONE OF $DATE, $LQR, $LDR;
       AT X-EVENT-SLOT DO PUTIN-SLOT(REF-PT).
  $DATE =
       IF ELEMENT- DATE OF X-PRE EXISTS
       THEN X-PUTIN := DATE OF X-PRE
       ELSE IF ELEMENT- LDATER OF X-PRE EXISTS
            THEN X-PUTIN := LDATER OF X-PRE
     [;IF MOREDATE OF X-PRE HAS VALUE LDATER X-PUTIN]
     [ THEN AT X-EVENT-SLOT DO PUTIN-SLOT(REF-PT)].
  $LQR = X-PUTIN := LQR OF X-PRE.
  $LDR = X-PUTIN := LDR OF X-PRE.
  $P = IF VALUE X-PUTIN IS NOT NULL
       THEN AT X-EVENT-SLOT DO PUTIN-SLOT(TPREP2).
* T-NPOS-REFPT
*     puts NVN words which are also H-TTGEN or H-TTMED and
*     which are in NPOS into REFPT.  If N in NPOS is NTIME1,
*     it puts it into UNIT in EVENT-slot of HOST.
T-NPOS-REFPT = IN NNN:
        IF $IS-NPOS-REFPT THEN $PUT-IN-REFPT
        ELSE $CHECK-TIME.
  $IS-NPOS-REFPT =
       BOTH CORE- X-CORE OF PRESENT-ELEMENT- X-PRE IS NVN
       AND EITHER X-S HAS MEMBER H-TTGEN
           OR X-S HAS MEMBER H-TTCOMP OR H-TTMED
              WHERE CORE-SELATT OF HOST- X-HOST DOES NOT HAVE
                    MEMBER H-TTCOMP.
  $PUT-IN-REFPT = IF $SETUP THEN $REFPT;
       ITERATET IF ALL OF $FIND-EVENT-TIME [T-MOD],
                          $SETUP-REFPT [T-REFPT-PN]
                THEN $REFPT
       UNTIL $NEXT-SLOT-FOR-HOST [T-MOD] FAILS.
  $SETUP =
       ALL OF $NOT-FORMATED [T-AGE], $FIND-FORMAT [T-FORMAT-SLOT],
              $SET-AND-FIND-H, $FIND-EVENT-TIME [T-MOD],
              $SETUP-REFPT [T-REFPT-PN].
  $REFPT = AT X-EVENT-SLOT DO FIND-SLOT(TPREP2);
       REPLACE PRESENT-ELEMENT- BY
        <TPREP2> (<NON-EMPTY> X-FRMT-SLOT
                              (<P> X-PUTIN = 'NPOS-TIME'));
       DO $SET-POINTERS [PUTIN-SLOT];
       X-PUTIN:= X-PRE;
       AT X-EVENT-SLOT DO PUTIN-SLOT(REF-PT).
  $CHECK-TIME =
       IF BOTH X-S HAS MEMBER NTIME1
          AND $SETUP
       THEN BOTH ALL OF $SET-QUANT, $N, $P
            AND ITERATET IF ALL OF $FIND-EVENT-TIME, $SETUP-REFPT
                         THEN ALL OF $N, $P
                UNTIL $NEXT-SLOT-FOR-HOST [T-MOD] FAILS.
  $SET-QUANT = AT X-EVENT-SLOT
       DO FIND-SLOT(Q-N);
       STORE IN X-QUANT.
  $N = X-UNIT:= X-PRE;
       AT X-EVENT-SLOT DO $PUTIN-UNIT [T-AGE].
  $Q= AT X-QUANT DO FIND-SLOT(NUM);
      REPLACE PRESENT-ELEMENT- BY
       <NUM> (<NON-EMPTY> X-FRMT-SLOT (<LQR> X-PUTIN
                                             (<LQ> (<NULL>)
                                             +<QVAR> (<Q>='[1]')
                                             +<RQ> (<NULL>))));
      DO $SET-POINTERS [PUTIN-SLOT].
  $P= AT X-EVENT-SLOT DO FIND-SLOT(TPREP1);
      REPLACE PRESENT-ELEMENT- BY
       <TPREP1> (<NON-EMPTY> X-FRMT-SLOT
                             (<P> X-PUTIN = 'NPOS-TIME'));
      DO $SET-POINTERS.
  $SET-AND-FIND-H =
       X-TYPE-SLOT:= SYMBOL EVENT-TIME;
       AT X-PRE DO $FIND-HOST-SLOT [T-MOD].
* ********* **********************************************************
*                                                                    *
*              Q U A N T I T Y   E X P R E S S I O N S               *
*                                                                    *
* ********* **********************************************************
* T-QUANT
*    THIS TRANSFORMATION HANDLES EXPRESSIONS OF QUANTITATIVE RESULTS,
*    PLACING THEM IN FORMAT NODE QUANT. (TIME AND AGE EXPR ARE EXCLUDED)
*    *CASES
*      1. LQR IN QPOS, WITH NULLN, NUNIT OR H-TXVAR AS CORE OF IMMED LNR;
*         [HCT WAS 24; TEST SHOWED 10 POLYS]
*      2. LQNR, WHERE N OF QN/NQ = NUNIT.
*         A. LQNR IN APOS   [A 10 LB. CHILD]
*         B. LQNR IN ASTG OF OBJECT  [WEIGHT WAS 2 LBS];
*         C. LQNR IN RN
*         EACH QN CAN HAVE A QNREP, CONTAINING A SECOND NUM + UNIT:
*            EG. 'WEIGHT 2 LBS 10 OZ';
*         EITHER CASE CAN BE CONJOINED [HCT 24 TO 37] INDICATING A
*         RANGE; IN THIS CASE QUANT WILL CONTAIN A RANGE MARKER 'BETW'
*         (CONTAINING THE CONJUNCTION), Q-N (FOR THE 1ST  VALUE) AND
*         Q-N2 (FOR THE SECOND VALUE).
*    *STEPS
*      1. CHECK COOC: NO TIME OR AGE EXPRESSIONS ALLOWED;
*         ONLY FIRST CONJUNCTION OPERATED ON IF THERE IS CONJUNCTION.
*      2. BUILD APPROPRIATE QUANT WITH Q-N -AND Q-N2 IF IN A CONJUNCTION
*      3. LOCATE LQR (STORED IN X31) AND UNIT EXPRESSION (X32);
*         NOTE THAT QNREP IS INSERTED INTO FORMAT AND ERASED IN QN FIRST
*      4. MOVE LQR AND UNIT INTO FORMAT:
*         LQR MOVED INTO NUM AND ORIGINAL ERASED;
*         ENTIRE QN OR LNR (MINUS LQR AND/OR QNREP) IS INSERTED INTO
*         UNIT-WD.
*    *POINTERS
*      IF LQR IN QPOS MODIFIES NULLN OR AN ALREADY FORMATTED
*      H-TXVAR WORD
*      THEN POINTER SET FROM QPOS TO NUM (FOR FIRST CONJUNCT ONLY)
*      OTHERWISE POINTER SET FROM NODE ABOVE LNR OR QN/NQ TO UNIT-WD.
*    *LEFT AND RIGHT ADJUNCTS OF Q, QN, NQ ARE IGNORED.
T-QUANT = IN LXR, QPERUNIT, DSTG, NNN, NQ, QN [, PQUANT]:
             [* LXR = LQR, LAR, LAR1, LNR, LDR, LTR *]
    AT PRESENT-ELEMENT- X-PRE
    IF $CHECK-COOC
    THEN IF $QUANT-IN-H-PALP
         THEN DO PUTIN-SLOT(TXRES)
         ELSE IF ONE OF $DS-NODE, $LAR-NODE
              THEN DO PUTIN-SLOT(QUANT)
              ELSE ALL OF [$SET-UP-PQUANT,] $SET-UP-QN, $INSERT,
                          $CHK-FOR-PERUNIT [T-PERUNIT],
                          $CHK-FOR-SCALESTG,
                          $CHK-FOR-PREP.
  $DS-NODE =
    EITHER X-PRE IS LNR
           WHERE EITHER CORE- X-PUTIN IS DS
                 OR VALUE OF ELEMENT- RN IS DS X-PUTIN
    OR X-PRE IS NNN WHERE CORE- X-PUTIN IS DS.
  $LAR-NODE = [* a small non-Q-wave anterior myocardial infarction *]
    X-PRE IS LAR
    WHERE CORE- X-PUTIN IS ADJ.
  $QUANT-IN-H-PALP =
      [ Example: Foie a2 3 cm du RC ]
    X-FORMAT IS FORMAT5;
    EITHER BOTH X-PRE IS LNR X-PUTIN
                WHERE CORE-ATT OF CORE- HAS MEMBER NUNIT
           AND X-PRE IS OCCURRING IN PN
    OR X-PRE IS PQUANT X-PUTIN;
    HOST- IS H-PTPALP.
  $SET-UP-PQUANT =
    IF X-PRE IS PQUANT
    THEN VALUE OF ELEMENT- QUANT EXISTS WHERE STORE IN X-PRE.
  $CHK-FOR-SCALESTG =
    IF ONE OF $QN-SCALE, $PTMEAS
    THEN BOTH IF X-TEMP DOES NOT HAVE ELEMENT- SCALESTG
              THEN AFTER LAST-ELEMENT- OF X-QUANT [Q-N]
                   INSERT <SCALESTG>
         AND AT X-QUANT, DO PUTIN-SLOT(SCALESTG).
  $QN-SCALE =
     BOTH X-PRE IS QN
     AND ELEMENT- SCALESTG X-PUTIN OF X-PRE IS NOT EMPTY.
  $PTMEAS =
      [* PUT H-PTMEAS OF PN UNIT STRUCTURE INTO SCALESTG *]
     BOTH X-PRE IS LNR
          WHERE CORE- X-UNIT IS NUNIT
     AND BOTH ELEMENT- RN OF X-PRE IS NOT EMPTY
              WHERE BOTH ELEMENT- PN X-PN EXISTS
                    AND VALUE OF X-PN IS 'DE' OR 'DES' OR 'OF'
         AND LNR X-PUTIN OF NSTG OF NSTGO OF X-PN EXISTS
                  WHERE CORE- IS H-PTMEAS.
  $CHK-FOR-PREP =
     IF EITHER X-PRE IS PQUANT WHERE ELEMENT- P X-PREP EXISTS
        OR EITHER X-PRE IS LNR
                  WHERE BOTH ASCEND TO PN
                       @AND ELEMENT- P X-PREP EXISTS
           OR EITHER X-PRE IS QN
                     WHERE BOTH IMMEDIATE-NODE- IS QUANT
                          @AND COELEMENT- P X-PREP EXISTS
              OR X-PRE IS QPERUNIT
                 WHERE BOTH IMMEDIATE-NODE- IS QUANT
                      @AND BOTH IMMEDIATE-NODE- IS NSTGO
                          @AND COELEMENT- P X-PREP EXISTS
     THEN BOTH X-PUTIN := X-PREP
          AND BOTH IF X-TEMP DOES NOT HAVE ELEMENT- PREP
                   THEN BEFORE VALUE OF X-QUANT INSERT <PREP>
              AND AT X-QUANT, DO PUTIN-SLOT(PREP).
  $CONJ-TEST =
       DO R(CONJ-NODE);
       EITHER Q-CONJ EXISTS OR $CONJ-TEST [IGNORE ',' PUNCT.];
       GO DOWN.
  $CHECK-COOC =
       ALL OF $NOT-FORMATED [T-AGE], $NO-CONJ, $QUANT-TYPE,
              $FIND-FORMAT [T-FORMAT-SLOT], $IS-FORMAT4OR5.
  $IS-FORMAT4OR5 =
       X-FORMAT IS FORMAT1-3 OR FORMAT13-MED OR FORMAT4 OR
       FORMAT5 OR FORMAT5-EKG OR FORMAT5-MISC OR FORMAT5F.
  $PRE-TO-QUANT-PTR =
       IF X-PRE IS NOT LQR OR LNR THEN $SET-QN-NQ-PTR.
  $SET-QN-NQ-PTR =
       X-QUANT := X-FRMT-SLOT;
       X-PUTIN:= X-PRE;
       DO $SET-POINTERS [PUTIN-SLOT(X)].
  $NO-CONJ =
     IF BOTH PRESENT-ELEMENT- X-PRE IS LQR
        AND ASCEND TO LNR PASSING THROUGH LN WHERE STORE IN X-LNR
    @THEN IMMEDIATE-NODE- IS NOT Q-CONJ
     ELSE IMMEDIATE-NODE- IS NOT Q-CONJ.
  $QUANT-TYPE =
        [* Checks for types of QUANT expressions:     *]
        [* LQR, PQUANT, QN, NQ, QPERUNIT, LNR, DS, or *]
        [* H-AMT in LAR, LAR1, NNN, DSTG, LDR or LTR  *]
    IF PRESENT-ELEMENT- IS LQR
    THEN ONE OF $Q-IN-QPOS, $Q-IN-RN, $Q-IN-QUANT
    ELSE IF X-PRE IS PQUANT
        [THEN AT ELEMENT- LQR OF QUANT, DO $NOT-FORMATED]
         THEN DO $QN-STRUCT
         ELSE IF PRESENT-ELEMENT- IS QN OR NQ
              THEN DO $QN-STRUCT
              ELSE IF X-PRE IS QPERUNIT
                   [WHERE ELEMENT- PERUNIT X-UNIT EXISTS]
                   THEN TRUE
                   ELSE IF X-PRE IS LNR
                           WHERE CORE- X-UNIT IS NUNIT OR H-AMT
                        THEN BOTH X-UNIT IS NOT NTIME1 OR
                                  H-PTPART OR H-PTAREA OR H-TTMED
                                  OR H-INST
                             AND $NOT-TPOSS-UNIT
                        ELSE EITHER $DS-NODE
                             OR BOTH X-PRE IS LAR OR LAR1 OR NNN
                                           OR DSTG OR LDR OR LTR
                                     WHERE CORE- X-UNIT IS H-AMT
                                AND $HOST-OK.
  $NOT-TPOSS-UNIT =
        [* 'our unit' is H-INST, not QUANT *]
      BOTH X-UNIT IS H-INST
      AND AT TPOS OF LEFT-ADJUNCT OF X-UNIT,
          BOTH VALUE X-LQR IS NOT EMPTY
          AND CORE- OF X-LQR IS NOT T:TPOSS.
  $QN-STRUCT =
      IF CORE-SELATT X-QNATT OF ELEMENT- N EXISTS
      THEN BOTH X-QNATT DOES NOT HAVE MEMBER NTIME1
           AND BOTH AT ELEMENT- LQR, DO $NOT-FORMATED
               AND AT ELEMENT- N, DO $NOT-FORMATED.
  $Q-IN-QUANT = IMMEDIATE-NODE- IS QUANT.
  $Q-IN-RN =
      PRESENT-ELEMENT- IS OCCURRING IN RADJSET
        WHERE HOST- X-HOST EXISTS;
      CORE-SELATT DOES NOT HAVE MEMBER NTIME1 OR H-AGE.
  $Q-IN-QPOS = ALL OF $OK-CORE, $HOST-OK, $TXRES-QUANT, $OK-P.
  $TXRES-QUANT =
       [* LQR: '3' should not be formatted in case of    *]
       [*    'foie a2 3 cm du RC', where 'a2 3 cm du RC' *]
       [* has been formatted as TXRES of PTPART 'foie' *]
     IF BOTH X-ATT HAS MEMBER NUNIT
       [AND BOTH X-FORMAT IS FORMAT5]
        AND EITHER IMMEDIATE PN OF IMMEDIATE LNR OF X-HOST EXISTS
            OR IMMEDIATE PQUANT EXISTS
     @THEN HOST- IS NOT H-PTPALP.
  $OK-CORE =
     AT CORE- EITHER PRESENT-ELEMENT- IS Q [QNUMBER OR H-AMT]
              OR PRESENT-ELEMENT- IS CPDNUMBR.
  $HOST-OK =
     EITHER EITHER HOST- X-HOST IS NULLN
            OR BOTH PRESENT-ELEMENT- IS OCCURRING IN OBJECT X-OBJ
               AND CORE- X-HOST OF COELEMENT- SUBJECT OF X-OBJ EXISTS
     OR BOTH CORE-SELATT X-ATT OF X-HOST HAS MEMBER
             NUNIT OR H-TXVAR
             OR H-INDIC OR H-RESP OR H-PTPART OR H-PTMEAS OR
             H-PTFUNC [2/1/89] OR H-NORMAL [has cleared considerably]
             OR H-TXRES OR H-TTMED OR H-DIAG [* GRI *]
        AND X-ATT DOES NOT HAVE MEMBER NTIME2 OR H-AGE OR H-TXPROC;
     IF X-UNIT EXISTS
    @THEN IF PRESENT-ELEMENT- IS NOT H-AMT
          THEN $CHK-NOREP
     ELSE $CHK-NOREP.
  $CHK-NOREP =
       IF X-ATT HAS MEMBER H-TXVAR
       THEN X-HOST IS H-TXVAR:NO-REP
         [IT IS RESULT OF TEST AND NOT NUMBER OF TESTS].
  $OK-P =
     IF AT X-HOST
        EITHER PRESENT-ELEMENT- IS NULLN
        OR CORE-ATT HAS MEMBER NUNIT
     THEN IF EITHER IMMEDIATE PN EXISTS
             OR IMMEDIATE PQUANT EXISTS
          @THEN P IS 'A2' OR 'DE' OR 'PRESQUE' OR 'SOUS'
                  [English] OR 'AT' OR 'OF' OR 'ON' OR 'IN' OR
                            'TO' OR 'OVER' OR 'FROM' OR 'UNDER'.
  $CONJOINED-TEST = IF $CONJOINED @THEN $CONJ.
  $Q-N-TO-Q-N2 = AT X-QUANT REPLACE PRESENT-ELEMENT- BY
                         <Q-N2>(ALL ELEMENTS OF X-QUANT);
                 STORE IN X-QUANT.
  $CONJOINED =
       EITHER $LNR-CONJ OR $QN-NQ-CONJ.
  $LNR-CONJ =
       IF PRESENT-ELEMENT- IS LQR WHERE X-LNR EXISTS
       @THEN COELEMENT- CONJ-NODE X12 EXISTS;
       AT ELEMENT- Q-CONJ DESCEND TO LN;
       DESCEND TO X-PRE;
       STORE IN X-PRE.
  $QN-NQ-CONJ = COELEMENT- CONJ-NODE X12 EXISTS;
       AT ELEMENT- Q-CONJ DESCEND TO QN OR NQ;
       STORE IN X-PRE.
  $CONJ =
       ALL OF $SET-UP-QN2, $INSERT [IN Q-N2], $Q-N-TO-Q-N2.
  $SET-UP-QN2  =
       AT X-QUANT DO $BUILD-Q-N;
       BEFORE X-QUANT INSERT <BETW>X-SLOT(<NULL>);
       VALUE X-PUTIN OF X12 EXISTS;
       AT X-SLOT DO PUTIN-SLOT(BETW).
  $SET-UP-QN =
     AT X-FORMAT, DO FIND-SLOT(QUANT) WHERE STORE IN X-TEMP;
     EITHER AT VALUE OF X-TEMP DO $BUILD-Q-N
        [* treadmill exercise stress testing demonstrating *]
        [* about 2 mm of inferior ST segment depression *]
     OR DO $BUILD-Q-N [T-BUILD-FORMAT].
  $INSERT = ALL OF $NONNUM-OR-NUM, $QNREP-TEST [T-AGE].
  $NONNUM-OR-NUM =
       IF X-UNIT [CORE OF X-PRE] IS H-AMT
       THEN $PUTIN-NONNUM
       ELSE BOTH $LQR AND $N.
  $PUTIN-NONNUM = AT X-QUANT REPLACE PRESENT-ELEMENT- BY
           <Q-N>X-QUANT (<NON-NUM>);
       X-PUTIN:= X-PRE;
       AT X-QUANT DO PUTIN-SLOT(NON-NUM).
  $PLU =
       IF 4TH ELEMENT OF ELEMENT- QN OF X-UNIT [UNIT-WD]
          IS N X-LQR WHERE VERIFY PRESENT-ELEMENT- IS 'PLURAL'
       THEN AT X-QUANT IF DO FILLED-SLOT(NUM)
                       THEN TRUE
                       ELSE $PUTIN-NUM [T-AGE].
  $LQR = EITHER PRESENT-ELEMENT- IS LQR X-LQR
         OR EITHER ELEMENT- LQR X-LQR EXISTS
            OR EITHER ELEMENT- Q X-LQR EXISTS
               OR EITHER X-PRE IS QPERUNIT
                         WHERE ELEMENT- LQR X-LQR EXISTS
                  OR $QUANT-LNR.
  $QUANT-LNR =
     BOTH X-PRE IS LNR WHERE CORE X-CORE EXISTS
     AND EITHER BOTH ELEMENT- LN OF X-PRE IS EMPTY
                AND X-CORE IS NUNIT [*new*] 
         OR EITHER AT QPOS OF LEFT-ADJUNCT OF X-CORE,
                   VALUE X-LQR IS NOT EMPTY
        [OR EITHER X-CORE HAS NODE ATTRIBUTE COMPUTED-ATT]
                  [WHERE PRESENT-ELEMENT- HAS MEMBER H-TTMED]
            OR EITHER X-CORE IS PLURAL
               OR AT TPOS OF LEFT-ADJUNCT OF X-CORE,
                  BOTH VALUE X-LQR IS NOT EMPTY
                  AND CORE- OF X-LQR IS 'A' OR 'AN' OR
             [French] 'UN' OR 'UNE' OR
                      'L''' OR 'LE' OR 'LA' OR 'LES'.
  $N = IF ONE OF $LQR-N-NOTFRMT,
                 $Q-CONJ-N,
                 $NQ-OR-QN,
                 $LNR-CHK [, $QPERUNIT]
       THEN IF X-PRE IS LNR [* core is NUNIT *]
               WHERE ELEMENT- LN IS EMPTY
            THEN $PUTIN-UNIT [T-AGE]
            ELSE $PUTIN-Q-N [T-AGE]
       ELSE $PUTIN-NUM [T-AGE].
  $QPERUNIT =
       X-PRE IS QPERUNIT;
       ELEMENT- N OF X-UNIT IS NUNIT.
  $LQR-N-NOTFRMT = X-PRE IS LQR;
       AT X-LNR BOTH $NOT-FORMATED [T-MOD]
                AND CORE- IS NOT 'POUR-CENT' OR 'PERCENT';
       X-UNIT:= X-LNR.
  $Q-CONJ-N =
       PRESENT-ELEMENT- IS Q-CONJ WHERE ELEMENT- N X-UNIT EXISTS.
  $NQ-OR-QN =
       X-PRE IS QN OR NQ WHERE ELEMENT- N X-UNIT IS NOT
             'POUR-CENT' OR 'PERCENT'.
  $LNR-CHK =
       X-PRE IS LNR WHERE X-CORE IS NOT 'POUR-CENT' OR 'PERCENT';
       X-UNIT:= X-PRE.
* T-PERUNIT
*   places PER + UNIT (or 'PERCENT') after UNIT in QUANT.
T-PERUNIT = IN PN:
       AT PRESENT-ELEMENT- X-PRE,
       DO $CHK-FOR-PERUNIT.
  $CHK-FOR-PERUNIT =
      IF ALL OF $HAVE-PERUNIT, $NOT-FORMATED [T-MOD],
               [$NOT-PERUNIT,] $FIND-FORMAT
      THEN $PUTIN-PERUNIT.
  $HAVE-PERUNIT =
       IF PRESENT-ELEMENT- IS PN X-PUTIN
       THEN BOTH P IS 'PAR' OR 'PER' OR 'PRO'
            AND BOTH LP IS EMPTY
                AND CORE- OF NSTG OF NSTGO IS NUNIT
       ELSE EITHER $PERUNIT-NOT-NULL
            OR ELEMENT- N X-PUTIN EXISTS
               WHERE PRESENT-ELEMENT- IS 'POUR-CENT' OR 'PERCENT'.
  $PERUNIT-NOT-NULL =
       EITHER PERUNIT IS NOT EMPTY
       OR AT PERUNIT DO R(PERUNIT)
             WHERE PRESENT-ELEMENT- IS NOT EMPTY [CHECK BOTH PERUNITS];
       STORE IN X-PUTIN.
  $PUTIN-PERUNIT =
       DO $QUANT-FULL [*GRI*];
      [AFTER UNIT OF X-QUANT INSERT <PERUNIT>;]
       AT X-QUANT DO PUTIN-SLOT(PERUNIT);
       IF X-PRE IS PN
       THEN AT ELEMENT- LNR X-PUTIN OF NSTG OF NSTGO
            DO $SET-POINTERS [PUTIN-SLOT(X)].
  $NOT-PERUNIT =
       ONE OF $HAVE-Q-N, $QUANT-FULL,
              $RXDOSE-FULL [Find Q-N this PERUNIT pertains to];
       PRESENT-ELEMENT- DOES NOT HAVE ELEMENT- PERUNIT.
  $HAVE-Q-N = X-QUANT EXISTS [Filling X-QUANT].
  $RXDOSE-FULL = DO FIND-SLOT(RXDOSE);
       STORE IN X-QUANT;
       PRESENT-ELEMENT- HAS ELEMENT- Q-N [* it is filled *].
  $QUANT-FULL = DO FIND-SLOT(QUANT);
       STORE IN X-QUANT;
       PRESENT-ELEMENT- HAS ELEMENT Q-N.
* T-MEDDOSE
*   FORMATS DOSAGE INFORMATION. THERE ARE 2 CASES:
*     1- PDOSE/MEDDOSE IN RN
*        - PLACE LQR OF QN IN RXNUM
*        - EVERYTHING ELSE IN QN INTO RXUNIT
*     RECURSIVELY LOOK FOR X-TIMES, H-TTMODE AND H-TTFREQ WORDS AND
*     PUT THEM IN RXFREQUENCY, RXMANNER AND RXPERIOD RESPECTIVELY.
*     2- LQNR IN APOS (MUST CHECK THAT N IS NOT NTIME1)
*        - DO THE SAME IN THE QN AS IN MEDDOSE
T-MEDDOSE = IN PDOSE, PN [, LQNR, MEDDOSE]: [* add PDOSE & PN 5/24/96 *]
      AT PRESENT-ELEMENT- X-PRE IF $CHECK-COOC THEN $MEDDOSE.
  $CHECK-COOC =
      [EITHER] BOTH X-PRE IS PDOSE OR PN
                   WHERE DO $IN-PDOSE-QUANT
              AND ALL OF $NOT-FORMATED, $HOST-CHK, $FIND-FORMAT,
                         $IS-FORMAT345
      [OR ALL OF $NOT-FORMATED] [T-AGE][, $HOST-CHK,]
      [          $FIND-FORMAT] [T-FORMAT-SLOT][, $IS-FORMAT3].
  $IS-FORMAT3 = X-FORMAT IS FORMAT1-3 OR FORMAT13-MED.
  $IS-FORMAT345 =
      X-FORMAT IS FORMAT1-3 OR FORMAT13-MED OR FORMAT4 OR FORMAT5
      OR FORMAT5-MISC [OR FORMAT5F].
  $HOST-CHK = IF X-PRE IS LQNR THEN HOST IS H-TTMED.
  $IN-PDOSE-QUANT =
      PRESENT-ELEMENT- HAS NODE ATTRIBUTE PHRASE-ATT X-DATT;
      X-DATT HAS MEMBER DOSE-PHRASE.
  $MEDDOSE =
      [EITHER] BOTH X-PRE IS PDOSE OR PN X-PUTIN
                   WHERE DO $IN-PDOSE-QUANT
              AND DO PUTIN-SLOT(QUANT)
      [OR ALL OF $CHK-DOSE, $GET-DOSE, $RXMODE, $SET-DOSE-PTR].
  $CHK-DOSE =
       DO FIND-SLOT(RXDOSE);
       STORE IN X-RXDOSE;
       EITHER BOTH DO FILLED-SLOT(RXDOSE)
             @AND DO FIND-SLOT(Q-N) WHERE STORE IN X-QUANT
       OR $BUILD-RXDOSE [T-BUILD-FORMAT].              (GLOBAL)
  $GET-DOSE = ONE OF $QN, $LQR-NULLN, $NULL-DOSE.
  $LQR-NULLN = CORE IS NULLN X-UNIT;
       COELEMENT- LQR X-LQR EXISTS;
       DO $PUTIN-Q-N.
  $NULL-DOSE = ELEMENT NULL EXISTS.
  $QN = EITHER CORE OF X-PRE IS QN
        OR ELEMENT- QN EXISTS;
        STORE IN X-QN;
       LQR X-LQR EXISTS WHERE COELEMENT- N X-UNIT EXISTS;
       DO $PUTIN-Q-N [T-AGE];
       AT X-QN BOTH $CHK-FOR-PERUNIT AND $QNREP-TEST [T-AGE].
  $SET-DOSE-PTR =
       X-PUTIN:= X-PRE;
       X-FRMT-SLOT:= X-RXDOSE;
       DO $SET-POINTERS [PUTIN-SLOT(X)].
  $RXMODE = ITERATET $LOOK UNTIL ELEMENT- RXMODE IS NOT EMPTY FAILS.
  $LOOK =
       AT VALUE VERIFY $FREQ-MANNER.
  $FREQ-MANNER =
       IF PRESENT-ELEMENT- IS EMPTY @THEN GO RIGHT;
       IF EITHER PRESENT-ELEMENT- X-PUTIN IS MANY-TIMES
          OR CORE-SELATT X-S HAS MEMBER H-TTFREQ
       THEN DO PUTIN-SLOT(RXFREQUENCY)
       ELSE IF X-S HAS MEMBER H-TTMODE
            THEN DO PUTIN-SLOT(RXMANNER).
* T-QN-TIME
*      puts time expression in QN or APOS (e.g. 4 HOUR TRANSFUSION)
*      into EVENT-TIME slot.
* -- 960528 -- take out QN that has TIME-ADVERBIAL
T-QN-TIME = IN QN, NQ [QN-TIME]:
     PRESENT-ELEMENT- X-PRE EXISTS;
     IF BOTH BOTH CORE-SELATT OF ELEMENT- N X-UNIT
                  OF PRESENT-ELEMENT- X-QN HAS MEMBER NTIME1
                     OR H-TMLOC OR H-AGE [* Mar 22 1999 *]
             AND $QN-IN-PQUANT [* Mar 10 1999 *]
        AND AT X-PRE,
            ALL OF [$NOT-FORMATED in T-AGE,]
                   $CHECK-COOC,
                   $FIND-FORMAT [T-FORMAT-SLOT],
                   $FIND-HOST-SLOT [T-MOD]
     THEN IF EITHER X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PATT
                    WHERE X-PATT HAS MEMBER TIME-PHRASE
             OR X-PRE HAS NODE ATTRIBUTE ADVERBIAL-TYPE X-ADVB
                WHERE X-ADVB DOES NOT HAVE MEMBER TIME-ADVERBIAL
          THEN DO $FIND-TIME-LOCS
          ELSE ITERATE BOTH $PUT-IN AND $PRE-TO-TIME-PTR
               UNTIL $NEXT-SLOT-FOR-HOST [T-MOD] FAILS.
  $QN-IN-PQUANT =
     DO $NOT-FORMATED [T-AGE];
     IF IMMEDIATE PQUANT OF X-PRE EXISTS
        WHERE DO $NOT-FORMATED
    @THEN STORE IN X-PRE.
  $FIND-TIME-LOCS =
       X-PUTIN := X-PRE;
       AFTER X-SLOT INSERT <EVENT-TIME> (<NON-EMPTY> X-FRMT-SLOT);
      [DO PUTIN-SLOT(TIME-LOCS)]
       DO $SET-POINTERS [PUTIN-SLOT].
  $PUT-IN  =
       BOTH $FIND-EVENT-TIME [T-MOD]
       AND $SETUP-REFPT [T-REFPT-PN];
       ALL OF $PUTIN-UNIT [T-AGE], $SCALE, $P, $Q.
  $SCALE  =
       IF BOTH VALUE X-PUTIN OF SCALESTG OF X-QN IS ADJ
         @AND CORE-SELATT HAS MEMBER H-TMDUR
       THEN AT X-EVENT-SLOT IF NOT DO FILLED-SLOT(TIMEPER)
                           @THEN DO PUTIN-SLOT(TIMEPER).
  $P = REPLACE TPREP1 OF X-EVENT-SLOT
          BY <TPREP1> (<P> X-FRMT-SLOT= 'NPOS-TIME');
       X-PUTIN:= X-FRMT-SLOT;
       DO $SET-POINTERS [T-FORMAT-SLOT].
  $Q = IF ELEMENT- LQR X-LQR OF X-QN IS NOT EMPTY
       THEN $PUTIN-NUM [T-AGE].
  $CHECK-COOC = BOTH $1 AND $2.
  $1 = IF HOST- IS N OR ADJ [* premature at 26 weeks *]
      @THEN CORE-SELATT DOES NOT HAVE MEMBER H-PT OR H-FAMILY OR
            H-INST [H-DOCTOR].
  $2 = IF EITHER ASCEND TO OBJECT OR ASCEND TO OBJBE
      @THEN NOT CORE- OF COELEMENT- SUBJECT IS N:NHUMAN;
       X-TYPE-SLOT:= SYMBOL EVENT-TIME.
* T-TPOSS
*     removes SELECT-ATT of possessive articles.
*     And inserts ADJUNCT-TYPE to HOST.
T-TPOSS = IN LTR:
     IF BOTH CORE- X-CORE OF PRESENT-ELEMENT- IS T:TPOSS
        AND X-CORE DOES NOT HAVE NODE ATTRIBUTE COMPUTED-ATT
     THEN DO $INSERT-ADJUNCT-TYPE.
  $INSERT-ADJUNCT-TYPE =
     X-ADJ-TYPE := NIL;
     X-ADJ := SYMBOL ADJUNCT-TYPE;
     PREFIX X-ADJ TO X-ADJ-TYPE;
     AT X-CORE, ASSIGN NODE ATTRIBUTE ADVERBIAL-TYPE
                WITH VALUE X-ADJ-TYPE.
* T-NO
*     TURNS LTR:'NO' OF HOST H-TXVAR:NO-REP
*     OF A FRAGMENT:NSTG INTO QUANT='[0]'.
T-NO = IN LTR:
     IF BOTH CORE- OF PRESENT-ELEMENT- X-PRE IS T:H-NEG
             ['AUCUN' OR 'AUCUNE' OR 'NON' OR 'NO']
        AND AT IMMEDIATE LNR X-LNR OF HOST X-HOST
            DO $IS-FORMATED
     THEN $CHK-TEST-LABRES.
  $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
  $CHK-TEST-LABRES =
     IF BOTH X-S HAS MEMBER H-TXVAR
             WHERE AT X-HOST, PRESENT-ELEMENT- IS H-TXVAR:NO-REP
        AND $IN-NSTG-FRAG
     THEN $SETUP-ZERO.
  $IN-NSTG-FRAG = AT X-PRE ASCEND TO NSTG PASSING THROUGH LN
                  WHERE IMMEDIATE-NODE- IS FRAGMENT.
  $SETUP-ZERO = DO $FIND-FORMAT [T-FORMAT-SLOT];
       DO FIND-SLOT(QUANT);
       AT VALUE DO $BUILD-Q-N [T-BUILD-FORMAT];
       REPLACE VALUE OF NUM OF X-QUANT BY
       <NON-EMPTY>X-FRMT-SLOT (<LQR>X-PUTIN (<LQ>(<NULL>)
                                            +<QVAR> (<Q>='[0]')));
       DO $SET-POINTERS;
       IF COELEMENT- N X-N OF X-HOST IS 'PLURAL'
       THEN BOTH X-TEMP:= NIL
            AND AT X-N ASSIGN NODE ATTRIBUTE FORMAT-PT WITH VALUE
                X-TEMP [ASSIGN FORMAT-PT TO NOTHING SO THAT]
                       [PLURAL IS NOT FORMATED];
       AT X-PRE ASSIGN NODE ATTRIBUTE FORMAT-PT WITH VALUE X-FRMT-SLOT.
* T-FORMAT-EKG-LEADS
T-FORMAT-EKG-LEADS = IN LLEADR:
    AT IMMEDIATE IN-LEADS X-PRE,
    IF ALL OF $FIND-FORMAT, $NOT-FORMATED
    THEN BOTH BOTH X-PUTIN := X-PRE
              AND AT X-FORMAT, DO PUTIN-SLOT(IN-LEADS)
         AND IF BOTH X-PRE HAS ELEMENT- LLEADR X-PUTIN
                AND AT X-PUTIN, DO $NOT-FORMATED
             THEN AT X-FORMAT, DO PUTIN-SLOT(IN-LEADS).
* T-FORMAT-SLOT
*  --- 2001 01 09 add FORMAT GENDER, i.e. node GRAM-NODE
*      to the right of CORE.
T-FORMAT-SLOT = IN LXR, NNN, DSTG, LD:
       BOTH DO $FORMAT-GENDER
       AND DO $FORMAT-SLOTS.
  $FORMAT-GENDER =
       IF BOTH PRESENT-ELEMENT- X-PRE IS OF TYPE LXR
          AND COELEMENT- GRAM-NODE X-PUTIN OF CORE-
                             IS '[MALE]' OR '[FEMALE]'
              WHERE CORE-ATT X-S OF X-PUTIN EXISTS
       THEN IF ALL OF $FIND-FORMAT, $NOT-FORMATED
            THEN AT X-FORMAT, DO PUTIN-SLOT(GENDER).
  $FORMAT-SLOTS =
       VERIFY $SET-PARSE-REG;
       EITHER $EXCEPTION
       OR IF $FIND-FORMAT
          THEN IF ONE OF $HAS-FAIL-SEL, $HAS-ADJUNCT-ATT,
                         $CORE-FAIL-SEL, $CORE-ADJUNCT-ATT, $F00-CHK
               THEN $SYNTAX-CHK
               ELSE BOTH $SUBCLASS-CHK AND $SYNTAX-CHK
          ELSE TRUE.
  $SET-PARSE-REG =                                       [GLOBAL]
       CORE- X-CORE OF PRESENT-ELEMENT- X-PRE EXISTS;
       EITHER BOTH X-CORE HAS NODE ATTRIBUTE COMPUTED-ATT X-S
              AND X-CORE HAS NODE ATTRIBUTE SELECT-ATT X-NEWLIST
                  WHERE DO $IS-MINOR-CLASS
       OR EITHER CORE-SELATT X-S OF X-CORE EXISTS
          OR X-S:= NIL.
  $EXCEPTION = ONE OF $IS-TM-SIGN, $IS-INTRO, [$IS-FORMATED,]
                      $IS-TM-OF-LXR,
                      $Y-OF-FORMATED, $NNN-IN-NNN,
                      $IS-LQR-LQNR, $IS-LCONNR, $IS-MOD-VERB,
                      $IS-LD, $IS-NEG-MODAL.
  $NNN-IN-NNN =
      BOTH X-PRE IS NNN
      AND IMMEDIATE-NODE- OF X-PRE IS NNN
          WHERE DO $IS-FORMATED.
  $IS-TM-OF-LXR =
      BOTH X-PRE IS OF TYPE LXR
      AND EITHER BOTH X-S HAS MEMBER H-TMDUR [7.30.92]
                 AND HOST- EXISTS
                     WHERE PRESENT-ELEMENT IS OCCURRING IN LXR
          OR BOTH X-PRE IS OF TYPE VERBAL [6.12.97]
             AND X-S HAS MEMBER H-TMBEG OR H-TMEND.
  $IS-TM-SIGN = [7.28.92]
      ALL OF $TM-SEM-CORE, $SIGN-SYMPTOM, $ERASE-SEM-CORE.
  $TM-SEM-CORE = [7.28.92]
      BOTH BOTH X-CORE HAS NODE ATTRIBUTE SELECT-ATT X-NEWLIST
           AND X-NEWLIST HAS MEMBER H-TMDUR
      AND X-S EXISTS WHERE PRESENT-ELEMENT- IS NOT NIL.
  $SIGN-SYMPTOM = [7.28.92]
      BOTH BOTH X-CORE HAS NODE ATTRIBUTE SEM-CORE X-SH
           @AND CORE-ATT X-SH-ATT OF CORE- EXISTS
      AND X-SH-ATT HAS MEMBER H-INDIC OR H-DIAG.
  $ERASE-SEM-CORE = [7.28.92]
      BOTH AT X-CORE, ERASE NODE ATTRIBUTE SEM-CORE
      AND FALSE.
  $IS-INTRO =
        [* LXR in INTRODUCER can be repeatedly formatted *]
        [* SPECIAL CASE: 'Heart: s1 s2, no murmur'       *]
      BOTH $IS-FORMATED
      AND IMMEDIATE-NODE- IS NOT INTRODUCER.
  $IS-LD =
        [* SPECIAL CASE: D of LD needs to be formatted. *]
      BOTH X-PRE IS LD
      AND VALUE OF X-PRE IS NOT D.
  $IS-MOD-VERB =
        [* EXCLUDE H-MODAL/H-NEG VERB FROM FORMATTING INTO VERB *]
      BOTH X-CORE IS V OR TV OR VEN OR VING
      AND X-S HAS MEMBER H-MODAL OR H-NEG.
  $Y-OF-FORMATED =
        [* If this is a Y-OF structure then check if   *]
        [* phrase had been formatted: if it did, exit. *]
      BOTH $IN-PN
      AND BOTH ONE OF $HAS-TRANSFORM-ATT, $IS-SEM-CORE-OF, $IS-X-FROM-N
          AND IMMEDIATE LNR OF X-HST HAS NODE ATTRIBUTE FORMAT-PT.
  $IN-PN =
      IF X-PRE IS OCCURRING IN PN
     @THEN HOST- X-HST EXISTS
      ELSE HOST- X-HST EXISTS.
  $HAS-TRANSFORM-ATT =
      X-PRE HAS NODE ATTRIBUTE TRANSFORM-ATT.
  $IS-SEM-CORE-OF =
      BOTH X-HST HAS NODE ATTRIBUTE SEM-CORE X-CMP
      AND CORE- OF X-PRE IS IDENTICAL TO X-CMP.
  $IS-X-FROM-N =
      BOTH EITHER X-HST HAS NODE ATTRIBUTE N-TO-RN-ATT X-CMP
           OR X-HST HAS NODE ATTRIBUTE N-TO-LN-ATT X-CMP
      AND X-PRE IS IDENTICAL TO X-CMP.
  $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
  $CORE-FAIL-SEL = AT X-CORE DO $HAS-FAIL-SEL.                   (GLOBAL)
  $CORE-ADJUNCT-ATT = AT X-CORE DO $HAS-ADJUNCT-ATT.             (GLOBAL)
  $HAS-FAIL-SEL =
       PRESENT-ELEMENT- HAS NODE ATTRIBUTE FAIL-SEL.
  $HAS-ADJUNCT-ATT =
       BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE ADVERBIAL-TYPE
       @AND PRESENT-ELEMENT- HAS MEMBER ADJUNCT-TYPE.
  $IS-LCONNR = EITHER X-PRE IS LCONNR
               OR X-PRE IS OCCURRING IN LCONNR.
  $F00-CHK = X-FORMAT IS FORMAT00.
  $FIND-SLOT = VERIFY X-NEWLIST:= LIST FORMAT-LIST;
       IF INTERSECT OF X-S IS NOT NIL
       THEN EITHER $PUT-IN-FORMAT OR TRUE.
  $PUT-IN-FORMAT =
       VERIFY X-PUTIN := X-PRE;
       VERIFY X-SIGNAL:= X-PRE [GET ARG FROM X-SLOT SIGNAL];
       VERIFY $CHK-FORMAT-TYPE.
  $CHK-FORMAT-TYPE =
       EITHER ITERATET SUCCESSORS X-INTERSECTION OF
                       X-INTERSECTION IS NOT NIL
              UNTIL $CHK-TYPE SUCCEEDS
       OR TRUE.
  $CHK-TYPE =
       EITHER BOTH DO $IS-CHANGE-X
               AND AT X-FORMAT DO FIND-SLOT(QUANT)
                  WHERE STORE IN X-SLOT
       OR [BOTH IF $IS-PT-GENDER THEN DO $IS-GENDER]
          [AND] ATTRIBUTE-LIST X-SLOT OF X-INTERSECTION EXISTS;
       IF ATTRIBUTE-LIST X-F OF X-SLOT EXISTS
       THEN AT X-FORMAT BOTH TEST FOR X-F AND $PUT-IN
       ELSE AT X-FORMAT DO $PUT-IN.
  $IS-PT-GENDER =
      [BOTH X-INTERSECTION HAS MEMBER H-PT OR H-FAMILY]
      [AND] X-INTERSECTION HAS MEMBER FEM OR MASC.
  $IS-GENDER =
       BOTH X-HEAD := HEAD OF X-INTERSECTION
       AND BOTH X-GENDER := LIST PT-GENDER
           AND X-GENDER HAS MEMBER X-HEAD.
  $PUT-IN =
       [* NOTE: To separate H-CHANGE:(MORE) from *]
       [*       H-CHANGE:(LESS) -- to do         *]
      EITHER BOTH DO $IS-CHANGE-X
             AND BOTH VERIFY X-SIGNAL := NIL
                 AND DO PUTIN-SLOT(QUANT)
      OR BOTH VERIFY X-SIGNAL := X-PRE [get arg from X-SLOT signal]
         AND DO PUTIN-SLOT(REGX);
      EITHER $TEST-FOR-GENDER
      OR IF SUCCESSORS OF X-INTERSECTION IS NOT NIL
         THEN $WARN-MESS1.
  $IS-CHANGE-X =
      X-S HAS MEMBER H-CHANGE OR H-CHANGE-MORE OR H-CHANGE-LESS
                  OR H-CHANGE-SAME.
  $TEST-FOR-GENDER =
       EITHER AT X-INTERSECTION DO $GENDER-TEST
              WHERE DO $PUTIN-OTHER [PUT IN SLOT OTHER THAN GENDER]
       OR BOTH SUCCESSORS X-INTERSECTION OF
               X-INTERSECTION IS NOT NIL
         @AND DO $GENDER-TEST
              WHERE AT X-INTERSECTION DO $PUTIN-GENDER.
  $PUTIN-OTHER =
       IF SUCCESSORS X-INTERSECTION OF X-INTERSECTION IS NOT NIL
          WHERE ATTRIBUTE-LIST X-SLOT EXISTS
       THEN $PUT-IN-FORMAT.
  $PUTIN-GENDER =
       ATTRIBUTE-LIST X-SLOT EXISTS [PUT IN GENDER SLOT];
       X-SIGNAL:= X-PRE;
       DO PUTIN-SLOT(REGX);
       IF $MORE-CHK
          [* more than 1 subclass on list excluding FEM/MASC *]
       THEN $WARN-MESS1 [HOMONYMN MESSAGE].
  $MORE-CHK =
       X-TEMP:= X-INTERSECTION;
       IF AT X-TEMP DO $GENDER-TEST
       THEN $HAS-2
       ELSE IF $HAS-SUCCESSOR
            THEN AT X-TEMP NOT $GENDER-TEST.
  $GENDER-TEST = ATTRIBUTE-LIST HAS MEMBER GENDER.
  $HAS-SUCCESSOR = SUCCESSORS X-TEMP OF X-TEMP EXISTS.
  $HAS-2 = DO $HAS-SUCCESSOR;
       DO $HAS-SUCCESSOR.
  $SPECIAL-CHK = IF X-SLOT IS RXMANNER
                 THEN $CHK-DOSE
                      [IN T-MEDDOSE-BUILD MEDDOSE IF ]
                      [IT IS NOT THERE FOR RXMANNER SLOT].
  $WARN-MESS1 = DO $WARNING-SIG [T-MOD];
       WRITE ON DIAG '* Only first ';
       WRITE ON DIAG 'subclass formatted ';
       WRITE ON DIAG 'for homonyms.';
       WRITE ON DIAG END OF LINE;
       AT X-CORE WRITE ON DIAG NODE NAME;
       WRITE ON DIAG ' = ';
       AT X-CORE WRITE ON DIAG WORDS SUBSUMED;
       WRITE ON DIAG ' = ';
       AT X-INTERSECTION WRITE ON DIAG LIST ELEMENT;
       WRITE ON DIAG END OF LINE.
  $FIND-FORMAT =
       X-SIGNAL:= NIL;
       AT X-PRE, ASCEND TO ASSERTION OR PARSE-CONN OR FRAGMENT
                        OR INTRODUCER PASSING THROUGH STRING;
       STORE IN X-ASSERT;
       IF PRESENT-ELEMENT- IS INTRODUCER
       THEN BOTH DO R(CENTER) [GET FIRST CENTER]
           @AND AT VALUE ITERATET GO RIGHT
                         UNTIL TEST FOR ASSERTION OR FRAGMENT
                         SUCCEEDS [go to first ASSERTION/FRAGMENT]
                              WHERE STORE IN X-ASSERT;
       AT X-ASSERT DO R(FORMAT-TYPES);
       STORE IN X-FORMAT.                                      (GLOBAL)
  $NO-SUBCLASS =
       X-S IS NIL.
  $SUBCLASS-CHK = EITHER $NO-SUBCLASS OR $FIND-SLOT.
  $SYNTAX-CHK =
       AT X-PRE, IF $SYNTAX-TEST
                 THEN ONE OF $IN-VERB, $IN-FRMT5-SUBJ, $IN-FRMT00,
                             $IN-FRMT6-OBJ, $TRUE.
  $TRUE = TRUE.
  $SYNTAX-TEST =
       DO $NOT-EMPTY;
       NOT [IF] $IS-FORMATED [THEN X-CORE IS OCCURRING IN VERB];
       X-PUTIN:=X-PRE.
  $NOT-EMPTY = PRESENT-ELEMENT- IS NOT EMPTY.
  $IN-VERB =
        [* Except for FORMAT1-3, also fill VERB in other formats *]
      AT X-CORE ASCEND TO VERB NOT PASSING THROUGH ADJSET1;
      IF EITHER NOT $IS-FORMATED
         OR X-FORMAT IS NOT [FORMAT1 OR] FORMAT1-3 [OR FORMAT13-MED]
      THEN DO $FILL-VERB.
  $FILL-VERB =
      X-SIGNAL := NIL;
      AT X-FORMAT DO PUTIN-SLOT(VERB);
      IF X-FORMAT IS FORMAT00
      THEN $SENTOP-CHK.
  $IN-FRMT5-SUBJ =
       X-CORE IS OCCURRING IN SUBJECT;
       X-FORMAT IS FORMAT5 OR FORMAT5-EKG OR FORMAT5-MISC OR FORMAT1-3
                OR FORMAT13-MED OR FORMAT5F;
       DO $IS-SUBJ-OTHER.
  $IS-SUBJ-OTHER =
       EITHER X-S HAS MEMBER H-INST
       OR X-S IS NIL;
       X-CORE IS N OR PRO;
       BOTH X-SIGNAL := NIL
       AND AT X-FORMAT DO PUTIN-SLOT(SUBJECT).
  $IN-FRMT00 =
       X-FORMAT IS FORMAT00;
       IF X-CORE IS OCCURRING IN SUBJECT
       THEN $PUTIN-SUBJ
       ELSE IF X-CORE IS OCCURRING IN OBJECT
            THEN $PUTIN-OBJ;
       DO $SENTOP-CHK.
  $IN-FRMT6-OBJ =
        X-FORMAT IS FORMAT6;
        IF X-CORE IS OCCURRING IN OBJECT THEN $PUTIN-OBJ.
  $SENTOP-CHK =
       IF X-S HAS MEMBER OPERATOR-LIST
       THEN AT X-FORMAT DO PUTIN-SLOT(SENT-OP).
  $PUTIN-SUBJ = AT X-FORMAT DO PUTIN-SLOT(SUBJECT).
  $PUTIN-OBJ = AT X-FORMAT DO PUTIN-SLOT(OBJECT).
  $IS-LQR-LQNR = X-PRE IS LQNR.
* T-COMP-ATT
T-COMP-ATT = IN LXR, DSTG, NNN:
       IF ONE OF $HAS-SEM-CORE, $HAS-N-TO-RN-ATT,
                 $HAS-N-TO-LN-ATT
      @THEN ONE OF $IS-FORMATED,
                   $HAS-FAIL-SEL, $HAS-ADJUNCT-ATT,
                   $CANNOT-BE-FRMTD, $ASSIGN-AND-TRANS.
  $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
  $CANNOT-BE-FRMTD =
       PRESENT-ELEMENT- HAS NODE ATTRIBUTE TRANSFORM-ATT.
  $ASSIGN-AND-TRANS =
       BOTH ASSIGN NODE ATTRIBUTE TRANSFORM-ATT
       AND TRANSFORM PRESENT-ELEMENT-.
  $HAS-SEM-CORE =
       CORE- X-CORE OF PRESENT-ELEMENT- HAS NODE ATTRIBUTE SEM-CORE
           WHERE BOTH PRESENT-ELEMENT- IS NOT EMPTY
                 AND EITHER PRESENT-ELEMENT- IS OCCURRING IN DSTG
                            OR NNN,
                     OR PRESENT-ELEMENT- IS OCCURRING IN LXR;
       IF $IS-NEG-MODAL
       THEN BOTH AT X-CORE, ERASE NODE ATTRIBUTE COMPUTED-ATT
            AND FALSE
       ELSE IF AT X-CORE, NOT $UNFORMATTABLE
            THEN BOTH AT X-CORE, ERASE NODE ATTRIBUTE SEM-CORE
                 AND FALSE.
  $HAS-N-TO-RN-ATT =
         [* NTN 04/12/89                              *]
         [* CONDITIONS FOR USE OF COMPUTED ATTRIBUTE: *]
         [* ONLY IF BOTH NODES BELONG TO MAJOR FORMAT *]
         [* SUBLANGUAGE CLASS.                        *]
       BOTH X-CORE HAS NODE ATTRIBUTE N-TO-RN-ATT X-ATT
       AND IF NOT $UNFORMATTABLE
           THEN BOTH AT X-CORE ERASE NODE ATTRIBUTE N-TO-RN-ATT
                AND FALSE.
  $HAS-N-TO-LN-ATT =
       BOTH X-CORE HAS NODE ATTRIBUTE N-TO-LN-ATT X-ATT
       AND IF NOT $UNFORMATTABLE
           THEN BOTH AT X-CORE ERASE NODE ATTRIBUTE N-TO-LN-ATT
                AND FALSE.
  $UNFORMATTABLE =
       IF BOTH X-CORE HAS NODE ATTRIBUTE COMPUTED-ATT X-COMP-ATT
          AND X-COMP-ATT DOES NOT HAVE MEMBER
              H-TMDUR OR H-TMLOC OR H-TMREP OR H-TMPREP
       THEN BOTH X-CORE HAS NODE ATTRIBUTE SELECT-ATT X-NEWLIST
                 WHERE DO $IS-MINOR-CLASS
            AND CORE-SELATT X-NEWLIST OF CORE- OF X-ATT EXISTS
                WHERE DO $IS-MINOR-CLASS.
  $IS-MINOR-CLASS =                                           [GLOBAL]
       BOTH X-MAJOR-ATTS := LIST MAJOR-FMT-CLASS
       AND INTERSECT OF X-MAJOR-ATTS IS NIL.
  $IS-NEG-MODAL =                                             [GLOBAL]
       BOTH X-CORE HAS NODE ATTRIBUTE COMPUTED-ATT
       AND BOTH X-CORE HAS NODE ATTRIBUTE SELECT-ATT
          @AND PRESENT-ELEMENT- HAS MEMBER H-NEG OR H-MODAL.
* T-PTPART
T-PTPART = IN LXR, DSTG, NNN:
      IF BOTH $NOT-FORMATED [T-FORMAT-SLOT]
         AND CORE-ATT [CORE-SELATT] X-S OF CORE- X-CORE OF
             PRESENT-ELEMENT- X-PRE HAS MEMBER
             H-PTPART OR H-PTAREA OR H-PTLOC OR H-PTSPEC
      THEN ALL OF $FIND-FORMAT [T-BUILD-FORMAT], $PLACE-BP.
  $PLACE-BP =
       BOTH ONE OF $COMP-ATT, $GET-HOST, $IN-PN,
                   $IN-INTRO, $IN-SUBJ, $IN-OBJ, $IN-VERBAL
       @AND $FRMT-CHK.
  $COMP-ATT = X-CORE HAS NODE ATTRIBUTE SEM-CORE
              [from COMPUTED-ATT construction].
  $GET-HOST = HOST- OF X-PRE EXISTS.
  $IN-PN = X-PRE IS OCCURRING IN PN;
        EITHER HOST- EXISTS
        OR EITHER $IN-NPN OR $IN-OBJ [SUBJECT or VERB is HOST].
  $IN-NPN =
        BOTH PRESENT-ELEMENT- IS OCCURRING IN NPN OR PNN X-NPN
        AND EITHER COELEMENT NSTGO EXISTS WHERE CORE- IS NOT NHUMAN
                   OR H-PT
            OR AT X-NPN DO $IN-OBJ.
  $IN-INTRO =
        X-PRE IS OCCURRING IN INTRODUCER
              WHERE AT VALUE OF COELEMENT- CENTER
                    ITERATET GO RIGHT
                    UNTIL TEST FOR ASSERTION OR FRAGMENT SUCCEEDS;
        EITHER $IN-FRAG OR $IN-ASSRT.
  $IN-FRAG = PRESENT-ELEMENT- IS FRAGMENT WHERE CORE- EXISTS.
  $IN-ASSRT = PRESENT-ELEMENT- IS ASSERTION;
       EITHER CORE-SELATT OF CORE X-CORE OF SUBJECT HAS MEMBER
            H-PTPART OR H-PTAREA OR H-PTLOC OR H-PTSPEC,
       OR $CHK-OBJ;
       X-CORE EXISTS.
  $CHK-OBJ = EITHER X-CORE IS NULL
             OR X-CORE IS 'IT' OR 'IL';
       DO $IN-SUBJ.
  $IN-SUBJ = PRESENT-ELEMENT- IS OCCURRING IN SUBJECT;
         EITHER $HOST-IS-OBJ OR $HOST-IS-VERB.
  $HOST-IS-OBJ = COELEMENT- OBJECT EXISTS;
       PRESENT-ELEMENT- IS NOT EMPTY;
       EITHER DESCEND TO LAR OR LNR, [ TEMP - XF?]
       OR TRUE;
       CORE- X-CORE EXISTS;
       IF PRESENT-ELEMENT- IS PN
      @THEN CORE- X-CORE OF LNR OF NSTG OF NSTGO EXISTS;
       PRESENT-ELEMENT- IS NOT EMPTY;
       IF CORE-SELATT EXISTS
      @THEN PRESENT-ELEMENT- DOES NOT HAVE MEMBER H-PT;
       X-CORE EXISTS.
  $IN-OBJ =
       PRESENT-ELEMENT- IS OCCURRING IN OBJECT
           WHERE EITHER $HOST-IS-SUBJ
                 OR CORE- OF COELEMENT VERBAL IS NOT EMPTY.
  $IN-VERBAL =
       PRESENT-ELEMENT- IS VERB
           WHERE DO $HOST-IS-SUBJ.
  $HOST-IS-SUBJ =
       CORE- OF COELEMENT SUBJECT IS NOT EMPTY;
       IF EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE N-TO-RN-ATT
          OR PRESENT-ELEMENT- HAS NODE ATTRIBUTE N-TO-LN-ATT
      @THEN CORE- EXISTS [IF SUBJ IS 'INCREASE IN PAIN',]
                         [HOST IS 'PAIN' AND NOT 'INCREASE'].
  $HOST-IS-VERB = CORE- X-CORE OF COELEMENT VERB EXISTS.
  $FRMT-CHK =
       EITHER $IMM-LXR OR TRUE;
       IF $IS-FORMATED
      @THEN ONE OF $IN-LADJSET, $IN-FORMAT-EKG, $FIND-SLOT-FOR-BP
       ELSE IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE TRANSFORM-ATT
               [* HOST could not be transformed *]
            THEN NOT TRUE
            ELSE $ASSIGN-TRANS-ATT.
  $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT X-PTFRMT.
  $IN-LADJSET =
        [* If host has been formatted at PTPART *]
        [* then do not format this node --      *]
        [* THE EFFECT is that this node will be *]
        [* formatted as left adjunct of host    *]
        [* thus PRESERVING THE INPUT TEXT ORDER.*]
      BOTH IMMEDIATE-NODE- X-TEMP OF X-PTFRMT IS PTPART
      AND AT X-PRE, ASCEND TO LADJSET.
  $IMM-LXR = EITHER IMMEDIATE LXR EXISTS
             OR PRESENT-ELEMENT- IS OCCURRING IN DSTG OR NNN.
  $ASSIGN-TRANS-ATT =
       BOTH ASSIGN NODE ATTRIBUTE TRANSFORM-ATT
       AND BOTH TRANSFORM X-PRE
           AND TRANSFORM PRESENT-ELEMENT-
               [* wait until HOST is transformed *].
  $IN-FORMAT-EKG = [* new FORMAT5-EKG *]
       BOTH X-FORMAT IS FORMAT5-EKG
       AND IMMEDIATE-NODE X-TEMP OF X-PTFRMT EXISTS;
        [* about 2mm of inferior ST segment depression *]
       PRESENT-ELEMENT- IS INTERVAL OR DIAG OR INDIC OR
                           NORMAL OR IN-LEADS;
       DO $BUILD-BP-MOD;
       X-SIGNAL:=NIL;
       DO $PUTIN-BP-SLOT.
  $FIND-SLOT-FOR-BP =
       IMMEDIATE-NODE- X-TEMP EXISTS;
       ONE OF $MED-INST-BP, $STAT-RESP, $BP-BP, $OTHER-BP;
       X-SIGNAL:=NIL;
       DO $PUTIN-BP-SLOT.
  $PUTIN-BP-SLOT = X-PUTIN:= X-PRE;
       AT X-MOD-SLOT DO PUTIN-SLOT(PTPART).
  $MED-INST-BP =
       PRESENT-ELEMENT- IS MED OR INST OR PROCEDURE;
       DO $MODIFIER-BP.
  $BP-BP = PRESENT-ELEMENT- IS PTPART;
       DO $MODIFIER-BP.
  $STAT-RESP = PRESENT-ELEMENT- IS STATUS [OR RESPONSE];
      AT X-FORMAT DO FIND-SLOT(PSTATE-SUBJ);
      DO $PSTATE-SUBJ-BP.
  $PSTATE-SUBJ-BP = PRESENT-ELEMENT- IS PSTATE-SUBJ;
       IF DO FILLED-SLOT(PSTATE-SUBJ)
      @THEN AT IMMEDIATE-NODE- DO $MOD-OF-BP
       ELSE DO FIND-SLOT(PTPART) WHERE STORE IN X-MOD-SLOT.
  $OTHER-BP = IMMEDIATE-NODE- OF X-TEMP EXISTS;
       ONE OF $PSTATE-BP, $BP-MOD-BP, $PSTATE-SUBJ-BP, $TEST-INFO-BP,
              $IN-PSTATE-SUBJ, $ERR-BP.
  $PSTATE-BP = PRESENT-ELEMENT- IS PSTATE-DATA [OR EXAM-FUNC];
      AT X-FORMAT DO FIND-SLOT(PSTATE-SUBJ);
      DO $PSTATE-SUBJ-BP.
  $IN-PSTATE-SUBJ =
       IF AT X-FORMAT EITHER DO FILLED-SLOT(PSTATE-DATA)
                      OR DO FILLED-SLOT(PSTATE-SUBJ)
       THEN AT X-FORMAT BOTH DO FIND-SLOT(PSTATE-SUBJ)
                       @AND $PSTATE-SUBJ-BP.
  $TEST-INFO-BP = PRESENT-ELEMENT- IS TEST-INFO OR RESULT;
       AT X-FORMAT DO FIND-SLOT(PTPART) WHERE STORE IN
          X-MOD-SLOT.
  $ERR-BP = NOT TRUE.
  $MODIFIER-BP =
       IF PRESENT-ELEMENT- IS PTPART
       THEN IF VALUE IS NON-EMPTY [SLOT IS FILLED]
            THEN $MOD-OF-BP
            ELSE STORE IN X-MOD-SLOT [PUT IN EMPTY PTPART]
       ELSE $MOD-OF-BP.
  $MOD-OF-BP = EITHER DO R(BP-MOD) WHERE DO $LOWEST-BP-NEST
               OR $BUILD-BP-MOD [GLOBAL IN T-BUILD-FORMAT].
  $BP-MOD-BP = PRESENT-ELEMENT- IS BP-MOD;
               ONE OF $BP-OF-LN, $BP-OF-RN, $BP-OF-OTHER.
  $BP-OF-LN = BOTH X-PRE IS OCCURRING IN LN
              AND AT VALUE [OF BP-MOD] DO $BUILD-BP-MOD.
  $BP-OF-RN = BOTH AT X-PRE ASCEND TO RN PASSING THROUGH PN
              AND $LOWEST-BP-NEST.
  $LOWEST-BP-NEST =
       EITHER ITERATE DESCEND TO BP-MOD
       OR TRUE;
       AT VALUE [of lowest BP-MOD in nest] DO $BUILD-BP-MOD.
  $BP-OF-OTHER = DO $LOWEST-BP-NEST.
* T-NEG
*     puts preverbal NEG into modifier list of the VERB.
*  -- 2/3/97, puts RV:PN:P NEG into modifier list of the VERB
*  -- 10/3/2000, puts RN/RA:PN:P NEG into modifier list of its object
*     E.g. NECK : supple without lymphadenopathy.
T-NEG = IN NEG, PN:
      IF BOTH PRESENT-ELEMENT- X-PRE IS NOT EMPTY
         AND ALL OF $FIND-VERB, $FIND-CORE
      THEN DO $MAKE-HOST-AND-TYPE.
  $FIND-VERB =
      EITHER COELEMENT- VERBAL EXISTS
             WHERE CORE- X-HOST EXISTS
      OR HOST- X-HOST EXISTS [* from RV:PN *].
  $FIND-CORE =
      EITHER CORE- X-CORE OF X-PRE IS NG:H-NEG
      OR BOTH CORE-ATT OF ELEMENT- P X-CORE OF X-PRE
              HAS MEMBER H-NEG
         AND EITHER IMMEDIATE-NODE- IS RV
             OR $NEGATED-OBJ-OF-PN.
  $NEGATED-OBJ-OF-PN =
      IMMEDIATE-NODE- IS RN OR RA;
      ELEMENT- LNR X-HOST OF NSTG OF NSTGO OF X-PRE EXISTS.
  $MAKE-HOST-AND-TYPE =
      X-TYPE := SYMBOL MODS; [* should be done in REG component *]
      AT X-CORE
      BOTH ASSIGN NODE ATTRIBUTE TYPE-ATT WITH VALUE X-TYPE
      AND ASSIGN NODE ATTRIBUTE SEM-CORE WITH VALUE X-HOST.
* T-LONE-PN
*   formats FRAGMENT:PN where P is H-NEG or H-MODAL.
*   This preposition phrase does not have a host.
* -- 12/31/2000
T-LONE-PN = IN PN:
      IF ALL OF $LONE-PN, $FIND-FORMAT
      THEN DO $MAIN-MODIFIERS.
  $LONE-PN =
      BOTH IMMEDIATE-NODE- OF PRESENT-ELEMENT- X-PRE IS FRAGMENT
           WHERE IMMEDIATE CENTER EXISTS
      AND CORE- X-PUTIN IS P;
      CORE-ATT OF X-PUTIN HAS MEMBER H-NEG OR H-MODAL;
      X-PUTIN DOES NOT HAVE NODE ATTRIBUTE FORMAT-PT.
  $MAIN-MODIFIERS =
      ELEMENT- VERB X-SLOT OF X-FORMAT EXISTS;
      AFTER X-SLOT INSERT <NEG>+<MODAL>;
      EITHER BOTH CORE-ATT OF X-PUTIN HAS MEMBER H-NEG
             AND DO PUTIN-SLOT(NEG)
      OR BOTH CORE-ATT OF X-PUTIN HAS MEMBER H-MODAL
         AND DO PUTIN-SLOT(MODAL).
* T-NEG-PREP
*   formats NEG preposition of VERB.
* -- 11/30/1998 add VBE+OBJECT:PN
T-NEG-PREP = IN PN:
      IF BOTH [ONE OF] $PN-IN-RV [, $PN-IN-OBJBE]
         AND $FIND-FORMAT
      THEN DO $MAIN-NEG.
  $PN-IN-RV =
      BOTH IMMEDIATE-NODE- OF PRESENT-ELEMENT- X-PRE IS RV
      AND CORE- X-PUTIN IS P;
      X-PUTIN HAS NODE ATTRIBUTE SEM-CORE;
      X-PUTIN HAS NODE ATTRIBUTE TYPE-ATT;
      CORE-ATT OF X-PUTIN HAS MEMBER H-NEG;
      X-PUTIN DOES NOT HAVE NODE ATTRIBUTE FORMAT-PT.
  $PN-IN-OBJBE =
      BOTH IMMEDIATE-NODE- OF PRESENT-ELEMENT- X-PRE IS OBJBE
           WHERE BOTH IMMEDIATE OBJECT EXISTS
                @AND CORE- X-VCORE OF COELEMENT- VERB IS VBE
      AND CORE- X-PUTIN IS P;
      EITHER X-PUTIN HAS NODE ATTRIBUTE SEM-CORE
      OR AT X-PUTIN, ASSIGN NODE ATTRIBUTE SEM-CORE WITH VALUE X-VCORE;
      EITHER X-PUTIN HAS NODE ATTRIBUTE TYPE-ATT
      OR BOTH X-TYPE := SYMBOL MODS
         AND AT X-PUTIN, ASSIGN NODE ATTRIBUTE TYPE-ATT WITH
                VALUE X-TYPE;
      CORE-ATT OF X-PUTIN HAS MEMBER H-NEG;
      X-PUTIN DOES NOT HAVE NODE ATTRIBUTE FORMAT-PT.
  $MAIN-NEG =
      ELEMENT- VERB X-SLOT OF X-FORMAT EXISTS;
      DO $CONSTRUCT-MODS;
      DO $SET-POINTERS [in PUTIN-SLOT].
  $CONSTRUCT-MODS =
      IF COELEMENT- MODS X-NOHOST-MOD OF X-SLOT EXISTS
      THEN TRUE
      ELSE AFTER X-SLOT
           INSERT <MODS> X-NOHOST-MOD (<NEG>+<MODAL>);
      IF AT ELEMENT- NEG X-NEG-MOD OF X-NOHOST-MOD
         DESCEND TO NON-EMPTY
      THEN AFTER LAST-ELEMENT- OF X-NEG-MOD
                INSERT <NON-EMPTY> X-FRMT-SLOT
      ELSE REPLACE X-NEG-MOD BY <NEG> (<NON-EMPTY> X-FRMT-SLOT).
* T-MOD
T-MOD = IN LXR, VERB, NEG, DSTG, NNN, LAUX:
      VERIFY BOTH $SET-PARSE-REG [T-FORMAT-SLOT]
             AND $COMPLEX-NPOS;
      ONE OF $INFO-SOURCE-PHRASE, $EXCEPTION, $IS-ASP.
  $COMPLEX-NPOS =
      IF X-PRE IS NNN
         WHERE BOTH IMMEDIATE-NODE IS NPOS
               AND LAST-ELEMENT- IS LAR X-LAR
      THEN AT X-LAR,
           BOTH CORE-ATT X-S OF CORE- X-CORE OF X-LAR EXISTS
           AND STORE IN X-PRE.
  $INFO-SOURCE-PHRASE =
      AT X-PRE, ASCEND TO ASSERTION OR PARSE-CONN OR FRAGMENT
                OR INTRODUCER PASSING THROUGH STRING;
      PRESENT-ELEMENT- HAS NODE ATTRIBUTE PHRASE-ATT
         WHERE PRESENT-ELEMENT- HAS MEMBER SOURCE-PHRASE.
  $MOD-NOT-FRMTD =
      NOT ITERATE $IS-FORMATED
          UNTIL EITHER $IN-MODIFIER
                OR $IN-VERB SUCCEEDS.
  $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
  $IN-VERB = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FILLED-PT
                 WHERE PRESENT-ELEMENT- IS OF TYPE VERBAL.
  $EXCEPTION =
      ONE OF [$NO-SUBCLASS,] [T-FORMAT-SLOT]
             $IS-LQR-LQNR [T-FORMAT-SLOT],
             $IS-LCONNR,
             $IS-ZERO-NO,
             $IS-QUANT,
             $IS-TIME-PN,
             $IS-TM-COMP-ATT [* GRI *],
             $HAS-FAIL-SEL [T-FORMAT-SLOT],
             $HAS-ADJUNCT-ATT [T-FORMAT-SLOT],
             $CORE-FAIL-SEL [T-FORMAT-SLOT],
             $CORE-ADJUNCT-ATT [T-FORMAT-SLOT].
  $IS-TIME-PN =
      AT X-PRE, ASCEND TO PN
      WHERE ALL OF [$IS-TIME-CORE,] $IS-TIME-PHRASE, $IS-FORMATED.
  $IS-TIME-PHRASE =
      EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE PHRASE-ATT
             WHERE PRESENT-ELEMENT- HAS MEMBER TIME-PHRASE
      OR PRESENT-ELEMENT- HAS NODE ATTRIBUTE ADVERBIAL-TYPE
         WHERE PRESENT-ELEMENT- HAS MEMBER TIME-ADVERBIAL.
  $IS-TM-COMP-ATT =
        [* clear COMPUTED-ATT H-INDIC or H-DIAG *]
        [* of a node with SELECT-ATT H-TMDUR    *]
      BOTH BOTH X-CORE HAS NODE ATTRIBUTE SELECT-ATT
           @AND PRESENT-ELEMENT- HAS MEMBER H-TMDUR
      AND BOTH BOTH X-CORE HAS NODE ATTRIBUTE COMPUTED-ATT
               @AND PRESENT-ELEMENT- HAS MEMBER H-INDIC OR H-DIAG
          AND AT X-CORE,
              BOTH ERASE NODE ATTRIBUTE COMPUTED-ATT
              AND IF PRESENT-ELEMENT HAS NODE ATTRIBUTE SEM-CORE
                  THEN ERASE NODE ATTRIBUTE SEM-CORE.
  $IS-QUANT =
      BOTH X-PRE IS LNR OR LQR OR LAR OR LAR1
                    WHERE DO $IS-FORMATED
     @AND IMMEDIATE QUANT EXISTS [* in QUANT not Q modifier *].
  $IS-ZERO-NO =
      X-PRE IS LTR
      WHERE EITHER X-CORE IS T:H-NEG [aucun, aucune, no, non, etc]
            OR AT COELEMENT- LT OF X-CORE [pas de]
               BOTH CORE- IS D:H-NEG
               AND CORE-SELATT X-S OF CORE- X-CORE EXISTS;
      AT X-PRE DO $IS-FORMATED;
      VALUE IS LQR WHERE CORE- IS '[0]'.
  $IS-ASP =
      EITHER $TIME-QUALS-VERB
      OR BOTH $MODIFIER-CHK AND $COEL-N-OF-CORE.
  $TIME-QUALS-VERB =
      [* TIME-QUALS verb H-TMBEG and H-TMEND has no host *]
      BOTH CORE- X-CORE OF X-PRE IS TV OR V OR VEN OR VING
           WHERE CORE-SELATT X-S HAS MEMBER H-TMBEG OR H-TMEND
      AND EITHER $IS-FORMATED
          OR ALL OF $FIND-FORMAT, $PUTIN-TIME-QUALS.
  $PUTIN-TIME-QUALS =
      [* since this type of verb is not a TIME-ASP *]
      [* by nature, it should be put in TIME-QUALS *]
      X-PUTIN := X-PRE;
      DO PUTIN-SLOT(TIME-QUALS).
  $COEL-N-OF-CORE =
      AT X-CORE ITERATET $MORE-MODIFIER UNTIL GO RIGHT FAILS.
  $MORE-MODIFIER =
      IF EITHER PRESENT-ELEMENT- X-PRE IS N OR GRAM-NODE
                WHERE CORE-SELATT X-S OF PRESENT-ELEMENT- X-CORE HAS
                      MEMBER H-TMREP OR H-TMLOC OR H-TMDUR [* 960530 *]
                      OR H-NEG OR H-MODAL OR H-VTENSE OR QNUMBER
         OR PRESENT-ELEMENT- X-PRE IS TV OR V OR VEN OR VING
            WHERE BOTH IMMEDIATE-NODE IS LAUX
                  AND CORE-SELATT X-S OF PRESENT-ELEMENT- X-CORE
                      HAS MEMBER H-NEG OR [H-TMREP OR] H-MODAL OR
                                 H-VTENSE OR QNUMBER
      THEN AT X-PRE VERIFY $MODIFIER-CHK.
  $IN-MODIFIER = ASCEND TO MODIFIERS.
  $MODIFIER-CHK =
      IF BOTH $IS-MODIFIER AND $MOD-NOT-FRMTD
      THEN ALL OF $FIND-FORMAT, $BUILD-SLOTS.
  $IS-MODIFIER =
      X-TYPE-SLOT:= LIST MODIFIER-LIST;
      ITERATET SUCCESSORS X-TYPE-SLOT OF X-TYPE-SLOT IS NOT NIL
      UNTIL $IDENTIFY-MODIFIER SUCCEEDS.
  $IDENTIFY-MODIFIER =
      X-NEWLIST:= ATTRIBUTE-LIST
        [LIST OF SUBCLASSES AND THEIR CORRESPONDING FORMAT SLOTS];
      INTERSECT OF X-S IS NOT NIL;
      X-TYPE:= NIL;
      X-HEAD := HEAD OF X-TYPE-SLOT;
      PREFIX X-HEAD TO X-TYPE; [set up list consisting of TYPE only]
      X-SAVE-ASPLIST:= X-INTERSECTION;
      X-ASP-LIST:= X-INTERSECTION.
  $BUILD-SLOTS =
      AT X-PRE IF DO $FIND-HOST-SLOT [Global]
                    [* Find slot in FORMAT for semantic host *]
                  WHERE X-HOST-SLOT:= X-SLOT [* Save host slot *]
               THEN ITERATE $BUILD-MODIFIER
                    UNTIL SUCCESSORS X-ASP-LIST OF X-ASP-LIST
                          IS NIL SUCCEEDS
               ELSE EITHER $HOSTLESS-NEG-MODAL
                    OR TRUE;
       DO $NEXT-SLOT.
  $HOSTLESS-NEG-MODAL =
       BOTH X-S HAS MEMBER H-MODAL OR H-NEG
       AND ELEMENT- VERB X-SLOT OF X-FORMAT EXISTS;
       DO $CONSTRUCT-MODS;
       X-PUTIN := X-PRE [X-CORE];
       DO $SET-POINTERS [in PUTIN-SLOT].
  $CONSTRUCT-MODS =
       IF COELEMENT- MODS X-NOHOST-MOD OF X-SLOT EXISTS
       THEN TRUE
       ELSE AFTER X-SLOT
            INSERT <MODS> X-NOHOST-MOD (<NEG>+<MODAL>);
       IF X-S HAS MEMBER H-MODAL
       THEN IF AT ELEMENT- MODAL X-MODAL-MOD OF X-NOHOST-MOD
               DESCEND TO NON-EMPTY
            THEN AFTER LAST-ELEMENT- OF X-MODAL-MOD
                 INSERT <NON-EMPTY> X-FRMT-SLOT
            ELSE REPLACE X-MODAL-MOD
                 BY <MODAL> (<NON-EMPTY> X-FRMT-SLOT)
       ELSE IF AT ELEMENT- NEG X-NEG-MOD OF X-NOHOST-MOD
               DESCEND TO NON-EMPTY
            THEN AFTER LAST-ELEMENT- OF X-NEG-MOD
                 INSERT <NON-EMPTY> X-FRMT-SLOT
            ELSE REPLACE X-NEG-MOD BY <NEG> (<NON-EMPTY> X-FRMT-SLOT).
  $NEXT-SLOT =
       ITERATET $BUILD-MODFRS
       UNTIL $NEXT-SLOT-FOR-HOST FAILS.
  $BUILD-MODFRS =
       X-ASP-LIST:= X-SAVE-ASPLIST;
       ITERATE $BUILD-MODIFIER
       UNTIL SUCCESSORS X-ASP-LIST OF X-ASP-LIST IS NIL SUCCEEDS.
  $NEXT-SLOT-FOR-HOST =
       X-NEXT-SLOT IS NOT NIL;
        [* Pre-empt the looping non-empty *]
       X-NEXT-SLOT IS NOT NON-EMPTY;
       AT X-NEXT-SLOT DO $IS-FORMATED;
       DO $HOST-OF-SLOT.                              [GLOBAL]
  $HOST-OF-SLOT =
       STORE IN X-NEXT-SLOT;
       IMMEDIATE-NODE- X-SLOT EXISTS [use node above NON-EMPTY];
       X-HOST-SLOT := X-SLOT.
  $FIND-HOST-SLOT =                                   [GLOBAL]
       BOTH VERIFY X-NEXT-SLOT := NIL
       AND IF $FIND-SEM-CORE
          @THEN $FIND-SLOT
           ELSE BOTH $ERR-MESS3 AND FALSE.
  $FIND-SEM-CORE =
       EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE SEM-CORE
              [* Go to semantic host of the modifier *]
       OR EITHER CORE- HAS NODE ATTRIBUTE SEM-CORE
          OR EITHER PRESENT-ELEMENT- IS OCCURRING IN PN
                    WHERE PRESENT-ELEMENT- HAS NODE ATTRIBUTE SEM-CORE
             OR EITHER PRESENT-ELEMENT- IS LAUX
                       WHERE CORE- OF IMMEDIATE-NODE EXISTS
                OR EITHER BOTH IMMEDIATE-NODE- OF X-CORE IS LT
                          AND HOST- OF X-PRE EXISTS [pas de]
                   OR PRESENT-ELEMENT- IS QN-TIME OR PQUANT
                      WHERE HOST- EXISTS;
       STORE IN X-SEM-CORE.
  $FIND-SLOT = EITHER $SLOT-FOR-RESULT OR $GET-SLOT.
  $SLOT-FOR-RESULT =
        [* If H-RESULT put ASPECTUAL as MODIFIER of PSTATE-DATA *]
        [* If PSTATE-DATA is NON-EMPTY; otherwise put on VERB   *]
       CORE-ATT HAS MEMBER H-RESULT OR H-INDIC;
       AT X-FORMAT DO FIND-SLOT(PSTATE-DATA);
       IF DO FILLED-SLOT(PSTATE-DATA) WHERE STORE IN X-NEXT-SLOT
       @ THEN IMMEDIATE-NODE EXISTS
       ELSE DO FIND-SLOT(VERB);
       STORE IN X-SLOT.
  $GET-SLOT =
       EITHER IMMEDIATE LXR X-HOST-LXR EXISTS
       OR EITHER PRESENT-ELEMENT- IS OCCURRING IN DSTG OR NNN
          OR TRUE;
       IF $IS-FORMATED
      @THEN $HOST-OF-SLOT
       ELSE IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE TRANSFORM-ATT
              [* HOST was transformed but could not be formatted *]
            THEN BOTH $ERR-MESS4 [Use V-TEST for HOST, write message]
                 AND FALSE
            ELSE EITHER $IS-IN-LCONNR
                 OR ALL OF $ASSIGN-TRANS, $T-HOST-XPRE, $NOT-TRUE.
  $IS-IN-LCONNR =
         [* If it is in LCONNR, slot CONN of *]
         [* CONNECTIVE is the slot for HOST. *]
       EITHER PRESENT-ELEMENT- IS LCONNR
       OR PRESENT-ELEMENT- IS OCCURRING IN LCONNR;
       DO FIND-SLOT(CONN);
       STORE IN X-SLOT.
  $ASSIGN-TRANS = ASSIGN NODE ATTRIBUTE TRANSFORM-ATT.
  $T-HOST-XPRE = BOTH TRANSFORM X-PRE
                 AND TRANSFORM PRESENT-ELEMENT-.
  $NOT-TRUE = NOT TRUE [WAIT UNTIL HOST IS TRANSFORMED].
  $CHK-HOST-IS-OK =
       IF X-PRE IS 'NEG-MEAN'
       THEN X-HOST-SLOT IS CHANGE
       ELSE EITHER X-TYPE IS TENSE OR QUANTITY OR Y-OF,
            OR $CHECK-HOST.
  $CHECK-HOST =
       X-NEWLIST:= LIST HOST-OF-MODIFIERS;
       X-NEWLIST HAS MEMBER X-TYPE
           [* Find type of MODIFIER on list HOST-OF-MODIFIERS *];
       X-HOST-LIST:= ATTRIBUTE-LIST
           [* Its ATTRIBUTE-LIST is a list of *]
           [* allowable hosts for this type of modifier];
       X-HOST-LIST EXISTS;
       DO $CHECK-HOST-OK.
  $CHECK-HOST-OK =
       AT X-HOST-SLOT
       ONE OF $SLOT-ON-LIST, $ASCEND-TO-SLOT, $IN-MODFR-SLOT,
              $ERR-MESS5 [COULD NOT FIND HOST SLOT- USE V-ZEROED].
  $SLOT-ON-LIST = TEST FOR X-HOST-LIST.
  $ASCEND-TO-SLOT = ASCEND TO X-HOST-LIST.
  $IN-MODFR-SLOT =
       X-HOST-SLOT EXISTS;
       ASCEND TO MODIFIERS;
       ITERATE GO LEFT UNTIL TEST FOR MODIFIERS FAILS
           [go to slot that MODIFIER is on];
       STORE IN X-HOST-SLOT;
       STORE IN X-SLOT;
       DO $CHECK-HOST-OK.
  $BUILD-MODIFIER =
       IF $CHK-HOST-IS-OK
       THEN $BUILD-IT.
  $BUILD-IT =
       X-SLOT:= X-HOST-SLOT [Restore host slot for testing];
       X-ASP-SLOT:= ATTRIBUTE-LIST OF X-ASP-LIST;
       X-SIGNAL:= NIL;
       ONE OF $MOD-SLOT, $TIME-ASP-SLOT, $BP-MOD-SLOT,
              $TENSE-SLOT, $TIME-QUAL-SLOT, $EVENT-TIME-SLOT,
              $QUANTFR-SLOT, $Y-OF-SLOT.
  $MOD-SLOT =
       X-TYPE IS MODS;
       AT X-SLOT IF $MODS-THERE
                 THEN EITHER $NEG-CHK [IS DOUBLE-NEG NEEDED]
                      OR AT X-MOD-SLOT DO $PUTIN-ASP-SLOT [NO NEG]
                 ELSE BOTH $BUILD-MODS [T-BUILD-FORMAT]
                      AND AT X-MOD-SLOT DO $PUTIN-ASP-SLOT.
  $MODS-THERE =
       DO HAS-MODIFIER(MODS);
       STORE IN X-MOD-SLOT.
  $NEG-CHK =
       X-ASP-SLOT IS NEG [IF NEG IS BEING FORMATED AND NEG IS]
                         [ALREADY FILLED THEN CREATE DOUBLE-NEG];
       AT X-MOD-SLOT DO FILLED-SLOT(NEG);
       STORE IN X-TEMP;
       AT X-MOD-SLOT IF DESCEND TO DOUBLE-NEG THEN $ERR-MESS6
                    ELSE $BUILD-DOUBLE.
  $BUILD-DOUBLE =
       AT X-TEMP, REPLACE PRESENT-ELEMENT- BY
          <DOUBLE-NEG> ( X-TEMP
                       + <NEG> X-MOD-SLOT (<NULL>));
       AT X-MOD-SLOT DO $PUTIN-ASP-SLOT.
  $PUTIN-ASP-SLOT =
       VERIFY X-PUTIN:= X-PRE;
       VERIFY X-SIGNAL:= X-PRE;
       VERIFY X-SLOT := X-ASP-SLOT;
       DO PUTIN-SLOT(REGX).
  $FIND-TIME-ASP =
       AT X-SLOT EITHER DO HAS-MODIFIER(TIME-ASP)
                        WHERE STORE IN X-TIME-SLOT
                 OR $BUILD-TIME-ASP [T-BUILD-FORMAT].      (GLOBAL)
  $TIME-ASP-SLOT =
       X-TYPE IS TIME-ASP;
       DO $FIND-TIME-ASP;
       AT X-TIME-SLOT DO $PUTIN-ASP-SLOT.
  $TIME-QUAL-SLOT =
       X-TYPE IS TIME-QUAL;
       DO $FIND-TIME-QUAL;
       AT X-TMQUAL-SLOT DO $PUTIN-ASP-SLOT.
  $FIND-TIME-QUAL =
       AT X-SLOT EITHER DO HAS-MODIFIER(TIME-QUAL)
                      WHERE STORE IN X-TMQUAL-SLOT
                 OR $BUILD-TIME-QUAL [T-BUILD-FORMAT].
  $EVENT-TIME-SLOT =
       X-TYPE IS EVENT-TIME;
       DO $FIND-EVENT-TIME;
       AT X-EVENT-SLOT DO $PUTIN-ASP-SLOT.
  $FIND-EVENT-TIME =
       AT X-SLOT EITHER DO HAS-MODIFIER(EVENT-TIME)
                        WHERE BOTH STORE IN X-EVENT-SLOT
                              AND DO $FIND-ASP-SLOT
                 OR $BUILD-EVENT-TIME [T-BUILD-FORMAT].
  $FIND-ASP-SLOT = [* build EVENT-TIME if cannot find TPREP2 *]
       VERIFY X-PUTIN:= X-PRE;
       VERIFY X-SIGNAL:= X-PRE;
       VERIFY X-SLOT := X-ASP-SLOT;
       DO FIND-SLOT(REGX).
  $BP-MOD-SLOT = NOT TRUE [TO BE ADDED].
  $QUANTFR-SLOT =
       X-TYPE IS QUANTITY;
       AT X-SLOT EITHER DO HAS-MODIFIER(QUANTITY)
                        WHERE STORE IN X-QUANT
                 OR $BUILD-QUANTITY [T-BUILD-FORMAT];
       AT X-QUANT DO $PUTIN-ASP-SLOT.
  $Y-OF-SLOT =
       X-TYPE IS Y-OF;
       X-CORE HAS NODE ATTRIBUTE N-TO-RN-ATT X-HST-SLT;
       X-HST-SLT HAS NODE ATTRIBUTE FORMAT-PT X-Y-SLOT;
       AT X-HST-SLT ERASE NODE ATTRIBUTE FORMAT-PT;
       BOTH AT X-PRE ASSIGN NODE ATTRIBUTE FORMAT-PT
            WITH VALUE X-Y-SLOT
       AND AT X-Y-SLOT ASSIGN NODE ATTRIBUTE FILLED-PT
           WITH VALUE X-PRE.
  $TENSE-SLOT = X-TYPE IS TENSE;
       AT X-SLOT EITHER EITHER BOTH X-PRE IS TENSE
                               AND DO HAS-MODIFIER(TENSE)
                                   WHERE STORE IN X-TIME-SLOT
                        OR DO HAS-MODIFIER(TENSE)
                           WHERE STORE IN X-TIME-SLOT
                 OR $BUILD-TENSE;
       AT X-TIME-SLOT DO $PUTIN-ASP-SLOT.
  $ERR-MESS3 =
        [USE VERB IF THERE IS NO HOST- WRITE WARNING MESS.]
       DO $WARNING-SIG;
       WRITE ON DIAG '* No HOST found for ';
       AT X-PRE DO $WRITE-NODE-INFO;
       WRITE ON DIAG END OF LINE.
  $WRITE-NODE-INFO =
       PRESENT-ELEMENT- X-NODE EXISTS;
       WRITE ON DIAG NODE NAME;
       WRITE ON DIAG ' subsuming - ';
       AT X-NODE WRITE ON DIAG WORDS SUBSUMED;
       WRITE ON DIAG ' - '.
  $ERR-MESS4 = [HOST OF TIME OR MOD COULD NOT BE FORMATED]
       VERIFY $MESS4.
  $MESS4 = DO $WARNING-SIG;
       WRITE ON DIAG '* Could not format ';
       WRITE ON DIAG 'HOST ';
       AT X-SEM-CORE DO $WRITE-NODE-INFO;
       WRITE ON DIAG '. MODIFIER = ';
       AT X-PRE DO $WRITE-NODE-INFO;
       WRITE ON DIAG '. It will not be ';
       WRITE ON DIAG 'formatted.';
       WRITE ON DIAG END OF LINE.
  $PUTIN-VERB =
       WRITE ON DIAG '* Slot VERB ';
       WRITE ON DIAG 'will be used.';
       WRITE ON DIAG END OF LINE;
       DO FIND-SLOT(VERB);
       STORE IN X-SLOT.
  $ERR-MESS5 = [ FORMAT SLOT CAN NOT HAVE TIME OR MODS ON IT]
       VERIFY $MESS5.
  $MESS5 = DO $WARNING-SIG;
       WRITE ON DIAG '* FORMAT SLOT = ';
       AT X-HOST-SLOT WRITE ON DIAG NODE NAME;
       WRITE ON DIAG '. It cannot have a ';
       WRITE ON DIAG 'modifier ';
       AT X-TYPE WRITE ON DIAG LIST ELEMENT;
       WRITE ON DIAG END OF LINE.
  $ERR-MESS6 =  [There is already a double NEG]
       DO $WARNING-SIG;
       WRITE ON DIAG '* There is a double ';
       WRITE ON DIAG 'NEG in MOD slot of ';
       AT X-SLOT WRITE ON DIAG NODE NAME;
       WRITE ON DIAG '. Cannot format ';
       AT X-PRE WRITE ON DIAG NODE NAME;
       WRITE ON DIAG ' = ';
       AT X-PRE WRITE ON DIAG WORDS SUBSUMED.
  $WARNING-SIG =
       WRITE ON DIAG '* <<<< WARNING ';
       WRITE ON DIAG 'CONDITION >>>>';
       WRITE ON DIAG END OF LINE.                                   (GLOBAL)
* ***** *************************************************************
*
*                    SEQUENCING TRANSFORMATIONS
*
* ***** *************************************************************
TSEQ-STRING = IN STRING, CENTER:
     EITHER $EXCEPTION
     OR BOTH IF DO DOWN1(INTRODUCER) WHERE PRESENT-ELEMENT- IS NOT EMPTY
            @THEN TRANSFORM PRESENT-ELEMENT-
        AND DO $TRANSFORM-ELEMENTS.
  $TRANSFORM-ELEMENTS =
       AT VALUE EITHER ITERATE GO RIGHT OR TRUE;
       IF PRESENT-ELEMENT- IS EMPTY
       THEN IF $LEFT-NOT-MTY
           @THEN ITERATE VERIFY $WHAT-TO-DO
                 UNTIL $LEFT-NOT-MTY FAILS
            ELSE TRUE
       ELSE ITERATE VERIFY $WHAT-TO-DO
            UNTIL $LEFT-NOT-MTY FAILS.
  $LEFT-NOT-MTY =
      ITERATE GO LEFT
      UNTIL BOTH PRESENT-ELEMENT- IS NOT INTRODUCER
            AND PRESENT-ELEMENT- IS NOT EMPTY SUCCEEDS.
  $WHAT-TO-DO =
       IF ONE OF $ATOM-TYPE, $IS-TEXTLET
       THEN TRUE
       ELSE IF $VERBAL-TYPE
            THEN BOTH $TRANSFORM-NEG
                 AND TRANSFORM PRESENT-ELEMENT-
            ELSE IF $TRANSFORM-TYPE
                 @THEN TRANSFORM PRESENT-ELEMENT-.
  $TRANSFORM-NEG =
     IF COELEMENT- NEG X-NEG IS NOT EMPTY
     THEN TRANSFORM X-NEG.
  $EXCEPTION =
       ONE OF $IS-EMPTY, $HAS-Q-CONJ, $IS-LN, $FORMATED-CHK,
              $HAS-FAIL-SEL [T-FIXUP-ATOMS],
              $HAS-ADJUNCT-ATT [T-FIXUP-ATOMS],
              $IS-NOFRMT.
  $FORMATED-CHK =
       BOTH $IS-FORMATED AND NOT $TIME-IN-TIME.
  $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
  $TIME-IN-TIME = VERIFY $TIME-TEST;
       AT RIGHT-ADJUNCT OF CORE OF NSTGO DO $TIME-TEST.
  $TIME-TEST = PRESENT-ELEMENT- IS PN;
       EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE ADVERBIAL-TYPE
              WHERE PRESENT-ELEMENT- HAS MEMBER TIME-ADVERBIAL
       OR PRESENT-ELEMENT- HAS NODE ATTRIBUTE PHRASE-ATT
          WHERE PRESENT-ELEMENT- HAS MEMBER TIME-PHRASE.
  $IS-EMPTY = PRESENT-ELEMENT- IS EMPTY.
  $IS-NOFRMT = PRESENT-ELEMENT- IS ASSERTION OR FRAGMENT;
       BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-ATT
       @AND PRESENT-ELEMENT- HAS MEMBER NOFRMT OR FRMT6.
  $HAS-Q-CONJ = PRESENT-ELEMENT- HAS ELEMENT- Q-CONJ.
  $IS-LN = PRESENT-ELEMENT- IS LN [transformed by TSEQ-LXR].
  $TRANSFORM-TYPE =
       ONE OF $STRING-TYPE, $LXR-TYPE, $ADJSET-TYPE,
              $CONJ-TYPE, $OBJ-TYPE, $IS-CENTER, $DESCENT-TYPE.
  $IS-CENTER = PRESENT-ELEMENT- IS CENTER OR PARSE-CONN.
  $IS-TEXTLET =
       PRESENT-ELEMENT- IS TEXTLET;
       ITERATE $TRANS-TEXT
       UNTIL VALUE OF COELEMENT MORESENT OF X-TEMP IS TEXTLET
             FAILS.
  $TRANS-TEXT = AT ONESENT X-TEMP TRANSFORM ELEMENT CENTER.
  $VERBAL-TYPE = PRESENT-ELEMENT- IS OF TYPE VERBAL.
  $ATOM-TYPE = PRESENT-ELEMENT- IS OF TYPE ATOM.
  $STRING-TYPE = PRESENT-ELEMENT- IS OF TYPE STRING.
  $ADJSET-TYPE = PRESENT-ELEMENT- IS OF TYPE ADJSET.
  $LXR-TYPE = EITHER PRESENT-ELEMENT- IS OF TYPE LXR
              OR PRESENT-ELEMENT- IS DSTG.
  $CONJ-TYPE = PRESENT-ELEMENT- HAS ELEMENT- Q-CONJ X1;
       IF COELEMENT SACONJ IS NOT EMPTY
       @THEN TRANSFORM VALUE;
       X1 EXISTS.
  $OBJ-TYPE = PRESENT-ELEMENT- IS OBJECT OR OBJBE OR PASSOBJ
              WHERE PRESENT-ELEMENT- IS NOT EMPTY.
  $DESCENT-TYPE =
       EITHER DESCEND TO QPERUNIT NOT PASSING THROUGH LXR
       OR EITHER DESCEND TO LXR
          OR EITHER DESCEND TO STRING NOT PASSING THROUGH LXR
             OR DESCEND TO DSTG NOT PASSING THROUGH LXR;
       IF PRESENT-ELEMENT- IS OF TYPE STRING
       THEN VERIFY NONE OF $HAS-FAIL-SEL, $HAS-ADJUNCT-ATT
       ELSE VERIFY AT CORE NONE OF $HAS-FAIL-SEL, $HAS-ADJUNCT-ATT.
* TSEQ-OBJ
*    PUTS DESCENT-TYPE LXR, STRING, DSTG OF OBJECT, OBJBE AND
*    PASSOBJ IN TRANSFORM STACK.
TSEQ-OBJ = IN OBJECT, OBJBE, PASSOBJ:
       IF PRESENT-ELEMENT- IS NOT EMPTY
       THEN EITHER PRESENT-ELEMENT- IS OBJBE
                   WHERE PRESENT-ELEMENT- IS OCCURRING IN OBJECT
                   [* been transformed already *]
            OR IF $DESCENT-TYPE [Global in TSEQ-STRING]
              @THEN TRANSFORM PRESENT-ELEMENT-.
* TSEQ-ADJUNCT
*     PUTS STRING, LXR, NNN OF AN ADJSET NODE ON TRANSFORM STACK.
TSEQ-ADJUNCT = IN ADJSET:
       IF PRESENT-ELEMENT- IS NOT EMPTY
       THEN AT LAST-ELEMENT- ITERATE VERIFY $TRANSFORM-ELS
                             UNTIL GO LEFT FAILS.
  $TRANSFORM-ELS =
       IF BOTH $NOT-EMPTY
          AND ONE OF $STRING-TYPE, $NNN-TYPE, $LXR-TYPE,
                     $ADJ-DESCENT-TYPE, $DESCENT-TYPE
      @THEN [AT PRESENT-ELEMENT-]
            BOTH IF EITHER PRESENT-ELEMENT- IS OCCURRING IN ADJADJ
                           WHERE ELEMENT- ADJADJ [LAR] EXISTS
                    OR BOTH PRESENT-ELEMENT- IS OCCURRING IN [NNN OR]
                                  NPOS
                            WHERE ELEMENT- NNN EXISTS
                       AND ELEMENT- LAR EXISTS
                @THEN $TRANSFORM-ELS
            AND BOTH TRANSFORM PRESENT-ELEMENT-
                AND IF PRESENT-ELEMENT- IS LAR
                       WHERE EITHER COELEMENT- LAR EXISTS
                             OR ELEMENT- LAR OF COELEMENT- ADJADJ EXISTS
                   @THEN TRANSFORM PRESENT-ELEMENT-.
  $ADJ-DESCENT-TYPE =
         [* Recursive ADJADJ -> ADJADJ+LAR *]
       BOTH EITHER PRESENT-ELEMENT- IS ADJADJ
            OR PRESENT-ELEMENT- IS APOS
       AND EITHER ELEMENT- LAR OF ELEMENT- ADJADJ EXISTS
           OR DESCEND TO QN PASSING THROUGH ADJADJ.
  $NOT-EMPTY = PRESENT-ELEMENT IS NOT EMPTY.
  $NNN-TYPE = DESCEND TO NNN OR QN-TIME NOT PASSING THROUGH LXR.
* TSEQ-DSTG-NNN
*    PUTS RECURSIVE DSTG OR NNN ON TRANSFORM STACK.
TSEQ-DSTG-NNN = IN DSTG, NNN:
       IF VALUE IS DSTG OR NNN
      @THEN TRANSFORM PRESENT-ELEMENT-.
* TSEQ-LXR
*    PUTS RADJSET, LADJSET, PARENSTG, DASHSTG AND NON-ATOMIC
*    CORE OF AN LXR ON TRANSFORM STACK.
TSEQ-LXR = IN LXR:
       BOTH IF ELEMENT- RADJSET IS NOT EMPTY
           @THEN AT LAST-ELEMENT- ITERATE VERIFY $TRANSFORM-RADJ
                                  UNTIL GO LEFT FAILS
       AND BOTH AT VALUE ITERATE IF TEST FOR PARENSTG OR DASHSTG
                                @THEN TRANSFORM PRESENT-ELEMENT
                         UNTIL GO RIGHT FAILS
           AND BOTH IF CORE- IS NOT OF TYPE ATOM
                   @THEN TRANSFORM PRESENT-ELEMENT-
               AND BOTH IF ELEMENT- LAUX EXISTS
                       @THEN TRANSFORM PRESENT-ELEMENT-
                   AND IF ELEMENT- LADJSET IS NOT EMPTY
                      @THEN TRANSFORM PRESENT-ELEMENT-.
  $TRANSFORM-RADJ =
       IF BOTH NONE OF $IS-EMPTY, $HAS-FAIL-SEL, $HAS-ADJUNCT-ATT
          AND ONE OF $STRING-TYPE, $LXR-TYPE, $DESCENT-TYPE
      @THEN TRANSFORM PRESENT-ELEMENT-
       ELSE IF ALL OF $IS-PN-ADJUNCT, $HAS-ADJUNCT-ATT, $HAS-RADJ
           @THEN DO $HAS-RADJ-PN.
  $IS-PN-ADJUNCT = PRESENT-ELEMENT- IS PN.
  $HAS-RADJ = DESCEND TO LXR.
  $HAS-RADJ-PN =
       IF ELEMENT- RADJSET IS NOT EMPTY
      @THEN AT LAST-ELEMENT- ITERATE VERIFY $TRANSFORM-RADJ
                             UNTIL GO LEFT FAILS.
  $IS-EMPTY = PRESENT-ELEMENT- IS EMPTY.
* TSEQ3A
*     PUTS ALL SA'S AND LCONNR OF PARSE-CONN ON TRANSFORM STACK.
TSEQ3A = IN PARSE-CONN:
       AT VALUE,
       LAST-ELEMENT- [SA] EXISTS;
       IF PRESENT-ELEMENT- IS NOT EMPTY THEN TRANSFORM PRESENT-ELEMENT-;
       GO LEFT; GO LEFT;
       IF PRESENT-ELEMENT- [FIRST SA] IS NOT EMPTY
       THEN TRANSFORM PRESENT-ELEMENT- [FIRST SA];
       GO RIGHT;
       TRANSFORM PRESENT-ELEMENT-[LCONNR].
* T-CLEANUP-PALP
*     DELETES [PALPATE] IF TXRES IS NOT EMPTY.
T-CLEANUP-PALP = IN ASSERTION, FRAGMENT:
     IF FOLLOWING-ELEMENT IS FORMAT5 [OR FORMAT5F OR FORMAT5-MISC]
        WHERE DO $FIND-PALPATE
     THEN IF COELEMENT- NON-EMPTY OF X-PALP EXISTS
          THEN DELETE X-PALP.
  $FIND-PALPATE =
     DO FIND-SLOT(LVR);
     GO UP [TO NON-EMPTY];
     PRESENT-ELEMENT X-PALP IS NON-EMPTY.
* T-SA-CLEANUP
*   moves an unformatted SA or RV to RV of the VERB.
*   e.g. PROTRUDE THE TONGUE OUT COMPLETELY.
T-SA-CLEANUP = IN RV, SA:
    IF PRESENT-ELEMENT- X-PRE IS NOT OCCURRING IN PARSE-CONN
    THEN AT VALUE OF [PRESENT-ELEMENT-] X-PRE
         ITERATE $FORMAT-PRECISIONS
         UNTIL GO RIGHT FAILS.
  $FORMAT-PRECISIONS =
      BOTH STORE IN X-SA-VALUE [* currently just below RV/SA *]
      AND IF NONE OF $EMPTY, $IS-FORMATED, $CORE-FORMATED
          THEN BOTH PRESENT-ELEMENT- X-PUTIN EXISTS
               AND $MOVE-TO-PRECISIONS;
      GO TO X-SA-VALUE.
  $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
  $MOVE-TO-PRECISIONS =
      BOTH DO $FIND-FORMAT
      AND DO PUTIN-SLOT(PRECISIONS).
  $CORE-FORMATED =
      EITHER AT CORE- DO $IS-FORMATED
      OR EITHER AT ELEMENT- LXR DO $IS-FORMATED [* NSTG under SA *]
         OR EITHER AT IMMEDIATE LXR DO $IS-FORMATED
            OR EITHER PRESENT-ELEMENT- IS PN WHERE AT ELEMENT-
                      LNR OF NSTG OF NSTGO DO $IS-FORMATED
               OR PRESENT-ELEMENT- IS QN [* never happens *]
                  WHERE AT LQR DO $IS-FORMATED.
* T-CLEANUP
*  if   A. a node has not been formatted, and
*       B. it occurs with H-BEH or H-PTFUNC verbs
*  then it is placed in DESCR along with VERB as a unit.
T-CLEANUP = IN LXR, [NPN,] DSTG, NNN, QN, NQ:
       AT PRESENT-ELEMENT- X-PRE
       IF $CHECK-FRMTED
      @THEN IF DO $CHECK-VERB
            THEN $PUT-IN-DESCR
            ELSE $MOVE-OBJECT.
  $CHECK-FRMTED =
       BOTH IF PRESENT-ELEMENT- IS QN OR NQ
            THEN BOTH IMMEDIATE PQUANT EXISTS
                        WHERE DO $NOT-FORMATED
                 AND AT ELEMENT- LQR DO $NOT-FORMATED
            ELSE IF BOTH PRESENT-ELEMENT- IS LDR
                    AND $NOT-FORMATED
                 THEN IMMEDIATE-NODE- IS NOT OF TYPE ADJSET
                 ELSE $NOT-FORMATED [T-AGE]
       AND ITERATE $UNDER-OBJ
           UNTIL CORE- OF COELEMENT- VERBAL X-VERB EXISTS SUCCEEDS.
  $MOVE-OBJECT =
        [* Unformatted OBJECT is moved under RV of VERB *]
       IF AT X-VERB EITHER DO $IS-FORMATED
                           WHERE IMMEDIATE-NODE- X-SLOT EXISTS
                    OR CORE-ATT OF CORE EXISTS
       THEN BOTH IF BOTH X-PRE IS OF TYPE LXR
                    AND AT X-PRE, IMMEDIATE PN EXISTS
                @THEN BOTH STORE IN X-PRE
                      AND DO $CHK-FMT-P
            AND BOTH IF VALUE OF X-VERB IS LVR X-LVR-V
                     THEN AFTER LAST-ELEMENT- OF RV OF X-LVR-V 
                          INSERT X-PRE
                     ELSE AFTER LAST-ELEMENT- OF RV OF X-VERB
                          INSERT X-PRE
                AND REPLACE X-PRE BY <NULL>.
  $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
  $CHK-FMT-P =
       IF ELEMENT- P HAS NODE ATTRIBUTE FORMAT-PT X-FPT
       THEN BOTH AT ELEMENT- P ERASE NODE ATTRIBUTE FORMAT-PT
            AND DELETE X-FPT.
  $UNDER-OBJ =
       EITHER IMMEDIATE PSTRING EXISTS OR TRUE;
       ASCEND TO OBJECT PASSING THROUGH QN OR PVO.
  $CHECK-VERB =
       BOTH CORE-SELATT HAS MEMBER [H-BEH OR] H-PTFUNC
       AND AT X-VERB DO $IS-FORMATED;
       IMMEDIATE-NODE- IS DESCR.
  $PUT-IN-DESCR =
       X-PUTIN:= X-PRE;
       DO PUTIN-SLOT(DESCR).
* T-NEG-PRED-PN
*     attaches NEG to its argument in OBJBE:PN or RN/RA:PN
T-NEG-PREDPN = IN PN:
      IF ALL OF $PN-IN-OBJBE-OR-RX, $FIND-FORMAT
      THEN DO $MAIN-NEG.
  $PN-IN-OBJBE-OR-RX =
      BOTH EITHER IMMEDIATE-NODE- OF PRESENT-ELEMENT- X-PRE IS OBJBE
                  WHERE BOTH IMMEDIATE OBJECT EXISTS
                       @AND CORE- X-VCORE OF COELEMENT- VERB IS VBE
           OR IMMEDIATE-NODE- OF PRESENT-ELEMENT- IS RN OR RA
      AND CORE- X-PUTIN IS P;
      ELEMENT- LNR X-LNR OF NSTG OF ELEMENT- NSTGO OF X-PRE EXISTS;
      CORE- X-NCORE OF X-LNR EXISTS;
      EITHER X-PUTIN HAS NODE ATTRIBUTE SEM-CORE
      OR AT X-PUTIN, ASSIGN NODE ATTRIBUTE SEM-CORE WITH VALUE X-NCORE;
      EITHER X-PUTIN HAS NODE ATTRIBUTE TYPE-ATT
      OR BOTH X-TYPE := SYMBOL MODS
         AND AT X-PUTIN, ASSIGN NODE ATTRIBUTE TYPE-ATT WITH
                VALUE X-TYPE;
      CORE-ATT OF X-PUTIN HAS MEMBER H-NEG;
      X-PUTIN DOES NOT HAVE NODE ATTRIBUTE FORMAT-PT.
  $MAIN-NEG =
      X-LNR HAS NODE ATTRIBUTE FORMAT-PT X-SLOT;
      DO $CONSTRUCT-MODS;
      DO $SET-POINTERS [in PUTIN-SLOT].
  $CONSTRUCT-MODS =
      IF COELEMENT- MODS X-NOHOST-MOD OF X-SLOT EXISTS
      THEN TRUE
      ELSE AFTER X-SLOT
           INSERT <MODS> X-NOHOST-MOD (<NEG>+<MODAL>);
      IF AT ELEMENT- NEG X-NEG-MOD OF X-NOHOST-MOD
         DESCEND TO NON-EMPTY
      THEN AFTER LAST-ELEMENT- OF X-NEG-MOD
                INSERT <NON-EMPTY> X-FRMT-SLOT
      ELSE REPLACE X-NEG-MOD BY <NEG> (<NON-EMPTY> X-FRMT-SLOT).
* T-WRITE-CT
*     WRITES COMMA TEMPLATES FOR DBMS:
*     COMMA TEMPLATES ARE DEFINED IN LIST FORMAT1-3-CT AND FORMAT5-CT,
*     WHICH SPELL OUT CORRESPONDANCE BETWEEN FORMAT1-3 AND FORMAT5
*     WITH THE COMMA LINE, WHERE EACH COMMA LINE IS A FORMAT.
*
* FORMAT STRUCTURE
*     1. SID - SENTENCE IDENTIFICATION
*     2. ROWNO - FORMAT NUMBER
*     3. CONJ - CONNECTIVE
*     4. TXPROC - PROCEDURE (F4:TXSPEC+TXVAR+SPEC-ACCESS)
*     5. TXEXAM - EXAMTEST
*     6. TTGEN - GEN
*     7. TTSURG - SURG
*     8. TTMEDDS - MED
*     9. TTCOMP - COMP
*    10. SUBJ - SUBJECT
*    11. VERB - VERB
*    12. NEGAT - NEG
*    13. MODAL - MODAL
*    14. DIAG - DIAG, ORGANISM
*    15. SGN_SYM - INDIC
*    16. RESULT - TTRES (F1-3)/TXRES (F5)/TESTRES (F4)
*    17. QUALIFIERS (F5/F1-3)
*    18. INFLUENCE - INFLUENCE (F5)
*    19. QUANT - QUANT
*    20. NORM - NORMAL
*    21. BODYPART - PTPART
*    22. BFUNCT - PTFUNC
*    23. PRECIS - PRECISIONS
*    24. EVENTS - TIME-LOCS -- new addition 11/07/95
*    25. TIMEWDS - TIME-QUALS
*    26. AGE
*    27. GENDER
*    28. TEXTPLUS - LEFT-OVERS
T-WRITE-CT = IN SENTENCE:
       BOTH IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE ANTECEDENT X-ANTE
            THEN DO $WRITE-NPLIST
       AND AT ELEMENT- TEXTLET DO $WRITE-TEXTLET.
  $WRITE-NPLIST =
       WRITE ON INFO '* NP LIST: ';
       WRITE ON INFO IDENTIFICATION; WRITE ON INFO ' ';
       AT X-ANTE, WRITE ON INFO LIST [ELEMENT];
       WRITE ON INFO END OF LINE.
  $WRITE-TEXTLET =
       BOTH AT ELEMENT- ONESENT DO $WRITE-ONESENT
       AND IF ELEMENT- MORESENT EXISTS
              [* To cope with new recovered tree 96/4/15 *]
           THEN AT ELEMENT- MORESENT DO $WRITE-MORESENT.
  $WRITE-ONESENT =
       AT VALUE,
       ITERATET $WHAT-TO-WRITE UNTIL $GO-NEXT FAILS.
  $WRITE-MORESENT =
       IF PRESENT-ELEMENT- IS NOT EMPTY
       THEN AT ELEMENT- TEXTLET DO $WRITE-TEXTLET.
  $GO-NEXT =
     ITERATE GO RIGHT
     UNTIL TEST FOR CENTER SUCCEEDS.
  $WHAT-TO-WRITE =
       VERIFY DO $CENTER-OUT.
  $CENTER-OUT =
     AT VALUE EITHER $IS-OUT-NODE OR $NEXT-IN-CENTER;
     ITERATE $WRITE-CENTER UNTIL $NEXT-IN-CENTER FAILS.
  $IS-OUT-NODE = PRESENT-ELEMENT- IS ASSERTION OR FRAGMENT.
  $NEXT-IN-CENTER =
     ITERATE GO RIGHT UNTIL $IS-OUT-NODE SUCCEEDS.
  $WRITE-CENTER =
     VERIFY IF PRESENT-ELEMENT- IS CONNECTIVE
               THEN DO $CONN-OUT
            ELSE IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE
                         FORMAT-ATT X-FRMT
                    WHERE X-FRMT HAS MEMBER NOFRMT [OR FRMT6]
                        [OR FRMT0] OR FRMT00
                 THEN [TRUE] VERIFY $WRITE-FRMT
                 ELSE [BOTH] $WRITE-FORMAT [AND $LEFTOVERS].
   $CONN-OUT = TRUE.
   $WRITE-FRMT =
      STORE IN X-NOFMT;
      WRITE ON INFO IDENTIFICATION;
      WRITE ON INFO '|R|||||||||||||'; WRITE ON INFO '|||||||||||||||';
      IN X-NOFMT, DO WRITE-WORDS; WRITE ON INFO '|';
      WRITE ON INFO END OF LINE;
      WRITE ON INFO END OF LINE.
  $WRITE-FORMAT =
     STORE IN X-ASSERT [starting location in tree];
     DO R(FORMAT-TYPES);
     DO $PROCESS-FORMAT.
  $PROCESS-FORMAT =
       [* Builds a new CT format X-PRE    *]
       [* puts CT FRAME nodes on X-PRE    *]
       [* writes the CT and delete X-PRE. *]
     ALL OF $RESHAPE-FORMAT, $WRITE-CT, $LEFTOVERS, $RECOVER-FMT.
  $RESHAPE-FORMAT =
       [* Add NEG and MODAL after VERB and          *]
       [* Add EVENTS-MODS and TIME-QUALS at the end. *]
     IF PRESENT-ELEMENT- X-POS IS FORMAT4
     THEN DO $RESHAPE-FORMAT4
     ELSE IF X-POS IS FORMAT0 OR FORMAT6
          THEN BOTH DO $RESHAPE-FORMAT0
               AND IF X-POS IS FORMAT6
                   THEN BEFORE VALUE OF PRECISIONS OF X-PRE
                        INSERT OBJECT OF X-POS
                   ELSE REPLACE INST OF X-PRE
                        BY INST OF X-POS
          ELSE BOTH BEFORE X-POS INSERT
                     <FORMAT-CT> X-PRE (ALL ELEMENTS OF X-POS)
               AND $RESHAPE-FORMAT35;
       [* include PT-DEMOG and INST in PRECISIONS *]
     IF AT ELEMENT- PARAGR X-PRECIS OF X-PRE DESCEND TO NON-EMPTY
     THEN BOTH DO $MOVE-TO-PRECISIONS
          AND REPLACE X-PRECIS BY <PARAGR>;
     IF AT INST X-PRECIS OF X-PRE DESCEND TO NON-EMPTY
     THEN BOTH DO $MOVE-TO-PRECISIONS
          AND REPLACE X-PRECIS BY <INST>;
     AFTER ELEMENT- VERB OF X-PRE INSERT <NEG> X-NEG
                                        +<MODAL> X-MOD;
    [AFTER LAST-ELEMENT- OF X-PRE INSERT <TIME-QUALS> X-TIME;]
    [LAST-ELEMENT- OF X-PRE EXISTS]
    [   WHERE PRESENT-ELEMENT- IS TIME-QUALS X-TIME;]
     EITHER ELEMENT- TIME-QUALS X-TIME OF X-PRE EXISTS
     OR AFTER LAST-ELEMENT- OF X-PRE INSERT
              <TIME-QUALS> X-TIME (<TM-PERIOD>+<TM-REPETITION>);
     IF ELEMENT- TENSE X-POS-TENSE OF X-PRE [X-POS] EXISTS
        WHERE DESCEND TO NON-EMPTY
     THEN BOTH BEFORE X-TIME INSERT
             <TIME-LOCS> X-EVENTS (ALL ELEMENTS OF X-POS-TENSE)
          AND REPLACE X-POS-TENSE BY X-POS-TENSE (<DUMMY>)
     ELSE BEFORE X-TIME INSERT <TIME-LOCS> X-EVENTS;
     AT PT-DEMOG X-PRECIS OF X-PRE,
        BOTH $MOVE-TO-AGE-GENDER AND $MOVE-TO-SUBJECT;
     AT X-PRE ITERATE BOTH $MOVE-MODS AND $TRAVERSE-TREE
              UNTIL PRESENT-ELEMENT- IS IDENTICAL TO X-PRE SUCCEEDS.
  $MOVE-TO-AGE-GENDER =
     BOTH BOTH ELEMENT- GENDER X-P-SEX OF X-PRECIS EXISTS
          AND BOTH AFTER X-TIME
                   INSERT <GENDER> X-GENDER (X-P-SEX)
              AND DELETE X-P-SEX
     AND BOTH ELEMENT- AGE X-P-AGE OF X-PRECIS EXISTS
         AND BOTH AFTER X-TIME INSERT X-P-AGE, X-AGE
             AND DELETE X-P-AGE.
  $MOVE-TO-SUBJECT =
     IF AT X-PRECIS DESCEND TO NON-EMPTY
     THEN BOTH IF VALUE X-VAL OF ELEMENT- PRECISIONS [SUBJECT] X-SUBJ
                  OF X-PRE EXISTS
               THEN BEFORE X-VAL INSERT ALL ELEMENTS OF X-PRECIS
               ELSE REPLACE X-SUBJ BY X-SUBJ (ALL ELEMENTS OF X-PRECIS)
          AND REPLACE X-PRECIS BY <PT-DEMOG>.
  $MOVE-TO-PRECISIONS =
     IF VALUE X-VAL OF ELEMENT- PRECISIONS X-SUBJ OF X-PRE EXISTS
     THEN BEFORE X-VAL INSERT ALL ELEMENTS OF X-PRECIS.
  $TRAVERSE-TREE =
     EITHER GO DOWN
     OR ITERATET GO UP
        UNTIL DO $GO-RIGHT SUCCEEDS.
  $GO-RIGHT =
     IF PRESENT-ELEMENT- X-CT IS NOT IDENTICAL TO X-PRE
     THEN GO RIGHT.
  $MOVE-MODS = [12/27/88 move NEG in TIME-ASP or EVENT-TIME]
       [* Moves all TIME expressions to TIME-QUALS, *]
       [*       all EVENT-TIME expressions to TIME-LOCS, *]
       [*       NEGATION phrases to NEG, and       *]
       [*       MODALITY to MODAL nodes.           *]
     IF BOTH PRESENT-ELEMENT- IS NOT TIME-QUALS
        AND PRESENT-ELEMENT- IS NOT TIME-LOCS
     THEN BOTH DO $ELEM-TIME-MODS
          AND BOTH IF PRESENT-ELEMENT- HAS ELEMENT- MODS X-IT
                   THEN BOTH ITERATE BOTH AT X-IT DO $ELEM-TIME-MODS
                                     AND ALL OF $FILL-NEG,
                                                $FILL-MODAL,
                                                $FILL-TENSE
                             UNTIL X-IT HAS ELEMENT- MODS
                                   X-IT FAILS
                        AND $REM-MODS
              AND IF PRESENT-ELEMENT- X-IT HAS ELEMENT- TENSE
                  THEN DO $FILL-TENSE
                  ELSE TRUE
     ELSE BOTH IF PRESENT-ELEMENT- X-MODS HAS ELEMENT- MODS X-IT
               THEN BOTH ITERATE ALL OF $FILL-NEG,
                                        $FILL-MODAL,
                                        $FILL-TENSE [$REMOVE-TENSE]
                         UNTIL X-IT HAS ELEMENT- MODS X-IT FAILS
                    AND $REM-MODS
               ELSE IF PRESENT-ELEMENT- X-IT HAS ELEMENT- TENSE
                    THEN DO $FILL-TENSE
                    ELSE TRUE
          AND ITERATET AT X-MODS DELETE ELEMENT- TENSE
              UNTIL X-MODS HAS ELEMENT- TENSE FAILS.
  $REMOVE-TENSE =
     IF ELEMENT- TENSE EXISTS
     THEN DELETE ELEMENT- TENSE.
  $ELEM-TIME-MODS =
     AT PRESENT-ELEMENT- X-FILLTIME
     ITERATET EITHER DO $FILL-TIME-LOCS
              OR DO $FILL-TIME-QUALS
     UNTIL [BOTH X-FILLTIME IS NOT EMPTY AND]
           X-FILLTIME HAS ELEMENT- TIME-ASP OR EVENT-TIME
              OR TIME-QUAL [*GRI*] X-VAL FAILS.
  $CHECK-NEG = [* Forget to rename variable X-NEG and *]
               [* cannot delete present MODS-NEG.     *]
     X-IT HAS NODE ATTRIBUTE FILLED-PT X1;
     IF X1 IS LNR WHERE AT CORE X2 ALL OF $LNR-1, $LNR-2
     THEN DO $PLUNK.
  $LNR-1 =
     IN LEFT-ADJUNCT OF X2 THE CORE OF LTR X-VAL OF TPOS IS H-NEG.
  $LNR-2 =
     BOTH X2 HAS NODE ATTRIBUTE COMPUTED-ATT
     AND X2 HAS NODE ATTRIBUTE N-TO-RN-ATT.
  $PLUNK =
     IF VALUE OF X-NEG EXISTS
     THEN TRUE
     ELSE BOTH REPLACE NEG OF X-PRE BY <NEG> (<NON-EMPTY> X10)
          AND DO $ASSIGN-ATTR.
  $ASSIGN-ATTR =
     AT X10 ASSIGN NODE ATTRIBUTE FILLED-PT WITH VALUE X-VAL;
     AT X-IT BOTH ERASE NODE ATTRIBUTE FILLED-PT
             AND ASSIGN NODE ATTRIBUTE FILLED-PT WITH VALUE X2.
  $FILL-TIME-LOCS =
     X-VAL IS EVENT-TIME;
     BOTH IF VALUE X-PREV-TENSE OF X-EVENTS EXISTS
          THEN AFTER LAST-ELEMENT- OF X-EVENTS
                     INSERT ALL ELEMENTS OF X-VAL
          ELSE REPLACE X-EVENTS BY X-EVENTS (ALL ELEMENTS OF X-VAL)
     AND REPLACE X-VAL BY <DUMMY> [DELETE X-VAL].
  $FILL-TIME-QUALS =
     BOTH IF VALUE X-PREV-TENSE OF X-TIME EXISTS
          THEN [EITHER $RM-TENSE-ATT -- take out]
               [OR] AFTER LAST-ELEMENT- OF X-TIME
                  INSERT ALL ELEMENTS OF X-VAL
          ELSE REPLACE X-TIME BY X-TIME (ALL ELEMENTS OF X-VAL)
     AND REPLACE X-VAL BY <DUMMY> [DELETE X-VAL].
  $RM-TENSE-ATT =
     EITHER BOTH $PREV-TENSE
            AND BOTH NOT $A-TENSE
                AND REPLACE X-TIME BY X-TIME (X-VAL)
     OR BOTH NOT $PREV-TENSE
        AND $A-TENSE.
  $PREV-TENSE =
     X-PREV-TENSE HAS NODE ATTRIBUTE FILLED-PT
     WHERE PRESENT-ELEMENT- IS '[PAST]' OR '[PRESENT]' OR '[FUTURE]'
               OR '[FUT]' OR '[PROG]' OR '[PERF]' OR '[FUT-IMP]'.
  $A-TENSE =
     X-VAL HAS NODE ATTRIBUTE FILLED-PT
     WHERE PRESENT-ELEMENT- IS '[PAST]' OR '[PRESENT]' OR '[FUTURE]'
               OR '[FUT]' OR '[PROG]' OR '[PERF]' OR '[FUT-IMP]'.
  $FILL-NEG =
     IF NEG OF X-IT HAS VALUE NON-EMPTY X-VAL
     THEN BOTH DO $FILL-SLOT-NEG
          AND REPLACE X-VAL BY <DUMMY> [DELETE NEG OF X-IT]
     ELSE IF NEG OF X-IT HAS VALUE DOUBLE-NEG X-DOUBLE
         @THEN BOTH BOTH AT VALUE X-VAL DO $FILL-SLOT-NEG
                    AND AT VALUE X-VAL OF ELEMENT- NEG,
                        DO $FILL-SLOT-NEG
               AND REPLACE X-VAL BY <DUMMY> [DELETE NEG OF X-IT].
  $FILL-SLOT-NEG =
     IF VALUE OF X-NEG EXISTS
     THEN AFTER LAST-ELEMENT- OF X-NEG INSERT X-VAL
     ELSE REPLACE NEG OF X-PRE BY <NEG> X-NEG (X-VAL).
  $FILL-TENSE =
     IF TENSE X-VAL OF X-IT HAS VALUE NON-EMPTY
     THEN BOTH IF VALUE OF X-EVENTS EXISTS
               THEN AFTER LAST-ELEMENT- OF X-EVENTS
                    INSERT ALL ELEMENTS OF X-VAL
               ELSE REPLACE X-EVENTS
                    BY X-EVENTS (ALL ELEMENTS OF X-VAL)
          AND BOTH REPLACE X-VAL BY <DUMMY>
                   [DELETE X-VAL TENSE OF X-IT]
              AND GO TO X-IT.
  $FILL-MODAL =
     IF MODAL X-VAL OF X-IT HAS VALUE NON-EMPTY
     THEN BOTH IF VALUE OF X-MOD EXISTS
               THEN AFTER LAST-ELEMENT- OF X-MOD
                    INSERT ALL ELEMENTS OF X-VAL
               ELSE REPLACE MODAL OF X-PRE
                    BY <MODAL> X-MOD (ALL ELEMENTS OF X-VAL)
          AND REPLACE X-VAL BY <DUMMY> [DELETE MODAL OF X-IT].
  $REM-MODS =
     IF X-IT EXISTS
     THEN BOTH AT X-IT, ITERATET BOTH GO UP AND STORE IN X-IT
                        UNTIL IMMEDIATE-NODE- IS MODS FAILS
        [@AND DELETE X-IT]
          AND REPLACE X-IT BY <DUMMY>.
  $RESHAPE-FORMAT35 =
     IF X-POS IS FORMAT1-3 OR FORMAT13-MED
     THEN BEFORE TREATMENT OF X-PRE INSERT
              <METHOD> (<PROCEDURE>
                       +<EXAMTEST>)
    [ELSE AFTER METHOD OF X-PRE INSERT]
    [         <TREATMENT> (<TT-NEG>]
    [                     +<TT-MODAL>]
    [                     +<GEN>]
    [                     +<SURG>]
    [                     +<MED>]
    [                     +<COMP>)];
        [* CT PTMEAS SHARES FIELD WITH PTFUNC *]
     IF VALUE OF ELEMENT- PTMEAS X-MEAS OF PSTATE-SUBJ OF X-PRE EXISTS
     THEN BOTH IF VALUE OF COELEMENT- PTFUNC X-FUNC OF X-MEAS EXISTS
               THEN AFTER LAST-ELEMENT- OF X-FUNC INSERT
                    ALL ELEMENTS OF X-MEAS
               ELSE REPLACE X-FUNC BY X-FUNC (ALL ELEMENTS OF X-MEAS)
          AND REPLACE X-MEAS BY <PTMEAS>.
  $RESHAPE-FORMAT0 =
     BEFORE X-POS INSERT
        <FORMAT-CT> X-PRE
                    (PARAGR OF X-POS
                    +PT-DEMOG OF X-POS
                    +<METHOD> (<PROCEDURE>+<EXAMTEST>)
                    +<TREATMENT> (<TT-NEG>
                                 +<TT-MODAL>
                                 +<GEN>
                                 +<SURG>
                                 +<MED>
                                 +<COMP>
                                 +<MED-DEVICE>)
                    +<SUBJECT> (PT OF X-POS)
                    +VERB OF X-POS
                    +<PSTATE-DATA> (<DIAG>
                                   +<INDIC>
                                   +<TTRES>
                                   +<QUALIFIERS>
                                   +<INFLUENCE>
                                   +<QUANT> (<NULL>)
                                   +<NORMAL>)
                    +<PSTATE-SUBJ> (<PT>
                                   +<PTPART>
                                   +<PTFUNC>
                                   +<PTMEAS>)
                    +INFO-SOURCE OF X-POS
                    +PRECISIONS OF X-POS
                    +<INST>
                    +TIME-QUALS OF X-POS).
  $RESHAPE-FORMAT4 =
     BOTH X-POS HAS ELEMENT- TEST-INFO X-TX
     AND BEFORE X-POS INSERT
           <FORMAT-CT> X-PRE
                       (<PT-DEMOG> (<AGE>
                                   +<RACE>
                                   +<GENDER>
                                   +<FAMILY>)
                       +<METHOD> (<PROCEDURE> X-TXPROC
                                              (ALL ELEMENTS OF X-TX)
                                 +<EXAMTEST>)
                       +<TREATMENT> (<GEN>
                                    +<SURG>
                                    +<MED>
                                    +<COMP>
                                    +<MED-DEVICE>)
                       +PT OF X-POS
                       +VERB OF X-POS
                       +RESULT OF X-TX
                       +<PSTATE-SUBJ> (<PTPART> X-PTPART
                                      +<PTFUNC>)
                       +INFO-SOURCE OF X-POS
                       +PRECISIONS OF X-POS
                       +INST OF X-POS
                       +TIME-QUALS OF X-POS);
     AFTER QUALIFIERS OF RESULT OF X-PRE INSERT <INFLUENCE>;
         [* Massage FORMAT4 into FORMAT-CT:                *]
         [* A. Put all elements of TEST-INFO before RESULT *]
         [*    into PROCEDURE node of FORMAT-CT.           *]
         [* B. Clean up structures under PROCEDURE         *]
     BOTH AT X-TXPROC, ALL OF $DEL-RESULT, $MOVE-PTPART,
                              $MOVE-BP-MOD, $CHK-TXSPEC, $CHK-TXVAR
     AND $CHK-PROCEDURE [* replace anew if deleted *];
         [* C. Move PT into SUBJECT *]
     IF AT ELEMENT- PT X-SUBJ OF X-PRE DESCEND TO NON-EMPTY
     THEN REPLACE X-SUBJ BY <SUBJECT> (ALL ELEMENTS OF X-SUBJ)
     ELSE REPLACE X-SUBJ BY <SUBJECT>;
         [* D. Recover MODS structure of FORMAT4 after VERB *]
     IF BOTH AT VERB OF X-POS FOLLOWING-ELEMENT EXISTS
             WHERE PRESENT-ELEMENT- IS NOT PRECISIONS
        AND VERB X-TXVERB OF X-PRE EXISTS
     THEN BOTH AFTER X-TXVERB INSERT X-POS, X-NEW-POS
          AND AT X-NEW-POS, DO $ACQUIRE-MODS.
  $ACQUIRE-MODS =
     BOTH BOTH DELETE LAST-ELEMENT- [TIME-QUALS]
          AND DELETE ELEMENT- PRECISIONS
     AND BOTH ITERATE DELETE VALUE
              UNTIL VALUE IS VERB SUCCEEDS
         AND BOTH DELETE VALUE [VERB]
             AND REPLACE X-NEW-POS BY ALL ELEMENTS OF X-NEW-POS.
  $DEL-RESULT = DELETE ELEMENT RESULT.
  $MOVE-PTPART =
     BOTH IF VALUE OF PTPART X-PRT EXISTS
          THEN REPLACE X-PTPART BY
               X-PTPART (ALL ELEMENTS OF X-PRT)
     AND DELETE X-PRT.
  $MOVE-BP-MOD =
     IF BP-MOD X-BPMOD EXISTS
     THEN BOTH AFTER X-PTPART INSERT X-BPMOD, X-NEWBP
          AND DELETE X-BPMOD.
  $CHK-TXSPEC =
     IF VALUE OF TXSPEC X-LAB EXISTS
     THEN REPLACE X-LAB BY ALL ELEMENTS OF X-LAB
     ELSE DELETE X-LAB.
  $CHK-TXVAR =
     IF VALUE OF TXVAR X-VAR EXISTS
     THEN REPLACE X-VAR BY ALL ELEMENTS OF X-VAR
     ELSE DELETE X-VAR.
  $CHK-PROCEDURE =
     IF X-TXPROC EXISTS [* due to deletion of all elements *]
     THEN TRUE
     ELSE BEFORE VALUE OF METHOD OF X-PRE INSERT <PROCEDURE>.
  $RECOVER-FMT =
    [BOTH DELETE X-PRE AND] GO TO X-POS.
  $WRITE-CT =
       [* Write sentence identification      *]
     AT X-PRE WRITE ON INFO IDENTIFICATION; WRITE ON INFO '|';
       [* write FORMAT type and row fields:  *]
       [* mark FORMAT type, 'L' for FORMAT4, *]
       [* 'R' for FORMAT5/F and FORMAT1-3    *]
     IF X-POS IS FORMAT4 THEN WRITE ON INFO 'L'
     ELSE WRITE ON INFO 'R'; WRITE ON INFO '|';
       [* Write CONNECTIVE field *]
     DO $WRITE-CONN; WRITE ON INFO '|';
    [AT X-PRE, GO LEFT;] AT X-ASSERT  [* to original parse tree *]
     DO $WRITE-CONN-LINK; WRITE ON INFO '|';
       [* Write content fields *]
     AT X-PRE, ITERATE BOTH $PROCESS-NODE
                       AND $GO-TO-NEXT-NODE
               UNTIL PRESENT-ELEMENT- X-CT IS IDENTICAL TO X-PRE
               SUCCEEDS.
  $WRITE-CONN =
    [AT X-PRE, GO LEFT;] AT X-ASSERT
     IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE CT-CONJ X-CONJ
     THEN AT X-CONJ, BOTH BOTH $WRITE-CONN-WORDS
                          AND WRITE ON INFO '|'
                     AND $WRITE-CONN-LINK
     ELSE WRITE ON INFO '|'.
  $WRITE-CONN-LINK =
     IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE CONJ-LINK X-CLINK
     THEN AT X-CLINK WRITE ON INFO LIST ELEMENT.
  $WRITE-CONN-WORDS =
     STORE IN X-LXR;
     BOTH CORE X-CORE OF X-LXR EXISTS AND $WRITE-FULL-LXR.
  $GO-TO-NEXT-NODE =
     EITHER GO DOWN
     OR ITERATET GO UP
        UNTIL DO $WRITE-CT-FS SUCCEEDS.
  $WRITE-CT-FS =
     IF PRESENT-ELEMENT- X-CT IS NOT IDENTICAL TO X-PRE
     THEN BOTH IF BOTH X-CT IS OF TYPE CT-DB-FIELDS
                  AND IF FOLLOWING-ELEMENT X-FOL OF X-CT EXISTS
                      THEN X-FOL IS NOT BP-MOD
               THEN WRITE ON INFO '|'
          AND GO RIGHT.
  $PROCESS-NODE =
     IF PRESENT-ELEMENT- IS NON-EMPTY
     THEN BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE FILLED-PT X-SLOT
          AND DO $WRITE-NONEMPTY.
  $WRITE-NONEMPTY =
     IF EITHER IMMEDIATE-NODE- IS TIME-QUALS OR TIME-LOCS
                                  OR NEG OR MODAL [OR PARAGR]
               WHERE X-SLOT IS NOT OF TYPE LXR
        OR X-SLOT IS QN-TIME
     THEN AT X-SLOT DO WRITE-WORDS
     ELSE AT X-SLOT DO $WRITE-SUBTREE.
  $WRITE-SUBTREE =
     STORE IN X-LXR;
     ONE OF $WRITE-PTFUNC, $WRITE-PDOSE, $WRITE-AGE, $WRITE-TIME,
            $WRITE-INTRO, $WRITE-LXR.
  $WRITE-INTRO =
     BOTH X-LXR IS NOT OF TYPE LXR [* for others *]
     AND VERIFY DO WRITE-WORDS.
  $WRITE-AGE =
     BOTH X-LXR IS PN OR QN
          WHERE BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE
                     PHRASE-ATT X-PHRASE-ATT
                AND X-PHRASE-ATT HAS MEMBER AGE-PHRASE
     AND AT X-LXR, VERIFY DO WRITE-WORDS.
  $WRITE-TIME =
     BOTH BOTH X-LXR IS PN OR NSTGT OR PDATE OR QN OR NQ OR LAR
          AND EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE
                           PHRASE-ATT X-PHRASE-ATT
                     WHERE X-PHRASE-ATT HAS MEMBER TIME-PHRASE
              OR PRESENT-ELEMENT- HAS NODE ATTRIBUTE
                     ADVERBIAL-TYPE X-PHRASE-ATT
                 WHERE X-PHRASE-ATT HAS MEMBER TIME-ADVERBIAL
     AND AT X-LXR, VERIFY DO WRITE-WORDS.
  $WRITE-PDOSE =
     BOTH X-LXR IS PN OR PDOSE OR QN
          WHERE BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE
                     PHRASE-ATT X-PHRASE-ATT
                AND X-PHRASE-ATT HAS MEMBER QUANT-PHRASE
     AND AT X-LXR, VERIFY DO WRITE-WORDS.
  $WRITE-PTFUNC =
     BOTH X-LXR IS PN
     AND BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE
              ADVERBIAL-TYPE X-PHRASE-ATT
         AND X-PHRASE-ATT HAS MEMBER BODYFUNC-PN;
     AT P OF X-LXR, VERIFY DO WRITE-WORDS;
     CORE- X-CORE OF LNR OF NSTG OF NSTGO OF X-LXR EXISTS;
     AT X-CORE DO $WRITE-FULL-LXR.
  $WRITE-LXR =
     CORE- X-CORE OF X-LXR EXISTS;
     DO $WRITE-FULL-LXR.
  $WRITE-FULL-LXR =
     [EITHER $LX-ID-CORE OR] DO $WRITE-LXR-IN-FULL.
  $LX-ID-CORE =
      [* Skip a node in LX with the same sublanguage *]
      [* class as its host - to be written out later *]
     EITHER X-SLOT IS LAR WHERE IMMEDIATE-NODE- IS ADJADJ
     OR X-SLOT IS NOT LNR OR LAR;
     HOST- X-HOST-LX OF X-SLOT EXISTS;
     CORE- OF X-SLOT HAS NODE ATTRIBUTE SELECT-ATT X-NEWLIST;
     X-HOST-LX HAS NODE ATTRIBUTE SELECT-ATT X-HATT;
     EITHER INTERSECT OF X-HATT IS NOT NIL
     OR EITHER BOTH X-TIME-LIST := LIST TIME-MODS-LIST
               AND BOTH X-TIME-LIST HAS MEMBER X-NEWLIST
                   AND X-TIME-LIST HAS MEMBER X-HATT
        OR BOTH EITHER X-POS IS FORMAT4
                       WHERE X-PTPART-LIST := LIST PTPART-F4-SLOT
                OR X-PTPART-LIST := LIST PTPART-SLOT
           AND BOTH X-PTPART-LIST HAS MEMBER X-NEWLIST
               AND X-PTPART-LIST HAS MEMBER X-HATT;
     AT X-SLOT, ERASE NODE ATTRIBUTE FORMAT-PT.
  $WRITE-LXR-IN-FULL =
     DO $P-RIGHT-OF-XSLOT;
     ALL OF $P-OF-LXR, $REST-OF-LQR, $L-ADJ, $ADJ-TO-ADJ;
     IF BOTH X-LXR IS LNR
        AND IMMEDIATE-NODE- OF X-CORE IS QN
     THEN AT X-CORE DO WRITE-WORDS
     ELSE IF X-LXR IS QN
          THEN AT X-LXR DO WRITE-WORDS
          ELSE AT X-CORE
               BOTH DO WRITE-WORDS
               AND ITERATET $CHK-COEL UNTIL $PART-OF-N FAILS;
     DO $R-ADJ.
  $ADJ-TO-ADJ =
     [* for the second argument of LAR to LAR *]
     IF BOTH X-LXR IS LAR
        AND AT X-LXR, ITERATE GO LEFT
                      UNTIL PRESENT-ELEMENT- IS LAR SUCCEEDS
     THEN AT PREVIOUS-ELEMENT- OF X-LXR, DO WRITE-WORDS.
  $CHK-COEL =
     VERIFY IF ALL OF $NOT-FORMATED, $NOT-SACONJ-Q-CONJ,
                      $NOT-LXR, $NOT-RADJSET
            THEN DO WRITE-WORDS.
  $NOT-LXR = PRESENT-ELEMENT- IS NOT OF TYPE LXR.
  $NOT-RADJSET = PRESENT-ELEMENT- IS NOT OF TYPE RADJSET.
  $NOT-SACONJ-Q-CONJ =
     PRESENT-ELEMENT- IS NOT SACONJ OR Q-CONJ OR QNREP.
  $PART-OF-N =
     GO RIGHT;
     EITHER PRESENT-ELEMENT- IS OF TYPE ATOM
     OR PRESENT-ELEMENT- IS LPR WHERE ELEMENT- P EXISTS.
  $P-RIGHT-OF-XSLOT =
     IF AT X-SLOT GO RIGHT
    @THEN IF BOTH PRESENT-ELEMENT- IS NON-EMPTY X-PSLOT
                  WHERE PRESENT-ELEMENT- HAS NODE ATTRIBUTE
                        FILLED-PT X-P
            @AND BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE PVAL-ATT
                 AND DO $IS-FORMATED
                     WHERE PRESENT-ELEMENT- IS IDENTICAL TO X-PSLOT
          THEN BOTH AT X-P DO WRITE-WORDS
               AND X-SLOT := X-PSLOT.
  $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
  $REST-OF-LQR =
     IF X-LXR IS LQR WHERE ELEMENT- CONJ-NODE EXISTS
    @THEN BOTH AT VALUE DO WRITE-WORDS
          AND IF VALUE IS NOT ',' [* SEPARATOR *]
              THEN AT CORE-CONJUNCT OF X-CORE DO WRITE-WORDS.
  $L-ADJ =
     X-NO-ADJ := NIL [adjunct message not written out yet];
     X-LADJ := X-CORE [left adjunct signal];
     IF $FILLED-LADJ
    @THEN $FIND-UNFORMATTED [write out left adjunct of LXR].
  $FILLED-LADJ =
     ONE OF $LADJ-OF-LXR, $LADJ-OF-DSTG, $LADJ-OF-NNN, $LADJ-OF-P;
     PRESENT-ELEMENT- IS NOT EMPTY.
  $LADJ-OF-LXR =
     X-LXR IS OF TYPE LXR;
     AT X-CORE LEFT-ADJUNCT-POS EXISTS.
  $LADJ-OF-DSTG =
     X-LXR IS DSTG;
     AT X-CORE DO L(DSTG).
  $LADJ-OF-NNN =
     X-LXR IS NNN;
     AT X-CORE DO L(NNN).
  $LADJ-OF-P =
     X-LXR IS P; DO L(LP).
  $FIND-UNFORMATTED =
     STORE IN X-ADJ [SAVE STARTING LOCATION];
     VERIFY X-LEFT-OVER := X-ADJ;
     ITERATE VERIFY $WRITE-ATOM
     UNTIL $MOVE-THROUGH-ADJ FAILS.
  $WRITE-ATOM =
     IF PRESENT-ELEMENT- IS OF TYPE ATOM
        WHERE BOTH NOT $ANY-NULL
              AND ONE OF $NOT-TIME, $NOT-FORMATED
     THEN BOTH $WRITE-ADJ-MESS
          AND DO WRITE-WORDS.
  $NOT-TIME =
     X-TIME-LIST := LIST TIME-MODS-LIST;
     BOTH BOTH X-CORE HAS NODE ATTRIBUTE SELECT-ATT X-C-ATT
          AND X-TIME-LIST HAS MEMBER X-C-ATT
     AND BOTH X-ADJ HAS NODE ATTRIBUTE SELECT-ATT X-ADJ-ATT
         AND X-TIME-LIST HAS MEMBER X-ADJ-ATT;
     IF X-ADJ HAS NODE ATTRIBUTE FORMAT-PT
     THEN AT X-ADJ, ERASE NODE ATTRIBUTE FORMAT-PT.
  $WRITE-ADJ-MESS =
     IF X-NO-ADJ IS NIL
     THEN X-NO-ADJ := X-LXR.
  $MOVE-THROUGH-ADJ =
     EITHER $GO-DOWN-ADJ
     OR ITERATET $GO-UP-ADJ
        UNTIL BOTH PRESENT-ELEMENT- IS NOT IDENTICAL TO X-ADJ
              AND GO RIGHT SUCCEEDS.
  $GO-DOWN-ADJ =
     PRESENT-ELEMENT- IS NOT EMPTY;
     BOTH EITHER DO $NOT-FORMATED
       [* Do not go through entire substructure if *]
       [*      it has been formatted               *]
          OR IMMEDIATE-NODE- OF X-CT IS REF-PT
     AND BOTH IF PRESENT-ELEMENT- IS PN
       [* PN case: LP+P are written out as LEFT-ADJ *]
       [* of CORE of LNR in NSTG of PN if CORE is   *]
       [* formatted -- Do not check PN in this case *]
       [* i.e. Do not go down formatted PN.         *]
              THEN VERIFY AT LNR OF NSTG OF NSTGO
                   DO $NOT-FORMATED
         AND IF PRESENT-ELEMENT- IS PQUANT
             THEN VERIFY AT LQR OF QPERUNIT OF QUANT
                  DO $NOT-FORMATED;
     GO DOWN.
  $GO-UP-ADJ =
       PRESENT-ELEMENT- IS NOT IDENTICAL TO X-ADJ;
       GO UP;
       PRESENT-ELEMENT- IS NOT IDENTICAL TO X-ADJ [NOT BACK AT START].
  $ANY-NULL =
     EITHER PRESENT-ELEMENT- IS NULL OR NULLN OR NULLOBJ OR NULLC
            OR NULLWH,
     OR PRESENT-ELEMENT- IS 'NULLN'.
  $R-ADJ =
     X-LADJ := NIL;
     X-RADJ := X-CORE;
     X-NO-ADJ := NIL;
     IF NEITHER X-LXR IS P
        NOR X-LXR IS DSTG OR NNN
     THEN IF BOTH RIGHT-ADJUNCT-POS X-RPOS OF X-CORE IS NOT EMPTY
             AND X-RPOS IS NOT PQUANT
          THEN AT X-RPOS, DO $FIND-UNFORMATTED.
  $P-OF-LXR =
      X-LADJ := NIL;
      X-RADJ := NIL;
      X-NO-ADJ := NIL;
      IF X-LXR IS LNR WHERE PRESENT-ELEMENT- IS OCCURRING IN PN X-PN
      THEN IF AT ELEMENT- P X-P OF X-PN DO $NOT-FORMATED
          @THEN IF COELEMENT- LP IS NOT EMPTY
               @THEN BOTH $FIND-UNFORMATTED
                    [Write out LP+P as left-ADJUNCT of NSTGO in PN]
                     AND $WRITE-OUT-P
                ELSE $WRITE-OUT-P
           ELSE TRUE
      ELSE IF X-LXR IS LCONNR
              WHERE AT X-CORE COELEMENT- LPR X-PN EXISTS
           THEN IF ELEMENT- LP OF X-PN IS NOT EMPTY
               @THEN $FIND-UNFORMATTED [write out LP as LEFT-ADJ of P]
                ELSE TRUE
           ELSE IF EITHER X-LXR IS LQR
                          WHERE PRESENT-ELEMENT- IS OCCURRING IN
                                PQUANT X-PN
                   OR X-LXR IS LDR
                      WHERE PRESENT-ELEMENT- IS OCCURRING IN PD X-PN
                THEN IF AT ELEMENT- P X-P OF X-PN DO $NOT-FORMATED
                     THEN $WRITE-OUT-P
                ELSE IF X-LXR IS N WHERE DO $IN-PDOSE
                     THEN IF AT ELEMENT- P X-P OF X-PN DO $NOT-FORMATED
                          THEN $WRITE-OUT-P.
  $IN-PDOSE =
      EITHER IMMEDIATE QN EXISTS
             WHERE IMMEDIATE MEDDOSE EXISTS
      OR IMMEDIATE MEDDOSE EXISTS;
      IMMEDIATE PDOSE X-PN EXISTS.
  $WRITE-OUT-P =
      AT X-P DO $WRITE-ATOM.
  $LEFTOVERS =
    [* LEFT-OVERS:                                    *]
    [* Writes out unformatted text in the last column *]
    [* of CT output.                                  *]
       GO TO X-ASSERT
      [STORE IN X-ASSERT] [starting location in tree];
       VERIFY $CHK-LEFTOVERS;
       WRITE ON INFO '|';
       WRITE ON INFO END OF LINE;
       WRITE ON INFO END OF LINE.
  $CHK-LEFTOVERS =
       ITERATE VERIFY $WRITE-UNFORMATED
       UNTIL $MOVE-THROUGH-TREE FAILS.
  $WRITE-UNFORMATED =
       IF $UNFORMATED-ATOM
       THEN DO WRITE-WORDS.
  $UNFORMATED-ATOM =
       PRESENT-ELEMENT- IS OF TYPE ATOM
       WHERE NONE OF $WRITTEN-NODE, $IS-FORMATED,
                     $ANY-NULL, $CORE-OF-FORMATED.
  $WRITTEN-NODE =
       PRESENT-ELEMENT- HAS NODE ATTRIBUTE CT-WRITTEN.
  $CORE-OF-FORMATED =
    [* IS CORE OF LXR IF IN LXR BUT NOT A LEFT OR *]
    [* RIGHT ADJUNCT.                             *]
       EITHER ASCEND TO LXR NOT PASSING THROUGH ADJSET1
       OR EITHER ASCEND TO DSTG NOT PASSING THROUGH ADJSET1
          OR EITHER ASCEND TO NNN NOT PASSING THROUGH ADJSET1
             OR ASCEND TO PDATE NOT PASSING THROUGH ADJSET1;
       EITHER DO $IS-FORMATED
       OR $IN-FORMATED-VERB-RV.
  $IN-FORMATED-VERB-RV =
       IMMEDIATE-NODE IS RV
       WHERE AT IMMEDIATE VERBAL, DO $IS-FORMATED.
  $MOVE-THROUGH-TREE =
       EITHER $GO-DOWN-TREE
       OR ITERATET $GO-UP-TREE UNTIL GO RIGHT SUCCEEDS.
  $GO-DOWN-TREE = PRESENT-ELEMENT- IS NOT EMPTY; GO DOWN.
  $GO-UP-TREE =
       GO UP;
       PRESENT-ELEMENT- IS NOT IDENTICAL TO X-ASSERT
       [* stop at starting point *].
* END-FORMATS
*CLOSE(A)
