*COMPILE()
* --- TRANSFORMATION COMPONENT - Version 12.0 2000.06.27
*     WRITE ON INFO / DIAG / STD
*     removes all selection lists.
* --- 05/18/2001: change H-TMPER to H-TMDUR, H-DEVICE to H-DEVMED
* --- 04/10/2001: Change SEM-HOST to SEM-CORE
* --- 04/10/2001: delete OFSTG
* --- 04/09/2001: add PHRASE-ATT TIME-POST-PHRASE
* --- May 7, 2000: install T-LXR-ANTCEDENT with changes to PROPOSE-ANTECEDENT
* --- To do:
*   ... she had one episode of coughing it up which was slightly pink.
*LKED()
*OBJSW=T
*BNF
<ADJN>        ::= NULL.
<DP1P>        ::= NULL.
<DP2PN>       ::= NULL.
<DP3PN>       ::= NULL.
<DP4PN>       ::= NULL.
<DPSN>        ::= NULL.
<NASOBJBE>    ::= NULL.
<NINRN>       ::= NULL.
<NGEV>        ::= NULL.
<NPVINGO>     ::= NULL.
<NPVINGSTG>   ::= NULL.
<NSVINGO>     ::= NULL.
<NPSNWH>      ::= NULL.
<NTHATS>      ::= NULL.
<PSNWH>       ::= NULL.
<PSVINGO>     ::= NULL.
<SOBJBE>      ::= NULL.
<NPSVINGO>    ::= NULL.
<NSNWH>       ::= NULL.
<PAREN-RV>    ::= NULL.
<PNHOWS>      ::= NULL.
<PNSNWH>      ::= NULL.
<PNTHATSVO>   ::= NULL.
<PNVINGSTG>   ::= NULL.
<PSTG>        ::= NULL.
<TOBE>        ::= NULL.
<VINGSTGPN>   ::= NULL.
<PNN>         ::= NULL.
<PVINGSTG>    ::= NULL.
<QUOTESTG>    ::= NULL.
<SNWH>        ::= NULL.
<SVEN>        ::= NULL.
<VINGOFN>     ::= NULL.
<VINGSTG>     ::= NULL.
<WHETHS>      ::= NULL.
<TANTSTG>     ::= NULL.
<VSUBJ>       ::= NULL.
* ATOMIC SYMBOLS NOT YET IN USE
<UNUSED> ::= <*CS0> / <*CS2> / <*CS3> / <*CS4> / <*CS5> /
             <*CS6> / <*CS7> / <*CS8> / <*CS10> /
             <*GRAM-NODE> / <*INT> / <*NG> /
             <*NULLPRO1> / <*NULLPRO2> / <*NULLC> / <*NULLN> .
<AINSIQUESTG>    ::= NULL.
<AND-ORSTG>      ::= NULL.
<AS-WELL-AS-STG> ::= NULL.
<ASSTG>          ::= NULL.
<ASTGP>          ::= NULL.
<BEDATE>         ::= NULL.
<BEINGO>         ::= NULL.
<BOTHSTG>        ::= NULL.
<C1SHOULD>       ::= NULL.
<COLONSTG>       ::= NULL.
<CPDNUMBR>       ::= NULL.
<CSSTG>          ::= NULL.
<DASHSTG>        ::= NULL.
<DATEVAR>        ::= NULL.
<DAYYEAR>        ::= NULL.
<DMQSTG>         ::= NULL.
<DOSE-OF-N>      ::= NULL.
<EGSTG>          ::= NULL.
<EITHERSTG>      ::= NULL.
<ENVINGO>        ::= NULL.
<ESPECIALLY-STG> ::= NULL.
<ETCSTG>         ::= NULL.
<FORTOVO-N>      ::= NULL.
<FRACTION>       ::= NULL.
<FTIME>          ::= NULL.
<HOWQASTG>       ::= NULL.
<HOWQSTG>        ::= NULL.
<IMPERATIVE>     ::= 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.
<LTIME>          ::= NULL.
<LTVR>           ::= NULL.
<LVSA>           ::= NULL.
<MEDDOSE>        ::= NULL.
<MOREDATE>       ::= NULL.
<MORESPEC>       ::= NULL.
<NAMESTG>        ::= NULL.
<NEG>            ::= NULL.
<NEGV>           ::= NULL.
<NEITHERSTG>     ::= NULL.
<NINRN>          ::= NULL.
<NISTG>          ::= NULL.
<NNN>            ::= NULL.
<NORSTG>         ::= NULL.
<NOTOPT>         ::= NULL.
<NPDOSE>         ::= NULL.
<NPSNWH>         ::= NULL.
<NPSVINGO>       ::= NULL.
<NPVO>           ::= NULL.
<NPWHS>          ::= NULL.
<NQ>             ::= NULL.
<NSNWH>          ::= NULL.
<NSPOS>          ::= NULL.
<NSTGP>          ::= NULL.
<NTHATS>         ::= NULL.
<NUMBRSTG>       ::= NULL.
<NVINGO>         ::= NULL.
<NVSA>           ::= NULL.
<NWHSTG>         ::= NULL.
<OBJBESA>        ::= NULL.
<ORNOT>          ::= NULL.
<PA>             ::= 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.
<PUISSTG>        ::= NULL.
<PTIME>          ::= 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.
<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.
<SPECIMEN>       ::= NULL.
<STOVO-N>        ::= NULL.
<SUB10>          ::= NULL.
<SUB2>           ::= NULL.
<SUB3>           ::= NULL.
<SUB4>           ::= NULL.
<SUB5>           ::= NULL.
<SUB6>           ::= NULL.
<SUB7>           ::= 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.
<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.
<WITHSTG>        ::= WITH <SACONJ> <Q-CONJ> .
<YESNOQ>         ::= NULL.
* BNF DEFINITIONS
*
* 1. SENTENCE
<SENTENCE>    ::= <TEXTLET> .
<TEXTLET>     ::= <ONESENT> <MORESENT> .
<ONESENT>     ::= <SECTION> <INTRODUCER> <CENTER> <ENDMARK> .
<SECTION>     ::= <SECT-NAME> / <*NULL>.
<SECT-NAME>   ::= '[' (SUBJECTIVE / OBJECTIVE / ASSESSMENT / PLAN
                      / ADMINISTRATION / RISK-BEHAVIORS
                      / PAST-MEDICAL-HISTORY / SOCIAL-HISTORY
                      / FAMILY-HISTORY / MEDICATIONS / PHYSICAL-EXAM
                      / PHYSICAL-EXAMINATION / LABORATORY DATA
                      / LAB / FOLLOW-UP / MEDICATIONS-ON-DISCHARGE
                      / DISCHARGE-DIAGNOSIS / DISCHARGE-PROCEDURES
                      / HISTORY-OF-PRESENT-ILLNESS / IMPRESSION
                      / HOSPITAL-COURSE / PATIENT-INSTRUCTIONS) ']'.
<MORESENT>    ::= <*NULL> / <TEXTLET> .
<INTRODUCER>  ::= AND / OR / BUT / <INT-PHRASE> (':'/ '-')
                   / <*NULL>.
<INT-PHRASE>  ::= FAMILY HISTORY / PREOPERATIVE DIAGNOSIS
                  / POSTOPERATIVE DIAGNOSIS / DISCHARGE STATUS
                  /ADMISSION DATE / DISCHARGE DATE / DATE OF BIRTH
                  /DISCHARGE MEDICATIONS / <*ADJ> / <LNR>.
<CENTER>      ::= (<ASSERTION> / <SEGADJ> / <QUISEG> / <FRAGMENT>
                   / <RBHIVSTG> / <OBES>) <PAREN-FRAG> .
<PAREN-FRAG>  ::= '(' <FRAGMENT> ')' / '(' <ASSERTION> ')' / <*NULL> .
<SEGADJ>      ::= <NSTGT> / <PDATE> / <LDR> / <PN> .
<QUISEG>      ::= WHO <VERB> <SA> <OBJECT> <SA-LAST> .
<ENDMARK>     ::= '.' / ';' / '#' / '-'.
* 2. CENTER STRINGS
<ASSERTION>   ::= <SA> <SUBJECT> <SA> <TENSE> <SA> <VERB> <SA>
                  <OBJECT> <SA-LAST> .
<FRAGMENT>    ::= <SA> (<TOVO> / <TVO> / <VO> / <VINGO> /<NSTGF>
                   / <BESHOW> / <SVEN> / <VENPASS> /<ASTGF> / <PN>
                   / <WHOSEG>/ <LDATER>) <SA-LAST> .
<RBHIVSTG>    ::= <RBSUBJ> ':' <RBPRED>.
<NSTGF>       ::= <NSTG> .
<ASTGF>       ::= <ASTG> .
<BESHOW>      ::= <PROC> <BESUBJ> [':' / '-'] [<PDATE>/<SACONJ>]<OBJBE>
                  <SA-LAST>.
<PROC>        ::= <NSTG> [<PDATE>] [':'] / <*NULL> .
<BESUBJ>      ::= <NSTG> / <*NULL> .
<WHOSEG>      ::= WHO <TENSE> <SA> <VERB> <SA> <OBJECT> <SA-LAST> .
<OBES>        ::= <ASTG> <SA> <TENSE> <SA> <VERB> <SA> <SUBJECT>
                  <SA-LAST> .
<RBSUBJ>      ::= <LNR> / <HOWMANY> / <PERUNIT> / <RBASTG> .
<RBASTG>      ::= <ASTG> <SA> .
<HOWMANY>     ::= HOW MANY <*N>.
<RBPRED>      ::= NO / NONE / UNKNOWN / <*DT> / <QUANT> / <TVO> /
                  <ASTG> / <DSTG> / <LNR> .
* 5. SUBJECT STRINGS
<SUBJECT>     ::= THERE / <EKGSTG> / <NSTG> / <*NULLWH> / <*NULLC> / <WHATS-N> .
<NSTG>        ::= <LNR> .
<LNR>         ::= <LN> <NVAR> <RN> .
<NVAR>        ::= <*N> / <*PRO> / <*VING> / <*DS> / <QN>/ <NQ> / <Q10S> .
<Q10S>        ::= <*Q>.
<EKGSTG>      ::= <LWVR> <RNEKG>.
<LWVR>        ::= <LN> <WVVAR> <RWV>.
<WVVAR>       ::= <*N>.
<RWV>         ::= <RWVOPTS> <RWV> / <*NULL>.
<RWVOPTS>     ::= <IN-LEADS> / <PN> / <VENPASS> / <TOVO>.
<IN-LEADS>    ::= (<*P> / <*NULL>) <LLEADR>.
<LLEADR>      ::= <LN> <LEADVAR> <RLEAD>.
<LEADVAR>     ::= <*N> '-' <*N> /
                  <*N> THROUGH <*N> /
                  <*N> '-' <*Q> /
                  <*N> THROUGH <*Q> / <*N> .
<RLEAD>       ::= <*D> / <*NULL>.
<RNEKG>       ::= <ADJINRN> / <*NULL>.
* 7. VERB AND VERBAL OBJECT STRINGS
<VERB>        ::= <*NULLFRAG> / <*NULLC> / <LV> <VVAR> <RV> .
<VVAR>        ::= <*TV> / <*V> .
<TENSE>       ::= <LW> <*W> <RW> / <*NULL> / <*NULLC> .
<LVR>         ::= <LV> <*V> <RV>.
<VENO>        ::= <LVENR> <SA> <OBJECT> <SA-LAST> .
<LVENR>       ::= <LV> <*VEN> <RV> .
<VENPASS>     ::= <LVENR> <SA> <PASSOBJ> <SA-LAST> .
<VINGO>       ::= <LVINGR> <SA> <OBJECT> <SA-LAST> .
<LVINGR>      ::= <LV> <*VING> <RV> .
* 8. OBJECT STRINGS
<OBJECT>      ::=  <*NULLFRAG> / <*NULLC> / <NPVINGO> / <NTOVO> / <NPN> /
                  <VENO> / <NSTGO> / <NPDOSE> / <PDATE> / <PQUANT> /
               <PSVINGO> / <DP2> / <DP3> / <DP1>/ <TOVO> / <PN> / <VO> /
               <NPVINGO> / <ND> / <DSTG> / <THATS> / <PNTHATS> /
               <VINGO> / <NTOBE> / <OBJECTBE> /
               <OBJBE> / <SVEN> / <VENPASS> / <NTHATS> / <ASTG> /
               <NN> / <SOBJBE> / <WHETHS> / <ASSERTION> /
               <C1SHOULD> / <SVO> / <NA> / <*NULLOBJ> .
<PASSOBJ>     ::= <ASTG> / <ASOBJBE> / <PVINGO> / <PNTHATS> / <PN> /
                  <PDOSE> / <NSTGO> /
              <TOVO> / <P1> / <DP1> / <OBJBE> / <*NULLOBJ> / <THATS> /
              <DSTG> / <ASSERTION> <DP1PN>.
<OBJECTBE>    ::= <VINGO> / <VENPASS> / <EKGSTG> / <TOVO> / <OBJBE> /
                  <THATS> / <WHERES>.
<OBJBE>       ::= <ASTG> / <QUANT> / <NSTG> / <PVINGO > / <PN> / <PQUANT> /
                   <PDATE> / <LDR> .
<QUANT>       ::= <QN> (<PDATE> / <*NULL>) / <QPERUNIT> (<PDATE> / <*NULL>)
                   / <NQ> (<PDATE> / <*NULL>).
<NQ>          ::= <*N> <LQR>.
<QPERUNIT>    ::= [THE] <LQR> <PERUNIT> <REG-ADJ>.
<PERUNIT>     ::= (BY / '/') <*N> / '%' / PER <*N> / A <*N> / <*NULL> .
<REG-ADJ>     ::= <*ADJ> / <*NULL>.
<QN>          ::= <LQR> <*N> <RQ> <PERUNIT> <SCALESTG> ['X' <QN>] .
<SCALESTG>    ::= <*ADJ> / <IN-DIM> / <*D> / <*NULL>.
<IN-DIM>      ::= (IN / OF) <*N> .
<Q-AGE>        ::= <*Q> .
<PQUANT>      ::= <*P> <QUANT> .
<ASTG>        ::= <LAR> .
<NSTGO>       ::= <EKGSTG> / <NSTG> / <QUANT> / <*NULLC> / <*NULLWH> .
<DSTG>        ::= <LDR> .
<ND>          ::= <NSTGO> <DSTG> .
<LDR>         ::= <LD> <*D> <RD> .
<NTOVO>       ::= <NSTGO> <TOVO> .
<TOVO>        ::= <LP> TO <VO> .
<THATS>       ::= THAT <ASSERTION> .
<C1SHOULD>    ::= (THAT /<*NULL>) <ASSERTION> .
<NTHATS>      ::= <NSTGO> <THATS> .
<TVO>         ::= <TENSE> <SA> <VERB> <SA> <OBJECT> <SA-LAST> .
<VO>          ::= <TENSE> <SA> <LVR> <SA> <OBJECT> <SA-LAST> .
<SVO>         ::= <ASSERTION>.
* 8A. P STRINGS
<PD>          ::= <*P> <LDR> .
<PN>          ::= <LP> <*P> <NSTGO> .
<NPN>         ::= <NSTGO> <PN> .
<PNTHATS>     ::= <PN> <THATS> .
<PVINGO>      ::= <*P> <VINGO>.
<PSVINGO>     ::= <*P> <SVINGO>.
<NPVINGO>     ::= <NSTGO> <SA> <PVINGO> .
<NPDOSE>      ::= <NSTGO> <PDOSE> .
<PDOSE>       ::= <*P> <*DS> [<*P> <*DS>] .
<P1>          ::= <*P> .
* 8B. DP STRINGS
<DP1>         ::= <*DP> .
<DP2>         ::= <*DP> <NSTGO> .
<DP3>         ::= <NSTGO> <*DP> .
<DP4>         ::= <*DP> OF (NSTGO / <VINGO>) .
<DP1PN>       ::= <*DP> <PN>.
* 8D. NOMINALIZATION WITH ZEROED VERB BE
<NA>          ::= <NSTG> <ASTG> .
<NN>          ::= <NSTGO> <NSTGO>.
<SOBJBE>      ::= <SUBJECT> <OBJBE>.
<SVEN>        ::= <SUBJECT> <VENPASS>.
<NTOBE>       ::= <NSTGO> TO BE <OBJBE>.
<SASOBJBE>    ::= <NSTG> AS <OBJBE>.
<ASOBJBE>     ::= AS <OBJBE>.
* 9. SENTENCE ADJUNCT STRINGS
<SA>          ::= <*NULL> / <SAOPTS> <SA> .
<SA-LAST>     ::= <SAOPTS> <SA> / <*NULL>.
<SAOPTS>      ::= <PDATE> / <SUB11> / <SUB9> / <SUB12> / <SUB0> / <PN> /
                  <PD> / <LDR> / <VENPASS> / <VINGO> / <NSTGT> / <RNSUBJ> /
                  <RSUBJ> / <SUB5> / <SUB1> / <SUB2> / <SUB3> / <SUB8> /
                  <TOVO> / <PVINGO> / <PWHERES>.
<PDATE>       ::= (<*P> / <*NULL>) <LDATER> .
<LDATER>      ::= <LDATE> <DATEVAR> <RDATE> .
<DATEVAR>     ::= <*DT> '-' <*DT> / <*DT> / <T-DATE> .
<T-DATE>      ::= THE <*Q>.
<NSTGT>       ::= <NSTG> .
<RNSUBJ>      ::= <WHS-N> / <PWHS>  / <VENPASS> / <PAREN-RN> .
<RSUBJ>       ::= (<*PRO> / <*Q> / <*T>) [<PN> / <*D>].
<SACONJ>      ::= <SA> .
* 10. SUBORDINATE CONJUNCTION STRINGS
<SUB0>        ::= <*CS0> <OBJBE>.
<SUB1>        ::= <*CS1> <ASSERTION> .
<SUB2>        ::= <*CS2> <VENPASS> .
<SUB3>        ::= <*CS3> <VINGO> .
<SUB5>        ::= <*CS5> <SVINGO>.
<SVINGO>      ::= <SUBJECT> <SA> <VINGO> .
<SUB8>        ::= AS (WAS / WERE /DID) <SUBJECT> .
<SUB9>        ::= <*CS9> <VO>.
<SUB11>       ::= <TM-PHRASE> <ASSERTION>.
<SUB12>       ::= SHOULD <SVO>.
<SUB13>       ::= NULL.
<SUB1-PHRASE> ::= NULL.
<TM-PHRASE>   ::= FOLLOWING WHICH / DURING WHICH TIME / DURING WHICH
                  / BEFORE WHICH / AFTER WHICH / AFTER WHICH TIME.
* 11. RN RIGHT ADJUNCTS OF N
<RN>          ::= <RNOPTS> <RN> / <*NULL> .
<RNOPTS>      ::= <PAREN-RN> / <TQVINGO> / <PDATE> / <BPART> / <VENPASS>
                   / <ADJINRN> / <NTIME>
                   / <*DS> / <QUANT> / <LDR> / <PQUANT> / <PDOSE>
                   /<PVINGO> / <TOVO> / <PN> / <VINGO> / <THATS>
                   / <WHERES> / <PWHS> / <WHS-N>
                   / - <TOVO-N> / <WHENS> / <WHOSES>/ <S-N>
                   / - <PERUNIT> / <PAREN-NSTG> / <APPOS>.
<TQVINGO>     ::= <TQ> <VINGO>.
<TQ>          ::= <*T> / <*Q>.
<S-N>         ::= <ASSERTION>.
<PAREN-RN>     ::= '(' <RNOPTS> <RN> ')' .
<PAREN-NSTG>  ::= <NSTG> / <VO> / <PERUNIT> .
<ADJINRN>     ::= <LAR> .
<NTIME>       ::= <N> .
<BPART>       ::= <LNR> / <*ADJ> .
<TOVO-N>      ::= <LP> TO <LVR> <SA> <OBJECT> <SA-LAST> .
<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>        ::= <BP-VALUE> /<*Q> X <*Q> / <RATIO> / <QPER> / <QTH>
                   / <*Q> '-' <*Q> / <*Q> TO <*Q> / <*Q> OR <*Q>
                   / <*Q> OVER <*Q> /  <*Q> '+' <*Q>
                   / <*Q> 'X' <*Q> 'X' <*Q> / <*Q> OF <*Q>
                   / <*Q> 'OUT OF' <*Q> / <*Q> .
<BP-VALUE>    ::= <*Q> '/' P.
<QPER>        ::= <*Q> '/' <*N> .
<RATIO>       ::= <*Q> '/' <*Q>  ['/' <*Q>] .
<QTH>         ::= <*N> TO <*N> .
<APOS>        ::= <ADJADJ> / <*NULL>.
<ADJADJ>      ::= <LAR> / <QN-OF> / <QN> / - <QPERUNIT> / <NQ>
                     / <ADJADJ> (<LAR> / <QN> / <QPERUNIT> / <NQ>).
<LAR>         ::= <LA> <AVAR> <RA> .
<AVAR>        ::= <*ADJ> / <*VEN> /<*VING> .
<QN-OF>       ::= <QN> OF .
<NPOS>        ::= <NNN> / <*NULL> .
<NNN>         ::= <*N> / <*DS> / <*N> (<*ADJ>/<*VEN>)
                       / <NNN> (<*N> / <*DS>).
* 13. RIGHT ADJUNCTS - OTHER THAN RN
<RT>          ::= <*NULL> .
<RQ>          ::= <*D> / <REG-ADJ> / <*NULL> .
<RA>          ::= ENOUGH / <PAREN-ADJ> / <PDATE> / <PQUANT> / <FORTOVO>
                  / <PN> / <PVINGO> / <TOVO> / <TOSTG> / <TOVO-N>
                  / <THATS> / <ASSERTION> / <WHETHS> / <*NULL> .
<PAREN-ADJ>   ::= '(' <*ADJ> ')' .
<FORTOVO>     ::= FOR <SUBJECT> <SA> <TOVO> .
<TOSTG>       ::= TO <LAR>.
<RD>          ::= <*NULL> .
<RV>          ::= <PVINGO> / <PDATE> / <PQUANT> / <PN> / <THATS>
                   / <C1SHOULD> / <LDR> / <TOVO> / <NSTGT> / <*NULL>
                   / <QN> .
<RW>          ::= <LDR> / <*NULL> .
<RDATE>       ::= <WHENS> / <*NULL> .
* 14. LEFT ADJUNCTS - OTHER THAN LN
<LT>          ::= <*NULL> / <*Q> /<*D> .
<LA>          ::= <*NULL> / <LDR> / <QN> / <*Q> .
<LQ>          ::= <*D> / <*NULL> / <*ADJ> .
<LV>          ::= <LDR> / <*NULL>.
<LW>          ::= <*D> / <*NULL> .
<LD>          ::= <*NULL> / <*D> .
<LP>          ::= <QN-TIME> / <LDR> / <*NULL> .
<QN-TIME>     ::= <LQR> <*N>.
<LDATE>       ::= <*NULL> / MID / EARLY / LATE / THE / <*D> .
* <LTIME>       ::= <*NULL> / <*D> .
* 15. WH-STRINGS
<WHS-N>       ::= (WHO / WHICH / THAT) <ASSERTION>.
<S-N>         ::= <ASSERTION>.
<PWHS>        ::= <*P> WHICH <ASSERTION>.
<WHENS>       ::= <WHEN-PHRASE> <ASSERTION> .
<WHEN-PHRASE> ::= WHEN / AT WHICH TIME / AFTER WHICH / <*NULL>.
<WHATS-N>     ::= WHAT <ASSERTION>.
<WHERES>      ::= WHERE <ASSERTION>.
<PWHERES>     ::= <*P> WHERE <ASSERTION>.
<WHOSES>      ::= WHOSE <ASSERTION>.
<WHETHS>      ::= (WHETHER OR NOT / WHETHER / WHERE / WHEN / HOW
                   / WHY / IF) (<ASSERTION>/<TOVO>) .
* 16. CONJUNCTION STRINGS
<ANDSTG>      ::= (AND / '&') <SACONJ> <Q-CONJ> (EACH / <*NULL>) .
<ORSTG>       ::= OR <Q-CONJ> .
<NORSTG>      ::= NOR <Q-CONJ> .
<INCLUDINGSTG> ::= INCLUDING <Q-CONJ> .
<BUTSTG>      ::= BUT <SACONJ> <Q-CONJ> .
<PLUSSTG>     ::= PLUS <Q-CONJ> .
<COMMASTG>    ::= ',' ( <SACONJ> <Q-CONJ> / <*NULL>) .
<ANDORSTG>    ::=  'AND/OR' <Q-CONJ>.
<ASWELLASSTG> ::=  'AS WELL AS' <Q-CONJ>.
<INADDITIONTOSTG> ::= 'IN ADDITION TO' <Q-CONJ>.
<PARTICULARLYSTG> ::= PARTICULARLY <Q-CONJ>.
<EGSTG>       ::= 'E.G.' <Q-CONJ> .
<IESTG>       ::= 'I.E.' <Q-CONJ> .
<Q-CONJ>      ::= <*NULL> .
* TRANSFORMATIONAL DUMMIES
<LAUX>           ::= NULL.
<AGENT>          ::= NULL.
<PNX2>           ::= (<PN> / <PVINGSTG>) <SA> (<PN> / <PVINGSTG>).
* DUMMY NODE FOR WRITING FORMAT
<STOP>           ::= NULL.
<DUMMY>          ::= NULL.
<QUESTION>       ::= NULL.
* FORMAT NODES
<MODAL>          ::= NULL.
<TM-PER>         ::= 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,
*       FRMT4-5, FRMT5, FRMT5F, 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,
      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,
      QALL, QNUMBER, QROVING, [* new *] QAGE, QTENS, QDATE, 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,
      FRMT4, FRMT4-5, FRMT5, FRMT5F, FRMT6, FUTURE,
      IMPARFAIT, IMPERTVE,
      NOFRMT,
      OBJECTPRO, OBJLIST,
      PASS-SEL [CLASS FOR SELECTION LISTS- ALWAYS PASS],
      POBJLIST, PROG,
      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 =
        [* 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,
      E-AX [axis], E-EKGPROC [EKG test], E-LEAD [leads],
      E-INTVL [interval], E-WV [wave, for EKG], EMPTY-SET,
      FAIL-SEL, FEM,
      GENERIC,
      H-AGE, H-ALLERGY, H-AMT,
      H-BECONN, H-BEH,
      H-CELLTYPE, H-CHANGE, H-CHANGE-MORE, H-CHANGE-LESS,
      H-CHANGE-SAME, H-CHANGEMK, H-CHEM, 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-NOCLASS, H-NORMAL, H-NULL,
      H-OBSERVE, H-ORG,
      H-POST, H-PT, H-PTAREA, 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-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, NTIME2, 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-PTDESCR,
      H-SET, H-SHAPE, H-STATUS,
      H-TRIGGER [*weak causative*], H-TESTVIEW, H-TIMEQUAL, H-TYPE,
      H-VRX, H-VTEST,
      H-VTENSE,
      V-HEAL.
* NODE-ATTRIBUTES
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,
      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.
ATTRIBUTE = ANTECEDENT, ANALINK, MARK, QLINK, FUT-IMP.
* 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.
* 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 = SAVE-SELECT-ATT [* save Pronoun select-att for antecedent *].
ATTRIBUTE = SUPPORT-ATT [* save support class *].
* 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].
* XF-GLOBALS
GLOBAL = $ADD-ADJUNCT [T-VENO, T-PASSIVE, T-PVO-FUTURE],
         $ADD-TO-TENSE-ATT [T-TENSE,T-REG-FRAG,T-PVO-FUTURE,T-VENO],
         $ADD-TO-TFORM-ATT [T-NPVO, T-FORTOVO, T-NPVINGO, T-NSVINGO,]
                           [T-QUANT-OF, T-RN-FILLIN, T-RN-WH,]
                           [T-SASOBJBE, T-SAWHICHSTG, T-SOBJBE,]
                           [T-SVINGO, T-THATS, T-PVO-FUTURE,]
                           [T-TOVO-OF-VSENT3, T-VENO, T-WHATS],
         $ASSIGN-NEG [T-SANS, T-WHETHS, T-NEG-MODAL-AFFIX],
         $ASSIGN-COMP-AND-SEL [TSEL-GLOBAL, T-PASSIVE],
         $BUILD-BE [T-CSSTG, T-FRAG-TO-ASSRT, T-REG-FRAG],
         $CHECK-PN-CONN [T-RN-FILLIN, T-EXPAND-TO-ASSERT],
         $CONN-SELATT-CHK [$CONN-CHK, T-REMOVE-THERE],
         $EXPAND-OBJ [T-EXPAND-OBJ, T-VENO],
         $EXPAND-TO-ASSERTION [T-EXPAND-TO-ASSERT, T-EXPAND-OBJ],
         $GET-CONN [T-REMOVE-THERE, T-RN-FILLIN],
         $LN-MAKE [T-WHATS-N, T-INTRO, T-LCDVA-N, T-NSVINGO,]
                  [T-TIME-PREFIX],
         $LN-RN-NULL [T-RN-WH, T-CSSTG],
         $MAKE-ASSERT [T-CSSTG, T-REG-FRAG],
         $NO-PREFIXES [T-NOUN, T-ADJ, T-D],
         $NOT-CHANGER-PHRASE [T-SA-VFORM, T-REG-FRAG, T-SA-SEARCH,]
                             [T-FRAG-TO-ASSERT],
         $NOT-EXPAND-STR [T-EXPAND-TO-ASSERT, T-EXPAND-OBJ],
         $ORSTG-CONJ, $REPLACE-OR-BY-AND
         [* T-LNR-NEG-X-OR-Y, T-LAR-NEG-X-OR-Y, T-NO-X-OR-Y *],
         $PRINT-TFORM-INFO [T-FRAG-TO-ASSRT, T-NPVO, T-REMOVE-THERE],
         $REPLACE-NEG [T-SANS, T-RN-FILLIN],
         $REASSIGN-ATT [T-TENSE, T-VENO, T-PVO-FUTURE,T-PASSIVE,]
                       [T-NSVINGO, T-NOUN, T-NEG-MODAL-AFFIX,]
                       [T-TIME-PREFIX, T-ADJ, T-VENAPOS, T-MONTH,]
                       [T-D, T-Q],
         $SOBJBE-TO-ASSN [T-SOBJBE, T-SOBJBE-IN-VSENT3],
         $SET-REG-ATT [T-NSVINGO, T-NOUN, T-MONTH].
GLOBAL = $QEMPTY, $QDELETE, $QINSERT, $TEST-NODE
            [ROUTINE PROPOSE-ANTECEDENTS].
* SUBLANGUAGE SELECTION LISTS
LIST VBE-LIST = VBE.
*  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
*     CONJ-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-INTVL, E-LEAD, E-WV [for EKG],
      H-AGE, H-AMT,
      H-BECONN, [H-BEH,]
      H-CHANGE, H-CHANGE-MORE, H-CHANGE-LESS, H-CHANGE-SAME, H-CONN,
      H-CHEM, [H-CELLTYPE,]
      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.
* CONJ-EQUIV-CLASSES
*     A list used by the parsing grammar (rules appearing in WCONJ9)
*     to determine sublanguage semantic compatibility of conjuncts 
*     (two or more phrases joined by commas, "and", "or", nor",...).
*
*     The following assumptions apply:
*     A. An attribute is always conjunctionally equivalent
*        to itself (full list of attributes is found in
*        SUBLANGUAGE-ATTS list).
*        E.g. 'headache, fever and vomiting' each has identical
*             sublanguage attribute H-INDIC.
*     B. CONJ-EQUIV-CLASSES list is a list of all equivalence
*        classes appearing in sublists (shown below).
*        E.g. 'pain on upper surface and fingers'
*             (H-PTAREA and H-PTPART are conjunction equivalents
*     C. A computed attribute COMPUTED-ATT of a phrase is
*        used first to determine compatibility with its conjoined
*        phrase.  For example, 'fever and stiff neck' are judged
*        CONJ-EQUIVALENT because 'stiff neck' has
*        COMPUTED-ATT = H-INDIC. The lists N-COMP-ATT-LN and
*        N-COMP-ATT-RN contain the word class combinations that
*        that constitute COMPUTED-ATTs.
*
LIST CONJ-EQUIV-CLASSES =
  (H-CHANGE, H-CHANGE-MORE, H-CHANGE-LESS, H-CHANGE-SAME,
     H-TXRES, H-RESULT 
     [* creatinine increase H-CHANGE-MORE and MB of 12 H-RESULT *]),
  (H-CHEM, H-INDIC
     [* signs of black widow toxin and venomization *]),
  (H-TXRES, E-WV [* EKG revealed sinus rhythm with Q-waves *]),
  (H-TXRES, H-PTMEAS [* salt content and volume of water *]),
  (H-PTFUNC, H-PTPART [* sensory and motor exam *]),
  (H-PTFUNC, H-TTCOMP [* deficits in mobility and self-care *]),
  (H-PTFUNC, H-TXCLIN
     [* deep tendon reflexes, motor and sensory exam are intact *]),
  (H-PTPART, H-PTAREA, H-PTSPEC),
  (H-PT, H-RECORD),
  (H-PT, H-FAMILY [* according to the patient and his mother *]),
  (H-PTDESCR, H-FAMILY [* no change in Social Hx or Family Hx *]),
  (H-DIAG, H-PTDESCR, H-INDIC, H-RESULT, H-TXRES, H-ORG,
     H-RESP, H-DESCR, H-NORMAL 
     [* normal left vein H-NORMAL but occlusion H-INDIC of distal RCA *]),
  (H-INDIC, H-PTLOC
     [* chest pain unassociated with SOB or radiation *]),
  (H-RESP, H-TTGEN, H-DIAG, H-TTMED
     [* pt's condition, instructions, diagnosis and medications *]),
  (H-INDIC, H-TXCLIN,
     H-RESULT [* pain profile, PE, normal lactate *]),
  (H-TTMED [* allergic to penicillin *], H-DIAG, H-CHEM, H-TXVAR,
     H-DIET
     [* denies reaction to bee stings, latex, iodine or shellfish *]),
  (H-DIAG, H-MODAL [* assessment and plan will be... *]),
  (H-DIAG, H-TTSURG [* status post MI, CABG *],
     H-RESULT [* including CABG and ejection fraction of 20 % *]),
  (H-VTEST, H-TXPROC [* blood sampling and biopsy *]),
  (H-TXCLIN, H-TXPROC [* ... exam and stress test *]),
  (H-TXCLIN, H-TTSURG [* refused surgery or workup *]),
  (H-TXCLIN, H-TTGEN [* examination and consult *]),
  (H-TMLOC, H-TXCLIN, H-TTGEN
     [* history, exam, and medical decision making *]),
  (H-TXPROC, H-RESP [* pleased with procedure and recuperation *]),
  (H-TXPROC, H-TXVAR [* no new ECG or enzyme changes *]),
  (H-TMLOC, H-TXPROC, H-TXRES
     [* his history, exercise tolerance test and EKG changes *]),
  (H-DEVMED, H-TXPROC [* his battery pack and leads *]),
  (H-DEVMED, H-TTGEN [* inhaler and peak flow self-monitoring *]),
  (H-DEVMED, H-TTMED [* IV steroids and nebulizers *]),
  (H-TXSPEC, H-TXVAR,H-TXPROC,H-PTSPEC,H-PTPART,H-ORG[,H-RESULT]),
  (H-TTCOMP, H-TTMED, H-TTSURG[, H-TTGEN, H-DEVMED]),
  (H-TTCOMP, H-TTGEN, H-TXPROC
     [* hospitalization, oxygenation, monitoring *]),
  (H-TTCOMP, H-TTSURG, H-DEVMED [* ...therapy, angioplasty, stent *]),
  (H-TTCOMP, H-INST [* physical therapy and nursing Home Health *]),
  (H-TTCOMP, H-DIET [* hydration and nutrition are adequate *]),
  (H-TTSURG, H-TXPROC 
            [* coronary angiography and cardiac catheterization *]),
  (H-TTSURG, H-DIAG [* left hip arthroplasty and Perth's disease *]),
  (NTIME1, NTIME2 [* last week and again yesterday *]),
  (H-TMBEG, H-CHANGE, H-TMEND, H-TMLOC, H-POST,
     H-CHANGE-MORE, H-CHANGE-LESS, H-CHANGE-SAME),
  (H-TMREP, H-TMDUR [* prolonged and desynchronized *]),
  (H-AMT, H-DESCR [* in severity and frequency *]),
  (NSENT1, NSENT2, NSENT3),
  (NSENT1,
     H-INDIC [* In view of the chest pain and the fact that... *]),
  (H-TTMED, H-CHEM, H-PTFUNC,
     H-TTCOMP [* relieved by drugs and sleep *]),
  (H-TMLOC, H-TXPROC [* by history and electrocardiagrams *]),
  (H-DESCR, H-PTLOC [* nondermatomal and poorly localizing *]),
  (H-TXCLIN, H-TXVAR [french]).
* 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-INST, [H-DOCTOR,] H-PT.
* SIGN-SYMP
*     LIST OF SIGNS AND SYMPTOMS.
LIST SIGN-SYMP = H-INDIC, H-DIAG.
* LIST NON-PRONOUN-CLASSES
*    CLASSES IN SUBLANGUAGE-ATTS THAT ARE NOT A PRONOUN.
* -- THIS IS CURRENTLY USED FOR PRONOUN-ANTECEDENT RESOLUTION.
*    MAY 7, 2000
LIST NON-PRONOUN-CLASSES =
     H-VTEST, H-VTENSE, H-TRIGGER, H-TRANSP, H-TTFREQ,
     H-STATUS, H-SHOW, H-ETHNIC, H-PTVERB, [H-PTPALP,]
     H-PTLOC, H-PTDESCR, [H-OCCASION,] H-OBSERVE,
     H-NULL, [H-NOCLASS, H-LABRES, H-INTOX, H-HOSP,]
    [H-GROW,] H-EVID, [H-EVENT, H-DOCTOR, H-DIMENSION,]
     H-DESCR, [H-CELLTYPE,] H-CHEM, H-CONN, [H-BEH,]
     H-BECONN, H-AMT, [E-WV] E-INTVL, E-LEAD, E-AX, VHAVE, VDO, VBE,
     QNUMBER, NUNIT, [NULLNCLASS,] MASC, FEM,
       [* Time antecedents will be done separately *]
     H-TMREP, H-TMPREP, H-TMDUR,
     H-TMLOC, H-TMEND, H-TMBEG,
     NTIME2, NTIME1.
LIST TVO-SUBJECT = H-INST, 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.
* SIG-CLASS
*     LIST OF SIGNIFICANT MEDICAL SUBCLASSES.  IF WORD HAS MORE THAN
*     ONE OF THESE, IT IS A HOMOGRAPH, EXCEPT FOR H-CHANGE, H-STATUS
*     COMBINATION.
LIST SIG-CLASS =
      EMPTY-SET, [H-BEH,]
      H-CHEM [*S*], [H-NOCLASS,]
      H-CHANGE, H-CHANGE-MORE, H-CHANGE-LESS, H-CHANGE-SAME,
      H-DIAG, H-EVID, [H-GROW,]
      H-INDIC, H-MODAL, H-NEG, H-NORMAL,
      H-PTAREA, H-PTDESCR, H-PTFUNC, H-PTLOC, H-PTMEAS, H-PTPART,
      H-RESP, H-STATUS,
      H-TMEND, H-TMBEG,
      H-TTSURG, H-TTCOMP, H-TTGEN, H-TTMED,
      H-TXCLIN, H-TXPROC, H-TXRES, H-TXSPEC, H-TXVAR,
      H-TRANSP,
      NUNIT.
* MAJOR-SEL-CLASS
*   INDICATES THE MAJOR SUBLANGUAGE CLASSES WHICH IF
*   PARTICIPATING IN A FAILED SELECTION LIST, THE
*   ENTIRE SENTENCE IS REJECTED. [980218]
LIST MAJOR-SEL-CLASS =
   [H-NEG, H-MODAL,]
    H-CHEM, [H-CELLTYPE, H-NOCLASS,] H-ORG,
    H-PT, H-PTAREA, H-PTLOC, H-PTMEAS, H-PTPART, H-PTFUNC, H-PTSPEC,
    H-DIAG, H-INDIC, H-RESP, H-DESCR, H-NORMAL,
    H-TTSURG, H-TTCOMP, H-TTGEN, H-TTMED, H-TTMODE,
    H-TXSPEC, H-TXVAR, H-TXPROC, H-TXRES, H-TXCLIN.
* 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.
LIST CONN-TYPE-LIST = CONN-TYPE.
LIST CHANGE-LIST = H-CHANGE, H-CHANGE-MORE, H-CHANGE-LESS, H-CHANGE-SAME.
* H-PTSPEC-LIST
LIST H-PTSPEC-LIST = H-PTSPEC.
LIST H-TXVAR-LIST = H-TXVAR.
LIST TESTRES-LIST = H-TXRES.
LIST VSENT-LIST = VSENT1,VSENT2,VSENT3.
LIST NONHUMAN-LIST = NONHUMAN.
LIST NUNIT-LIST = NUNIT.
LIST QNUMBER-LIST = QNUMBER.
* AREA-LIST
*   USED BY T-FIXUP-ATOMS TO REMOVE H-PTAREA FROM
*   LIST ALSO CONTAINING H-PTPART- THIS IS DONE TO DETERMINE
*   WHETHER OR NOT WORD WITH H-PTPART AND H-PTAREA HAS ANOTHER SIG>
*   SUBCLASS AND THEREFORE IS A HOMOGRAPH.
LIST AREA-LIST = H-PTAREA.
* CONNECTIVE-LIST CONTAINS LIST OF WORD CLASSES TO BE TREATED AS
*     CONNECTIVES.
LIST CONNECTIVE-LIST =
      H-CONN, H-BECONN, CONJ-LIKE.
* NULLOBJ-LIST IS USED BY SELECTION TSEL-NULLOBJ WHEN OBJECT IS
*      NULLOBJ.
LIST NULLOBJ-LIST = NULLOBJ .
* SENTOBJ-LIST IS USED BY SELECTION TSEL-SENTOBJ FOR SENTENTIAL OBJ
LIST SENTOBJ-LIST = SENTOBJ .
* 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.
* PN-NULLOBJ-LIST IS USED IN TSEL-VEN-SUBJ TO CHECK THAT SURFACE SUBJECT
*     IS UNDERLYING OBJECT; THIS IS TRUE ONLY IF PASSOBJ = PN OR NULLOBJ
LIST PN-NULLOBJ-LIST = PN, NULLOBJ.
LIST NULLN-LIST = NULLNCLASS.
* BE-OR-SHOW-LIST IS USED BY TSEL-OBJ-VS FOR 'BE' OR 'SHOW'
* IN BESHOW.
LIST BE-OR-SHOW-LIST = VBE, H-SHOW .
* CONJSEL IS USED IN $WITH-CONJ OF TSEL-P-N TO MARK CONJUNCTION-LIKE
*   USE OF 'WITH', AS IN 'SWELLING WITH TENDERNESS'.
LIST CONJSEL = CONJ-LIKE.
* BECONN-LIST IS USED IN TSEL-VERB-SUBJ TO MARK CONNECTIVE-LIKE USE
*  OF 'BE' AS IN 'FOOT IS A BODYPART'
LIST BECONN-LIST = H-BECONN  .
* CONN-LIST IS USED IN TSEL-VERB-OBJ TO MARK VERBS WHICH ARE H-CONN .
LIST CONN-LIST = H-CONN .
* BEREP-LIST IS USED IN TSEL-VERB-SUBJ TO SET UP A LIST SIMILIAR
* TO LIST BE-S-O BUT HAVING BEREP AS SUBCLASS IN PLACE OF VBE.
LIST BEREP-LIST = BEREP .
* WHERE-LIST
*     LISTS ALLOWABLE HOSTS FOR WHERE + ASSERTION RELATIVE CLAUSE
LIST WHERE-LIST = EMPTY-SET.
* FORMAT-EQUIV-CLASS
LIST FORMAT-EQUIV-CLASS =
       ([H-LABRES,] H-INDIC, H-DIAG, H-DESCR, H-RESULT),
       (H-TXVAR, H-PTFUNC, [H-GROW,] H-TXCLIN, H-PTMEAS).
* MODAL-LIST
*    contains modal attribute H-MODAL for construction of SELECT-ATT.
LIST MODAL-LIST = H-MODAL.
LIST GENDER-LIST = MASC, FEM.
LIST NUMBER-LIST = SINGULAR, PLURAL.
LIST PRO-HUMAN-LIST = NHUMAN, NONHUMAN.
* CONN-ARGS-CLASSES
*    [OBSOLETE]
*    IS USED IN NOUN+PREPOSITIONAL PHRASE STRUCTURE IN WHICH
*    P IS AN H-CONN.
*    USED IN WCONJ9-DEFER [NOW OBSOLETE].
LIST CONN-ARGS-CLASSES =
     (H-DIAG, H-PTDESCR, H-INDIC, H-RESULT, H-TXRES,
      [H-ORG, H-STATUS,] H-RESP),
     (H-TXCLIN, H-PTFUNC, H-PTPART),
     (H-TTCOMP, H-TTMED, H-TTSURG, H-TTGEN),
     (H-TTSURG, H-TXPROC).
* SUPPORT-CLASSES-LIST
*   list of support classes and their main classes
LIST SUPPORT-CLASSES-LIST =
    GENERIC:(H-INDIC,H-DIAG,H-TTCOMP,H-ORG,H-TTMED,H-TTGEN,
             H-TXRES,H-DESCR,H-AMT),
    MASC:(H-PT,H-FAMILY,H-INST),
    FEM:(H-PT,H-FAMILY,H-INST),
    H-ALLERGY:(H-DIAG [* allergy *], H-INDIC [* allergen *]),
    H-PTPALP:(H-PTPART [* palpable bodypart *]),
    H-POST:(H-DIAG, H-DIET, H-INDIC, H-ORG, H-PTFUNC,
            H-TTCOMP, H-TTGEN, H-TTSURG, H-TXPROC),
    H-TMLOC:(H-AGE [* old *],
             H-CONN [* lead *],
             H-DIAG, H-DIET, H-INDIC, H-ORG,
             H-MODAL [* temporize *],
             H-TTCOMP, H-TTGEN, H-TTSURG, H-TXPROC,
             H-PTDESCR [* vacation *],
             H-PTFUNC [* menopause, thelarche *]),
    H-TMREP:(H-AMT [* mostly *],
             H-DIAG [* reinfarcts *],
             H-INDIC [* reoccurrence *],
             H-OBSERVE [* re-read *],
             H-PTVERB [* re-present *],
             H-RESP [* relapse *],
             H-TMLOC [* monthly, daily, nightly, weekly, yearly, seasonal *],
             H-TTCOMP [* recast, ... *],
             H-TTGEN [* readmit, reevaluate, ... *],
             H-TTSURG [* re-excision, re-cardiac catheterization *],
             H-TXPROC [* rechallenge *],
             H-TXRES [* reinterpret *],
             H-TXCLIN [* reexamination *]),
    H-TMDUR:(H-CHANGE-MORE [* progress *],
             H-CHANGE-SAME [* remain *],
             H-DESCR [* slow, slower, slowly *],
             H-TTGEN [* phased *]),
    H-TMBEG:(H-CONN [* trigger *],
             H-TTGEN [* initiate *]),
    H-TMEND:(H-RESP [* resolve *],H-TTGEN [* stop *],
             H-TTSURG [* removal *]).
* TYPE LISTS
*
TYPE ADJSET     = LA, LD, LDATE, LN, LP, LQ, LT, LTIME, LV, LW, RA,
                  RDATE, RD, RN, RQ, RT, RV, RW, SA, SA-LAST, LAUX.
TYPE ADJSET1    = LA, LD, LN, LP, LQ, LT, LTIME, LV, LW, ADJADJ, NNN,
                  ANDSTG, ANDORSTG, COMMASTG, BUTSTG, LAUX,
                  RA, RD, RN, RQ, RT, RV, RW, RWV.
TYPE RNOPTSET   = ADJINRN, PDATE, PN, PQUANT, VENPASS, TOVO , TOVO-N,
                  PWHS, LDR, [NPWHS,] DS, APPOS, PERUNIT, PDOSE,
                  PVINGO, VINGO, WHS-N, WHENS, WHOSES, PAREN-RN, BPART.
TYPE CONJ-NODE  = ANDSTG, ANDORSTG, ASWELLASSTG, BUTSTG, COMMASTG,
                  INADDITIONTOSTG, INCLUDINGSTG, ORSTG, NORSTG, PARTICULARLYSTG,
                  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, PARTICULARLYSTG,
                  PLUSSTG, WITHSTG, THANSTG,
                  [FRENCH] DMQSTG, NISTG, PUISSTG, INTSTG, AINSIQUESTG.
TYPE LADJSET    = LA, LAUX, LD, LDATE, LN, LP, LQ, LT, LTIME, LW, LV.
TYPE LXR        = LAR, LDATER, LDR, LNR, LQR, LTR, LVR, LVENR, LVINGR,
                  VERB, LLEADR [ekg], LWVR [ekg].
TYPE MINLIST    = PN, D, SUB1, NSTGT, INT, PDATE, TOVO, PVO.
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, RD, RDATE, RN, RNOPTS, RQ, RT, RV, RW, RWV [ekg],
                  RWVOPTS [ekg], RLEAD [ekg].
TYPE RECURSIVE  = TPOS, ADJADJ, NNN, RN, SA, LDR.
TYPE REPETITIVE = RN, RV.
TYPE STGSEG     = ASSERTION, TOVO, VINGO, QN, PVO, SVO.
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, PWHERES, 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, 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, SUB8, 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.
* 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.
TYPE VERBLIKE =
     TENSE, VERB, VERB1, VERB2, LVINGR, LVENR, LVR, LTVR.
TYPE NONLIT-ATOM =
      ADJ, CS0, CS1, CS2, CS3, CS4, CS5, CS6, CS7, CS8, D,
      [DATE,] DP, [INITIAL,] INT, N, NS, NULL, NULLC, NULLFRAG,
      NULLN, NULLOBJ, [NULLRECIP,] NULLWH, P, PRO, Q, T, TV,
      V, VEN, VING, W.
TYPE NP-LIKE = NSTG, EKGSTG, WHN.
TYPE ASSN-LIKE =
      ASSERTION, YESNOQ, IMPERATIVE, FRAGMENT,
      WHQ, WHQ-N, PWHQ, PWHQ-PN, WHNQ-N, PWHNQ, PWHNQ-PN,
      VO, OBES, TSUBJVO,
      FORTOVO, [SVINGO,] TOVO, [VINGSTG,]
      SOBJBE, SASOBJBE, SOBJBESA, [SVEN,]
      NASOBJBE, NVSA, NTOVO, STOVO-N,
      Q-CONJ,
      VENPASS.
*RESTR
* GRAMMAR SECTION
* ********** **************************************** **********
*                                                                *
*                          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 =
    [* take consideration of N under QN out of core- NVAR:QN *]
    DESCEND TO STRING NOT PASSING THROUGH ADJSET1;
    IF TEST FOR LN
    THEN $RIGHT-TO-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 LOCAL(XX-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 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-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) LOCAL(X150) =
  [* 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- LOCAL(X5) =
    [* 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- LOCAL(X7,XX-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 VINGO OR
        TOVO OR PVO OR VO OR Q-CONJ [* 20011217 add VINGO *].
 $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) LOCAL(X300) =
    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-  LOCAL(X200) =
  [* 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 LOCAL(X200,X600) =
  [* 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 LOCAL(X100,X500) =
  [* 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;
      [* this routine grossly assumes that    *]
      [* if X100 has POSTCONJELEMs, then they *]
      [* lie in between X100 and X500         *]
      [*     X100                             *]
      [*      +----- &                        *]
      [*             |                        *]
      [*             +---- Q-CONJ             *]
      [*                   |        X500      *]
      [*                   +---...---+        *]
      [*                                      *]
    EITHER BOTH AT X500, ITERATE GO LEFT
                         UNTIL TEST FOR CONJ-NODE SUCCEEDS
           AND AT X100, 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)
* CORE-SUPPORT-ATT
*   THIS ROUTINE WORKS LIKE A SELECTION LIST.
*   INPUT: NODE
*   OUTPUT: SUPPORT SUBLANGUAGE-ATTS IS STORED IN
*           THE NODE'S SUPPORT-ATT:MAIN-ATT
*           WHILE IT IS REMOVED FROM SELECT-ATT.
ROUTINE CORE-SUPPORT-ATT =
    CORE-SELATT X-SELATT OF PRESENT-ELEMENT- X100 EXISTS;
    IF BOTH SUCCESSORS OF X-SELATT IS NOT NIL
       AND X-NEWLIST := LIST SUPPORT-CLASSES-LIST
    THEN IF ALL OF $GET-SUPPORT-ATT, $GET-MAIN-ATT, $BUILD-SUPPORT-ATT
         THEN AT X100,
              BOTH ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE X-SELATT
              AND ASSIGN NODE ATTRIBUTE SUPPORT-ATT WITH VALUE X-SUPATT.
  $GET-SUPPORT-ATT =
     [* check if a class from SELECT-ATT is in the SUPPORT-CLASSES-LIST *]
    INTERSECT X-SUPPORT-ATTS OF X-SELATT IS NOT NIL.
  $GET-MAIN-ATT =
     [* check if a class from SELECT-ATT is the MAIN class *]
    ATTRIBUTE-LIST X-NEWLIST OF X-SUPPORT-ATTS IS NOT NIL;
    INTERSECT X-MAIN-ATTS OF X-SELATT IS NOT NIL.
  $BUILD-SUPPORT-ATT =
     [* taking X-SUPATT out of SELECT-ATT *]
    X-SUBLIST := X-SUPPORT-ATTS;
    X-SELATT := COMPLEMENT OF X-SELATT;
     [* store X-SUPPORT-ATT:X-MAIN-ATT to X-SUPATT *]
    X-SUPATT := NIL;
    X-MAIN-ATT := HEAD OF X-MAIN-ATTS;
    X-SUPPORT-ATT := HEAD OF X-SUPPORT-ATTS;
    PREFIX X-MAIN-ATT:X-SUPPORT-ATT TO X-SUPATT.
ROUTINE INTERSECT =
[* Takes intersection of list in current location with list stored ]
[* in register X-NEWLIST, and creates the list representing 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-;
INTERSECT X-NEWLIST WITH X-CURRENTLIST INTO X-INTERSECTION.
ROUTINE RINTERSECT =
    X-CURRENTLIST := PRESENT-ELEMENT-;
    INTERSECT X-NEWLIST WITH X-CURRENTLIST INTO X-INTERSECTION;
    INTERSECT X-CURRENTLIST WITH X-INTERSECTION INTO X-CURRENTLIST;
    GO 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 CURRENT 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.
* NEW-HOST
*    FINDS POTENTIAL NEW HOST FOR RIGHT-ADJUNCTS OR SA-
*    1- IF OLD HOST IS IN A NEST OF PN'S, THEN NEW HOST WILL BE THE
*       N IN THE NEXT LEVEL UP, IF THERE IS ONE; OTHERWISE
*    2- IF HOST IS NOT IN A NEST OF PN'S THEN NEW HOST WILL BE
*       THE NEXT LEVEL VERB OF THE IMMEDIATE-STRING.
*       [X-START,X-HOST]
*
ROUTINE NEW-HOST =
    AT X-START, IT IS NOT THE CASE THAT FOLLOWING-ELEMENT- EXISTS
                WHERE PRESENT-ELEMENT- IS NOT EMPTY;
    NEITHER X-START IS [NOT] OCCURRING IN OBJECT OR OBJBE
    NOR IMMEDIATE-NODE- OF X-START IS SA;
    X-CONJ := X-HOST [old host];
    BOTH X-CONJ := NIL
         [* RA contains PN, PQUANT *]
         [* RN contains ADJINRN, PD, PDATE, PN, PQUANT, PVO, *]
         [*             VENPASS, WHENS *]
         [* RV contains PD, PDATE, PN, PQUANT *]
         [* SA contains FTIME, INT, LDR, NSTGT PDATE, PN *]
    AND IF X-START IS ADJINRN OR NSTGT OR PN [OR QN] OR PD OR
                              PDATE OR PQUANT OR PVO OR VENPASS
       @THEN DO $UP-TO-RADJ [$NEXT-CORE]
        ELSE NOT TRUE [CANNOT FIND NEW HOST].
 $UP-TO-RADJ =
    AT X-HOST, ITERATE GO UP UNTIL $UP-LIMIT SUCCEEDS.
 $UP-LIMIT =
    [* Limits of search for new RADJSET are:     *]
    [*     (1) found new RADJSET or SA           *]
    [*     (2) the immediate node has lexically  *]
    [*         filled right coelement            *]
    [*     (3) the immediate node has right SA   *]
    BOTH BOTH IMMEDIATE-NODE- IS NOT SA
         AND NOT $RIGHT-NOT-EMPTY
    AND BOTH ITERATET GO UP
             UNTIL BOTH PRESENT-ELEMENT- X-NEWADJ EXISTS
                   AND $SEARCH-FOR-RADJ SUCCEEDS
        AND IF X-IMM IS SA
            THEN BOTH X-START IS NOT ADJINRN
                 AND CORE- X-HOST OF COELEMENT VERBAL OF X-IMM EXISTS
            ELSE AT X-NEWADJ, HOST- X-HOST EXISTS.
 $SEARCH-FOR-RADJ =
    EITHER IMMEDIATE-NODE- X-IMM IS OF TYPE RADJSET
    OR EITHER X-IMM IS SA
       OR EITHER AT X-IMM DO $RIGHT-NOT-EMPTY
          OR AT X-IMM DO $RIGHT-IS-SA.
 $RIGHT-NOT-EMPTY =
    ITERATE GO RIGHT UNTIL PRESENT-ELEMENT- IS NOT EMPTY SUCCEEDS.
 $RIGHT-IS-SA =
    ITERATE GO RIGHT
    UNTIL BOTH PRESENT-ELEMENT- X-IMM IS SA
          AND VALUE X-NEWADJ OF X-IMM EXISTS SUCCEEDS.
 $NEXT-CORE =
    IF X-HOST IS OCCURRING IN PN OR FTIME OR NSTGT OR PDATE
    @THEN IF BOTH PRESENT-ELEMENT- IS OCCURRING IN SA X-NEWADJ
             AND X-START IS NOT ADJINRN
          THEN AT X-NEWADJ CORE- X-HOST OF COELEMENT VERBAL EXISTS
          ELSE IF PRESENT-ELEMENT- IS OCCURRING IN RADJSET X-NEWADJ
               @THEN HOST- X-HOST EXISTS
               ELSE IF X-START IS NOT ADJINRN
                    THEN $NEXT-STRING-V
                    ELSE NOT TRUE
    ELSE $NEXT-STRING-V.
 $NEXT-STRING-V =
    IMMEDIATE STRING EXISTS;
    ITERATE GO UP
       UNTIL EITHER CORE X-HOST OF COELEMENT VERBAL IS NOT EMPTY
             OR PRESENT-ELEMENT- IS OF TYPE RADJSET
                WHERE HOST X-HOST IS NOT EMPTY SUCCEEDS.
* ********* CONJUNCTION ROUTINES FOR TRANSFORMATIONS
ROUTINE CONJUNCT = PRESENT-ELEMENT- HAS NODE ATTRIBUTE POSTCONJELEM.
* EXPAND
*     THE EXPAND ROUTINE OPERATES RECURSIVELY TO EXPAND CONJUNCTS OF
*     CONJUNCTS, AND CAN ALSO HANDLE SEVERAL CONJUNCTIONS ON A SINGLE
*     LEVEL (ALTHOUGH THIS IS VERY RARE).  IT RESETS THE NODE
*     ATTRIBUTES POSTCONJELEM (WHICH POINTS FORWARD TO THE NEXT
*     CONJUNCT OF AN ELEMENT) AND PRECONJELEM (WHICH POINTS BACKWARD
*     TO THE PRECEDING CONJUNCT OF AN ELEMENT) FOR THE NEW
*     STRUCTURE.
*
*     EXPAND STARTS AT NODE X.  IF THERE ARE ANY CONJUNCTIONAL
*     STRINGS [TYPE CONJ-NODE] ON LEVEL BELOW X, EXPAND COMPLETES THE
*     DEFINITION OF Q-CONJ SO THAT IT IS A COMPLETE STRING [I.E.
*     SUBJ VERB1 OBJ1 CONJ VERB2 OBJ2 ==> SUBJ VERB1 OBJ1 CONJ
*     SUBJ VERB2 OBJ2]. NODE X IS INSERTED BETWEEN Q-CONJ AND ITS
*     ELEMENTS SO THAT Q-CONJ=X=ELEMENTS OF Q-CONJ. THE CONJUNCTIONAL
*     STRING IS MOVED FROM THE LEVEL BELOW X UP ONE LEVEL TO THE
*     RIGHT OF X.
*
ROUTINE EXPAND =
      VERIFY ALL OF $REGSTG, $REGVAL, $XCONJ-TEST.
  $REGSTG = PRESENT-ELEMENT- X21 EXISTS [save starting node in X21].
  $REGVAL = LAST-ELEMENT- X22 OF X21 EXISTS
           [Node to be tested for conjunction in X22,]
           [start at rightmost].
  $XCONJ-TEST =
      ITERATET $EXPAND-CONJ UNTIL $TEST-FOR-CONJ FAILS;
      GO UP [to original string];
      ITERATE VERIFY $ASSIGN-ATT UNTIL GO RIGHT FAILS
            [EXPAND if there are conjunctionsi;]
            [EXPAND each conjunction].
  $TEST-FOR-CONJ =
      AT X22
      ITERATET GO LEFT
      UNTIL TEST FOR CONJ-NODE
            WHERE VERIFY ELEMENT- Q-CONJ EXISTS SUCCEEDS;
      STORE IN X22;
      ELEMENT- Q-CONJ X23 EXISTS
            [ complete Q-CONJ so that it is a complete STRING]
            [ i.e. it has same elements as X ].
  $EXPAND-CONJ = BOTH $COMPLETE-Q-CONJ AND $MOVE-CONJ-UP
            [COMPLETE Q-CONJ AND MOVE CONJ-NODE UP ONE LEVEL].
  $COMPLETE-Q-CONJ =
       ALL OF $COMPLETE-FRONT, $COMPLETE-END, $ERASE-PRE-POST
            [COMPLETE FRONT AND END OF Q-CONJ.  ERASE CONJUNCTION]
            [ NODE ATTRIBUTES].
  $COMPLETE-FRONT =
       AT VALUE X25 OF X23
       EITHER ITERATET $INSERT-PREVELEM
              UNTIL $FRONT-INCOMPLETE FAILS
       OR TRUE
            [LOCATE NODE THAT SHOULD BE INSERTED IN FRONT OF Q-CONJ].
  $INSERT-PREVELEM =
       BEFORE X25 INSERT X24 [INSERT NODE AT FRONT OF Q-CONJ];
       STORE IN X25;
       GO TO X24.
  $FRONT-INCOMPLETE =
         [* Go to the corresponding preconjuncts and then left *]
       ITERATET $PRECONJ [COEL1-] UNTIL GO LEFT SUCCEEDS;
         [* which is format equivalent statement *]
       ITERATET GO LEFT UNTIL $FMT-EXPANDABLE SUCCEEDS;
       STORE IN X24.
  $FMT-EXPANDABLE =
         [* statement phrases bypassed by expand conjunction *]
       PRESENT-ELEMENT- IS NOT OF TYPE STATEMENT-EQV-NODES.
  $COMPLETE-END =
       LAST-ELEMENT- X25 OF X23 [Q-CONJ] EXISTS;
       AT X22 EITHER ITERATET $INSERT-NEXTELEM
                     UNTIL $END-INCOMPLETE FAILS
              OR TRUE
         [LOCATE NODES THAT SHOULD BE INSERTED AFTER END OF Q-CONJ].
  $END-INCOMPLETE =
         [* Go to the node to the right of CONJ-NODE *]
       ITERATET $PREVIOUS-CONJ UNTIL GO RIGHT SUCCEEDS;
         [* which is format equivalent statement *]
       ITERATET GO RIGHT UNTIL $FMT-EXPANDABLE SUCCEEDS;
       STORE IN X24.
  $PREVIOUS-CONJ =
       BOTH IMMEDIATE-NODE- IS Q-CONJ
      @AND IMMEDIATE-NODE- EXISTS [GO UP TO NEXT CONJUNCTION LEVEL].
  $INSERT-NEXTELEM =
       AFTER X25 INSERT X24 [INSERT NODE AT END PART OF Q-CONJ];
       STORE IN X25;
       GO TO X24.
  $ERASE-PRE-POST =
       AT VALUE OF X23 ITERATE VERIFY $ERASE-ATT
                       UNTIL GO RIGHT FAILS
           [ERASE PRECONJELEM AND POSTCONJELEM ATTRIBUTES OF ]
           [ELEMENTS OF Q-CONJ AND STARTING NODE RESPECTIVELY].
  $ERASE-ATT =
       BOTH $ERASE-PRE
       AND IF X26 EXISTS
          @THEN BOTH $ERASE-POST AND $RESET-X26 .
  $ERASE-PRE =
       IF PRESENT-ELEMENT- X28 HAS NODE ATTRIBUTE PRECONJELEM X26
       THEN ERASE NODE ATTRIBUTE PRECONJELEM.
  $ERASE-POST =
       IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE POSTCONJELEM X26
       THEN ERASE NODE ATTRIBUTE POSTCONJELEM.
  $MOVE-CONJ-UP = [RENAME Q-CONJ AND MOVE CONJ-NODE UP]
       BOTH $NAME-Q-CONJ AND $MOVE-UP.
  $NAME-Q-CONJ =
       REPLACE X23 BY X23 (X21 (ALL ELEMENTS OF X23))
           [VALUE OF Q-CONJ IS NAME OF STARTING NODE].
  $ERASE-RESET-PRE =
       AT VALUE X27 OF Q-CONJ OF X25
       BOTH $ERASE-PRE
       AND IF X26 EXISTS
           THEN BOTH $RESET-POST AND $RESET-X26.
  $RESET-POST =
      [BOTH AT X21] [ORIGINAL NODE] [PRESENT-ELEMENT- X0 EXISTS]
      [AND] AT X26
       ASSIGN PRESENT ELEMENT NODE ATTRIBUTE POSTCONJELEM
       WITH VALUE X21.
  $RESET-X26 =
       AFTER X26 INSERT <STOP>;
       STORE IN X26;
       DELETE X26 [RESETS X26 TO BE EMPTY];
       GO TO X28 [STARTING POINT FOR $ERASE-ATT].
  $ERASE-RESET-POST =
       AT X27
       IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE POSTCONJELEM X26
       THEN BOTH ERASE NODE ATTRIBUTE POSTCONJELEM
            AND IF X26 EXISTS THEN BOTH $RESET-PRE AND $RESET-X26.
  $RESET-PRE =
      [BOTH AT X21 PRESENT-ELEMENT- X0 EXISTS]
      [AND] AT X26
           ASSIGN PRESENT ELEMENT NODE ATTRIBUTE PRECONJELEM
           WITH VALUE X21.
  $MOVE-UP =
       ALL OF $INSERT-CONJ-UP, $DELETE-LOWERCONJ, $ERASE-RESET-PRE,
              $ERASE-RESET-POST, $EXPAND-NEW, @$RESTORE-REG.
  $INSERT-CONJ-UP = [MOVE CONJ-NODE X22 UP ONE LEVEL]
       AFTER X21 INSERT X22;
       STORE IN X25.
  $DELETE-LOWERCONJ = [DELETE LOWER LEVEL CONJ-NODE]
       DELETE X22;
       STORE IN X22.
  $ASSIGN-ATT =
       IF BOTH PRESENT-ELEMENT- X19 IS OF TYPE CONJ-NODE
                 [CHECK DONT HAVE JUST PUNCTUATION COMMASTG]
               WHERE VERIFY ELEMENT- Q-CONJ EXISTS
          AND $MATCHED-ASSERTS
       THEN ALL OF $CONJ-TO-RIGHT
            [IF THERE IS A CONJ-NODE TO THE RIGHT  ]
            [OF THIS ONE, STORE IT IN X29 AND ERASE]
            [ITS PRECONJELEM NODE ATTRIBUTE],
                   $ASSIGN1
            [ASSIGN PRECONJELEM ND ATT FOR THIS CONJ-ND],
                   $ASSIGN2
            [IF X29 EXISTS ASSIGN PRECONJELEM TO ITS Q-CONJ].
  $MATCHED-ASSERTS =
     [* Routine EXPAND expects same node name on both sides of  *]
     [* CONJ-NODE, so at the following allowed frame will fail: *]
     [*                                                         *]
     [*            ASSERTION ---- &                             *]
     [*                           |                             *]
     [*                           +------- Q-CONJ               *]
     [*                                    |                    *]
     [*                                    FRAGMENT...          *]
       ITERATE GO LEFT UNTIL TEST FOR CONJ-NODE FAILS;
       IF PRESENT-ELEMENT- X191 IS ASSERTION
       THEN VALUE OF Q-CONJ OF X19 IS ASSERTION
       ELSE IF X191 IS FRAGMENT
            THEN VALUE OF Q-CONJ OF X19 IS FRAGMENT.
  $CONJ-TO-RIGHT =
       IF ITERATE GO RIGHT
          UNTIL TEST FOR CONJ-NODE
                WHERE VERIFY ELEMENT- Q-CONJ EXISTS SUCCEEDS
      @THEN $ERASE-RIGHT.
  $ERASE-RIGHT =
       STORE IN X29;
       VALUE OF ELEMENT- Q-CONJ EXISTS;
       ITERATE VERIFY $ERASE-ATT UNTIL GO RIGHT FAILS .
  $ASSIGN1 = DO PRE-POST-CONJELEM.
  $ASSIGN2 = IF BOTH X29 EXISTS
                AND $MATCHED-ASSNS
             THEN AT X29, BOTH DO PRE-POST-CONJELEM AND $RESET-X29.
  $MATCHED-ASSNS =
       IF X191 IS ASSERTION
       THEN VALUE OF Q-CONJ OF X29 IS ASSERTION
       ELSE IF X191 IS FRAGMENT
            THEN VALUE OF Q-CONJ OF X29 IS FRAGMENT.
  $RESET-X29 =
       AFTER X29 INSERT <STOP>;
       STORE IN X29;
       DELETE X29 [THIS EMPTIES REGISTER X29 ];
       GO TO X19 [STARTING POINT FOR $ASSIGN-ATT].
  $EXPAND-NEW =
          [CALL EXPAND FROM VALUE OF Q-CONJ TO EXPAND]
          [NESTED CONJUNCTIONS]
       AT VALUE OF Q-CONJ OF X25, DO EXPAND.
  $RESTORE-REG =
       GO UP [TO Q-CONJ]; GO UP [TO CONJ-NODE];
       ITERATE GO LEFT UNTIL TEST FOR CONJ-NODE FAILS
                 [GO BACK TO ORIGINAL STRING];
       DO $REGSTG [PUT ORIGINAL STRING BACK INTO X21];
       DO $REGVAL
         [PUT LAST COELEMENT OF ORIGINAL STRING BACK INTO X22].
* IS-EVENT: ASSUMED TO BE AT A LIST OF SUBCLASSES. CHECKS LIST TO
*           SEE WHETHER IT HAS A SUBCLASS ON IT CORRESPONDING TO
*           A MEDICAL EVENT. IF IT DOES 'IS-EVENT' RETURNS SUCCESSFUL.
*           OTHERWISE 'IS-EVENT' FAILS.
ROUTINE IS-EVENT =
      PRESENT-ELEMENT- HAS MEMBER SIG-CLASS;
      IF PRESENT-ELEMENT- X-IS-EV HAS MEMBER MOD-CLASS
              [MAKE SURE IT IS MOD A BODYPART OR UNIT MOD]
      THEN BOTH X-NEWLIST:= LIST SIG-CLASS WHERE INTERSECT X-IS-EV
              OF X-IS-EV IS NOT NIL
           AND X-SUBLIST:= LIST MOD-CLASS
                [TEST LIST WITHOUT MODIFIERS]
               WHERE COMPLEMENT OF X-IS-EV IS NOT NIL.
* NEXT-ADJUNCT
ROUTINE NEXT-ADJUNCT(X) =
     IF PRESENT-ELEMENT- IS EMPTY
        THEN $FIND-NEXT-ADJUNCT
     ELSE IF PRESENT-ELEMENT- IS OF TYPE ADJSET
          THEN AT VALUE, DO $AT-ADJUNCT
          ELSE $FIND-LAST-REQUIRED.
 $AT-ADJUNCT =
      [* $AT-ADJUNCT:  EXECUTED AT VALUE OF NON-EMPTY ADJSET-S    *]
      [* AND ADJAUX-ES.                                           *]
      [*      1. IF THIS VALUE IS THE ADJUNCT SOUGHT, RETURN      *]
      [*      2. ELSE, IF THIS VALUE IS AN ADJAUX (SECONDARY      *]
      [* ADJUNCT GROUPING), CALL $AT-ADJUNCT RECURSIVELY TO       *]
      [* LOOK ONE LEVEL FURTHER DOWN                              *]
      [*      3. ELSE LOCATE LAST REQUIRED ELEMENT OF THIS        *]
      [* ADJUNCT STRING AND THEN FIND THE NEXT ADJUNCT THEREAFTER *]
     EITHER TEST FOR X
     OR IF PRESENT-ELEMENT- IS OF TYPE ADJAUX
        THEN AT VALUE, DO $AT-ADJUNCT
        ELSE $FIND-LAST-REQUIRED.
  $FIND-LAST-REQUIRED =
      [* $FIND-LAST-REQUIRED:  EXECUTED AT ANY NONEMPTY NODE, IT   *]
      [* DESCENDS IN THE TREE TO THE LAST ATOM WHICH IS PART OF A  *]
      [* REQUIRED STRING ELEMENT AND THEN CALLS $FIND-NEXT-ADJUNCT *]
     ITERATET
        ITERATET GO LEFT UNTIL $REQUIRED SUCCEEDS
     UNTIL DO LAST-ELEMENT- FAILS;
     DO $FIND-NEXT-ADJUNCT.
 $REQUIRED =
     BOTH PRESENT-ELEMENT- IS NOT OF TYPE ADJSET1
     AND EITHER PRESENT-ELEMENT- IS NOT EMPTY
         OR PRESENT-ELEMENT- IS NVAR.
 $FIND-NEXT-ADJUNCT =
      [* $FIND-NEXT-ADJUNCT GOES RIGHT AND UP THE PARSE TREE  *]
      [* TO THE NEXT NON-EMPTY ELEMENT.  IF THE ELEMENT IS AN *]
      [* ADJSET OR ELEMENT OF AN ADJSET (AS COULD BE THE CASE *]
      [* FOR REPETITIVE ADJSET NODES), IT IS EXAMINED BY      *]
      [* $AT-ADJUNCT.  IF THE ELEMENT IS A REQUIRED STRING    *]
      [* ELEMENT, OR IF THERE ARE NO NON-EMPTY ELEMENTS IN    *]
      [* THE TREE, THE ROUTINE FAILS (NO MORE ADJUNCTS).      *]
     IF ITERATE
           ITERATET GO UP UNTIL GO RIGHT SUCCEEDS
        UNTIL PRESENT-ELEMENT- IS EMPTY FAILS
    @THEN IF PRESENT-ELEMENT- IS OF TYPE ADJSET
        THEN AT VALUE, DO $AT-ADJUNCT
        ELSE IF IMMEDIATE-NODE IS OF TYPE ADJSET
             THEN $AT-ADJUNCT
             ELSE FALSE
     ELSE FALSE.
*
*
*        P R O N O U N - A N T E C E D E N T S   R O U T I N E
*
*
* ROUTINE PROPOSE-ANTECEDENTS FINDS A LIST OF POSSIBLE ANTECEDENTS FOR
* A PRONOUN AND ATTACHES THIS LIST TO THE NSTG-HOST OF THIS PRONOUN.
ROUTINE PROPOSE-ANTECEDENTS =
      STORE IN XLIM;
      STORE IN XRLIM [* right edge limit *];
      BOTH BOTH X-FOUND := NIL AND X-LIST-OF-ANTE := NIL
      AND BOTH IF THE CORE- IS PRO:PROSELF
                  THEN DO $REFLEXIVE
               ELSE DO $ANTECEDENT-SEARCH
          AND IF BOTH X-LIST-OF-ANTE IS NOT NIL
                 AND X1 EXISTS [* no need for found antecedent *]
              THEN AT X1, ASSIGN NODE ATTRIBUTE ANTECEDENT
                          WITH VALUE X-LIST-OF-ANTE.
 $REFLEXIVE =
    [* SIMILAR TO ROUTINES OF $ANTECEDENT-SEARCH, HOWEVER, WITH  *]
    [* THE FOLLOWING DIFFERENCES :                               *]
    [*  1. THE SEARCH ONLY GOES UP AS FAR AS THE FIRST ASSERTION *]
    [*     NODE ENCOUNTERED; AND                                 *]
    [*  2. IT ONLY SEARCHES THE LEFT BRANCHES OF THE MARKED      *]
    [*     PATH.                                                 *]
      BOTH ITERATET $REFLEX-LOOP UNTIL $TEST-FOR-ASSN SUCCEEDS
      AND AT X1, DO $ERASE-MARK.
   $REFLEX-LOOP =
      DO $SEARCH-FOR-HOST; X3 := XTOP;
      DO $LOOK-LEFT-TREE; XLIM := X3.
   $TEST-FOR-ASSN =
      PRESENT-ELEMENT- XTOP IS OF TYPE ASSN-LIKE.
 $ANTECEDENT-SEARCH =
    [* EXECUTE THE FOLLOWING ROUTINES :                          *]
    [*  1. LOOK FOR A CYCLIC NODE -- EITHER NSTG OR ASSERTION--  *]
    [*     ABOVE THE PRO ($SEARCH-FOR-HOST);                     *]
    [*  2. SEARCH FOR ALL NSTG'S ON THE LEFT BRANCHES OF THIS    *]
    [*     CYCLIC NODE ($LOOK-LEFT-TREE);                        *]
    [*  3. IF THIS CYCLIC NODE IS THE HIGHEST ASSERTION, I.E.    *]
    [*     UNDER QUESTION OR CENTER NODE, THEN TERMINATE ROUTINE.*]
    [*  4. LOOK FOR A CYCLIC NODE ABOVE THE PRESENT ONE;         *]
    [*  5. SEARCH FOR ALL NSTG'S ON THE LEFT-BRANCHES UNDER      *]
    [*     THIS CYCLIC NODE AND PROPOSE THEM AS POSSIBLE ANTE-   *]
    [*     CEDENTS OF PRO;                                       *]
    [*  6. IF THIS IS AN ASSERTION NODE, THEN LOOK ALSO UNDER    *]
    [*     THE RIGHT BRANCHES FOR ALL NSTG'S AND PROPOSE THEM AS *]
    [*     POSSIBLE ANTECEDENTS OF PRO ($LOOK-RIGHT-TREE).  THIS *]
    [*     SEARCH SHOULD NOT GO UNDER ANY CYCLIC NODE;           *]
    [*  7. GO TO STEP 3.                                         *]
    [* EXECUTING THESE ROUTINES INVOLVES THE SETTING-UP AND      *]
    [* TEARING-DOWN OF A MARKED PATH -- THE CHAIN OF COMMANDING  *]
    [* NODES.                                                    *]
      DO $SEARCH-FOR-HOST; STORE IN X2;
      DO $LOOK-LEFT-TREE; XLIM := X2;
      ITERATET $LOOP-SEARCH
      UNTIL EITHER X-FOUND IS NOT NIL [* empty ? *]
            OR $TEST-FOR-CENTER SUCCEEDS;
      AT X1, DO $ERASE-MARK;
      IF BOTH X-ANAPHOR-HEAD EXISTS
         AND X-FOUND IS NOT NIL [* empty ? *]
      THEN BOTH DO $STORE-WORDPOS
           AND BOTH REPLACE X-ANAPHOR-HEAD BY X-FOUND, X1-NEW
               AND $RESTORE-WORDPOS.
      $STORE-WORDPOS =
         X-ANAPHOR-HEAD HAS NODE ATTRIBUTE WORD-POS X-WORDPOS.
      $RESTORE-WORDPOS =
         AT X1-NEW, ASSIGN NODE ATTRIBUTE WORD-POS WITH VALUE X-WORDPOS.
   $SEARCH-FOR-HOST =
    [* SET UP THE MARKED PATH : WHILE LOOKING FOR A CYCLIC NODE  *]
    [*        ABOVE PRO, MARK EVERY NODE ON THE WAY UP, INCLU-   *]
    [*        DING THE NSTG:PRO.  The right edge of search.      *]
      ITERATE $MARK-UP UNTIL $TEST-FOR-CYCLIC SUCCEEDS.
     $MARK-UP =
        BOTH ASSIGN NODE ATTRIBUTE MARK
        AND GO UP.
     $TEST-FOR-CYCLIC =
        EITHER PRESENT-ELEMENT- XTOP IS OF TYPE NP-LIKE
        OR EITHER XTOP IS OF TYPE ASSN-LIKE
           OR XTOP IS CENTER [* for conjoined CENTERs *];
        ASSIGN NODE ATTRIBUTE MARK.
   $LOOK-LEFT-TREE =
    [* THIS IS BREADTH-SEARCH, TOP-DOWN, LEFT-TO-RIGHT ROUTINE   *]
    [* ON THE LEFT BRANCHES OF, INCLUDING, THE MARKED PATH.      *]
      XLAST := XLIM; XFIRST := XLIM; XX := XTOP;
      DO $QINSERT;
      ITERATET $L-BREADTH-SEARCH UNTIL $QEMPTY SUCCEEDS.
     $QEMPTY =                                                  [GLOBAL]
        XFIRST DOES NOT HAVE NODE ATTRIBUTE QLINK.
     $L-BREADTH-SEARCH =
        DO $QDELETE;
        ITERATE  $L-ADDQ UNTIL $GO-RIGHT FAILS.
     $L-ADDQ =
        IF NOT $TEST-NODE-LEFT THEN DO $QINSERT.
     $GO-RIGHT = [* not passing the right edge *]
        BOTH PRESENT-ELEMENT- DOES NOT HAVE NODE ATTRIBUTE MARK
        AND GO RIGHT.
   $LOOP-SEARCH =
      BOTH $SEARCH-FOR-HOST AND X3 := XTOP;
      BOTH $LOOK-LEFT-TREE
      AND IF X3 IS ASSERTION
          THEN BOTH $LOOK-RIGHT-TREE
               AND BOTH IF XRLIM IS IDENTICAL TO XSTART
                        THEN $LOOK-RIGHT-OF-RLIM
                   AND XRLIM := X3;
      XLIM := X3.
   $TEST-FOR-CENTER =
      EITHER XTOP IS CENTER
        [* May 7, 2000--take out PRECONJELEM test *]
      OR EITHER [EITHER] IMMEDIATE-NODE- OF XTOP IS CENTER
                [OR BOTH IMMEDIATE-NODE- OF XTOP IS Q-CONJ]
                [   AND AT XTOP, DO $CONJOINED-CENTERS]
         OR EITHER IMMEDIATE-NODE- OF XTOP IS QUESTION
                   WHERE IMMEDIATE-NODE- IS CENTER
            OR IMMEDIATE-NODE- IS INTRODUCER.
     $CONJOINED-CENTERS = [* corresponding to epar10a *]
         EITHER ITERATE PRESENT-ELEMENT- HAS NODE ATTRIBUTE
                        PRECONJELEM [* go to top conjuncts *]
         OR TRUE;
         IMMEDIATE-NODE- IS CENTER.
     $LOOK-RIGHT-TREE=
    [* THIS IS ALSO BREADTH-SEARCH, TOP-DOWN, LEFT-TO-RIGHT      *]
    [* ROUTINE ON THE RIGHT BRANCHES OF, BUT NOT INCLUDING,      *]
    [* THE MARKED PATH.                                          *]
        XTOP HAS IMMEDIATE-NODE- XX;
        GO TO XLIM;
        ASSIGN NODE ATTRIBUTE QLINK WITH VALUE XX;
        XLAST := XX;
        ITERATET $R-BREADTH-SEARCH UNTIL $QEMPTY SUCCEEDS.
     $R-BREADTH-SEARCH =
        DO $QDELETE;
        IF IMMEDIATE-NODE- OF PRESENT-ELEMENT- HAS NODE ATTRIBUTE MARK
        THEN ITERATET GO RIGHT UNTIL $MARK-TEST SUCCEEDS;
        ITERATE $R-ADDQ UNTIL GO RIGHT FAILS.
     $R-ADDQ =
        IF NOT $TEST-NODE-RIGHT THEN DO $QINSERT.
     $MARK-TEST =
        PRESENT-ELEMENT- HAS NODE ATTRIBUTE MARK.
     $LOOK-RIGHT-OF-RLIM =
        XRLIM HAS IMMEDIATE-NODE- XX;
        XLAST := XTOP; XFIRST := XTOP; DO $QINSERT;
        ITERATET $R-BREADTH-SEARCH UNTIL $QEMPTY SUCCEEDS.
     $QDELETE =                                                 [GLOBAL]
        BOTH AT XFIRST, STORE IN XOLD
        AND XFIRST HAS NODE ATTRIBUTE QLINK;
        STORE IN XFIRST;
        BOTH AT XOLD, ERASE NODE ATTRIBUTE QLINK
        AND GO DOWN.
     $QINSERT =                                                 [GLOBAL]
        AT XLAST, ASSIGN NODE ATTRIBUTE QLINK WITH VALUE XX;
        XLAST := XX.
     $TEST-NODE-LEFT =
        EITHER DO $ANTECEDENT-FOUND [* stop test if antecedent found *]
        OR  BOTH DO $LIST-ANTES
            AND EITHER DO $TEST-NODE
                OR XX IS IDENTICAL TO XLIM.
     $TEST-NODE-RIGHT =
        EITHER DO $ANTECEDENT-FOUND [* stop test if antecedent found *]
        OR  BOTH DO $LIST-ANTES
            AND EITHER DO $TEST-NODE
                OR EITHER XX IS IDENTICAL TO XRLIM
                   OR EITHER XX IS OF TYPE NP-LIKE
                      OR XX IS OF TYPE ASSN-LIKE.
     $ANTECEDENT-FOUND =
        [* if anaphor is a PRO                *]
        [* return true if antecedent is found *]
        IF BOTH X-ANAPHOR-HEAD EXISTS
           AND X-ANAPHOR-HEAD IS PRO
        THEN X-FOUND IS NOT NIL.
     $TEST-NODE =                                               [GLOBAL]
        EITHER BOTH VALUE OF XX IS NOT NULLN
               AND XX IS EMPTY
        OR EITHER XX IS OF TYPE ATOM
           OR XX IS OF TYPE VERBLIKE.
    $LIST-ANTES =
    [* $LIST-ANTES only considers NP-ATOMS as possible   *]
    [*             ANTECEDENTS of the ANAPHOR X1.        *]
      IF BOTH PRESENT-ELEMENT- XX IS
              N OR NS OR [PRO OR] VING OR NULLN [OR DATE]
              WHERE XX-SEL-ATT := CORE-ATT OF XX
    [* Among the possible antecedents, the ROUTINE rejects    *]
    [* NULLN in a partitive type noun phrase =                *]
    [*        NSTG = < ONE OR NULLN -- OF -- ANAPHOR X1>      *]
         AND BOTH BOTH NOT $PARTITIVE
                  AND BOTH BOTH X-ANAPHOR-HEAD EXISTS
                           AND X-ANAPHOR-HEAD IS PRO
                      AND ALL OF $GET-SEL-CLASS, $COLLECT-SPECS,
                                 $TEST-ANTECEDENT
                 [* only if XX-SEL-ATT is not nil *]
             AND XX-SEL-ATT IS NOT NIL
      THEN BOTH XX HAS NODE ATTRIBUTE INDEX X15
           AND BOTH PREFIX X15 TO X-LIST-OF-ANTE
               AND IF BOTH X-ANAPHOR-HEAD EXISTS
                      AND X-ANAPHOR-HEAD IS NOT IDENTICAL TO XX
                   THEN X-FOUND := XX.
    $GET-SEL-CLASS =
         [* get dictionary attribute list of the proposed antecedent *]
       XX-ATTS := ATTRIBUTE-LIST OF XX.
    $COLLECT-SPECS =
         [* get current SELECT-ATT of anaphor *]
       X-ANAPHOR-HEAD HAS NODE ATTRIBUTE SELECT-ATT X-MLP-ATT;
         [* get GENDER, NUMBER, HUMAN of anaphor *]
       ATTRIBUTE-LIST X-ATT-LIST OF X-ANAPHOR-HEAD EXISTS;
       BOTH X-NEWLIST := LIST GENDER-LIST
       AND X-GENDER := INTERSECT OF X-ATT-LIST;
       BOTH X-NEWLIST := LIST NUMBER-LIST
       AND X-NUMBER := INTERSECT OF X-ATT-LIST;
       BOTH X-NEWLIST := LIST PRO-HUMAN-LIST
       AND X-HUMAN := INTERSECT OF X-ATT-LIST.
    $TEST-ANTECEDENT =
       EITHER X-HUMAN IS NIL [* is silent on NHUMAN attribute *]
       OR XX-ATTS HAS MEMBER X-HUMAN;
       EITHER X-GENDER IS NIL [* is silent on GENDER *]
       OR XX-ATTS HAS MEMBER X-GENDER;
       EITHER X-NUMBER IS NIL [* is silent on NUMBER *]
       OR EITHER XX-ATTS HAS MEMBER X-NUMBER
              [* or antecedent does not have SINGULAR or PLURAL *]
          OR BOTH X-NEWLIST := LIST NUMBER-LIST
             AND INTERSECT OF XX-ATTS IS NIL;
       X-NEWLIST := X-MLP-ATT;
       XX-SEL-ATT := INTERSECT OF XX-SEL-ATT.
    $PARTITIVE =
       BOTH EITHER XX IS NULLN
            OR XX SUBSUMES 'ONE' OR 'ONES'
       AND RIGHT-ADJUNCT-POS XRAP HAS NODE ATTRIBUTE MARK;
      [ELEMENT- RNP OF XRAP EXISTS;]
       AT ELEMENT- PN OF XRAP, BOTH P IS 'OF'
                       AND CORE- OF NSTG OF NSTGO IS IDENTICAL TO X1.
   $ERASE-MARK =
    [* ERASE THE MARKED PATH (AFTER *]
    [* ROUTINE ANTECEDENT IS DONE). *]
      ITERATE $ERASE-UP UNTIL $CENTER SUCCEEDS.
     $CENTER = PRESENT-ELEMENT- IS CENTER.
     $ERASE-UP =
        BOTH IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE MARK
             THEN ERASE NODE ATTRIBUTE MARK
        AND GO UP.
T-WRITE7 = IN SENTENCE:
    [WRITE ON TAPE7;]
     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 IDENTIFICATION;
     WRITE ON INFO END OF LINE;
     WRITE ON INFO SENTEXT [SOURCE];
     WRITE ON INFO END OF LINE;
     WRITE ON INFO END OF LINE.
* ***** ****************************************************************
*
*
*             E N G L I S H    T R A N S F O R M A T I O N S
*
*
* ***** ****************************************************************
* **********  GLOBAL SUBSTATEMENTS *********
T-GLOBAL = IN SENTENCE: TRUE.
*- REP
  $REP = REP SWITCH IS ON.
*- ASSIGN-COMP-AND-SEL
*     ASSIGN NEW SELECT-ATT AND IF NECCY A NEW COMPUTED ATT FOR X-N,
*     USING XN-SEL AS THE LIST CREATED BY SELECTION
*  ** INPUT: X-N [ATOM TO RECEIVE SELECT-ATT AND COMPUTED-ATT]
*  ** OUTPUT: SELECT-ATT, COMPUTED-ATT (RECOMPUTED) ASSIGNED TO X-N.
  $ASSIGN-COMP-AND-SEL =
      IF XN-SEL IS NOT NIL
      THEN IF X-N HAS NODE ATTRIBUTE COMPUTED-ATT X-NEWLIST
           THEN $NEW-COMP-AND-SEL
               [ASSIGN BOTH NEW COMPUTED-ATT AND NEW SELECT-ATT]
           ELSE $ASSIGN-XN-SEL
               [OTHERWISE ASSIGN NEW SELECT-ATT ONLY].
  $ASSIGN-XN-SEL =
    AT X-N, IF XN-SEL IS NOT NIL
            THEN IF EITHER X-N DOES NOT HAVE NODE
                           ATTRIBUTE SELECT-ATT
                    OR BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE
                            SELECT-ATT X-SEL
                       AND X-XEL DOES NOT HAVE MEMBER XN-SEL
                 THEN ASSIGN PRESENT ELEMENT NODE ATTRIBUTE
                      SELECT-ATT WITH VALUE XN-SEL.
  $NEW-COMP-AND-SEL =
      X-COMP-ATT := INTERSECT OF XN-SEL [AND COMPUTED-ATT OF X-N];
     [* XN-SEL WAS CREATED BASED ON THE COMPUTED-ATT LIST OF X-N  *]
     [* XN-SEL IS EQUIVALENT TO A SUBSET OF THE COMPUTED-ATT LIST *]
     [* HOWEVER, THE STRUCTURE OF XN-SEL IS NOT CORRECT BECUASE   *]
     [* THE ROUTINE INTERSECT REATED THIS LIST FROM THE GRAMMAR   *]
     [* LIST, SUCH AS V-S-O, AND NOT FROM THE COMPUTED-ATT LIST   *]
     [* OF X-N, WHICH HAS FOR EACH COMPUTED ATTRIBUTE AN ATTRIBUTE*]
     [* CONSISTING OF THE CORRESPONDING SELECT ATTS.  BY GETTING  *]
     [* THE INTERSECTION OF XN-SEL AND THE COMPUTED-ATT LIST OF   *]
     [* X-N, WE GET X-COMP-ATT, A PROPER SUBSET OF COMPUTED-ATT.  *]
     [* SELECT-ATT IS THEN CREATED FROM THIS NEW CORRECT COMP-ATT *]
      XN-SEL := NIL [INITIALIZE FOR SELECT-ATT];
      XN-COMP-ATT := X-COMP-ATT [SAVE LOC OF BEGINNING OF LIST];
       [XN-COMP-ATT IS THE NEW COMPUTED-ATT LIST]
      ITERATE $CREATE-SEL-ATT
       [ CREATE NEW SELECT-ATT LIST FROM ATT-LIST of ]
       [ MEMBERS OF COMP-ATT)]
      UNTIL BOTH X-COMP-ATT := SUCCESSORS OF X-COMP-ATT
            AND X-COMP-ATT IS NIL SUCCEEDS;
      DO $ASSIGN-XN-SEL;
      AT X-N, ASSIGN PRESENT ELEMENT NODE ATTRIBUTE COMPUTED-ATT
              WITH VALUE XN-COMP-ATT [ASSIGN COMPUTED-ATT] .
  $CREATE-SEL-ATT =
      X-HEAD := ATTRIBUTE-LIST OF X-COMP-ATT
       [* CONSISTS OF 1 ATTRIBUTE; ADD IT TO SELECT-ATT LIST *];
      IF XN-SEL DOES NOT HAVE MEMBER X-HEAD
      THEN PREFIX X-HEAD TO XN-SEL.
*- $CONN-CHK
*     CHECKS PRESENT ELEMENT FOR AN ELEMENT ON CONNECTIVE-LIST;
*     SUCCEEDS IF PRESENT ELEMENT HAS ONE, FAILS OTHERWISE.
  $CONN-CHK =
     BOTH X-CONN-LIST := LIST CONNECTIVE-LIST
     AND CORE-ATT HAS MEMBER X-CONN-LIST.
  $CONN-SELATT-CHK =
     PRESENT-ELEMENT- HAS NODE ATTRIBUTE SELECT-ATT
     WHERE PRESENT-ELEMENT- HAS MEMBER CONNECTIVE-LIST.
*- $SET-REG-ATT
*    PUTS SIGNIFICANT ATTRIBUTES OF AN ATOM INTO REGISTERS, PRIOR TO
*    REPLACING THE ATOM BY ITS CANONIACAL FORM.
  $SET-REG-ATT =
     EITHER X-FREE HAS NODE ATTRIBUTE WORD-POS XX-WPOS-ATT
     OR XX-WPOS-ATT := NIL;
     EITHER X-FREE HAS NODE ATTRIBUTE COMPUTED-ATT XX-COMP-ATT
     OR XX-COMP-ATT := NIL;
     EITHER X-FREE HAS NODE ATTRIBUTE N-TO-LN-ATT XX-N-LNATT
     OR XX-N-LNATT:= NIL;
     EITHER X-FREE HAS NODE ATTRIBUTE N-TO-RN-ATT XX-N-RNATT
     OR XX-N-RNATT:= NIL;
     EITHER X-FREE HAS NODE ATTRIBUTE TENSE-ATT XX-TENSE-ATT
     OR XX-TENSE-ATT:=NIL;
     EITHER X-FREE HAS NODE ATTRIBUTE SELECT-ATT XX-SELATT
     OR EITHER BOTH CORE-SELATT XX-SELATT OF X-FREE EXISTS WHERE
                       X-SUBLIST:= LIST CONNECTIVE-LIST
               AND XX-SELATT:= COMPLEMENT OF XX-SELATT
                   [REMOVE H-CONN IF NOT ASSIGNED BY SELECT-ATT]
        OR XX-SELATT:= NIL.
*- $REASSIGN-ATT
*    AFTER AN ATOM HAS BEEN REPLACED BY ITS CANONIACAL FORM,
*    SIGNIFICANT ATTRIBUTES ARE REASSIGNED FROM REGISTERS.
  $REASSIGN-ATT =
     IF XX-WPOS-ATT IS NOT NIL
     THEN AT X-CANON ASSIGN NODE ATTRIBUTE WORD-POS
                   WITH VALUE XX-WPOS-ATT;
     IF XX-COMP-ATT IS NOT NIL
     THEN AT X-CANON ASSIGN NODE ATTRIBUTE COMPUTED-ATT
                   WITH VALUE XX-COMP-ATT;
     IF XX-TENSE-ATT IS NOT NIL
     THEN AT X-CANON ASSIGN NODE ATTRIBUTE TENSE-ATT
            WITH VALUE XX-TENSE-ATT;
     IF XX-N-LNATT IS NOT NIL
     THEN AT X-CANON ASSIGN NODE ATTRIBUTE N-TO-LN-ATT WITH VALUE
                              XX-N-LNATT;
     IF XX-N-RNATT IS NOT NIL
     THEN AT X-CANON ASSIGN NODE ATTRIBUTE N-TO-RN-ATT WITH VALUE
                              XX-N-RNATT;
     IF XX-SELATT IS NOT NIL
     THEN AT X-CANON ASSIGN NODE ATTRIBUTE SELECT-ATT
                   WITH VALUE XX-SELATT.
*- PRINT-TFORM-INFO
*    WILL PRINTOUT NAME OF RESTRICTION EXECUTING EVENTUALLY.
  $PRINT-TFORM-INFO = TRUE
     [AT PRESENT-ELEMENT- X-PRES]
     [WRITE ON INFO '*** Executing ';]
     [WRITE ON INFO ' transformation ';]
     [WRITE ON INFO ' in ';]
     [AT X-PRES, DO $PRINT-NODE-INFO;]
     [WRITE ON INFO END OF LINE].
  $PRINT-NODE-INFO = TRUE
     [VERIFY WRITE ON INFO NODE NAME;]
     [VERIFY WRITE ON INFO 'which subsumes ';]
     [WRITE ON INFO WORDS SUBSUMED].
* T-ASSIGN-INDEX
*      ASSIGN NODE ATTRIBUTE INDEX TO NON-NULL ATOMS.
*     ASSIGN SERIALIZATION (NODE ATTRIBUTE INDEX) TO
*     ATOMIC NODES, NOUNS, ADJECTIVES, VERBS, PREPOSITIONS,
*     CONJUNCTIONS, WH-WORDS, ETC., SCANNING TREE IN PREORDER,
*     WHILE MAKING A LINKED ANAPHOR LIST.
T-ASSIGN-INDEX = IN SENTENCE:
   BOTH PRESENT-ELEMENT- XQ EXISTS
   AND ITERATE BOTH $PROCESS-NODE AND $GO-TO-NEXT-NODE.
 $PROCESS-NODE =
      BOTH $ANAPHOR
     [ALL OF $PROCESS-ATOM, $PROCESS-NSTG, $PROCESS-TPOS]
      AND ALL OF $PROCESS-ATOM, $PROCESS-WH, $PROCESS-CONJ.
 $ANAPHOR =
      IF EITHER THE PRESENT-ELEMENT- IS NSTG OR WHN OR EKGSTG
           WHERE EITHER THE CORE- X1 IS PRO OR NULLN
                 OR CORE- OF TPOS OF ELEMENT- LN OF LNR IS T:DEF
           [* THIS WILL MISS THE SECOND TPOS OF CONJOINED LN'S *]
           [* BECAUSE OF NON-STACKING 'ELEMENT- LN'            *]
         OR IT- IS TPOS WHERE CORE- X1 IS T:TPOSS
      THEN BOTH AT XQ, ASSIGN NODE ATTRIBUTE ANALINK WITH VALUE X1
           AND AT X1, STORE IN XQ.
 $PROCESS-ATOM =
      IF [EITHER PRESENT-ELEMENT- IS DATEPREP WHERE CORE X1 EXISTS]
         [OR] EITHER PRESENT-ELEMENT- IS VING X1
                     WHERE IMMEDIATE-NODE- IS NVAR
              OR PRESENT-ELEMENT- IS
                 N OR NS OR PRO OR NULLN [OR DATE] OR T OR P OR
                 V OR TV OR VEN OR VING OR ADJ OR Q OR DS OR DT X1
      THEN DO $ASSIGN-INDEX.
 $PROCESS-WH =
      IF PRESENT-ELEMENT- IS
            'WHO' OR 'WHOM' OR 'WHOSE' OR 'WHICH' OR 'WHAT' OR
            'WHERE' OR 'WHEN' OR 'HOW' OR 'WHY' X1
            WHERE X1 IS NOT OF TYPE NONLIT-ATOM
      THEN DO $ASSIGN-INDEX.
 $PROCESS-CONJ =
   IF PRESENT-ELEMENT- X1 IS OF TYPE CONJ-NODE THEN $ASSIGN-INDEX.
 $GO-TO-NEXT-NODE =
   EITHER GO DOWN
   OR ITERATET GO UP UNTIL GO RIGHT SUCCEEDS.
 $ASSIGN-INDEX =
   GENERATE SYMBOL; STORE IN X-INDEX;        [GLOBAL]
   GO TO X1; ASSIGN NODE ATTRIBUTE INDEX WITH VALUE X-INDEX.
 $PROCESS-NSTG =
    IF PRESENT-ELEMENT- IS NSTG OR EKGSTG X1
    THEN $ASSIGN-INDEX.
 $PROCESS-TPOS =
    IF BOTH PRESENT-ELEMENT- IS TPOS X1
       AND PRESENT-ELEMENT- IS NOT EMPTY
    THEN $ASSIGN-INDEX.
* T-ANTECEDENTS
*   PROPOSES ALL POSSIBLE ANTECEDENTS FOR ALL EXISTING
*   ANAPHORS IN THE PRESENT SENTENCE BY GOING THROUGH
*   STRUCTURALLY WEAK
*   C-COMMANDING RELATIONS BETWEEN PRO AND THE NP-ANTECEDENT NODE.
T-ANTECEDENTS = IN SENTENCE :
    BOTH PRESENT-ELEMENT- XQ EXISTS
    AND ITERATET $LK-FOR-ANTECEDENTS
        UNTIL XQ HAS NODE ATTRIBUTE ANALINK X1 FAILS.
 $LK-FOR-ANTECEDENTS =
    AT X1, DO $UP-TO-NP;
    IF IMMEDIATE-NODE- IS NOT INTRODUCER
       [* at INTRODUCER, there is no current sentence antecedents *]
    THEN AT XSTART, DO PROPOSE-ANTECEDENTS;
    AT XQ, ERASE NODE ATTRIBUTE ANALINK;
    AT X1, STORE IN XQ.
 $UP-TO-NP =
    IF EITHER X1 IS OF TYPE NONLIT-ATOM
       OR X1 IS QN WHERE IMMEDIATE-NODE- IS NVAR
    THEN ITERATE GO UP
         UNTIL PRESENT-ELEMENT- IS NSTG OR WHN OR EKGSTG XSTART
               SUCCEEDS.
* T-RESERVE-ANTES
*   ATTACHES A LIST OF SERIAL NUMBERS OF NSTG'S, TPOS'S
*   AND CONJ'S TO THE SENTENCE NODE, PRESUMABLY TO BE USED IN CASE
*   WE NEED ANTECEDENTS FOR AN ANAPHOR IN THE COMING SENTENCES.
T-RESERVE-ANTES = IN SENTENCE :
      BOTH AT ELEMENT- TEXTLET
           BOTH AT ELEMENT- ONESENT DO $RESERVE-ANTES
           AND IF ELEMENT- MORESENT X-MORESENT IS NOT EMPTY
               THEN AT ELEMENT- ONESENT OF ELEMENT- TEXTLET
                    OF X-MORESENT DO $RESERVE-ANTES
      AND ASSIGN NODE ATTRIBUTE ANTECEDENT WITH VALUE X-LIST-OF-ANTE.
 $PROCESS-TEXTLET =
      AT ELEMENT- TEXTLET
      BOTH BOTH AT ELEMENT- ONESENT DO $RESERVE-ANTES
           AND IF ELEMENT- INTRODUCER IS NOT EMPTY
               THEN DO $RESERVE-INTRO
      AND IF ELEMENT- MORESENT X-MORESENT IS NOT EMPTY
          THEN AT X-MORESENT DO $PROCESS-TEXTLET.
 $RESERVE-INTRO =
      STORE IN XX;
      AT INTRODUCER, STORE IN XFIRST; STORE IN XLAST;
      DO $QINSERT [GLOBAL];
      ITERATET $BREADTH-SEARCH
      UNTIL $QEMPTY [GLOBAL] SUCCEEDS.
 $RESERVE-ANTES =
      STORE IN XX;
      AT CENTER, STORE IN XFIRST; STORE IN XLAST;
      DO $QINSERT [GLOBAL];
      BOTH X-LIST-OF-ANTE := NIL
      AND ITERATET $BREADTH-SEARCH
          UNTIL $QEMPTY [GLOBAL] SUCCEEDS.
 $BREADTH-SEARCH =
      DO $QDELETE [GLOBAL];
      ITERATE $ADD-TO-QUEUE UNTIL GO RIGHT FAILS.
 $ADD-TO-QUEUE =
      BOTH DO $LIST-ANTECEDENT
      AND IF NOT $TEST-NODE [GLOBAL]
          THEN DO $QINSERT [GLOBAL].
 $LIST-ANTECEDENT =
        [* ONLY LIST NOUNS AND PRONOUNS AS POSSIBLE ANTECEDENTS *]
      IF ONE OF $NP-ATOMS, $CONJ-NODE, $WH-PHRASE
      THEN BOTH XX HAS NODE ATTRIBUTE INDEX XINDEX
           AND PREFIX XINDEX TO X-LIST-OF-ANTE.
   $NP-ATOMS =
      EITHER PRESENT-ELEMENT- XX IS T:TPOSS
      OR EITHER XX IS N OR NS OR [VING OR] PRO OR NULLN [OR DATE]
         OR XX IS VING
            WHERE IMMEDIATE-NODE- IS NVAR.
   $CONJ-NODE = XX IS OF TYPE CONJ-NODE.
   $WH-PHRASE =
      BOTH XX IS NOT OF TYPE NONLIT-ATOM
      AND XX IS 'WHO' OR 'WHOM' OR 'WHOSE' OR 'WHICH' OR 'WHAT' OR
                'WHERE' OR 'WHEN' OR ['HOW' OR] 'WHY'.
* T-ADD-ELEMENTS
*    ADDS AN EMPTY THIRD SA TO THE FRENCH ASSERTION.
T-ADD-ELEMENTS = IN ASSERTION:
     IF BOTH ELEMENT- PROPOS X1 EXISTS
        AND FOLLOWING-ELEMENT- OF X1 IS NOT SA
     THEN AFTER X1 INSERT <SA> (<NULL>);
     IF BOTH ELEMENT- TENSE X1 EXISTS
        AND PREVIOUS-ELEMENT- OF X1 IS NOT NEG
     THEN BEFORE X1 INSERT <NEG> (<NULL>).
* T-SCOPE-NODE
*   replaces the second element (OR, AND, NOR) of the
*   strings (EITHER...OR, BOTH...AND, NEITHER...NOR) by its first
*   element (EITHER, BOTH, NEITHER), and erases the scope node.
*   Double scope nodes are not allowed.
T-SCOPE-NODE = IN LNR, ASSERTION, LN, PN, PDATE, VENPASS, TOVO, LAR,
                  VINGO, VO, VENO, [YESNOQ,] LAR1 [, NNN, LDATER]:
      IF ELEMENT- SCOPE-NODE X1 EXISTS
      THEN $MOVE-SCOPE.
 $MOVE-SCOPE =
      AT X1, DO R(CONJ-NODE); STORE IN X2;
      AT X2, GO DOWN; STORE IN X3;
      REPLACE X3 BY VALUE OF X1;
      DELETE X1.
* T-LXR-ANTECEDENT
*    looks for antecedents of an LXR
*  X1: pronoun needing antececent
*  X-START: its NSTG
T-LXR-ANTECEDENT = IN LXR:
     IF BOTH CORE- X-ANAPHOR-HEAD OF PRESENT-ELEMENT- X-PRE IS PRO X1
        AND $TEST-ANAPHOR
     THEN DO $LNR-ANTECEDENT-SEARCH.
  $TEST-ANAPHOR =
     X1 DOES NOT HAVE NODE ATTRIBUTE PLACE-HOLDER;
      [* if pronoun already has a class but not nil *]
     CORE-ATT X1-ATT OF X1 EXISTS;
     X-SUBLIST := LIST NON-PRONOUN-CLASSES;
     BOTH COMPLEMENT X-COMPL OF X1-ATT IS NOT NIL
     AND SUCCESSORS OF X-COMPL IS NOT NIL.
  $LNR-ANTECEDENT-SEARCH =
       [* starting from its NSTG *]
     ITERATE GO UP
     UNTIL PRESENT-ELEMENT- IS NSTG OR WHN OR EKGSTG XSTART
           SUCCEEDS;
       [* TO BE DONE:                                   *]
       [* referential: keep going to the previous       *]
       [* sentence and look/insert possible antecedents *]
       [ITERATE DO PROPOSE-ANTECEDENTS]
       [UNTIL BOTH X1 HAS NODE ATTRIBUTE ANTECEDENT]
       [      AND GO TO PREVIOUS SENTENCE FAILS]
     BOTH DO PROPOSE-ANTECEDENTS
     AND IF BOTH BOTH X-ANAPHOR-HEAD EXISTS
                 AND X1 EXISTS
            AND X-ANAPHOR-HEAD IS IDENTICAL TO X1
               [* Antecedent not found...           *]
         THEN IF X-ANAPHOR-HEAD HAS NODE
                 ATTRIBUTE SAVE-SELECT-ATT X-SEL-ATT
               [* restore parse assigned SELECT-ATT *]
              THEN AT X-ANAPHOR-HEAD ASSIGN NODE ATTRIBUTE
                   SELECT-ATT WITH VALUE X-SEL-ATT.
T-LXR-GENDER = IN LXR:
     IF BOTH CORE- X-HEAD OF PRESENT-ELEMENT- X-PRE IS PRO
             OR T OR N X1
        AND ATTRIBUTE-LIST X1-ATTS OF X1 HAS MEMBER FEM OR MASC
     THEN BOTH IF X1-ATTS HAS MEMBER FEM
               THEN AFTER X1 INSERT
                    <GRAM-NODE> X-GRAM = '[FEMALE]':(FEM)
               ELSE AFTER X1 INSERT
                    <GRAM-NODE> X-GRAM = '[MALE]':(MASC)
          AND $ASSIGN-SELECT.
  $ASSIGN-SELECT =
     ATTRIBUTE-LIST X-GENDER OF X-GRAM EXISTS;
     AT X-GRAM ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE X-GENDER.
* T-LNR-NEG-X-OR-Y
*   expands negation in LNR to its conjunct(s) and
*   changes OR to AND.
T-LNR-NEG-X-OR-Y = IN LNR:
     IF $HIGHER-NEG
     THEN $CHANGE-TO-AND.
  $HIGHER-NEG =
     BOTH ASCEND TO OBJECT PASSING THROUGH N-OBJ-IN-STR
          WHERE COELEMENT- VERBAL X1 EXISTS
     AND $CHECK-ADJUNCTS.
  $CHECK-ADJUNCTS =
     AT X1 [VERBAL]
     EITHER CORE- IS H-NEG
     OR EITHER AT ELEMENT- RV DO $DSTG
        OR EITHER BOTH GO LEFT @AND $DSTG
           OR BOTH GO RIGHT [TO SA] @AND $DSTG.
  $DSTG = CORE- X2 OF ELEMENT- DSTG IS D:H-NEG
     ['NOT', 'AUCUNEMENT', 'JAMAIS', 'NE PAS', 'NON' 'PAS'].
  $CHANGE-TO-AND =
     ITERATET BOTH $REPLACE-OR-BY-AND AND $TEST
     UNTIL $ORSTG-CONJ FAILS.
  $ORSTG-CONJ =
     DESCEND TO ORSTG [OR ANDSTG] PASSING THROUGH STRING;
     STORE IN X1;
    [VERIFY ELEMENT- SACONJ X-SA EXISTS;]
     ELEMENT- Q-CONJ X-CONJ EXISTS.                [GLOBAL]
  $REPLACE-OR-BY-AND =
     REPLACE VALUE OF X1 [ORSTG] BY 'AND'
    [REPLACE X1] [ORSTG] [BY]
    [  <ANDSTG> ( 'AND']
    [           + <NULL> X-NOT]
    [           + X-SA]
    [           + X-CONJ)].                         [GLOBAL]
  $TEST =
       IF BOTH X2 IS T:H-NEG ['NO', 'NON']
          AND CONJUNCT OF ELEMENT- LN EXISTS
      @THEN IF CORE- OF ELEMENT- TPOS X3 IS EMPTY
            THEN REPLACE VALUE OF X3 BY
                 <LTR> ( <LT> (<NULL>)
                       + X2
                       + <RT> (<NULL>) )
            ELSE TRUE
       ELSE IF X2 IS D:H-NEG ['NOT']
            THEN REPLACE X-NOT BY <NOTOPT> (X2).
* T-LN-NEG-X-OR-Y
*    expands negative adverbs from LA to its conjunct, and
*    changes OR to AND.
T-LN-NEG-X-OR-Y = IN LN:
     IF BOTH PRESENT-ELEMENT- X-PRE EXISTS
             WHERE ELEMENT- CONJ-NODE EXISTS
        AND $NEG-ADV
     THEN $CHANGE-TO-AND.
  $NEG-ADV =
     BOTH ELEMENT- TPOS X-TPOS IS NOT EMPTY
          WHERE ELEMENT- LTR X-LTR EXISTS
     AND CORE- X2 OF X-LTR IS T:H-NEG.
  $CHANGE-TO-AND =
     ITERATET BOTH $REPLACE-OR-BY-AND [global in T-LNR-NEG-X-OR-Y]
              AND $TEST
     UNTIL $ORSTG-CONJ [global in T-LNR-NEG-X-OR-Y] FAILS.
  $TEST =
     IF CONJUNCT X-T OF X-TPOS EXISTS
        WHERE PRESENT-ELEMENT- IS EMPTY
     THEN REPLACE VALUE OF X-T BY X-LTR.
* T-LAR-NEG-X-OR-Y
*    expands negative adverbs from LA to its conjunct, and
*    changes OR to AND.
T-LAR-NEG-X-OR-Y = IN LAR:
     IF BOTH PRESENT-ELEMENT- X-PRE EXISTS
             WHERE ELEMENT- CONJ-NODE EXISTS
        AND $NEG-ADV
     THEN $CHANGE-TO-AND.
  $NEG-ADV =
     BOTH ELEMENT- LA X-LA IS NOT EMPTY
          WHERE ELEMENT- LDR X-LDR EXISTS
     AND EITHER CORE- X2 OF ELEMENT- LD OF X-LDR IS D:H-NEG
         OR CORE- X2 OF X-LDR IS D:H-NEG.
  $CHANGE-TO-AND =
     ITERATET BOTH $REPLACE-OR-BY-AND [global in T-LNR-NEG-X-OR-Y]
              AND $TEST
     UNTIL $ORSTG-CONJ [global in T-LNR-NEG-X-OR-Y] FAILS.
  $TEST =
     IF CONJUNCT X-T OF X-LA EXISTS
        WHERE PRESENT-ELEMENT- IS EMPTY
     THEN REPLACE VALUE OF X-T BY X-LDR.
* T-NO-X-OR-Y
*     CONVERTS AN 'OR' IN THE SCOPE OF A NEGATIVE INTO A COPY OF THE
*     NEGATIVE AND AN 'AND'.  THE STRUCTURE CAN THEN BE EXPANDED
*     BY T-EXPAND-TO-ASSERT TO GIVE THE SEMANTICALLY
*     EQUIVALENT CONJOINED ASSERTIONS.
*          E.G. 'NO HEART DISEASE OR KIDNEY DISEASE' ==>
*               'NO HEART DISEASE AND NO KIDNEY DISEASE'
*     NOTE THAT THIS TRANSFORMATION REARRANGES THE LOGICAL
*     OPERATORS IN A PARSE TREE JUST PRIOR TO THE EXPANSION OF CONJUNCTIONS.
*     SPECIFICALLY,  'NO (X OR Y)' ==> 'NO X AND NO Y'.
*     IN THE CASE OF 'NO X OF Y OR Z', THE CONNECTIVE 'OR' NEED ONLY BE
*     CHANGED TO 'AND', GIVING AFTER EXPANSION 'NO X OF Y AND NO X OF Z'.
*     IN THIS CASE, THE TRANSFORMATION MUST RECURSIVELY CHECK FOR OTHER
*     ORSTGS IN THE ADJUNCTS.
T-NO-X-OR-Y = IN LNR:
     IF EITHER $TPOS OR $HIGHER-NEG
     THEN $CHECK.
  $TPOS =
     CORE- X2 OF ELEMENT- TPOS OF ELEMENT- LN X-LN IS T:H-NEG
           ['NO', 'WITHOUT', 'SANS', 'AUCUN', 'AUCUNE', 'PAS DE'].
  $HIGHER-NEG =
     BOTH ASCEND TO OBJECT PASSING THROUGH N-OBJ-IN-STR
          WHERE COELEMENT- VERBAL X1 EXISTS
     AND $CHECK-ADJUNCTS.
  $CHECK-ADJUNCTS =
     AT X1 [VERBAL]
     EITHER AT ELEMENT- RV DO $DSTG
     OR EITHER BOTH GO LEFT @AND $DSTG
        OR BOTH GO RIGHT [TO SA] @AND $DSTG.
  $DSTG = CORE- X2 OF ELEMENT- DSTG IS D:H-NEG
     ['NOT', 'AUCUNEMENT', 'JAMAIS', 'NE PAS', 'NON' 'PAS'].
  $CHECK = ITERATET BOTH $REPLACE-OR-BY-AND AND $TEST
           UNTIL $ORSTG-CONJ FAILS.
  $TEST =
       IF BOTH X2 IS T:H-NEG ['NO', 'NON']
          AND CONJUNCT OF ELEMENT- LN EXISTS
      @THEN IF CORE- OF ELEMENT- TPOS X3 IS EMPTY
            THEN REPLACE VALUE OF X3 BY
                 <LTR> (<LT> (<NULL>) + X2 + <RT> (<NULL>))
            ELSE TRUE
       ELSE IF X2 IS D:H-NEG ['NOT']
            THEN REPLACE X-NOT BY <NOTOPT> (X2).
* ***** **************************************************************
*
*               C O N J U N C T I O N    E X P A N S I O N
*
*      1) ELEMENTS TENSE AND VERB ARE EXPANDED;
*      2) STRINGS AND LXR'S ARE EXPANDED.
*
*    IN ORDER FOR T-VENO TO WORK PROPERLY, TENSE AND VERB OF
*    ASSERTION, AS WELL AS ASSERTION ITSELF MUST BE EXPANDED FIRST.
*
* ***** **************************************************************
* T-EXPAND-CENTER-SA
*     DISTRIBUTES FIRST CONJUNCT SA'S TO ALL CENTERS.
T-EXPAND-CENTER-SA = IN CENTER:
     IF BOTH PRESENT-ELEMENT- HAS ELEMENT- ASSERTION OR FRAGMENT X-PRE
        AND X-PRE HAS NODE ATTRIBUTE POSTCONJELEM X-C2
     THEN DO $PASS-SA-TO-CONJUNCT.
  $PASS-SA-TO-CONJUNCT =
     BOTH DO $PASS-SA-TIME
     AND IF CONJUNCT X-PRE OF X-PRE HAS NODE ATTRIBUTE
            POSTCONJELEM X-C2
         THEN DO $PASS-SA-TO-CONJUNCT.
  $PASS-SA-TIME =
     IF FIRST SA X-SA OF X-PRE IS NOT EMPTY
     THEN AT X-C2 IF FIRST SA IS EMPTY
                  THEN AT FIRST SA REPLACE PRESENT-ELEMENT- BY X-SA.
  $SA-TIME =
     EITHER VALUE X-VAL OF X-SA IS PDATE OR NSTGT OR FTIME,
     OR EITHER BOTH X-VAL IS PN
               AND P OF X-VAL IS H-TMPREP
        OR BOTH X-VAL IS LDR
           AND CORE- OF X-VAL IS H-TMLOC OR H-TMREP OR H-TMDUR.
* T-EXPAND-TENSE
*     FIRST EXPANDS TENSE AND THEN THE VERB.
*     EXPANDS ANY CONJOINED TENSE OR VERB IN ASSERTION IN ORDER TO
*     SIMPLIFY VERB DE-TENSING TRANSFORMATIONS.
T-EXPAND-TENSE = IN ASSERTION:
    IF TENSE IS NOT EMPTY @THEN DO EXPAND;
    IF VERB IS NOT EMPTY  @THEN DO EXPAND.
* T-EXPAND-TO-OBJECT
*   expands conjoined OBJECTs of VENO into a series of
*   OBJECT:VENOs.
T-EXPAND-TO-OBJECT = IN ASSERTION:
    IF BOTH PRESENT-ELEMENT- X-PRE HAS ELEMENT- OBJECT X-OBJ
            WHERE VALUE IS VENO X-VENO
       AND X-VENO HAS ELEMENT- CONJ-NODE
    THEN AT X-VENO, DO $EXPAND-TO-OBJECT.
 $EXPAND-TO-OBJECT =
    BOTH DO EXPAND
  [@AND ITERATET DO EXPAND]
  [     UNTIL CONJUNCT EXISTS FAILS]
   @AND IF CONJUNCT EXISTS
        THEN $EXPAND-TO-ASSERTION [Global in T-EXPAND-TO-ASSERT].
* T-EXPAND-OBJ
*     EXPANDS CONJOINED ELEMENTS AND VERBS UNDER OBJECT, OBJBE,
*     AND PASSOBJ.
*     THIS TRANSFORMATION OPERATES RECURSIVELY FOR OBJECTS WHICH
*     THEMSELVES CONTAIN COMPLEX OBJECT STRINGS.  AGAIN THIS
*     SIMPLIFIES VERB DE-TENSING TRANSFORMATIONS, PARTICULARLY
*     THOSE WHICH INVOLVE MANIPULATION OF OBJECT STRINGS
*     SUCH AS T-VENO WHICH "UNDOES" THE PERFECT TENSE.
*     E.G. (1) 'WE FOUND THE TEXTBOOKS IN THE LIBRARY AND THE ATLAS
*               ON MY SHELF'  ==>
*              'WE FOUND THE TEXTBOOKS IN THE LIBRARY AND WE FOUND THE
*               ATLAS ON MY SHELF'
*          (2) 'THEY HAD EATEN DINNER AND GONE TO THE MOVIES'  ==>
*              'THEY HAD EATEN DINNER AND THEY HAD GONE TO THE MOVIES'
T-EXPAND-OBJ = IN ASSERTION, FRAGMENT:
    IF PRESENT-ELEMENT- IS FRAGMENT
    THEN IF SECOND ELEMENT IS OF TYPE STRING
         @THEN $EXPAND-OBJ
         ELSE TRUE
    ELSE $EXPAND-OBJ.
  $EXPAND-OBJ =
    IF PRESENT-ELEMENT- HAS ELEMENT- OBJECT OR OBJBE
   @THEN IF CORE- IS OF TYPE STRING
            WHERE BOTH BOTH PRESENT-ELEMENT- IS NOT [QN OR] NQ
                       AND VALUE IS NOT QN
                  AND EITHER CONJUNCT EXISTS [*must check for conjunct*]
                      OR BOTH PRESENT-ELEMENT- IS VENPASS
                         AND AT VALUE, CONJUNCT EXISTS [ 2000.Oct.26 ]
         THEN AT CORE-, IF NOT $NOT-EXPAND-STR
                        THEN IF ELEMENT- VERBAL EXISTS
                            @THEN $EXPAND-UP
                             ELSE $EXPAND-UP.
  $EXPAND-UP =
     BOTH DO EXPAND
     @AND IF CONJUNCT EXISTS
          THEN $EXPAND-TO-ASSERTION [Global in T-EXPAND-TO-ASSERT].
* T-EXPAND-BESHOW
*     EXPANDS CONJOINED BESHOW TO FRAGMENT.
T-EXPAND-BESHOW = IN FRAGMENT:
     IF ELEMENT- BESHOW X-BESHOW EXISTS
        WHERE ELEMENT- CONJ-NODE EXISTS
     THEN AT X-BESHOW, DO $EXPAND-BESHOW-UP.
 $EXPAND-BESHOW-UP =
     DO EXPAND;
     IF CONJUNCT EXISTS THEN $EXPAND-TO-FRAG.
 $EXPAND-TO-FRAG =
     ITERATET AT IMMEDIATE-NODE DO EXPAND
     UNTIL TEST FOR FRAGMENT SUCCEEDS.
* T-EXPAND-TO-ASSERT
*     expands LXR and STRING node and keeps expanding upwards until
*     it reaches ASSERTION or CENTER, except when the present-element
*     is an LNR that is a conjoined numerical expression.
*     e.g. 'BETWEEN 2% AND 4%' is not expanded.
* -- 11/15/95 add reset PVAL-ATT from PN:P to VERB
* -- 11/13/96 add restriction to expansion in APOS
T-EXPAND-TO-ASSERT = IN LXR, STRING:
     AT PRESENT-ELEMENT- X-PRE
    [BOTH $WRITE-PTREE]
    [AND] [BOTH] ONE OF $EXCEPTION, $CONJ-IN-STR, $OLD-EXPAND
          [AND $WRITE-PTREE].
  $WRITE-PTREE =
     WRITE ON INFO '*** ELEMENT- TREE ***'; WRITE ON INFO END OF LINE;
     WRITE ON INFO IDENTIFICATION;
     WRITE ON INFO SENTEXT [SOURCE];
     WRITE ON INFO PARSE TREE WITH WORD FORMS;
     WRITE ON INFO END OF LINE.
  $EXCEPTION =
     EITHER X-PRE IS OF TYPE N-OMITTING-WH-STRING
     OR EITHER X-PRE IS OF TYPE PN-OMITTING-WH-STG
        OR EITHER X-PRE HAS ELEMENT- ASSERTION
           OR ONE OF $EXCEPT-NODES, $CHECK-LQR [, $CHECK-LN].
  $CHECK-LN =
     NOT $MAJOR-LN-CONJS.
  $MAJOR-LN-CONJS =
     X-PRE IS LN;
     ELEMENT- CONJ-NODE EXISTS;
     GO LEFT;
     PRESENT-ELEMENT- IS APOS X-APOS-1;
     X-APOS-1 HAS NODE ATTRIBUTE POSTCONJELEM X-APOS-2;
     CORE-ATT X-ATT1 OF CORE- OF X-APOS-1 IS NOT NIL;
     CORE-ATT X-ATT2 OF CORE- OF X-APOS-2 IS NOT NIL;
     X-MAJOR-CLASS := LIST MAJOR-SEL-CLASS;
     X-MAJOR-CLASS HAS MEMBER X-ATT1;
     X-MAJOR-CLASS HAS MEMBER X-ATT2.
  $EXCEPT-NODES =
     X-PRE IS NQ OR QUANT [QN] OR SENTENCE [ROOT] OR ONESENT.
  $CONJ-IN-STR =
     BOTH X-PRE HAS ELEMENT- EXPAND-STR X-ELE
                [ELEMENT- looks through TYPE STGSEG]
     AND BOTH AT X-ELE
              DO EXPAND
         @AND IF CONJUNCT EXISTS
              THEN $EXPAND-TO-ASSERTION.
  $NOT-EXPAND-STR =
     EITHER PRESENT-ELEMENT- IS OF TYPE STRING-TO-ASSERT
     OR [Do not EXPAND STRINGS -- to be transformed by T-RN-FILLIN]
        VERIFY EITHER PRESENT-ELEMENT- X-NOEXP IS VINGO OR VENPASS
                      OR APPOS [OR ADJINRN -- 5/11/89]
                      OR TOVO OR THATS OR PDATE [* 11/30/94 *]
                      WHERE BOTH IMMEDIATE-NODE- IS OF TYPE ADJSET
                            AND IF X-NOEXP IS APPOS [OR ADJINRN]
                                   WHERE X7:= X-NOEXP
                                THEN NOT $SIG-CHECK [T-RN-FILLIN]
               OR PRESENT-ELEMENT- IS NSTG OR EKGSTG
                  WHERE BOTH PRESENT-ELEMENT- IS OCCURRING IN PN
                       @AND ALL OF $CHECK-PN-CONN [Global T-RN-FILLIN],
                                   $NOT-FRAGMENT-PN.
  $NOT-FRAGMENT-PN =
      [* conjoined PN can expand: Status post aortic aneurysm *]
      [* repair and aortic valvular suspension on 09/07/2000. *]
     IMMEDIATE-NODE- IS NOT FRAGMENT.
  $SIG-CHECK = [ MEDICAL FORMATTING ONLY ]
     CORE-SELATT X-HOSTATT OF HOST OF X-PRE EXISTS;
     X-SUBLIST := LIST MOD-CLASS;
     BOTH CORE-ATT X-ATT OF CORE- OF X7 HAS MEMBER SIG-CLASS
     AND COMPLEMENT OF X-ATT IS NOT NIL;
     IF X-HOSTATT HAS MEMBER H-STATUS OR H-RESP
     THEN AT X-ATT NOT $SAME-FRMT
     ELSE IF X-ATT HAS MEMBER H-STATUS OR H-RESP
          THEN AT X-ATT NOT $SAME-FRMT.
  $SAME-FRMT =
     EITHER PRESENT-ELEMENT- HAS MEMBER H-INDIC OR H-DIAG OR H-NORMAL,
     OR PRESENT-ELEMENT- HAS MEMBER MOD-CLASS.
  $OLD-EXPAND =
     BOTH DO EXPAND
     AND IF CONJUNCT EXISTS
         THEN IF NOT $NO-EXPAND
              THEN BOTH $EXPAND-TO-ASSERTION
                   AND $ADJUST-PVAL-ATT [* 11/15/95 *].
  $ADJUST-PVAL-ATT =
     [* EXPAND copies everything from under PN up to ASSERTION *]
     [* An unexpected result of which is *]
     [* PVAL-ATTs pointing from OBJECT:PN:P to CORE- of VERB *]
     [* now all points to the lowest VERB *]
     IF AT X-PRE [* pointing to first LXR *],
        BOTH $WRONG-PVAL-ATTS AND $VERBS-DIFFER
     THEN AT X-ASSN1,
          ITERATE EITHER $RESET-PVAL OR $NO-PVAL
          UNTIL PRESENT-ELEMENT- HAS NODE ATTRIBUTE POSTCONJELEM
                FAILS.
  $WRONG-PVAL-ATTS =
     PRESENT-ELEMENT- IS LNR;
     GO UP; [* this node should be NSTG *]
     GO UP; PRESENT-ELEMENT- IS NSTGO;
     GO UP; PRESENT-ELEMENT- IS PN;
     BOTH ASCEND TO ASSERTION
          PASSING THROUGH N-OBJ-IN-STR
          WHERE STORE IN X-ASSN1
     AND ELEMENT- P X-P HAS NODE ATTRIBUTE PVAL-ATT X-PATT;
     IF PRESENT-ELEMENT- IS NULL
     THEN BOTH AT X-P, ERASE NODE ATTRIBUTE PVAL-ATT
          AND FALSE.
  $VERBS-DIFFER =
     AT X-ASSN1
     CORE- X-VATT OF ELEMENT- VERB EXISTS;
     X-VATT IS NOT IDENTICAL TO X-PATT.
  $WRONG-PVALS =
     PRESENT-ELEMENT- IS LNR;
     BOTH ASCEND TO ASSERTION
          PASSING THROUGH N-OBJ-IN-STR
          WHERE STORE IN X-ASSN1
     AND GO UP;
     GO UP; PRESENT-ELEMENT- IS NSTGO;
     GO UP; PRESENT-ELEMENT- IS PN;
     ELEMENT- P HAS NODE ATTRIBUTE PVAL-ATT;
         [IMMEDIATE PN EXISTS]
         [WHERE ELEMENT- P HAS NODE ATTRIBUTE PVAL-ATT;]
     ASCEND TO ASSERTION
     PASSING THROUGH N-OBJ-IN-STR;
     STORE IN X-ASSN;
     BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE PRECONJELEM
     AND PRESENT-ELEMENT- DOES NOT HAVE NODE ATTRIBUTE POSTCONJELEM;
     X-ASSN IS NOT IDENTICAL TO X-ASSN1.
  $NO-PVAL =
     STORE IN X-ITER;
     CORE- X-VCORE OF ELEMENT- VERB EXISTS;
     EITHER X-VCORE IS NOT IDENTICAL TO X-PATT [* 10/12/1999 *]
     OR X-VCORE DOES NOT HAVE ATTRIBUTE OBJLIST:PN:PVAL;
     GO TO X-ITER.
  $RESET-PVAL =
     STORE IN X-ITER;
     BOTH CORE- X-VCORE OF ELEMENT- VERB EXISTS
     AND EITHER ELEMENT- PN OF OBJBE OF ELEMENT- OBJECTBE
                OF ELEMENT- OBJECT EXISTS
            [* passive where PN moved from RV to after object *]
         OR EITHER ELEMENT- PN OF ELEMENT- OBJECT EXISTS
            OR VALUE OF ELEMENT- OBJECT EXISTS
               WHERE ELEMENT- PN EXISTS;
     [AT ELEMENT- P,]
        IF [PRESENT-ELEMENT- HAS NODE ATTRIBUTE PVAL-ATT]
           ELEMENT- LP IS NOT EMPTY
           WHERE CORE-ATT OF CORE- OF ELEMENT- LDR
                 HAS MEMBER H-NEG OR H-MODAL
        THEN AT ELEMENT- P
             ASSIGN NODE ATTRIBUTE PVAL-ATT WITH VALUE X-VCORE
        ELSE AT ELEMENT- P
             IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE PVAL-ATT
             THEN ERASE NODE ATTRIBUTE PVAL-ATT;
     GO TO X-ITER.
  $CHECK-LQR =
     BOTH PRESENT-ELEMENT- IS LQR
     AND NOT BOTH ELEMENT- ANDSTG EXISTS
               [* want to expand                     *]
               [*   'CLOUDING OF ETHMOIDAL SINUS ON  *]
               [*    THE 4 AND 24 HR SCANS',         *]
               [* but not                            *]
               [*     '10 TO 12 HR SCAN'             *]
            AND BOTH IMMEDIATE-NODE- IS QN
                AND COELEMENT- N IS NTIME1.
  $NO-EXPAND = ONE OF $1, $2, $3.
  $1 = BOTH PRESENT-ELEMENT- IS LNR AND $X-UNIT.
  $2 = ASCEND TO PN PASSING THROUGH LN
       WHERE ELEMENT- P IS 'ENTRE' OR 'BETWEEN'.
  $3 = COELEMENT- TOSTG EXISTS.
  $X-UNIT =
     BOTH DESCEND TO LQR PASSING THROUGH LN
     AND EITHER BOTH CORE- X1 IS NUNIT
                AND X1 IS NOT NTIME2 OR H-TTMED
         OR EITHER BOTH X1 IS NULLN
                   AND ELEMENT- RN IS EMPTY
            OR X1 IS '\'.
  $EXPAND-BETWEEN = TRUE [to be written].
  $EXPAND-TO-ASSERTION =
     ITERATET AT IMMEDIATE-NODE DO EXPAND
     UNTIL BOTH $READJUST-LNR
           AND $NOT-EXPAND-STR SUCCEEDS.
  $READJUST-LNR =
        [* Readjust pointers such as N-TO-LN-ATT *]
        [* or N-TO-RN-ATT to their local nodes.  *]
     BOTH IF PRESENT-ELEMENT X-LXR IS NSTG OR EKGSTG [LNR]
          THEN ITERATE AT CORE- OF X-LXR DO $REASSIGN-N-TO-XN
               UNTIL X-LXR HAS NODE ATTRIBUTE POSTCONJELEM X-LXR FAILS
        [* Erase all duplicates of RN done by EXPAND *]
     AND IF X-LXR IS LNR
         THEN AT ELEMENT- RN
              IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE POSTCONJELEM X-XN
              THEN BOTH REPLACE X-XN BY <RN> (<NULL>)
                   AND ERASE NODE ATTRIBUTE POSTCONJELEM.
  $REASSIGN-N-TO-XN =
     BOTH $REASSIGN-LN-ATT AND $REASSIGN-RN-ATT.
  $REASSIGN-LN-ATT =
     IF PRESENT-ELEMENT- X-HOST HAS NODE ATTRIBUTE N-TO-LN-ATT X-ATT
     THEN IF $WRONG-HOST
          THEN AT X-HOST ERASE NODE ATTRIBUTE N-TO-LN-ATT.
  $REASSIGN-RN-ATT =
     IF BOTH X-HOST HAS NODE ATTRIBUTE N-TO-RN-ATT X-ATT
        AND $WRONG-HOST
     THEN AT X-HOST ERASE NODE ATTRIBUTE N-TO-RN-ATT.
  $WRONG-HOST =
     AT X-ATT ITERATE GO UP
              UNTIL PRESENT-ELEMENT- X-RN IS RN OR LN SUCCEEDS;
     HOST- IS NOT IDENTICAL TO X-HOST.
* T-MOVE-SA-LAST
*    moves SA-LAST in TOVO-N up.
T-MOVE-SA-LAST = IN TOVO-N:
     IF EITHER ELEMENT- SA-LAST X-SA-LAST IS NOT EMPTY
        OR BOTH ELEMENT- OBJECT IS EMPTY
           AND ELEMENT- SA X-SA-LAST IS NOT EMPTY
     THEN ALL OF $MOVE-SA-LAST, $TRANSFORM-SA.
 $MOVE-SA-LAST =
     ASCEND TO ASSERTION OR FRAGMENT;
     IF ELEMENT- SA-LAST X-SA EXISTS
     THEN REPLACE X-SA
          BY <SA> X-NEWSA (ALL ELEMENTS OF X-SA-LAST)
     ELSE IF LAST-ELEMENT- X-SA IS SA X-NEWSA
          THEN IF X-SA IS EMPTY
               THEN REPLACE X-SA
                    BY <SA> X-NEWSA (ALL ELEMENTS OF X-SA-LAST)
               ELSE BEFORE VALUE OF X-SA
                    INSERT ALL ELEMENTS OF X-SA-LAST
          ELSE AFTER LAST-ELEMENT-
               INSERT <SA> X-NEWSA (ALL ELEMENTS OF X-SA-LAST);
     REPLACE X-SA-LAST BY <SA> (<NULL>).
 $TRANSFORM-SA = TRANSFORM X-NEWSA.
* T-ADJUST-LNR
*    *Temporary* stop gap:
*    wonder why this happens for a certain conjoined expression
*    where expand leaves hanging TPOS and QPOS under LNR
T-ADJUST-LNR = IN LXR:
     IF BOTH EITHER PRESENT-ELEMENT IS LNR
             OR PRESENT-ELEMENT IS LAR
                WHERE ASCEND TO LNR PASSING THROUGH LN
        @AND BOTH VALUE OF PRESENT-ELEMENT- X-LNR IS TPOS
             AND ELEMENT- LN EXISTS
     THEN AT X-LNR, BOTH DELETE ELEMENT- TPOS
                    AND DELETE ELEMENT- QPOS.
* T-EXPAND-TO-NSTG
T-EXPAND-TO-NSTG = IN LNR, LAR, LN, PN:
         [ASSERTION, PDATE, VENPASS, PVO, TOVO, VO,]
         [VINGO, VENO, YESNOQ, LAR1, NNN, LDATER :]
     IF ELEMENT- CONJ-NODE EXISTS
     THEN [EITHER $CHECK-LN * Global in T-EXPAND-TO-ASSERT *]
          [OR] $EXPAND-UP.
 $EXPAND-UP =                                                  [GLOBAL]
     DO EXPAND;
     IF CONJUNCT EXISTS THEN $EXPAND-TO-ANIQ.
 $EXPAND-TO-ANIQ =
     ITERATET AT IMMEDIATE-NODE DO EXPAND
     UNTIL TEST FOR NSTG OR EKGSTG SUCCEEDS
           [OR ASSERTION OR IMPERATIVE OR YESNOQ].
* T-EXPAND-LQR
*      DOES A PARTIAL EXPANSION (UP TO LNR OR QN OR NQ)
*      IN CONJOINED QUANTITY EXPRESSIONS. THE EXPANSION IS DONE ONLY
*      UP TO THE LNR, QN, OR NQ LEVEL BECAUSE THESE CONJUNCTIONS
*      GENERALLY REPRESENT RANGES, NOT TWO SEPARATE ASSERTIONS.
*          e.g. 'HEMATOCRIT WAS 25 TO 34' is not equivalent to
*               'HEMATOCRIT WAS 25 TO HEMATOCRIT WAS 34'.
*      THE PARTIAL EXPANSION IS DONE SO THAT EACH NUMBER CARRIES ITS
*      UNIT:
*          e.g. '25 TO 34 MG.' ==> '25 MG. TO 34 MG.'
*      THIS MAKES THE QUANTITY EXPRESSION MORE REGULAR.
T-EXPAND-LQR = IN LQR:
      IF EITHER PRESENT-ELEMENT- HAS ELEMENT- TOSTG OR DASHSTG
         OR BOTH PRESENT-ELEMENT- HAS ELEMENT- ANDSTG
            AND IF IMMEDIATE-NODE- IS QN
                THEN COELEMENT- N IS NOT NTIME1
      THEN BOTH BOTH DO EXPAND
               @AND ITERATE AT IMMEDIATE-NODE DO EXPAND
                    UNTIL TEST FOR NQ OR QUANT [QN] OR LNR SUCCEEDS
          @AND IF CONJUNCT [2nd LNR] OF VALUE OF IMMEDIATE NSTG EXISTS
              @THEN IF ELEMENT- RN IS NOT EMPTY
                   @THEN REPLACE PRESENT-ELEMENT- BY <RN> (<NULL>).
* T-EXPAND-RX
*     EXPANDS RIGHT ADJUNCT OF LXR UP TO ASSERTION OR FRAGMENT.
* NOTES: Now only allows PN.
T-EXPAND-RX = IN LNR, LAR:
     AT LAST-ELEMENT- [RN, RA],
     IF PRESENT-ELEMENT- IS NOT EMPTY
     THEN AT VALUE,
          ITERATE IF BOTH PRESENT-ELEMENT- IS PN
                     AND ELEMENT- CONJ-NODE EXISTS
                  THEN DO $EXPAND-PASS-LXR
          UNTIL GO RIGHT FAILS.
 $EXPAND-PASS-LXR =
     DO EXPAND;
     IF CONJUNCT EXISTS THEN $EXPAND-TO-ASSN.
 $EXPAND-TO-ASSN =
     ITERATET AT IMMEDIATE-NODE DO EXPAND
     UNTIL TEST FOR FRAGMENT OR ASSERTION SUCCEEDS.
* ***** ********************************************************
*
*        A S S E R T I O N   T R A N S F O R M A T I O N S
*
* ***** ********************************************************
* T-INTRO
*      converts N in INTRODUCER to full LNR.
T-INTRO = IN INTRODUCER:
     IF PRESENT-ELEMENT- X-PRE HAS ELEMENT- N OR ADJ
     THEN DO $LXR-INTRO
     ELSE IF VALUE X-ET OF X-PRE IS 'ET'
          THEN IF FIRST SA X-SA OF VALUE OF COELEMENT- CENTER EXISTS
               THEN BOTH IF X-SA IS EMPTY
                         THEN REPLACE X-SA BY <SA> (X-ET, X-NEWET)
                         ELSE BEFORE VALUE OF X-SA INSERT X-ET, X-NEWET
                    AND REPLACE X-ET BY <NULL>
               ELSE TRUE
          ELSE IF X-ET IS INT-PHRASE
               THEN REPLACE X-ET BY ALL ELEMENTS OF X-ET.
  $LXR-INTRO =
     IF X-PRE HAS ELEMENT- N X-N
     THEN REPLACE X-PRE BY
          X-PRE (<LNR>X1 ( <LN> ( <TPOS> (<NULL>)
                                + <QPOS> (<NULL>)
                                + <APOS> (<NULL>)
                                + <NPOS> (<NULL>))
                         + <NVAR> (ALL ELEMENTS OF X-PRE)
                         + <RN> (<NULL>)))
     ELSE IF X-PRE HAS ELEMENT- ADJ X-ADJ
          THEN REPLACE X-PRE BY
               X-PRE (<LAR>X1 ( <LA> (<NULL>)
                              + <AVAR> (ALL ELEMENTS OF X-PRE)
                              + <RA> (<NULL>)));
     TRANSFORM X1.
* T-MODAL
*   (1) FOR SUFFIXED FORM, REPLACES W BY CLASS W (TO REMOVE SUFFIX).
*   (2) PLACES NEGATIVE FROM SUFFIX 'NT' OR FROM RW AT BEG. OF 3RD SA;
*       (NOTE - NEGATED 'WILL' IS NOT CONSIDERED FUTURE TENSE.)
*   (3) moves node TENSE (other than forms of 'DO') under <MODAL>
*       after CORE of VERB.
*       <MODAL> will dominate elements such as 'CAN', 'MUST', etc.
*   (4) removes TENSE from STRING.
*   (5) SETS NODE ATTRIBUTE TENSE-ATT POINTING FROM CORE OF VERB
*       TO LIST CONTAINING TENSE ATTRIBUTES PRESNT, PAST, FUTURE.
*       E.G. 'HE DIDN'T GO TO THE LIBRARY'  ==>
*            'HE NOT GO TO THE LIBRARY'      (TENSE-ATT = PAST)
*
* NOTE: THIS DOES NOT DEAL WITH SCOPE PROBLEMS IN RELATION TO SA'S OR
*       TO NEGATIVES.
*       (IN PARTICULAR IT DOES NOT HANDLE 'MAY NOT' VS. 'CAN NOT'.)
T-MODAL = IN ASSERTION:
     IF TENSE X-TENSENODE IS NOT EMPTY
     THEN ALL OF $TENSE, $ADJUNCTS, $MODAL.
  $TENSE =
     IF CORE- X1 OF X-TENSENODE IS PAST
     THEN AT VERB BOTH X-TENSE := SYMBOL PAST
                  AND DO $ADD-TO-TENSE-ATT [Global in T-TENSE]
     ELSE IF X1 IS FUT ['WILL' OR 'IS TO']
          THEN AT VERB BOTH X-TENSE := SYMBOL FUT [FUTURE]
                       AND $ADD-TO-TENSE-ATT [Global in T-TENSE]
          ELSE IF BOTH X1 IS 'SHOULD'
                  AND CORE OF ELEMENT- VERB IS 'OBTAIN'
               THEN AT VERB BOTH X-TENSE:= SYMBOL FUT-IMP
                            AND $ADD-TO-TENSE-ATT [Global in T-TENSE]
               ELSE AT VERB BOTH X-TENSE:= SYMBOL PRESNT
                            AND $ADD-TO-TENSE-ATT [Global in T-TENSE].
  $ADJUNCTS =
     ALL OF $RW, $NEG, $LW.
  $NEG =
     IF X1 [CORE OF TENSE] HAS ATTRIBUTE NEGATIVE
     THEN $ADD-NEG.
  $ADD-NEG =
     BOTH IF X1 IS NOT EMPTY
          THEN BEFORE VALUE OF LV OF VERB
               INSERT <DSTG> (X1, X-D)
          ELSE BEFORE VALUE OF LV OF VERB
               INSERT <DSTG> (<D>X-D = 'NOT': (NEGATIVE,H-NEG,PREFX)
                             ^ ((('NOT'), D:(NEGATIVE,H-NEG,PREFX))))
     AND EITHER $CLASS-REPLACE OR TRUE;
     DO $ASSIGN-NEG [*Global*].
  $CLASS-REPLACE =
     X-FREE := X1;
     DO $SET-REG-ATT
    [REPLACE X1 BY CLASS W OF X1, X-CANON];
     DO $REASSIGN-ATT.
  $RW =
     IF RW X-RW OF X-TENSENODE IS NOT EMPTY
     THEN BOTH BEFORE VALUE OF LV OF VERB
               INSERT ALL ELEMENTS OF X-RW
          AND REPLACE X-RW BY X-RW (<NULL>).
  $LW =
     IF LW X-LW OF X-TENSENODE IS NOT EMPTY
     THEN BOTH BEFORE VALUE OF LV OF VERB
               INSERT <DSTG> (D OF X-LW)
             [* Regularize D of LW so that CLASS         *]
             [* transformations will apply appropriately *]
          AND REPLACE X-LW BY X-LW (<NULL>).
  $MODAL =
     BOTH IF X1 IS NOT EMPTY [VDO]
          THEN [BOTH] BEFORE VALUE OF LV OF VERB
                    INSERT X-TENSENODE, X-NEW
              [AND BOTH X-ADDSEL := SYMBOL H-MODAL]
              [    AND AT CORE- OF X-NEW DO $ADD-TO-SELATT]
     AND REPLACE X-TENSENODE BY <TENSE> (<NULL>).
  $ADD-TO-SELATT =
     IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE SELECT-ATT X-SEL
     THEN IF X-SEL DOES NOT HAVE MEMBER X-ADDSEL
          THEN $PREFIX-SEL
          ELSE TRUE
     ELSE $ADD-SELATT.
  $PREFIX-SEL =
     BOTH VERIFY PREFIX X-ADDSEL TO X-SEL
     AND ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE X-SEL.
  $ADD-SELATT =
     BOTH VERIFY X-SEL:= NIL
     AND DO $PREFIX-SEL.
* T-TENSE
*     strips simple present or past tense from VERB, replaces VERB
*     by its canonical form, and sets node attribute TENSE-ATT
*     pointing from core- of VERBAL to list containing attribute
*     identifying tense information that was stripped, i.e. attribute
*     PAST or PRESNT.
*          E.g. 'He went to California'  ==>
*               'He go to California'  (TENSE-ATT = PAST)
*     If the verb is in the present tense, and not 'have' or 'be', it
*     is also marked as generic to record the fact that the event
*     takes place either repeatedly or over a time period.
*          E.g. 'He lives in Canada'  ==>
*               'He live (GENERIC) in Canada'
*  ** Note for French Grammar:
*     Tense markers include PRESNT, PAST, FUT, IMP, COND, FUTURE.
T-TENSE = IN ASSERTION, LNR, LAR:
     IF CORE X1 OF VERB X-VERB IS TV X-TV
     THEN BOTH $X-TENSE AND $MORE-TENSE
     ELSE IF BOTH PRESENT-ELEMENT- X-LNR IS LNR OR LAR
             AND CORE- X1 IS PAST OR FUT OR FUTURE
          THEN ONE OF $N-PAST-TENSE, $N-FUT-TENSE.
  $MORE-TENSE = [for 'DE1JA2' and 'JAMAIS']
     AT X-VERB IF EITHER CORE- OF ELEMENT- LV IS PAST OR FUTURE,
                  OR CORE- OF ELEMENT- RV IS PAST OR FUTURE
               THEN DO $ADD-TO-TENSE-ATT.
  $N-PAST-TENSE =
     BOTH X1 IS PAST [for 'POST-OSTHE1OSYTHE2SE' ]
     AND IF X1 IS NOT NTIME1 OR NTIME2 OR H-TMBEG OR H-TMEND
                        OR H-TMLOC OR H-TMDUR OR H-TMREP
         THEN DO $PAST-MARKING.
  $PAST-MARKING =
     AT X-LNR BOTH X-TENSE := SYMBOL PAST
              AND DO $ADD-TO-TENSE-ATT.
  $N-FUT-TENSE =
     BOTH X1 IS FUTURE [for implicit future, 'pre1-ope1ratoire']
     AND AT X-LNR BOTH X-TENSE := SYMBOL FUTURE
                  AND $ADD-TO-TENSE-ATT.
  $ADD-TO-TENSE-ATT = DO $CHECK-TENSEATT.                   [GLOBAL]
  $CHECK-TENSEATT =
     BOTH CORE- X-CORE EXISTS
     AND $ADD-TO-LIST.
  $ADD-TO-LIST =
     IF X-CORE HAS NODE ATTRIBUTE TENSE-ATT X-TENSELIST
     THEN EITHER AT X-TENSELIST PRESENT-ELEMENT- HAS MEMBER X-TENSE
          OR BOTH PREFIX X-TENSE TO X-TENSELIST
             AND AT X-CORE ASSIGN NODE ATTRIBUTE TENSE-ATT
                 WITH VALUE X-TENSELIST
     ELSE BOTH X-TENSELIST := NIL
          AND $ADD-IT.
  $ADD-IT =
     BOTH PREFIX X-TENSE TO X-TENSELIST
     AND AT X-CORE
         ASSIGN PRESENT ELEMENT NODE ATTRIBUTE TENSE-ATT
         WITH VALUE X-TENSELIST.
  $X-TENSE =
    [IF EITHER OBJECT HAS ELEMENT- VENO]
    [   OR AT X1, DO R(VEN)]
    [THEN X-TENSE := SYMBOL PAST ]
    [ELSE]IF EITHER BOTH X1 IS 'OBTAIN'
                    AND CORE- OF TENSE IS 'SHOULD'
             OR X1 IS 'RECOMMENDED' OR 'RECOMMEND' OR 'RECOMMENDS'
          THEN X-TENSE := SYMBOL FUT-IMP
          ELSE IF X1 IS PAST
          THEN X-TENSE := SYMBOL PAST
          ELSE IF X1 IS IMP
               THEN X-TENSE := SYMBOL IMPARFAIT
               ELSE IF X1 IS FUT
                    THEN X-TENSE := SYMBOL FUT
                    ELSE IF X1 IS FUTURE
                         THEN X-TENSE := SYMBOL FUTURE
                         ELSE IF X1 IS COND
                              THEN X-TENSE := SYMBOL CONDITIONNEL
                              ELSE X-TENSE := SYMBOL PRESNT;
     AT X-VERB DO $ADD-TO-TENSE-ATT;
     EITHER $REPLACE-CLASS OR TRUE.
  $REPLACE-CLASS =
     X-FREE := X-TV;
     DO $SET-REG-ATT [;]
    [REPLACE X-TV BY CLASS V OF X-TV, X-CANON;]
    [DO $REASSIGN-ATT 20030805] [GLOBAL].
* T-EXPAND-IMPLIED-TENSE
*    expands major ASSERTION implied verbal TENSE to
*    embedded OBJECT ASSERTION.
*    08.21.1997 -- change to SA instead of OBJECT
*    28.03.2000 -- put FUT-IMP into VERB of TOVO in T-PVO-IN-SA
T-EXPAND-IMPLIED-TENSE = IN C1SHOULD, SVO, TOVO:
     IF IMMEDIATE-NODE- IS SA [OBJECT]
        WHERE COELEMENT- VERB EXISTS
     THEN EITHER AT ELEMENT- VERB X-VERB OF ELEMENT- ASSERTION X-ASSN
                 BOTH DO $INSERT-FUT-IMP
                 AND TRANSFORM X-ASSN
          OR EITHER [PVO] AT ELEMENT- LVR X-VERB DO $INSERT-FUT-IMP
             OR IF [TOVO] ELEMENT- LVR X-VERB OF ELEMENT- VO EXISTS
                THEN DO $INSERT-FUT-IMP [see also T-PVO-IN-SA].
  $INSERT-FUT-IMP =
     BOTH X-TENSE := SYMBOL FUT-IMP
     AND AT X-VERB DO $ADD-TO-TENSE-ATT.
* T-SIMPLIFY-PVO
*    expands PVO object of VERB with attribute VSENT3, such as 'SEEM',
*    'DECIDE', into ASSERTION with matrix SUBJECT as SUBJECT.
*       e.g.  'DOCTOR DECIDED TO CONTINUE THERAPY' ==>
*             'DOCTOR DECIDE DOCTOR CONTINUE THERAPY'
*    Node attribute TFORM-ATT is set to contain list with member
*    TPVO.
T-SIMPLIFY-PVO = IN ASSERTION:
    IF BOTH CORE- X-VCORE OF ELEMENT- VERB X-MVERB HAS ATTRIBUTE VSENT3
       AND VALUE OF ELEMENT- OBJECT X-MOBJ IS PVO OR TOVO X-PVO
    THEN IF $NEG-MODAL-VERB
         THEN ALL OF $SET-UP, $COLLAPSE-PVO.
  $NEG-MODAL-VERB =
    CORE-ATT OF X-VCORE HAS MEMBER H-MODAL OR H-NEG.
  $SET-UP =
    BOTH ELEMENT- SUBJECT X-SUBJ EXISTS
    AND ELEMENT- TENSE X-TENSE EXISTS;
    EITHER VERB X-VERB OF X-PVO EXISTS
    OR EITHER
          AT X-PVO, BOTH ELEMENT- VERBAL X-VERB OF ELEMENT- VO EXISTS
                    AND BOTH SECOND ELEMENT ['TO'] X-PVO-TO EXISTS
                        AND ELEMENT- VO X-PVO EXISTS
       OR LVR X-VERB OF X-PVO EXISTS.
  $COLLAPSE-PVO =
      [* move object up one level *]
    IF X-TENSE IS EMPTY
    THEN REPLACE CORE- OF X-TENSE
         BY X-VCORE + X-PVO-TO [SECOND ELEMENT 'TO' OF X-PVO]
    ELSE AFTER CORE- OF X-TENSE
         INSERT X-VCORE + X-PVO-TO [SECOND ELEMENT 'TO' OF X-PVO];
    IF FOLLOWING-ELEMENT- OF X-MOBJ IS NOT RV
    THEN AFTER X-MOBJ INSERT <RV> X-MRV (<NULL>);
    ELEMENT- LV X-LV OF X-MVERB EXISTS;
    IF LP OF X-PVO IS NOT EMPTY
    THEN IF X-LV IS EMPTY
         THEN REPLACE X-LV BY <LV> (ALL ELEMENTS OF LP OF X-PVO)
         ELSE AFTER LAST-ELEMENT- OF X-LV
              INSERT ALL ELEMENTS OF LP OF X-PVO;
    ELEMENT- LV X-LV OF X-MVERB EXISTS;
    REPLACE X-VCORE BY CORE OF X-VERB;
    IF RV OF XVERB IS NOT EMPTY
    THEN IF RV OF X-MVERB IS EMPTY
         THEN REPLACE RV OF X-MVERB BY RV OF X-VERB
         ELSE AFTER LAST-ELEMENT- OF RV OF X-MVERB
              INSERT ALL ELEMENTS OF RV OF X-VERB;
    IF LV OF X-VERB IS NOT EMPTY
    THEN AFTER LAST-ELEMENT- OF X-LV
         INSERT ALL ELEMENTS OF LV OF X-VERB;
    IF FIRST SA X-SA1 OF X-PVO IS NOT EMPTY
    THEN IF THE FOLLOWING-ELEMENT- X-MSA OF X-MVERB IS SA
         THEN IF X-MSA IS EMPTY
              THEN REPLACE X-MSA BY X-SA1
              ELSE BEFORE VALUE OF X-MSA
                   INSERT ALL ELEMENTS OF X-SA1
         ELSE TRUE;
    IF RV X-RV OF X-PVO IS NOT EMPTY
    THEN IF COELEMENT- RV X-MRV OF X-VERB IS EMPTY
         THEN REPLACE X-MRV BY X-RV
         ELSE BEFORE VALUE OF X-MRV
              INSERT ALL ELEMENTS OF X-RV;
    IF SECOND SA X-SA2 OF X-PVO IS NOT EMPTY
    THEN IF THE FOLLOWING-ELEMENT- X-MSA OF X-MRV IS SA
         THEN IF X-MSA IS EMPTY
              THEN REPLACE X-MSA BY X-SA2
              ELSE BEFORE VALUE OF X-MSA
                   INSERT ALL ELEMENTS OF X-SA2
         ELSE TRUE;
    IF THIRD SA X-SA3 OF X-PVO IS NOT EMPTY
    THEN IF THE FOLLOWING-ELEMENT- X-MSA OF X-MRV IS SA
         THEN IF X-MSA IS EMPTY
              THEN REPLACE X-MSA BY X-SA3
              ELSE BEFORE VALUE OF X-MSA
                   INSERT ALL ELEMENTS OF X-SA3
         ELSE TRUE;
    REPLACE X-MOBJ BY OBJECT OF X-PVO.
* T-EXISTENTIAL
*    tugs existential of THATS into itself.
*    It is likely that ASSERTION...
*    It is apparent that ASSERTION...
T-EXISTENTIAL = IN ASSERTION:
     AT PRESENT-ELEMENT- X-PRE
     IF BOTH BOTH EITHER CORE- OF ELEMENT- SUBJECT X2 IS 'THERE'
                  OR CORE- OF ELEMENT- SUBJECT X2 IS 'IT' [OR 'IL']
             AND EITHER CORE-ATT OF CORE- X-V OF ELEMENT- VERB HAS MEMBER VBE
                 OR ATTRIBUTE-LIST OF X-V HAS MEMBER BEREP [OR H-EVID OR H-NEG]
        AND EITHER VALUE X6 OF ELEMENT- OBJBE X7 OF ELEMENT- OBJECTBE
                   OF ELEMENT- OBJECT X-OBJ IS ASTG
                   WHERE ELEMENT- THATS X-THATS OF ELEMENT- RA OF
                         ELEMENT- LAR OF X6 EXISTS
            OR VALUE X6 OF ELEMENT- OBJBE X7 OF ELEMENT- OBJECT X-OBJ IS ASTG
               WHERE ELEMENT- THATS X-THATS OF ELEMENT- RA OF ELEMENT- LAR OF
                     X6 EXISTS
     THEN DO $EXIST.
  $EXIST =
     ELEMENT- ASSERTION X-ASSN OF X-THATS EXISTS;
     AFTER X-PRE INSERT X-ASSN, X-NEWASSN;
     DELETE X-ASSN;
     BEFORE VALUE OF ELEMENT- LV OF ELEMENT- VERBAL OF X-NEWASSN
     INSERT VALUE X-LAR OF X6;
     DELETE X-OBJ;
     BEFORE VALUE OF ELEMENT- SA OF X-NEWASSN
     INSERT X-PRE, X-NEWXPRE;
     DELETE X-PRE.
* T-REMOVE-THERE
*     (Existential there-sentences)
*     replaces a 'there'-SUBJECT of an ASSERTION by its NSTG OBJECT
*     and then moves the RN [VENPASS, VINGO, ADJINRN, or PN] of the
*     new SUBJECT NSTG into the OBJECT position, leaving a NULL RN
*     in SUBJECT.  This prevents the formation of extra ASSERTIONs by
*     T-RN-FILLIN.  If the RN is not one of the class specified above,
*     the OBJECT NSTG is moved into SUBJECT position and the verb VBE
*     is replaced by 'exist'. For examples:
*       1.  'There was cardiomegaly noted' ==> 'Cardiomegaly was noted'
*       2.  'There was meningitis due to bacterial infection'  ==>
*               'Meningitis was due to bacterial infection'
*       3.  'There was history of pain' ==> 'History of pain exists'
T-REMOVE-THERE = IN ASSERTION:
     AT PRESENT-ELEMENT- X-PRE
     IF BOTH BOTH EITHER CORE- OF ELEMENT- SUBJECT X2 IS 'THERE'
                  OR BOTH CORE- OF ELEMENT- SUBJECT X2 IS 'IL'
                     AND CORE- OF ELEMENT- PROPOS IS 'Y'
             AND CORE-ATT OF CORE- X-V OF ELEMENT- VERB HAS MEMBER VBE
        AND VALUE X6 OF ELEMENT- OBJBE X7 OF ELEMENT- OBJECTBE
            OF ELEMENT- OBJECT X-OBJ IS NSTG OR EKGSTG
     THEN EITHER $THERE
          OR $EXIST.
  $THERE =
     BOTH ELEMENT- RN X10 OF ELEMENT- LNR OF X6 [NSTG] IS
          NOT EMPTY
     AND BOTH ONE OF $V-FORM, $ADJ-IN-RN, $PN
         AND BOTH $IN-ASSERT AND $SHIFT.
  $V-FORM = VALUE X9 OF X10 [RN] IS VINGO OR VENPASS.
  $ADJ-IN-RN = X9 [VALUE OF RN] IS ADJINRN.
  $PN =
     BOTH X9 [VALUE OF RN] HAS ELEMENT- PN
    @AND AT ELEMENT- P X-P
         DO $GET-CONN [GLOBAL].
  $IN-ASSERT =
     BOTH AFTER LAST-ELEMENT- OF ELEMENT- SA OF X-PRE
          INSERT VALUE OF X2
     AND REPLACE VALUE OF X2 [SUBJECT]
         BY X6 [NSTG OBJECT].
  $SHIFT =
     REPLACE X7 [OBJBE]
     BY X9 [VINGO, VENPASS, ADJINRN, OR PN];
     DELETE VALUE OF ELEMENT- RN OF ELEMENT- LNR OF ELEMENT- NSTG
            OF X2 [SUBJECT].
  $EXIST =
     BOTH $IN-ASSERT
     AND BOTH $TENSE
         AND BOTH X-EXIST := X-V [REPLACE X-V]
             [     BY <V> X-EXIST = 'EXIST': (H-EVID)]
             AND IF X-TENSELIST EXISTS
                 THEN AT X-EXIST
                      ASSIGN PRESENT ELEMENT NODE ATTRIBUTE TENSE-ATT
                      WITH VALUE X-TENSELIST;
     REPLACE X-OBJ
     BY <OBJECT> (<NULLOBJ>).
  $TENSE =
     IF X-V [VBE] HAS NODE ATTRIBUTE TENSE-ATT
    @THEN STORE IN X-TENSELIST.
  $GET-CONN =
     EITHER $CONN-SELATT-CHK [GLOBAL]
     OR IMMEDIATE-NODE- [PN] HAS NODE ATTRIBUTE ADVERBIAL-TYPE
        WHERE PRESENT-ELEMENT- HAS MEMBER CONN-TYPE.
* T-REG-FRAG
*     expands NSTG fragments with VENPASS or VINGO in RN into
*     full ASSERTIONS with 'BE'.
*     e.g.    'NO RALES HEARD PREVIOUSLY'
*          => 'NO RALES BE HEARD PREVIOUSLY'
T-REG-FRAG = IN ASSERTION, FRAGMENT:
     AT PRESENT-ELEMENT- X10
     IF EITHER BOTH VALUE OF VERB IS NULLFRAG
                    [* if the VERB is NULLFRAG, so is the OBJECT *]
               AND BOTH ELEMENT- SUBJECT EXISTS
                  @AND DO $NSTG
        OR DO $NSTG
     THEN BOTH AT X10 [FRAGMENT, ASSERTION]
               DO $MAKE-ASSERT [T-CSSTG]
          AND BOTH BOTH $ADJINRN AND $FILL-IN
              AND DELETE X10 [ASSERTION, FRAGMENT]
     ELSE IF BOTH X20 [RN] HAS ELEMENT- PVO OR TOVO [OR TOBE] X12
             AND $CHECK-SUBJ
          THEN ONE OF $NSTG-T-PVO, $NSTG-T-TOVO.
  $NSTG = [* NTN 1/28/89 removes ADJINRN *]
     BOTH BOTH EITHER ELEMENT- NSTG X1 EXISTS
               OR ELEMENT- EKGSTG X1 EXISTS
         @AND ELEMENT- LNR OF X1 HAS ELEMENT- RN X20
              WHERE PRESENT-ELEMENT- HAS ELEMENT- VENPASS OR VINGO
                    [OR ADJINRN] X2
     AND $CHECK-COOC.
  $CHECK-COOC =
     [BOTH]
     BOTH IF X2 IS ADJINRN
          THEN APOS OF COELEMENT- LN OF X20 [RN] IS EMPTY
     AND IF X2 IS VINGO
         THEN NOT $PTLOC-VINGO
     [AND DO $NOT-CHANGER-PHRASE] [Global in T-SA-VFORM].
  $PTLOC-VINGO =
     BOTH CORE-ATT OF CORE- OF X1 HAS MEMBER H-INDIC OR H-DIAG
     AND CORE-ATT OF CORE- OF LVINGR OF X2 HAS MEMBER H-PTLOC.
  $ADJINRN =
     IF X2 IS ADJINRN
     @THEN REPLACE PRESENT-ELEMENT-
           BY <OBJBE> X2 (<ASTG> (VALUE [LAR])).
  $CHECK-SUBJ =
     BOTH CORE- X19 OF X1 [NSTG] IS N OR PRO
     AND IF CORE- OF ELEMENT- LVR [VERB] OF VO X13 OF X12
            [PVO OR TOVO OR TOBE] HAS ATTRIBUTE NOTNSUBJ X18
         THEN LISTS X18 AND X19 HAVE NO COMMON ATTRIBUTE.
  $NSTG-T-PVO =
     BOTH X12 IS PVO
     AND AFTER PRESENT-ELEMENT- INSERT
            <ASSERTION> X7
              (FIRST SA OF X10
              + <SUBJECT> (X1 [NSTG])
              + <SA> (<NULL>)
              +NEG OF X12 [X13]
              +TENSE OF X12 [X13]
              + <SA> (<NULL>)
              + <VERB> (ALL ELEMENTS OF LVR OF X12 [X13])
              +FIRST SA OF X12 [X13]
              +OBJECT OF X12 [X13]
              +RV OF X12 [X13]
              +SECOND SA X9 OF X12 [X13]);
     AFTER LAST-ELEMENT- OF X9 [SA OF PVO]
        INSERT ALL ELEMENTS OF SECOND SA OF X10;
     EITHER REPLACE VALUE [PVO] OF RN OF LNR OF NSTG OF
            SUBJECT OF X7 BY <NULL>
     OR REPLACE VALUE [PVO] OF RN OF LNR OF EKGSTG OF
            SUBJECT OF X7 BY <NULL>;
     AT VERB OF X7 REPLACE V BY <VVAR> (ELEMENT- V);
     IF LV X-LV OF VERB OF X7 IS NOT EMPTY
     THEN AFTER LAST-ELEMENT- OF X-LV INSERT ELEMENT- P OF X12
     ELSE REPLACE VALUE OF X-LV BY ELEMENT- P OF X12;
     DELETE X10;
    [AT LAST-ELEMENT- OF VVAR OF VERB OF X7 DO $TENSE-T;]
     IF VALUE OF OBJECT OF X7 IS NSTGO X-NSTG
     THEN EITHER AT CORE- X-CORE OF LNR OF NSTG OF X-NSTG
                 DO $MAKE-SELATT
          OR AT CORE- X-CORE OF LNR OF EKGSTG OF X-NSTG
             DO $MAKE-SELATT;
     TRANSFORM X7 [NEW ASSERTION].
  $NSTG-T-TOVO =
     BOTH X12 IS TOVO
     AND AFTER PRESENT-ELEMENT- INSERT
            <ASSERTION> X7
              (FIRST SA OF X10
              + <SUBJECT> (X1 [NSTG])
              + <SA> (<NULL>)
              + <NEG> (<NULL>)
              + <TENSE> (<NULL>)
              + <SA> (<NULL>)
              + <VERB> (ALL ELEMENTS OF LVR OF [X12] X13)
              + <SA> (<NULL>)
              +OBJECT OF [X12] X13
              + <RV> (<NULL>)
              + <SA> (<NULL>));
     EITHER REPLACE VALUE [TOBE] OF RN OF LNR OF NSTG OF
            SUBJECT OF X7 BY <NULL>
     OR REPLACE VALUE [TOBE] OF RN OF LNR OF NSTG OF
        SUBJECT OF X7 BY <NULL>;
     AT VERB OF X7 REPLACE V BY <VVAR> (ELEMENT- V);
     IF LV X-LV OF VERB OF X7 IS NOT EMPTY
     THEN BOTH AFTER LAST-ELEMENT- OF X-LV
               INSERT <P> X-P12 = 'to'
          AND IF SECOND ELEMENT [TO] OF X12 HAS NODE
                 ATTRIBUTE WORD-POS X-WPOS
              THEN AT X-P12 ASSIGN NODE ATTRIBUTE WORD-POS
                   WITH VALUE X-WPOS;
     DELETE X10;
    [AT LAST-ELEMENT- OF VVAR OF VERB OF X7 DO $TENSE-T;]
     IF VALUE OF OBJECT OF X7 IS NSTGO X-NSTG
     THEN EITHER AT CORE- X-CORE OF LNR OF NSTG OF X-NSTG
                 DO $MAKE-SELATT
          OR AT CORE- X-CORE OF LNR OF NSTG OF X-NSTG
             DO $MAKE-SELATT;
     TRANSFORM X7 [NEW ASSERTION].
  $MAKE-SELATT =
     BOTH CORE-SELATT X-S OF X-CORE EXISTS
     AND ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE X-S.
  $TENSE-T =
     BOTH X-TENSE := SYMBOL FUT
     AND $ADD-TO-TENSE-ATT [GLOBAL IN T-TENSE].
  $FILL-IN =
     BOTH AT X106 [VERB] DO $BUILD-BE [T-CSSTG]
     AND ALL OF $VEN, $X-COPY-SUBJ, $SA, $TFORM.
  $TFORM = TRANSFORM X111 [NEW ASSERTION].
  $X-COPY-SUBJ = REPLACE X102 [SUBJECT] BY
                    <SUBJECT> (X1, X3  [NSTG FROM FRAGMENT]).
  $VEN = BOTH REPLACE X108 [OBJECT] BY
           <OBJECT> (<OBJECTBE>( X2 ))
         AND REPLACE X2 BY <NULL> [replace value of RN that was moved].
  $SA =
     FIRST SA X-SA OF X10 EXISTS;
     ITERATE IF X-SA IS NOT EMPTY
             THEN BEFORE VALUE OF X101 INSERT ALL ELEMENTS OF X-SA
     UNTIL AT X-SA DO R(SA) WHERE PRESENT-ELEMENT- X-SA EXISTS FAILS.
* T-NULLFRAG-TO-FRAG
*     TRANSFORMS AN ASSERTION WITH A NULLFRAG VERB AND OBJECT AND
*     WITH A NSTG SUBJECT INTO A NSTG FRAGMENT.
T-NULLFRAG-TO-FRAG = IN ASSERTION:
     AT PRESENT-ELEMENT- X-ASSRT
     IF BOTH VALUE OF VERB IS NULLFRAG
             [if verb is NULLFRAG, so is object]
        AND EITHER ELEMENT- NSTG X-NSTG OF ELEMENT- SUBJECT EXISTS
            OR ELEMENT- EKGSTG X-NSTG OF ELEMENT- SUBJECT EXISTS
     THEN $FRAG.
  $FRAG =
     ALL OF $MOVE-SA, $BUILD-FRAG, $TRANSFORM-FRAG.
  $MOVE-SA =
     AT LAST-ELEMENT X-LASTSA OF X-ASSRT
     BOTH VALUE X-VALSA OF X-LASTSA EXISTS
     AND ITERATET IF BOTH PRESENT-ELEMENT- IS SA OR RV X-SA
                     AND PRESENT-ELEMENT- IS NOT EMPTY
                  THEN BOTH AT VALUE X-PRE [OF RV OR SA]
                            DO $FILL-LAST-SA
                       AND REPLACE X-SA BY X-SA (<NULL>)
         UNTIL BOTH PRESENT-ELEMENT- IS NOT SUBJECT
               AND GO LEFT FAILS.
  $FILL-LAST-SA =
     ITERATE BOTH BEFORE X-VALSA
                  INSERT X-PRE, X-TEMP
             AND AT X-TEMP
                 STORE IN X-VALSA
     UNTIL AT X-PRE
           BOTH BOTH GO RIGHT
                @AND STORE IN X-PRE
           AND X-PRE IS NOT NULL  FAILS.
  $BUILD-FRAG =
     REPLACE X-ASSRT
     BY <FRAGMENT> X-FRAG
           (ELEMENT- SA [FIRST SA] OF X-ASSRT
            + ALL ELEMENTS OF SUBJECT OF X-ASSRT
            + X-LASTSA).
  $TRANSFORM-FRAG =
     TRANSFORM X-FRAG.
* T-SA-SEARCH
*    THE FILLING IN OF MISSING SUBJECT IN CERTAIN SA CONSTRUCTIONS
*    E.G. 'PVO/VINGO/VENPASS/CSSTG/RNSUBJ REQUIRES THE FILLING IN OF
*    THE SURFACE SUBJECT; THEREFORE THIS TRANSFORMATION MUST BE DONE
*    BEFORE THE PASSIVE IS DONE.  IN ADDITION SINCE SA IS PLACED IN
*    THE FIRST (LOWEST) AVAILABLE POSITION, IT IS NECESSARY TO SEARCH
*    OBJECT STRINGS FOR SA'S WHICH MAY BELONG ON A HIGHER LEVEL;
*    THESE SA'S ARE THEN ACTIVATED (TRANSFORMED) BEFORE OTHER
*    REARRANGEMENT OPERATIONS ARE CARRIED OUT (I.E. THE PASSIVE).
T-SA-SEARCH = IN ASSERTION:
     BOTH $SA-CHECK AND $SA-IN-OBJ.
  $SA-CHECK =
     AT VALUE ITERATE $SA-TEST UNTIL GO RIGHT FAILS.
  $SA-TEST =
     IF BOTH PRESENT-ELEMENT IS SA
        AND PRESENT-ELEMENT- HAS ELEMENT PVO OR TOVO OR VENPASS OR
              RNSUBJ OR CSSTG OR VINGO OR SUB1 OR SUB10 OR SUB5
              OR SUB9 OR SUB11 OR SUB13
           [WHERE DO $NOT-CHANGER-PHRASE] [GLOBAL - T-SA-VFORM]
    @THEN TRANSFORM PRESENT-ELEMENT.
  $SA-IN-OBJ =
     IF PRESENT-ELEMENT HAS ELEMENT OBJECT OR PASSOBJ
        WHERE CORE IS OF TYPE STRING
     @THEN BOTH $SA-CHECK AND $SA-IN-OBJ.
* T-SA-SEARCH-FRAG
*    transforms sentence phrasal adjunct.
T-SA-SEARCH-FRAG = IN FRAGMENT:
     BOTH $SA-CHECK AND $SA-IN-ELEM.
  $SA-CHECK =
     AT VALUE ITERATE $SA-TEST UNTIL GO RIGHT FAILS.
  $SA-TEST =
     IF BOTH PRESENT-ELEMENT IS SA
        AND PRESENT-ELEMENT- HAS ELEMENT PVO OR TOVO OR VENPASS OR
            RNSUBJ OR CSSTG OR VINGO OR SUB1 OR SUB9 OR SUB10 OR SUB5
              OR SUB9 OR SUB11 OR SUB13
           [WHERE DO $NOT-CHANGER-PHRASE] [GLOBAL - T-SA-VFORM]
    @THEN TRANSFORM PRESENT-ELEMENT.
  $SA-IN-ELEM =
     IF PRESENT-ELEMENT HAS ELEMENT BESHOW OR PVO OR TOVO OR VO
        OR VENPASS
    @THEN BOTH $SA-CHECK AND $SA-IN-ELEM.
* T-VENO
*   TRANSFORMS PERFECT TENSE CONSTRUCTIONS BY REPLACING THE AUX 'HAVE'
*   (IN VERB) WITH THE UNTENSED FORM OF THE VERB. IT ALSO MARKS THE
*   CORE- OF THE VERB AS PERFECT BY SETTING NODE ATTRIBUTE TENSE-ATT
*   TO POINT TO LIST CONTAINING ELEMENT PERF.  NOTE THAT TENSE-ATT
*   LIST MAY CONTAIN MORE THAT ONE ELEMENT (E.G. PAST PERF).
*   THE OBJECT OF VENO IS MOVED INTO THE OBJECT OF ASSERTION
*   AND THE SA'S AND RV'S OF VENO ARE RELOCATED IN ASSERTION.
*   THIS TRANSFORMATION NOT ONLY REMOVES AFFIXES BUT ALSO
*   REGULARIZES THE TYPE OF OBJECT OTHER TRANSFORMATIONS MUST DEAL
*   WITH.  IT IS CRUCIALLY ORDERED BEFORE T-VINGO AND AFTER T-TENSE.
*   THE SENTENCE 'HE HAD FINISHED THE ASSIGNMENT', AFTER BEING
*   OPERATED ON PREVIOUSLY BY T-TENSE TO GET THE NODE ATTRIBUTE
*   TENSE-ATT = PRESNT IS OPERATED ON BY T-VENO.
*    E.G. 'HE HAVE (TENSE-ATT = PRESNT) FINISHED THE ASSIGNMENT' ==>
*         'HE FINISH (TENSE-ATT = PRESNT PERF) THE ASSIGNMENT'
*   NOTE:  THIS TRANSFORMATION WILL NOT OPERATE ON PARTICIPIAL
*   CONSTRUCTIONS, E.G. 'AFTER HAVING TAKEN PENICILLIN...', since
*   here T-VENO would have to be executed after T-VINGO.
T-VENO = IN ASSERTION, PVO, TOVO:
    IF BOTH EITHER PRESENT-ELEMENT- IS ASSERTION [OR TOVO OR PVO]
               WHERE PRESENT-ELEMENT- HAS ELEMENT- OBJECT X-OBJECT
            OR [PVO or TOVO]
               ELEMENT- OBJECT X-OBJECT OF ELEMENT- VO EXISTS
       AND BOTH AT X-OBJECT EITHER CORE IS VENO X30
                            OR VALUE IS VENO X30
           AND EITHER CORE-SELATT OF CORE X51 OF
                  ELEMENT- VERB X35 HAS MEMBER VHAVE
               OR $V-ETRE
    THEN ALL OF $ADD-TENSE, $TRANSFER-VENO, $MOVE-OBJECT.
  $V-ETRE =
       [* FRENCH PASSE1 COMPOSE1 SURFACES AS                *]
       [*  (AS OPPOSED TO PASSIVE)                          *]
       [*    1. CONJUGATED WITH VERB AVOIR (VHAVE)          *]
       [*    2. CONJUGATED WITH VERB ETRE (VBE) IF          *]
       [*       A. MAIN VERB IS VERB OF MOTION (VETRE)      *]
       [*       B. MAIN VERB IS REFLEXIVE/RECIPROXAL (VSE)  *]
       [*       C. MAIN VERB IS PRONOMINAL (VMIDDLE).       *]
     BOTH CORE-SELATT OF CORE- X51 OF X35 HAS MEMBER VBE
     AND EITHER CORE-SELATT X-ATT OF CORE- OF
                LVENR OF X30 HAS MEMBER VETRE
         OR EITHER BOTH X-ATT HAS MEMBER VSE
                   AND COELEMENT PROPOS IS NOT EMPTY
            OR EITHER X-ATT IS VMIDDLE
               OR X30 [VENO] HAS NODE ATTRIBUTE REFLEXIVE.
  $ADD-TENSE =
     BOTH IF X51 HAS NODE ATTRIBUTE TENSE-ATT X-TENSELIST
          THEN AT CORE- OF LVENR OF X30 [VENO]
               ASSIGN NODE ATTRIBUTE TENSE-ATT WITH VALUE
                      X-TENSELIST
     AND AT LVENR X31 OF X30 [VENO]
         BOTH X-TENSE := SYMBOL PAST
         AND DO $ADD-TO-TENSE-ATT.
  $TRANSFER-VENO =
     ALL OF $X-LV, $X-RV, $VEN.
  $X-LV =
     IF LV OF X31 HAS ELEMENT- DSTG OR LDR X38
     THEN IF ELEMENT LV X-LV OF X35 HAS ELEMENT- DSTG
         @THEN BOTH ITERATE GO DOWN
              @AND AFTER PRESENT-ELEMENT- INSERT X38
          ELSE AT X-LV REPLACE PRESENT-ELEMENT- BY X-LV (X38).
  $X-RV =
     IF BOTH RV X37 OF X31 IS NOT EMPTY
        AND RV X41 OF X35 EXISTS
     THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $VEN =
     BOTH AFTER CORE- OF X35 INSERT VEN OF X31
     AND $CLASS-REPLACE.
  $CLASS-REPLACE =
     X-FREE := X-CORE;
     AT CORE- X-CANON OF X35 DO $SET-REG-ATT
    [REPLACE X-VEN BY <VVAR> (CLASS V OF X-VEN, X-CANON);]
    [DO $REASSIGN-ATT 20030805] [GLOBAL].
  $MOVE-OBJECT = ALL OF $X-SA1, $X-SA2, $X-RV1, $X-OBJECT.
  $X-RV1 =
      IF BOTH RV X37 OF X30 IS NOT EMPTY
         AND RV X41 OF IMMEDIATE ASSERTION OF X30 EXISTS
      THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $X-SA1 =
      IF BOTH FIRST SA X37 OF X30 [VERB-STRING] IS NOT EMPTY
         AND 4TH SA X41 OF IMMEDIATE ASSERTION OF X30 EXISTS
      THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $X-SA2 =
     IF BOTH SECOND SA X37 OF X30 [VERB-STRING] IS NOT EMPTY
        AND 5TH SA X41 OF IMMEDIATE ASSERTION OF X30 EXISTS
     THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $X-OBJECT =
     BOTH REPLACE VALUE OF OBJECT BY
             VALUE OF OBJECT OF X30
     AND BOTH EITHER PRESENT-ELEMENT- IS ASSERTION
              OR EITHER IMMEDIATE ASSERTION EXISTS
                 OR EITHER IMMEDIATE TOVO EXISTS
                    OR IMMEDIATE PVO EXISTS
        @AND $EXPAND-OBJ [Global in T-EXPAND-OBJECT].
* T-VINGO
*   TRANSFORMS ASSERTIONS WITH PROGRESSIVE VERBS INTO ASSERTIONS WITHOUT THE
*   PROGRESSIVE STRUCTURE AND THE TENSE INFORMATION 'PROG' ADDED TO THE SIM-
*   PLIFIED VERB.  IT SUBSTITUTES THE UNTENSED V OF VING FOR THE FORM OF
*   'BE' AND THEN MOVES ANY NON-EMPTY STRUCTURE IN THE ORIGINAL OBJECT UP
*   TO THE ASSERTION LEVEL, INCLUDING RELOCATING THE SA'S AND RV'S OF VINGO
*   IN THE ASSERTION SA AND RV SLOTS.
*   IN T-VINGO, X30 IS VINGO, AND X35  IS THE VERB IN ASSERTION.
T-VINGO = IN ASSERTION, PVO, TOVO:
       IF BOTH VALUE OF OBJECTBE OF OBJECT IS VINGO X30
             AND CORE- X51 OF VERB X35 EXISTS
       THEN ALL OF $ADD-TENSE, $TRANSFER-VINGO,
                  [$REPLACE-VING,] $MOVE-OBJ-UP.
  $REPLACE-VING =
     AT CORE- X-VING OF X-VERB
     X-FREE := X-VING;
     DO $SET-REG-ATT;
     X-CANON := X-VING;
     DO $REASSIGN-ATT.
  $ADD-TENSE =
       BOTH IF X51 HAS NODE ATTRIBUTE TENSE-ATT X-TENSELIST
            THEN AT CORE- OF LVINGR X31 OF X30 [VINGO]
                 ASSIGN NODE ATTRIBUTE TENSE-ATT WITH
                 VALUE X-TENSELIST
       AND AT LVINGR X31 OF X30 [VINGO]
           BOTH X-TENSE := SYMBOL PROG
           AND $ADD-TO-TENSE-ATT [GLOBAL IN T-TENSE].
  $TRANSFER-VINGO =
     ALL OF $X-PROPOS, $X-LV, $X-RV, $VING.
  $X-PROPOS =
     IF ELEMENT- PROPOS X-PRO1 OF X30 IS NOT EMPTY
     THEN IF COELEMENT- PROPOS X-PRO OF X35 IS NOT EMPTY
          THEN BOTH $GOTO-PROPOS
               AND REPLACE X-PRO BY X-PRO1
          ELSE REPLACE X-PRO BY X-PRO1.
  $X-LV =
     IF LV OF X31 HAS ELEMENT- DSTG OR LDR X38
     THEN IF ELEMENT LV X-LV OF X35 HAS ELEMENT- DSTG
         @THEN BOTH ITERATE GO DOWN
              @AND AFTER PRESENT-ELEMENT- INSERT X38
          ELSE AT X-LV REPLACE PRESENT-ELEMENT- BY X-LV (X38).
  $X-RV =
     IF BOTH RV X37 OF X31 IS NOT EMPTY
        AND RV X41 OF X35 EXISTS
     THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $GOTO-PROPOS =
     ITERATE LAST-ELEMENT- X-PRO EXISTS
     UNTIL X-PRO IS EMPTY SUCCEEDS.
  $VING =
     BOTH DO $INSERT-VING
     AND DO $CLASS-REPLACE.
  $INSERT-VING =
     AT CORE- X-XC OF X35
     BOTH IF FOLLOWING-ELEMENT- IS V OR TV OR VING OR VEN
         @THEN STORE IN X-XC
     AND AFTER X-XC INSERT VING OF X31.
  $CLASS-REPLACE =
     X-FREE := X-CORE;
     AT CORE- X-CANON OF X35 DO $SET-REG-ATT [;]
    [REPLACE X-VING BY <VVAR> (CLASS V OF X-VING, X-CANON);]
    [DO $REASSIGN-ATT 20030805] [GLOBAL].
  $MOVE-OBJ-UP = ALL OF $X-LVSA, $X-SA1, $X-SA2, $X-RV1, $X-OBJECT.
  $X-LVSA =
     IF BOTH LVSA X37 OF X30 [VENO] IS NOT EMPTY
        AND SECOND SA X41 OF IMMEDIATE ASSERTION EXISTS
     THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $X-SA1 =
      IF BOTH FIRST SA X37 OF X30 [VERB-STRING] IS NOT EMPTY
         AND 4TH SA X41 OF IMMEDIATE ASSERTION OF X30 EXISTS
      THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $X-SA2 =
     IF BOTH SECOND SA X37 OF X30 [VERB-STRING] IS NOT EMPTY
        AND 5TH SA X41 OF IMMEDIATE ASSERTION OF X30 EXISTS
     THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $X-RV1 =
      IF BOTH RV X37 OF X30 IS NOT EMPTY
         AND RV X41 OF IMMEDIATE ASSERTION OF X30 EXISTS
      THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $X-OBJECT =
     BOTH REPLACE VALUE OF OBJECT BY
             VALUE OF OBJECT OF X30
     AND BOTH EITHER PRESENT-ELEMENT- IS ASSERTION
              OR EITHER IMMEDIATE ASSERTION EXISTS
                 OR EITHER IMMEDIATE TOVO EXISTS
                    OR IMMEDIATE PVO EXISTS
        @AND $EXPAND-OBJ [Global in T-EXPAND-OBJECT].
* T-PVO-FUTURE
*    CHANGES 'IS TO' PVO PHRASES (E.G. 'IS TO BE FOLLOWED') INTO AN
*    ASSERTION IF THE SUBJECT INFORMATION IS PRESENT OR INTO TVO WHEN IT
*    IS NOT.  THE VERB OF THE ASSERTION IS COPIED FROM THE VERB OF THE
*    PVO AND A NODE ATTRIBUTE TENSE-ATT IS SET POINTING FROM THE CORE
*    OF THE VERB TO A LIST CONTAINING THE ATTRIBUTE FUTURE.  THE
*    OBJECT OF PVO IS MOVED UP TO THE OBJECT OF ASSERTION OR TVO, AND
*    RV'S AND SA'S OF PVO ARE RELOCATED IN THE HIGHER STRING.
*    NOTICE THAT IT IS POSIBLE TO GET A TENSE 'FUTURE PAST PERFECT' FROM
*    A SENTENCE LIKE 'HE WAS TO HAVE BEEN FOLLOWED'.
*         E.G. 'HE IS TO BE FOLLOWED IN CLINIC' ==>
*              'HE IS (HE BE (TENSE-ATT = FUTURE) FOLLOWED IN CLINIC)'
T-PVO-FUTURE = IN ASSERTION:
    IF BOTH VALUE OF OBJECTBE OF OBJECT OF PRESENT-ELEMENT- X46 IS
            PVO OR TOVO OR TOBE
       AND CORE X51 OF ELEMENT- VERB X17 IS VBE [E.G. 'HE IS TO GO']
    THEN $OBJ-T.
  $OBJ-T =
     AT ELEMENT- OBJECT GO DOWN [OBJECTBE];
     GO DOWN [PVO/TOVO];
     IF PRESENT-ELEMENT- IS PVO OR TOVO
     THEN EITHER ELEMENT- VO X30 EXISTS
          OR IF ELEMENT- LVR X-LVR EXISTS
             THEN REPLACE X-LVR BY <VO> X30 (X-LVR)
     ELSE STORE IN X30 [new PVO/TOVO];
     ALL OF $X-SA1, $X-SA2, $X-RV1, $LV-X;
     EITHER VERB X31 OF X30 EXISTS
     OR BOTH LVR X31 OF X30 EXISTS
        AND REPLACE CORE- OF X31 BY <VVAR> (CORE- OF X31);
     AT X17 STORE IN X35 [VERB];
     DO $VERB-T;
     AT X46 [PRESENT-ELEMENT- = ASSERTION] DO $X-OBJECT.
  $X-SA1 =
      IF BOTH FIRST SA X37 OF X30 [VERB-STRING] IS NOT EMPTY
         AND 4TH SA X41 OF IMMEDIATE ASSERTION OF X30 EXISTS
      THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $X-SA2 =
     IF BOTH SECOND SA X37 OF X30 [VERB-STRING] IS NOT EMPTY
        AND 5TH SA X41 OF IMMEDIATE ASSERTION OF X30 EXISTS
     THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $X-RV1 =
      IF BOTH RV X37 OF X30 IS NOT EMPTY
         AND RV X41 OF IMMEDIATE ASSERTION OF X30 EXISTS
      THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $LV-X = IF BOTH LV X37 OF X30 IS NOT EMPTY
             AND SECOND SA X41 OF IMMEDIATE ASSERTION EXISTS
          THEN $ADD-ADJUNCT.
  $ADD-ADJUNCT =
     [ $ADD-ADJUNCT CHECKS SA OR RV (X37) IN OBJECT STRING; IF IT IS  ]
     [ NOT EMPTY THEN IT EITHER APPENDS IT TO THE END OF THE MATCHING ]
     [ RV OR SA (X41) IN THE ASSERTION STRING, OR IF THAT ADJUNCT     ]
     [ (X41) IS NULL, IT REPLACES X47.                                ]
     IF X41 IS EMPTY
     THEN REPLACE X41 BY X37
     ELSE BEFORE VALUE OF X41 [NULL ELEMENT]
          INSERT ALL ELEMENTS OF X37.                           [GLOBAL]
  $X-OBJECT =
     BOTH REPLACE VALUE OF OBJECT BY
             VALUE OF OBJECT OF X30
     AND BOTH EITHER PRESENT-ELEMENT- IS ASSERTION
              OR EITHER IMMEDIATE ASSERTION EXISTS
                 OR EITHER IMMEDIATE TOVO EXISTS
                    OR IMMEDIATE PVO EXISTS
        @AND $EXPAND-OBJ [Global in T-EXPAND-OBJECT].
  $VERB-T = ALL OF $X-LV, $X-RV, $VER-T.
  $X-LV =
     IF LV OF X31 HAS ELEMENT- DSTG OR LDR X38
     THEN IF ELEMENT LV X-LV OF X35 HAS ELEMENT- DSTG
         @THEN BOTH ITERATE GO DOWN
              @AND AFTER PRESENT-ELEMENT- INSERT X38
          ELSE AT X-LV REPLACE PRESENT-ELEMENT- BY X-LV (X38).
  $X-RV =
     IF BOTH RV X37 OF X31 IS NOT EMPTY
        AND RV X41 OF X35 EXISTS
     THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $VER-T =
     BOTH BOTH REPLACE X17 [VERB]
               BY X17 (ALL ELEMENTS OF X31 [VERB OF PVO/TOVO])
          AND $CLASS-REPLACE
     AND AT LAST-ELEMENT OF VVAR OF X17 [VERB IN ASSERTION]
         DO $TENSE-T.
  $CLASS-REPLACE =
     AT CORE X-FREE OF VVAR X-VVAR OF X17 [VERB]
     DO $SET-REG-ATT [;]
    [REPLACE X-VVAR BY <VVAR> (CLASS V OF VALUE OF X-VVAR, X-CANON);]
    [DO $REASSIGN-ATT 20030805] [GLOBAL].
  $TENSE-T =
     BOTH X-TENSE := SYMBOL FUT
     AND $ADD-TO-TENSE-ATT [GLOBAL IN T-TENSE].
* T-IT-REPLACEMENT
*    REPLACES 'IT' IN SUBJECT BY SN WHEN THE SN IS IN RV OF VENPASS
*    IN THE OBJECT OF AN ASSERTION.
*         E.G. 'IT WAS DECIDED TO CONTINUE TREATMENT'  ==>
*              'TO CONTINUE TREATMENT WAS DECIDED'
*    NOTE: T-PASSIVE WILL OPERATE ON THE TRANSFORMED ASSERTION.
T-IT-REPLACEMENT = IN ASSERTION:
     IF BOTH VALUE OF RV OF ELEMENT- LVENR OF
             ELEMENT- VENPASS OF ELEMENT- OBJECTBE
             OF ELEMENT- OBJECT IS SN OR TOVO [OR PVO] X1
        AND CORE- OF ELEMENT- SUBJECT X2 IS [FRENCH] 'IL' OR 'IT'
     THEN BOTH REPLACE VALUE OF X2 [SUBJECT]
               BY X1 [SN/TOVO]
          AND REPLACE X1 [SN/TOVO] BY <NULL>.
* T-VERBAL-CHANGE
*     IF VERB IS H-CHANGE WITH SOME QUALIFICATION MORE OR LESS,
*     THEN ASSIGN '[PLUS]' OR '[MOINS]' TO APOS OF OBJECT.
T-VERBAL-CHANGE = IN ASSERTION:
      IF BOTH CORE-ATT X-VATT OF CORE- X-V OF VERB X-PRE HAS MEMBER
                          H-CHANGE-MORE OR H-CHANGE-LESS
         AND VALUE OF OBJECT IS NSTGO X-NSTG
             WHERE VALUE IS NSTG OR EKGSTG
      THEN AT ELEMENT- APOS OF LN OF LNR OF VALUE OF X-NSTG
           DO $ADD-LAR.
  $ADD-LAR =
     IF PRESENT-ELEMENT- X-QP IS EMPTY
     THEN BOTH REPLACE X-QP BY
               <APOS> (<LAR>X-LAR
                         (<LA> (<NULL>)
                         +<AVAR> (<ADJ>X-Q = '[CHANGE]':(H-AMT))
                         +<RA> (<NULL>)))
          AND AT HOST- OF X-Q
              ASSIGN NODE ATTRIBUTE N-TO-LN-ATT WITH VALUE X-LAR
     ELSE IF EITHER LA X-LA OF ELEMENT- LAR OF X-QP IS EMPTY
             OR LA X-LA OF ELEMENT- LAR OF VALUE OF X-QP IS EMPTY
          THEN REPLACE X-LA BY
            <LA> (<LAR> (<LA> (<NULL>)
                        +<AVAR> (<ADJ> X-Q = '[CHANGE]':(H-AMT))
                        +<RA> (<NULL>)))
          ELSE AFTER LAST-ELEMENT- OF X-LA
                     [OF ELEMENT- LAR OF VALUE OF X-QP] INSERT
               <LAR> (<LA> (<NULL>)
                     +<AVAR> (<ADJ> X-Q = '[CHANGE]':(H-AMT))
                     +<RA> (<NULL>));
     IF X-VATT HAS MEMBER H-CHANGE-MORE
     THEN REPLACE X-Q BY <ADJ> = '[MORE]':(H-AMT)
     ELSE IF X-VATT HAS MEMBER H-CHANGE-LESS
          THEN REPLACE X-Q BY <ADJ> = '[LESS]':(H-AMT);
     IF CORE-SELATT X-ATTS OF X-Q IS NOT NIL
     THEN AT X-Q ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE X-ATTS.
* T-TIME-SUB2
*    assigns TIME-ADVERBIAL to SUB2:H-TMPREP+H-TTGEN.
T-TIME-SUB2 = IN SUB2:
     IF BOTH VALUE IS CS2:H-TMPREP
        AND CORE-ATT OF CORE- OF ELEMENT- VERBAL OF ELEMENT- VENPASS
            HAS MEMBER NTIME1 OR H-TTGEN
     THEN BOTH DO $BUILD-TIME-ADVERBIAL
          AND ASSIGN NODE ATTRIBUTE ADVERBIAL-TYPE WITH VALUE X-TIME.
  $BUILD-TIME-ADVERBIAL =
     X-TIME := NIL;
     X-ADD := SYMBOL TIME-ADVERBIAL;
     PREFIX X-ADD TO X-TIME.
* T-PASSIVE
*    TURNS CERTAIN PASSIVE ASSERTIONS INTO ACTIVE ASSERTIONS.
*    T-PASSIVE CAN BE CONSIDERED A SPECIAL TYPE OF CANONICAL FORM
*    TRANSFORMATION WHICH CONVERTS A PASSIVE INTO AN ACTIVE.
*    IT MUST ALSO REARRANGE THE ASSERTION:
*    THE SUBJECT IS COMBINED WITH THE PASSOBJ FOUND IN VENPASS
*    TO FORM A NEW OBJECT; THE TRANSFORMATION SEARCHES FOR AN AGENT IN
*    FORM OF PN, WHERE P = 'BY', WHICH BECOMES THE NEW SUBJECT (IF NONE IS
*    FOUND, THE SUBJECT = NSTG (NULL));  THE ADJUNCTS FROM VENPASS
*    STRING IN OBJECT ARE MAPPED INTO ADJUNCT SLOTS ON THE NEW VERB
*    OR UNDER THE MAIN ASSERTION.
* $CORR-OBJECT SUBSTATEMENT IDENTIFIES TYPE OF PASSIVE OBJECT AND
*    COMBINES IT WITH SURFACE SUBJECT TO FORM ACTIVE OBJECT.
*   -$401 - NULLOBJ
*       - $4011 - NSTG SUBJ  ==> NSTGO
*       - $4012 - SNSUBJ  ==> THATS, PVO/TOVO OR SNWH (VALUE)
*       - $4013 - VINGSTG SUBJ  ==> VINGSTG
*       - $4014 - NULL SUBJ VENPASS
*   - $402 - P1 OBJ
*       - $4021 - NSTG SUBJ  ==> PN
*       - $4022 - VINGSTG SUBJ  ==> PVINGSTG
*       - $4023 - SNWH SUBJ  ==> PSNWH
*   - $403 - MISCELLANEOUS
*       - $4031 - VINGO OBJ  ==> SVINGO
*                  ('They were seen laughing' ==> '() saw they laughing')
*       - $4032 - PVO/TOVO OBJ  ==> NPVO/NTOVO
*                  ('They were known to kill' ==> '() knew they to kill')
*       - $4033 - TOBE OBJ  ==> NTOBE
*   - $404 - NSTGO PASSOBJ ('WE ARE CALLED DOGS BY THEM')
*       - $4041 - NSTG SUBJ  ==> NN
*       - $4042 - THAT SUBJ  ==> NTHATS ('THAT X WE WARN THEM')
*       - $4043 - SNWHSUBJ  ==> NSNWH
*       - $4044 - NULL SUBJ VENPASS
*   - $405 - IT SUBJ - THAT OBJ  ==> NULL OBJ/THAT SUBJ
*               ('It was known THAT X' ==> '() knew THAT X')
*            NULL-SUBJ [] concerned THATS ==> [IT] [] concerned THATS
*   - $406 - PN OBJ
*       - $NSTG - NSTG SUBJ @NPN
*       - $VINGSTG - VINGSTG SUBJ  ==> VINGSTGPN
*       - $SNWH - SNWH SUBJ  ==> PNSNWH
*       - $THATS - THAT SUBJ  ==> PNTHATS (THATS) --(TENSED VERB)
*       - $C1SHOULD - THATS SUBJ  ==> PNTHATSVO (C1SHOULD) - (UNTENSED VERB)
*   -$407 - DP OBJECTS
*       - $4071 - NSTG/VINGSTG SUBJECT, DP1 OBJECT  ==> DP2
*       - $4072 - NSTG/VINGSTG SUBJECT, DP1PN OBJECT  ==> DP2PN
*       - $4073 - NSTG/VINGSTG SUBJECT, DP1P OBJECT  ==> DP1PN
*    - $408 - NSTG SUBJECT- ASSERTION/THATS OBJ  ==> NTHATS
*                ('MOTHER WAS TOLD SHE HAD A SORE THROAT'  ==>
*                 '() TOLD MOTHER SHE HAD A SORE THROAT')
*    - $409 - ASOBJBE OBJECT  ==> SASOBJBE
*                ('THE CHILD WAS TREATED AS A PARTIALLY TREATED MENINGITIS'
*                ==> '() TREATED THE CHILD AS A PARTIALLY TREATED MENINGITIS'
T-PASSIVE = IN ASSERTION:
       IF BOTH EITHER EITHER CORE- X1 OF ELEMENT- VERB X7 IS VBE
                      OR $RIGHT-VERBAL-ATOM
               OR X1 IS NULL WHERE COELEMENT- OBJECT OF X7 HAS VALUE
                   OBJECTBE [FROM T-RN-FILLIN]
          AND CORE- X6 OF OBJECT X8 IS VENPASS
       THEN BOTH $AGENT-SEARCH
            AND IF X6 EXISTS [Check: DO NOT do passive 2X with conj]
                THEN BOTH $ACTIVE-VERB AND $CORR-OBJECT.
  $RIGHT-VERBAL-ATOM =
       AT X1, GO RIGHT;
       IF PRESENT-ELEMENT- IS VEN OR VING
       THEN PRESENT-ELEMENT- IS VBE.
  $CHECK-COOC = TRUE.
  $ACTIVE-VERB =
     BOTH $SET-X35-X31
     AND  BOTH ALL OF $MARK-TENSE, $X-LV, $X-VENPASS-RV,
                      $SAVE-MODAL, $REPLACE-VERB
          AND AT X6 [VENPASS]
              BOTH STORE IN X30
              AND ALL OF $X-LVSA, $X-SA1, $X-RV1, $X-SA2.
  $X-LV =
     IF LV OF X31 HAS ELEMENT- DSTG OR LDR X38
     THEN BOTH IF BOTH DO $X-VERB-LVR
                  AND ELEMENT LV X-LV OF X35 IS NOT EMPTY
                  [HAS ELEMENT- DSTG]
                  [* T-MODAL moves TENSE into VERB:LV also *]
               THEN AFTER LAST-ELEMENT- OF X-LV INSERT X38
                   [BOTH ITERATE GO DOWN]
                  [@AND AFTER PRESENT-ELEMENT- INSERT X38]
               ELSE AT X-LV REPLACE PRESENT-ELEMENT- BY X-LV (X38)
          AND REPLACE X38 BY <NULL>.
  $X-VERB-LVR =
     IF ELEMENT- LVR X-35-LVR OF X35 EXISTS
     THEN REPLACE X-35-LVR BY ALL ELEMENTS OF X-35-LVR.
  $X-SA1 =
      IF BOTH FIRST SA X37 OF X30 [VERB-STRING] IS NOT EMPTY
         AND 4TH SA X41 OF IMMEDIATE ASSERTION OF X30 EXISTS
      THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $X-RV1 =
      IF BOTH RV X37 OF X30 IS NOT EMPTY
         AND RV X41 OF IMMEDIATE ASSERTION OF X30 EXISTS
      THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $X-SA2 =
     IF BOTH SECOND SA X37 OF X30 [VERB-STRING] IS NOT EMPTY
        AND 5TH SA X41 OF IMMEDIATE ASSERTION OF X30 EXISTS
     THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $X-LVSA =
     IF BOTH LVSA X37 OF X30 [VENO] IS NOT EMPTY
        AND SECOND SA X41 OF IMMEDIATE ASSERTION EXISTS
     THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $SET-X35-X31 =
      [* $X-LV, REQUIRES SETTING *]
      [* REGISTERS X35 FOR VERB AND X31 FOR LVENR  *]
     BOTH VERB X35 EXISTS
          WHERE DO $X-VERB-LVR
     AND  LVENR X31 OF X6 [VENPASS] EXISTS.
  $X-VENPASS-RV =
     IF BOTH RV X37 OF X35 [VERB] IS NOT EMPTY
        AND  RV X41 OF LVENR X31 OF X6 [VENPASS] EXISTS
     THEN $ADD-ADJUNCT [GLOBAL IN T-PVO-FUTURE].
  $MARK-TENSE =
        [* RESET NODE ATTRIBUTE TENSE-ATT TO POINT FROM   *]
        [* VEN IN LVENR TO TENSE-ATT OF 'BE'.             *]
        [* NOTICE THAT T-TENSE OPERATES BEFORE T-PASSIVE. *]
     IF CORE X40 OF VERB X35 HAS NODE ATTRIBUTE TENSE-ATT X-TENSELIST
     THEN BOTH IF CORE X-VEN OF X6 [VENPASS] HAS NODE ATTRIBUTE
                   TENSE-ATT X-TENSE
               THEN PREFIX X-TENSE TO X-TENSELIST
          AND AT X-VEN
              ASSIGN PRESENT ELEMENT NODE ATTRIBUTE TENSE-ATT
              WITH VALUE X-TENSELIST.
  $SAVE-MODAL =
     IF COELEMENT- MODAL X-MODAL OF X40 [V] EXISTS
     THEN AFTER CORE X-VEN-CORE [VEN] OF X31 [LVENR]
          INSERT X-MODAL.
  $REPLACE-VERB =
     BOTH $RESTORE-VERB
     AND IF COELEMENT- MODAL X-MODAL OF VVAR X-VVAR OF X35 EXISTS
                  [* If MODAL occurs, move it next to V *]
         THEN BOTH AFTER LAST-ELEMENT- OF X-VVAR INSERT X-MODAL
              AND DELETE X-MODAL.
  $RESTORE-VERB =
     BOTH BOTH ALL OF $CLASS-REPLACE, $EXTENDED-CORE
          AND IF CORE- OF X35 IS NOT NULL [* temporary *]
              THEN BEFORE CORE- X-VEN-CORE OF X31 INSERT CORE- OF X35
     AND BOTH IF ELEMENT- LV OF X31 IS EMPTY
              THEN REPLACE ELEMENT- LV OF X31 BY LV OF X35
              ELSE BEFORE VALUE OF ELEMENT- LV OF X31
                   INSERT ALL ELEMENTS OF ELEMENT- LV OF X35
         AND REPLACE X35 BY X35 (ALL ELEMENTS OF X31 [LVENR]).
  $EXTENDED-CORE =
     IF BOTH AT CORE- OF X35, GO RIGHT
       @AND PRESENT-ELEMENT- X-XC IS VING OR VEN
     THEN BEFORE CORE- X-VEN-CORE OF X31 INSERT X-XC.
  $CLASS-REPLACE =
     CORE- X-FREE OF X31 EXISTS;
     AT CORE- X-CANON OF X35 DO $SET-REG-ATT [Global];
     EITHER X-CANON HAS NODE ATTRIBUTE WORD-POS XX-WPOS-ATT
     OR TRUE [;]
    [DO $REASSIGN-ATT 20030805] [Global].
  $AGENT-SEARCH =
     AT ASSERTION X14
     EITHER AT X6 [VENPASS] ITERATE NEXT-ADJUNCT PSTRING X12 EXISTS
                            UNTIL $AGENT-TEST SUCCEEDS
     OR $ZEROED-AGENT.
  $ZEROED-AGENT = AFTER LAST-ELEMENT OF X14 [ASSERT]
                  INSERT <AGENT> (<NSTG> (<NULL>)).
  $AGENT-TEST =
     BOTH P OF X12 [PSTRING] IS 'PAR' OR 'BY'
     AND ALL OF $CHECK-SEL, $BUILD-AGENT, $REMOVE-LP, [$REMOVE-P,]
                $DELETE-PN.
  $CHECK-SEL =
     IF $CHECK
     THEN $ASSIGN-COMP-AND-SEL [GLOBAL FROM NWSELU].
  $CHECK =
     CORE-ATT X-NEWLIST OF CORE- X-N OF NSTGO OF X12 [PSTRING] EXISTS;
     INTERSECT OF CORE-ATT OF X6 [VENPASS] IS NOT NIL;
     XN-SEL := X-INTERSECTION
      [* VENPASS SELECT LIST CONTAINS POSSIBLE SUBJECTS *].
  $BUILD-AGENT =
     EITHER $INFLUENCE
     OR AFTER LAST-ELEMENT OF X14 [ASSERTION]
                   INSERT <AGENT> (X12, X32).
  $INFLUENCE =
        [* Structure H-CHANGE par H-PTFUNC          *]
        [*           H-CHANGE par H-DIET           *]
        [* goes in a single slot INFLUENCE. 4/15/91 *]
     BOTH [BOTH] CORE-ATT X-VSEL OF X-VEN HAS MEMBER H-CHANGE
          [AND X-VSEL HAS MEMBER H-RESP]
     AND CORE-ATT OF X-N HAS MEMBER H-PTFUNC OR H-DIET;
     IF X37 [RV of main VERB] IS EMPTY
     THEN REPLACE X37 BY <RV> (X12, X-NEW12)
     ELSE AFTER LAST-ELEMENT- OF X37 INSERT X12, X-NEW12;
     AT X-NEW12, BOTH $BUILD-ADJUNCT-TYPE
                 AND ASSIGN NODE ATTRIBUTE ADVERBIAL-TYPE WITH
                     VALUE X-TYPE-LIST;
     DELETE X12.
  $BUILD-ADJUNCT-TYPE =
     X-TYPE-LIST := NIL;
     X-ADJ-TYPE := SYMBOL ADJUNCT-TYPE;
     PREFIX X-ADJ-TYPE TO X-TYPE-LIST.
  $REMOVE-LP =
     IF LP OF X32 [AGENT] EXISTS
    @THEN BOTH IF VALUE IS NOT NULL
               THEN AFTER X12 [PSTRING IN ORIG. POSITION]
                    INSERT VALUE OF LP OF X32
          AND DELETE PRESENT-ELEMENT.
  $REMOVE-P =
     IF ELEMENT- NSTGO X39 OF X32 [PSTRING] EXISTS
     THEN BOTH IF ELEMENT- RV X41 OF LVENR OF X6 IS EMPTY
               THEN BEFORE VALUE OF X41 INSERT ELEMENT- P OF X32
               ELSE AFTER LAST-ELEMENT- OF X41
                    INSERT ELEMENT- P OF X32
          AND REPLACE X32 BY ALL ELEMENTS OF X39
     ELSE IF X32 HAS ELEMENT WHETHS OR WHETHTOVO OR WHS-N X39
          THEN REPLACE X32 BY <SN> (<SNWH> (X39)).
  $DELETE-PN = REPLACE X12 BY <NULL> [DELETE X12].
  $CORR-OBJECT =
     IF SUBJECT X1 OF ASSERTION X14 EXISTS
     THEN EITHER [* Not passive *]
             ONE OF $ASTG [* case VENPASS:PASSOBJ:OBJBE:ASTG *],
                    $VSENT3-SOURCE [* case of INFO-SOURCE *]
          OR BOTH ONE OF $DSTG, $401, $402, $403, $404,
                         $405, $406, $407, $408, $409, $410, $WHETHS
             AND IF AGENT X5 OF X14 [ASSERTION] EXISTS
                 THEN BOTH REPLACE SUBJECT OF X14
                           BY <SUBJECT> (ALL ELEMENTS OF X5)
                      AND DELETE X5.
  $ASTG = [* Not passive *]
          EITHER BOTH VALUE OF PASSOBJ X2 OF X6 IS OBJBE
                      WHERE VALUE IS ASTG
                 AND REPLACE X8 [OBJECT] BY VALUE OF X2
          OR BOTH VALUE OF X2 IS ASTG
             AND REPLACE X8 [OBJECT] BY X8 (VALUE OF X2).
  $VSENT3-SOURCE = [* Ex: the patient was found to be comatose *]
       [* The patient "was judged as" having an AMI *]
     BOTH VALUE OF X2 [PASSOBJ] IS PVO OR TOVO [OR TOBE] OR PVINGO X4
     AND BOTH X-VEN-CORE [OF X31 LVENR] IS VSENT3
         AND DO $INFO-SOURCE.
  $INFO-SOURCE =
     IF X4 IS TOVO
        WHERE ELEMENT- VO X-PVO EXISTS
     THEN AFTER LAST-ELEMENT- OF LAST-ELEMENT- OF X7 [MAIN VERB]
          INSERT LP OF X4 + SECOND ELEMENT OF X4
     ELSE IF X4 IS PVINGO
             WHERE ELEMENT- VINGO X-PVO EXISTS
     THEN AFTER LAST-ELEMENT- OF LAST-ELEMENT- OF X7 [MAIN VERB]
          INSERT P OF X4 ['as'];
     EITHER ELEMENT- LVR X-LVR OF X-PVO EXISTS
     OR ELEMENT- LVINGR X-LVR OF X-PVO EXISTS;
     AT X8 [MAIN OBJECT], GO RIGHT;
     PRESENT-ELEMENT- IS SA X-LAST-SA;
     AFTER X14 [ASSERTION] INSERT
           <ASSERTION> X-INFO-ASSN
                       (FIRST SA OF X14
                       + X1 [SUBJECT], X-NEWSUBJ
                       + <SA> (<NULL>)
                       + <NEG> X-NEG (<NULL>)
                       + TENSE OF X14
                       + <SA> (<NULL>)
                       + <VERB> (ALL ELEMENTS OF X-LVR [OF X-PVO])
                       + FIRST SA OF X-PVO
                       + OBJECT OF X-PVO
                       + <RV> (<NULL>)
                       + <SA> X-INFOSA (ALL ELEMENTS OF X-LAST-SA));
     IF X-PVO IS TOVO
     THEN BEFORE VALUE OF X-INFOSA
          INSERT ALL ELEMENTS OF THIRD SA OF X-PVO; 
     DELETE X2 [PASSOBJ];
     REPLACE FIRST SA OF X14 BY <SA> (<NULL>);
     REPLACE X1 BY <SUBJECT> (<NULL>);
     IF ELEMENT- NEG X-NEG-14 OF X14 EXISTS
     THEN BOTH REPLACE X-NEG BY X-NEG-14
          AND REPLACE X-NEG-14 BY <NEG> (<NULL>);
     REPLACE ELEMENT- TENSE OF X14 BY <TENSE> (<NULL>);
     REPLACE X6 [VENPASS] BY <NULL>;
     REPLACE X-LAST-SA [MATRIX 5th SA] BY <SA> (<NULL>);
     BEFORE VALUE OF FIRST SA OF X-INFO-ASSN INSERT X14, X-NEWASSN;
     DELETE X14;
     X-TEMP := SYMBOL SOURCE-PHRASE;
     X-INFO := NIL; PREFIX X-TEMP TO X-INFO;
     AT X-NEWASSN, ASSIGN NODE ATTRIBUTE PHRASE-ATT WITH VALUE X-INFO;
     TRANSFORM X-INFO-ASSN.
  $DSTG = BOTH VALUE OF X2 IS DSTG X22
          AND IF X37 [RV of main VERB] IS EMPTY
              THEN REPLACE X37 BY <RV> (X22, X-NEW2)
              ELSE AFTER LAST-ELEMENT- OF X37 INSERT X22, X-NEW2;
          DO $4011 [moving SUBJECT to OBJECT].
  $401 = BOTH DO $DISPLACED-PN
         AND BOTH VALUE OF PASSOBJ X2 OF X6 IS NULLOBJ
             AND ONE OF $4011, $4012, $4014.
       $DISPLACED-PN = [* Ex: she was found on the floor *]
         IF VALUE OF PASSOBJ X2 OF X6 IS OBJBE
            WHERE VALUE IS PN X-OBJBE-PN
         THEN BOTH AFTER LAST-ELEMENT- OF RV OF X35 [VERB]
                   INSERT X-OBJBE-PN, X-NEWPN
              AND REPLACE VALUE OF X2 BY <NULLOBJ>.
       $4011 = BOTH VALUE OF X1 IS NSTG OR EKGSTG
               AND REPLACE X8 [OBJECT] BY
                   X8 (<NSTGO> (ALL ELEMENTS OF X1)).
       $4012 = [ For 'It was elected to treat the patient medically' ]
               [ which was transformed by T-IT-REPLACEMENT.          ]
               BOTH VALUE OF X1 IS TOVO [OR PVO]
               AND REPLACE X8 [OBJECT] BY
                   X8 (ALL ELEMENTS OF X1).
       $4014 =
         [ For VENPASS FRAGMENT WHICH HAS BEEN EXPANDED TO ]
         [ ASSERTION AND VENPASS CSSTG                     ]
               BOTH VALUE OF X1 IS NULL X41
               AND REPLACE X8 BY X8 (X41).
  $402 = BOTH BOTH VALUE OF X2 IS P1
             @AND VALUE OF P1 IS P X4
         AND ONE OF $4021, $4022, $4023.
       $4021 = BOTH VALUE OF X1 IS NSTG OR EKGSTG
               AND REPLACE X8 [OBJECT] BY
                 X8 (<PN> (<LP> (<NULL>)
                          +X4 [P]
                          +<NSTGO> (ALL ELEMENTS OF X1))).
       $4022 = BOTH VALUE OF X1 IS VINGSTG X3
               AND REPLACE X8 BY X8 (<PVINGSTG> (X4 + X3)).
       $4023 = BOTH BOTH VALUE OF X1 IS SN @AND VALUE OF SN IS SNWH X3
               AND REPLACE X8 BY X8 (<PSNWH> (X4 + X3)).
   $403 = ONE OF $4031, $4032, $4033.
       $4031 = BOTH VALUE OF X2 IS VINGO X4
               AND REPLACE X8 BY
                    X8 (<SVINGO> (X1
                                 +<SA>(<NULL>)
                                 +X4)).
       $4032 = BOTH VALUE OF X2 IS PVO OR TOVO X4
               AND REPLACE X8 BY
                    X8 (<NPVO> (X1
                               +<RV>(<NULL>)
                               +<SA>(<NULL>)
                               +X4)).
       $4033 = BOTH VALUE OF X2 IS TOBE X4
               AND REPLACE X8 BY
                    X8 (<NTOBE> (X1
                                +<RV>(<NULL>)
                                +<SA>(<NULL>)
                                +X4)).
   $404 = BOTH EITHER VALUE OF X2 IS NSTGO X4
               OR VALUE OF X2 IS OBJBE X4
          [* temporary: for case RN:VENPASS:PASSOBJ:OBJBE:NSTG *]
                  WHERE VALUE IS NSTG OR EKGSTG
          AND ONE OF $4041, $4042, $4043, $4044.
       $4041 = BOTH VALUE OF X1 IS NSTG OR EKGSTG
               AND REPLACE X8 [OBJECT] BY
                    X8 (<NN> (<NSTGO> (ALL ELEMENTS OF X1)
                             +<SA>(<NULL>)
                             +X4)).
       $4042 = BOTH BOTH VALUE OF X1 IS SN
                   @AND VALUE OF SN IS THATS X3
               AND REPLACE X8 BY
                    X8 (<NTHATS> (X4
                                 +<RV>(<NULL>)
                                 +<SA>(<NULL>)
                                 +X3)).
       $4043 = BOTH BOTH VALUE OF X1 IS SN
                   @AND VALUE OF SN IS SNWH X3
               AND REPLACE X8 BY
                    X8 (<NSNWH> (X4
                                +<RV>(<NULL>)
                                +<SA>(<NULL>)
                                +X3)).
       $4044 = BOTH VALUE OF X1 IS NULL
               AND REPLACE X8 BY X8 (X4).
   $405 = BOTH BOTH VALUE OF X2 [PASSOBJ] IS THATS
               AND EITHER CORE- OF SUBJECT IS 'IL' OR 'IT'
                   OR BOTH SUBJECT IS EMPTY [* 20000331 *]
                      AND CORE- OF VERB IS '[]'
          AND REPLACE X8 [OBJECT] BY X8 (VALUE OF X2).
   $406 = EITHER BOTH VALUE X3 OF X2 [PASSOBJ] IS PN
                 AND ONE OF $NSTG-PN, $VINGSTG-PN, $SNWH-PN,
                            $THATS-PN, $C1SHOULD-PN
          OR BOTH VALUE X3 OF X2 [PASSOBJ] IS PNTHATS
             AND DO $PN-THATS.
      $NSTG-PN =
           BOTH EITHER VALUE OF X1 [SUBJECT] IS NSTG OR EKGSTG
                                   OR NSTGO [* object cases *],
                OR X1 IS EMPTY
           AND REPLACE X8 [OBJECT] BY
             X8 (<NPN> (<NSTGO>(ALL ELEMENTS OF X1)
                        +<SA>(<NULL>)
                        +X3 [PN])).
      $VINGSTG-PN = BOTH VALUE X6 OF X1 IS VINGSTG
                    AND REPLACE X8
                        BY X8 (<VINGSTGPN> (X6
                                           + <SA> (<NULL>)
                                           + X3 [PN])).
      $SNWH-PN = BOTH VALUE X6 OF SN OF X1 IS SNWH
                 AND REPLACE X8
                     BY X8 (<PNSNWH> (P OF X3
                                     + NSTGO OF X3
                                     + <RV> (<NULL>)
                                     + <SA> (<NULL>)
                                     + X6 [SNWH])).
      $THATS-PN = BOTH VALUE X6 OF SN OF X11 IS THATS
                  AND BOTH CORE- OF ELEMENT- VERB OF ELEMENT- ASSERTION
                           OF X6 IS TV
                      AND REPLACE X8
                          BY X8 (<PNTHATS> ( P OF X3
                                           + NSTGO OF X3
                                           + <RV> (<NULL>)
                                           + <SA> (<NULL>)
                                           + X6 [THATS])).
      $PN-THATS = BOTH X3 IS PNTHATS
                  AND REPLACE X8 [OBJECT]
                  BY X8 (<PNTHATS> (LP OF ELEMENT- PN OF X3
                                   +P OF ELEMENT- PN OF X3
                                   +NSTGO OF ELEMENT- PN OF X3
                                   +<RV> (<NULL>)
                                   +<SA> (<NULL>)
                                   +THATS OF X3)).
      $C1SHOULD-PN = BOTH VALUE X6 OF SN OF X1 IS THATS
                     AND BOTH CORE- OF ELEMENT- VERB OF ELEMENT-
                             ASSERTION OF X6 IS V
                         AND REPLACE X8
                             BY X8 (<PNTHATSVO> (P OF X3
                                                + NSTGO OF X3
                                                + <RV> (<NULL>)
                                                + <SA> (<NULL>)
                                                + <C1SHOULD>
                                                 (ALL ELEMENTS OF X6))).
  $407 = ONE OF $4071, $4072, $4073.
      $4071 = BOTH VALUE X21 OF X2 [PASSOBJ] IS DP1
              AND BOTH REPLACE X8 [OBJECT]
                       BY X8 (<DP2> (VALUE OF X21 [DP1]
                                    + <DUMMY> X22))
                  AND $DUMMY-1.
      $4072 = BOTH BOTH VALUE X21 OF X2 [PASSOBJ] IS DP1PN
                   @AND ELEMENT- SA IS EMPTY
              AND BOTH REPLACE X8 [OBJECT]
                       BY X8 (<DP2PN>
                                (<DP2> ( DP OF X21 [DP1PN]
                                       + <DUMMY> X22)
                                + THIRD ELEMENT OF X21 ))
                  AND $DUMMY-1.
      $4073 = BOTH VALUE X21 OF X2 [PASSOBJ] IS DP1P
              AND BOTH REPLACE X8 [OBJECT]
                       BY X8 (<DP1PN>
                               ( DP OF X21 [DP1P]
                                 + <SA> (<NULL>)
                                 + <DUMMY> X23))
                  AND EITHER $PN OR $PVINGSTG.
      $DUMMY-1 = EITHER BOTH VALUE OF X1 [SUBJECT] IS NSTG OR EKGSTG
                        AND REPLACE X22 [DUMMY]
                            BY <NSTGO> (ALL ELEMENTS OF X1)
                 OR BOTH VALUE X24 OF X1 IS VINGSTG
                    AND REPLACE X22 [DUMMY]
                        BY X24 [VINGSTG].
      $PN = BOTH VALUE OF X1 [SUBJECT] IS NSTG OR EKGSTG
            AND REPLACE X23 [DUMMY]
                BY <PN> ( <LP> (<NULL>)
                        + P OF X21 [DP1P]
                        + <NSTGO> (ALL ELEMENTS OF X1 [SUBJECT])).
      $PVINGSTG = BOTH VALUE OF X1 [SUBJECT] IS VINGSTG
                  AND REPLACE X23 [DUMMY]
                      BY <PVINGSTG> ( P OF X21 [DP1P]
                                    + ALL ELEMENTS OF X1 [SUBJECT]).
  $408 =
     BOTH BOTH VALUE OF X2 [PASSOBJ] IS THATS OR ASSERTION X3
          AND VALUE OF X1 [SUBJECT] IS NSTG OR EKGSTG
     AND REPLACE X8 [OBJECT]
         BY X8 (<NTHATS> (ALL ELEMENTS OF X1
                          + <RV> (<NULL>)
                          + <SA> (<NULL>)
                          + X3 [ASSERTION OR THATS])).
  $409 =
     BOTH VALUE OF X2 [PASSOBJ] IS ASOBJBE X3
     AND REPLACE X8 [OBJECT]
         BY X8 (<SASOBJBE>
                   (X1 [SUBJECT]
                    + <SA> (<NULL>)
                    + ALL ELEMENTS OF X3
                    + <SA> (<NULL>))).
  $410 =
     BOTH VALUE X-VAL OF X2 [PASSOBJ] IS PDOSE
     AND $4101.
    $4101 =
       CORE- X-N OF X1 [SUBJECT] EXISTS;
       REPLACE X8 [OBJECT] BY
           X8 (<NPDOSE> (X-N + X-VAL)) .
  $WHETHS =
     BOTH BOTH VALUE OF X2 [PASSOBJ] IS WHETHS X3
          AND AT X8 ITERATE GO RIGHT
              UNTIL PRESENT-ELEMENT- IS SA X-WHETHS SUCCEEDS
     AND REPLACE X-WHETHS [last SA]
         BY X-WHETHS (<SAWH> (X3 [WHETHS])).
* T-SOBJBE-OF-VSENT3
*   converts ASSN: ... VSENT3 + SOBJBE ...
*   to SOURCE-PHRASE VSENT3 + ASSERTION of SOBJBE.
T-SOBJBE-OF-VSENT3 = IN ASSERTION:
    AT PRESENT-ELEMENT- X-MAIN-ASSN
    IF BOTH CORE- X-VCORE OF ELEMENT- VERB HAS ATTRIBUTE VSENT3
       AND VALUE OF ELEMENT- OBJECT IS SOBJBE X-PVO
    THEN ALL OF $SET-UP, $SOBJBE-TO-ASSN [Global in T-SOBJBE],
                $MAKE-INFO-SOURCE.
  $SET-UP =
    BOTH ELEMENT- SUBJECT X-SUBJ EXISTS
    AND BOTH ELEMENT- VERB X-MAINVERB EXISTS
        AND ELEMENT- OBJECT X-MAINOBJ EXISTS;
    AFTER X-MAIN-ASSN INSERT X-PVO, X10;
    DELETE X-PVO.
  $MAKE-INFO-SOURCE =
    IF FIRST SA X-SA1 OF X-ASSRT [of SOBJBE] IS EMPTY
    THEN REPLACE X-SA1
         BY <SA> (<ASSERTION> X-NEWPRE (ALL ELEMENTS OF X-MAIN-ASSN))
    ELSE BEFORE VALUE OF X-SA1
         INSERT <ASSERTION> X-NEWPRE (ALL ELEMENTS OF X-MAIN-ASSN);
    X-TEMP := SYMBOL SOURCE-PHRASE;
    X-SOURCE := NIL; PREFIX X-TEMP TO X-SOURCE;
    AT X-NEWPRE, ASSIGN NODE ATTRIBUTE PHRASE-ATT WITH VALUE X-SOURCE;
    DELETE X-MAIN-ASSN.
* T-PVO-OF-VSENT3
*    EXPANDS PVO OBJECT OF VERB WITH ATTRIBUTE VSENT3, SUCH AS 'SEEM',
*    'DECIDE', INTO ASSERTION WITH MATRIX SUBJECT AS SUBJECT.
*       E.G.  'DOCTOR DECIDED TO CONTINUE THERAPY' ==>
*             'DOCTOR DECIDE DOCTOR CONTINUE THERAPY'
*    NODE ATTRIBUTE TFORM-ATT IS SET TO CONTAIN LIST WITH MEMBER
*    TPVO.
T-PVO-OF-VSENT3 = IN ASSERTION:
    IF BOTH CORE- X-VCORE OF ELEMENT- VERB HAS ATTRIBUTE VSENT3
       AND EITHER VALUE OF ELEMENT- OBJECT IS PVO X-PVO
                  WHERE STORE IN X-TOVO
           OR VALUE OF ELEMENT- OBJECT IS TOVO X-TOVO
              WHERE ELEMENT- VO X-PVO EXISTS
    THEN ALL OF $SET-UP, $ASSERT [$SET-TFORM-ATT].
  $SET-UP =
    BOTH ELEMENT- SUBJECT X-SUBJ EXISTS
    AND BOTH ELEMENT- VERB X-MAINVERB EXISTS
        AND ELEMENT- OBJECT X-MAINOBJ EXISTS;
    EITHER VERB X-VERB OF X-PVO EXISTS
    OR LVR X-VERB OF X-PVO EXISTS.
  $ASSERT =
    IF X-TOVO [X-PVO] IS TOVO
    THEN BOTH BEFORE VALUE OF X-PVO INSERT <LP> (<NULL>)
         AND BOTH BEFORE X-VERB INSERT <SA> (<NULL>)
             AND BOTH AFTER OBJECT OF X-PVO INSERT <RV> (<NULL>)
                 AND AFTER X-VERB INSERT <SA> (<NULL>);
    ELEMENT- RV X-MAINRV OF X-MAINVERB EXISTS;
    IF LP X-LP OF X-TOVO IS NOT EMPTY
    THEN AFTER LAST-ELEMENT- OF X-MAINRV
         INSERT ALL ELEMENTS OF X-LP;
    AFTER LAST-ELEMENT- OF X-MAINRV
    INSERT SECOND ELEMENT OF X-TOVO;
    IF FIRST SA X-VOSA OF X-PVO IS NOT EMPTY
    THEN AFTER LAST-ELEMENT- OF X-MAINRV
         INSERT ALL ELEMENTS OF X-VOSA;
    IF ELEMENT- LV X-LV OF X-VERB IS NOT EMPTY
    THEN AFTER LAST-ELEMENT- OF X-MAINRV
         INSERT ALL ELEMENTS OF X-LV;
    AFTER LAST-ELEMENT- OF X-MAINRV INSERT CORE- OF X-VERB;
    IF ELEMENT- RV X-RV OF X-VERB IS NOT EMPTY
    THEN AFTER LAST-ELEMENT- OF X-MAINRV
         INSERT ALL ELEMENTS OF X-RV;
    IF SECOND SA X-VOSA OF X-PVO IS NOT EMPTY
    THEN BOTH THE FOLLOWING-ELEMENT- OF X-MAINVERB IS SA X-MAINSA
         AND AFTER LAST-ELEMENT- OF X-MAINSA
             INSERT ALL ELEMENTS OF X-VOSA;
    IF 3RD SA X-VOSA OF X-PVO IS NOT EMPTY
    THEN AFTER LAST-ELEMENT- OF X-MAINSA
         INSERT ALL ELEMENTS OF X-VOSA;
    REPLACE X-MAINOBJ BY ELEMENT- OBJECT OF X-PVO.
  $ASSERT-OLD =
    IF X-TOVO [X-PVO] IS TOVO
    THEN BOTH BEFORE VALUE OF X-PVO INSERT <LP> (<NULL>)
         AND BOTH BEFORE X-VERB INSERT <SA> (<NULL>)
             AND BOTH AFTER OBJECT OF X-PVO INSERT <RV> (<NULL>)
                 AND AFTER X-VERB INSERT <SA> (<NULL>);
    REPLACE X-TOVO
         BY <ASSERTION> X-ASSRT
            (<SA> (<NULL>)
            + X-SUBJ [SUBJECT OF ASSERTION]
            + <SA> (VALUE OF LP OF X-PVO)
            + <NEG> (<NULL>)
            + <TENSE> (<NULL>)
            + <SA> (<NULL>)
            + X-VERB [VERB OF PVO/TOVO]
            + FIRST SA OF X-PVO
            + OBJECT OF X-PVO
            + RV OF X-PVO
            + SECOND SA OF X-PVO);
    IF X-ASSRT HAS ELEMENT LVR X-LVR
    THEN REPLACE X-LVR BY <VERB> (ALL ELEMENTS OF X-LVR);
    TRANSFORM X-ASSRT.
  $SET-TFORM-ATT =
    AT X-ASSRT
    BOTH X-TFORM := SYMBOL TTOVO
    AND $ADD-TO-TFORM-ATT [GLOBAL IN T-NPVO].
* T-VERBAL-OBJECT
*    TRANSFORMS ASSERTIONS WITH VINGO OR PVO OBJECTS INTO ASSERTIONS
*    WITH VERB FROM PVO OR VINGO AS MAIN VERB OF THE ASSERTION. THE
*    FIRST THREE SA'S FROM THE ORIGINAL ASSERTION ARE COPIED INTO THE
*    LV OF VERBAL; THE THIRD SA, [RV,] 4TH SA ARE COPIED INTO RV OF
*    VERBAL. THEN THE ORIGINAL VERB OF ASSERTION IS MOVED INTO THE
*    3RD SA [SA AFTER TENSE] OF THE ASSERTION. THE ORIGINAL VERB
*    CARRIES ALONG ITS TENSE INFORMATION AS A NODE-ATTRIBUTE TENSE-
*    ATT. TENSE-ATT WAS PREVIOUSLY ASSIGNED BEFORE T-VERBAL-OBJECT IS
*    EXECUTED. THEN IT MOVES ANY NON-EMPTY STRUCTURE IN THE ORIGINAL
*    OBJECT UP TO THE ASSERTION LEVEL, INCLUDING RELOCATING THE SA'S
*    AND RV'S OF VERBAL IN OBJECT INTO THE ASSERTION SA AND RV SLOTS.
*          E.G. 'HE BEGAN TO WALK' ==> 'HE BEGAN WALK'
*               'HE BEGAN WALKING' ==> 'HE BEGAN WALK'
T-VERBAL-OBJECT = IN ASSERTION:
     AT PRESENT-ELEMENT- X-ASSERT
     IF VALUE OF OBJECT IS VINGO OR PVO OR TOVO OR VO X-VERB-OBJ
        WHERE DO $GET-TO
     THEN ALL OF $MOVE-ASSERT-SA,
                 $VERB-TOGETHER,
                 $MOVE-OBJ-UP,
                 $LVINGR,
                 $TRANSFORM-ASSERT.
  $GET-TO =
     EITHER BOTH X-VERB-OBJ IS TOVO
            AND SECOND ELEMENT X-VTO EXISTS
     OR EITHER BOTH X-VERB-OBJ IS PVO
               AND ELEMENT- P X-VTO EXISTS
        OR TRUE.
  $MOVE-ASSERT-SA =
      [* Moves SA of ASSERTION into LV or RV of VERB so that ]
      [* VERBAL can be moved as a unit into SA.              ]
     BOTH $SA-TO-LV AND $SA-TO-RV.
  $SA-TO-LV =
     BOTH EITHER VALUE X-VAL-LV OF LV X-LV OF ELEMENT-
                 VERBAL X-VERB EXISTS
          OR VALUE X-VAL-LV OF LV X-LV OF ELEMENT-
             LVR X-VERB OF ELEMENT- VERBAL EXISTS
     AND AT X-VERB ITERATE $MOVE-TO-LV
                   UNTIL GO LEFT FAILS.
  $MOVE-TO-LV =
     IF BOTH PRESENT-ELEMENT- IS SA OR RV X-SA
        AND NOT $KEEP-AS-SA
     THEN BOTH $LV AND $SA-NULL.
  $LV =
     IF X-VAL-LV IS NOT NULL
     THEN BOTH BEFORE X-VAL-LV
               INSERT ALL ELEMENTS OF X-SA
          AND BOTH AT X-VAL-LV
                   IF BOTH GO LEFT
                     @AND PRESENT-ELEMENT- IS NULL X-NULL
                   THEN DELETE X-NULL
              AND VALUE X-VAL-LV OF X-LV EXISTS
     ELSE BOTH REPLACE X-VAL-LV BY ALL ELEMENTS OF X-SA
          AND BOTH IF LAST-ELEMENT- OF X-LV IS NULL
                      [carried with SA ELEMENTS]
                  @THEN DELETE PRESENT-ELEMENT-
              AND VALUE X-VAL-LV OF X-LV EXISTS.
  $SA-TO-RV =
     BOTH VALUE X-VAL-RV OF RV X-RV OF X-VERB EXISTS
     AND AT X-VERB ITERATE $MOVE-TO-RV
                   UNTIL GO RIGHT FAILS.
  $MOVE-TO-RV =
     IF BOTH PRESENT-ELEMENT- IS SA OR RV X-SA
        AND NOT $KEEP-AS-SA
     THEN BOTH $RV AND $SA-NULL.
  $RV =
     IF X-VAL-RV IS NOT NULL
     THEN BOTH AFTER X-VAL-RV INSERT ALL ELEMENTS OF X-SA
          AND BOTH IF LAST-ELEMENT- OF X-RV IS NULL
                  @THEN DELETE PRESENT-ELEMENT-
              AND LAST-ELEMENT- X-VAL-RV OF X-RV EXISTS
     ELSE BOTH REPLACE X-VAL-RV BY ALL ELEMENTS OF X-SA
          AND VALUE X-VAL-RV OF X-RV EXISTS.
  $KEEP-AS-SA =
     EITHER VALUE X-VAL-SA IS NULL
     OR EITHER X-VAL-SA IS SAWH OR LVR
        OR EITHER BOTH X-VAL-SA IS PN
                 @AND CORE-SELATT OF P IS H-CONN
           OR COELEMENT- CSSTG OF X-VAL-SA EXISTS.
  $SA-NULL =
     REPLACE X-SA BY X-SA (<NULL>).
  $VERB-TOGETHER =
     EITHER ELEMENT- VERBAL OF VALUE OF OBJECT EXISTS
     OR EITHER EITHER ELEMENT- VERBAL OF ELEMENT- VO OF TOVO
                      OF OBJECT EXISTS
               OR ELEMENT- VERBAL OF TOVO OF OBJECT EXISTS [*GRI*]
        OR ELEMENT- VERBAL [OF ELEMENT- VO] OF PVO OF OBJECT EXISTS;
     [PRESENT-ELEMENT- HAS ELEMENT LV;]
     BOTH $LOWER-SUPPORT-VERBS AND $SET-VERB-ATTS.
  $LOWER-SUPPORT-VERBS =
     IF X-VERB IS NOT EMPTY
     THEN BOTH IF EITHER X-VERB IS LVR OR LVINGR
                  OR X-VERB DOES NOT HAVE ELEMENT- VVAR
               THEN REPLACE CORE-
                    BY <LAUX> X-LAUX (CORE- OF X-VERB)
                      +<VVAR> (CORE-, X-V-CORE)
               ELSE IF ELEMENT- LAUX OF X-VERB EXISTS
                    THEN REPLACE CORE-
                         BY <LAUX> X-LAUX
                                   (ALL ELEMENTS OF LAUX OF X-VERB
                                   +ALL ELEMENTS OF VVAR OF X-VERB)
                           +<VVAR> (CORE-, X-V-CORE)
                    ELSE REPLACE CORE-
                         BY <LAUX> X-LAUX
                                   (ALL ELEMENTS OF VVAR OF X-VERB)
                           +<VVAR> (CORE-, X-V-CORE)
          AND BOTH IF LV OF X-VERB IS NOT EMPTY
                   THEN BEFORE VALUE OF ELEMENT- LV
                        INSERT ALL ELEMENTS OF LV OF X-VERB
              AND BOTH IF NEGV OF X-VERB IS NOT EMPTY
                       THEN BEFORE VALUE OF ELEMENT- LV
                            INSERT ALL ELEMENTS OF NEGV OF X-VERB
                  AND IF RV OF X-VERB IS NOT EMPTY
                      THEN BEFORE VALUE OF ELEMENT- LV
                           INSERT ALL ELEMENTS OF RV OF X-VERB;
     IF BOTH X-VTO EXISTS
        AND X-VTO HAS NODE ATTRIBUTE WORD-POS X-WPOS
     THEN AFTER LAST-ELEMENT- OF X-LAUX INSERT X-VTO, X-NEWVTO
          [AT X-NVTO, ASSIGN NODE ATTRIBUTE WORD-POS WITH VALUE X-WPOS].
  $SET-VERB-ATTS =
     BOTH IF X-V-CORE HAS NODE ATTRIBUTE COMPUTED-ATT X-V-COMP
          THEN AT CORE- ASSIGN NODE ATTRIBUTE COMPUTED-ATT
                        WITH VALUE X-V-COMP
     AND IF X-V-CORE HAS NODE ATTRIBUTE SELECT-ATT X-V-SEL
         THEN AT CORE- ASSIGN NODE ATTRIBUTE SELECT-ATT
                       WITH VALUE X-V-SEL
    [IF X-VERB-OBJ IS TOVO OR VO OR PVO]
    [THEN DO $ASSIGN-TENSE-ATT].
  $ASSIGN-TENSE-ATT =
     X-FUTIMP := SYMBOL FUT-IMP;
     X-TENSE := NIL;
     PREFIX X-FUTIMP TO X-TENSE;
     AT X-V-CORE ASSIGN NODE ATTRIBUTE TENSE-ATT WITH VALUE X-TENSE.
  $MOVE-OBJ-UP =
     ALL OF $SET-REGS, $X-LVSA, $X-LV, $X-SA1, $X-SA2, $X-RV1,
            $TRANSFER-VERB-OBJ, $X-LAST-SA, $X-OBJECT.
  $X-LVSA =
     IF BOTH LVSA X37 OF X30 [VENO] IS NOT EMPTY
        AND SECOND SA X41 OF IMMEDIATE ASSERTION EXISTS
     THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $X-LV =
     IF LV OF X31 HAS ELEMENT- DSTG OR LDR X38
     THEN IF ELEMENT LV X-LV OF X35 HAS ELEMENT- DSTG
         @THEN BOTH ITERATE GO DOWN
              @AND AFTER PRESENT-ELEMENT- INSERT X38
          ELSE AT X-LV REPLACE PRESENT-ELEMENT- BY X-LV (X38).
  $X-SA1 =
      IF BOTH FIRST SA X37 OF X30 [VERB-STRING] IS NOT EMPTY
         AND 4TH SA X41 OF IMMEDIATE ASSERTION OF X30 EXISTS
      THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $X-SA2 =
     IF BOTH SECOND SA X37 OF X30 [VERB-STRING] IS NOT EMPTY
        AND 5TH SA X41 OF IMMEDIATE ASSERTION OF X30 EXISTS
     THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $X-RV1 =
      IF BOTH RV X37 OF X30 IS NOT EMPTY
         AND RV X41 OF IMMEDIATE ASSERTION OF X30 EXISTS
      THEN $ADD-ADJUNCT [Global in T-PVO-FUTURE].
  $TRANSFER-VERB-OBJ =
     REPLACE X-VERB [VERB IN ASSERTION] BY
        X-VERB (ALL ELEMENTS OF X-VERBAL [VERB IN PVO/TOVO]).
  $X-OBJECT =
     BOTH REPLACE VALUE OF OBJECT BY
             VALUE OF OBJECT OF X30
     AND BOTH EITHER PRESENT-ELEMENT- IS ASSERTION
              OR EITHER IMMEDIATE ASSERTION EXISTS
                 OR EITHER IMMEDIATE TOVO EXISTS
                    OR IMMEDIATE PVO EXISTS
        @AND $EXPAND-OBJ [Global in T-EXPAND-OBJECT].
  $X-LAST-SA =
     IF LAST-ELEMENT- OF X35 [VO] IS SA
        WHERE PRESENT-ELEMENT- X-LAST-SA IS NOT EMPTY
     THEN DO $MOVE-LAST-SA.
  $MOVE-LAST-SA =
     AT ELEMENT- OBJECT OF X-ASSERT,
     ITERATE GO RIGHT UNTIL PRESENT-ELEMENT- IS SA OR RV SUCCEEDS;
     STORE IN X-RVSA;
     IF X-RVSA IS EMPTY
     THEN REPLACE X-RVSA BY X-RVSA (ALL ELEMENTS OF X-LAST-SA)
     ELSE BEFORE VALUE OF X-RVSA
          INSERT ALL ELEMENTS OF X-LAST-SA.
  $SET-REGS =
      [SET REGISTERS FOR GLOBALS]
     EITHER ELEMENT- VERBAL X-VERBAL OF VALUE X30 OF OBJECT EXISTS
     OR EITHER ELEMENT- VERBAL X-VERBAL OF VO X30 OF TOVO
               OF OBJECT EXISTS
        OR ELEMENT- VERBAL X-VERBAL OF VO X30 OF PVO OF OBJECT EXISTS;
     AT X-VERBAL STORE IN X31;
     AT X30 [PVO/TOVO, VINGO] STORE IN X35.
  $LVINGR =
     IF CORE- OF X-VERB IS VING
     THEN $REPLACE-VING
     [ELSE X-VERB IS LVR].
  $REPLACE-VING =
     AT CORE- X-VING OF X-VERB
     X-FREE := X-VING;
     DO $SET-REG-ATT;
     X-CANON := X-VING [;]
    [DO $REASSIGN-ATT 20030805].
  $TRANSFORM-ASSERT =
     TRANSFORM X-ASSERT.
* T-TAKE-TIME-TO
*   CHANGES THE SENTENCE FORM
*      'TAKE ... NTIME1 TOVO/PVO'
*   TO THE NEW FORM
*      '[VERB [LV ... TAKE TO] [VVAR DO] [RV ... NTIME1]] [OBJECT X]'
* *** NOTES: NEED TO MOVE ATTRIBUTES OF 'TAKE'
T-TAKE-TIME-TO = IN ASSERTION:
     IF ALL OF $VERB-TAKE, $TIME-OBJECT, $RN-TOVO
     THEN DO $RAISE-TOVO.
  $VERB-TAKE =
     CORE- X-VERB OF VERB X-TAKE IS 'TAKE' OR 'TOOK' OR 'TAKES'
                                 OR 'TAKEN'.
  $TIME-OBJECT =
     VALUE X-OBJ-VAL OF OBJECT X-OBJECT IS NSTGO;
     CORE- X-TIME OF ELEMENT- NSTG X-NSTG IS NTIME1.
  $RN-TOVO =
     RIGHT-ADJUNCT OF X-TIME IS TOVO OR PVO X-PVO.
  $RAISE-TOVO =
     ALL OF $SET-UP, $MOVE-TAKE, $RAISE-SA1, $RAISE-SA2,
            $RAISE-OBJECT, $CLEAN-TOVO, $BUILD-PN-TIME,
            $REMOVE-OBJECT.
  $SET-UP =
     VALUE X-TO [P OR 'TO'] OF X-PVO EXISTS;
     ELEMENT- OBJECT X-VO-OBJ [OF ELEMENT- VO] OF X-PVO EXISTS;
     AT X-VO-OBJ, DO L(SA);
     STORE IN X-VO-SA1;
     AT X-VO-OBJ, DO R(SA);
     STORE IN X-VO-SA2;
    [ELEMENT- VO OF] X-PVO HAS ELEMENT- LVR X-LVR;
     ELEMENT- LV X-LV OF X-LVR EXISTS;
     AT X-OBJECT, DO R(SA);
     STORE IN X-SA2;
     AT X-OBJECT, DO L(SA);
     STORE IN X-SA1;
     ELEMENT- LV X-TAKE-LV OF X-TAKE EXISTS;
     ELEMENT- RV X-TAKE-RV OF X-TAKE EXISTS.
  $MOVE-TAKE =
     ALL OF $MOVE-LV, $MOVE-MAIN-VERB, $RAISE-LOWER-VERB.
  $MOVE-LV =
     IF X-LV IS EMPTY
     THEN REPLACE X-LV BY X-TAKE-LV, X-NEWLV
     ELSE BOTH BEFORE VALUE OF X-LV
               INSERT ALL ELEMENTS OF X-TAKE-LV
          AND AT X-LV, STORE IN X-NEWLV;
     DELETE X-TAKE-LV.
  $MOVE-MAIN-VERB =
     IF X-VERB HAS NODE ATTRIBUTE TENSE-ATT X-TENSE
     THEN AT CORE- OF X-LVR, ASSIGN NODE ATTRIBUTE TENSE-ATT
          WITH VALUE X-TENSE;
     IF X-NEWLV IS EMPTY
     THEN REPLACE X-NEWLV BY X-NEWLV (ALL ELEMENTS OF X-TAKE)
     ELSE AFTER LAST-ELEMENT- OF X-NEWLV
          INSERT ALL ELEMENTS OF X-TAKE;
     AFTER LAST-ELEMENT- OF X-NEWLV INSERT X-TO;
     IF ELEMENT- RV X-NEWRV OF X-NEWLV IS NOT EMPTY
     THEN REPLACE X-NEWRV BY ALL ELEMENTS OF X-NEWRV
     ELSE DELETE X-NEWRV.
  $RAISE-LOWER-VERB =
     REPLACE X-TAKE BY X-TAKE (ALL ELEMENTS OF X-LVR).
  $RAISE-SA1 =
     IF X-VO-SA1 IS NOT EMPTY
     THEN IF X-SA1 IS EMPTY
          THEN REPLACE X-SA1 BY X-SA1 (ALL ELEMENTS OF X-VO-SA1)
          ELSE AFTER LAST-ELEMENT- OF X-SA1
               INSERT ALL ELEMENTS OF X-VO-SA1.
  $RAISE-SA2 =
     IF X-VO-SA2 IS NOT EMPTY
     THEN BEFORE VALUE OF X-SA2
          INSERT ALL ELEMENTS OF X-VO-SA2.
  $RAISE-OBJECT =
     AFTER X-OBJECT INSERT X-VO-OBJ, X-NEWOBJ.
  $CLEAN-TOVO =
     DELETE X-PVO.
  $BUILD-PN-TIME =
     IF X-SA1 IS EMPTY
     THEN REPLACE X-SA1 BY
          X-SA1 (<PN> X-PN (<LP> (<NULL>)
                          +<P> = '[IN]' : ('IN')
                          +X-OBJ-VAL [NSTGO OF X-OBJECT]))
     ELSE AFTER LAST-ELEMENT- OF X-SA1 INSERT
          <PN> X-PN (<LP> (<NULL>)
                    +<P> = '[IN]' : ('IN')
                    +X-OBJ-VAL [NSTGO OF X-OBJECT]);
     DELETE X-OBJ-VAL;
     AT X-PN, BOTH $MK-TIME-ADV
              AND ASSIGN NODE ATTRIBUTE ADVERBIAL-TYPE
                  WITH VALUE X-TIME.
  $MK-TIME-ADV =
     X-ADV := SYMBOL TIME-ADVERBIAL;
     X-TIME := NIL;
     PREFIX X-ADV TO X-TIME.
  $REMOVE-OBJECT =
     IF X-OBJECT EXISTS
     THEN BOTH IF X-OBJECT IS NOT EMPTY
               THEN BEFORE VALUE OF X-NEWOBJ
                    INSERT ALL ELEMENTS OF X-OBJECT
          AND DELETE X-OBJECT.
* T-SACONJ
*      CHANGES SACONJ IN BESHOW TO SA
*
T-SACONJ = IN FRAGMENT:
       IF ELEMENT SACONJ OF BESHOW IS NOT EMPTY
      @THEN BOTH VALUE X-SA EXISTS
            AND REPLACE PRESENT-ELEMENT- BY X-SA.
* T-FRAG-TO-ASSRT
*     REGULARIZES FRAGMENTS, CHANGING THEM INTO ASSERTIONS:
*    1. SOBSBESHOW
*        REMOVE THE BESHOW NODE, ADD APPROPRIATE VERB BASED ON
*        SELECT-ATT ASSIGNED TO BESHOW, AND BUILD CORRECT OBJECT
*        NODES; ADD SA'S AND RV'S.
*              'E.G. 'EXTREMITIES NORMAL' ==> 'EXTREMITIES BE NORMAL'
*                   'SKIN NO ERUPTIONS'  ==> 'SKIN SHOW NO ERUPTIONS'
*
*    2. VFORM = PVO, VINGO, VENPASS:
*          ADD NULL SUBJECT, VERB = 'BE', BUILD CORRECT OBJECT, ADD SA'S
*          AND RV.
*             E.G. 'TOLD TO RETURN TO CLINIC' ==>
*                  '() BE TOLD TO RETURN TO CLINIC'
*    3. ASTG OR PN FRAGMENT:
*          ADD NULL SUBJECT, VERB = 'BE', BUILD CORRECT OBJECT (=OBJBE),
*          ADD SA'S AND RV.
*             E.G. 'ON PROPHYLAXIS WITH BICILLIN' ==>
*                  '() BE ON PROPHYLAXIS WITH BICILLIN'
*    4. TVO:
*          ADD NULL SUBJECT.
*             E.G. 'WAS SEEN BY LOCAL MD'  ==>
*                  '() WAS SEEN BY LOCAL MD'
*
*    REGISTERS:
*       X1 = ORIGINAL FRAGMENT, UNDER WHICH ELEMENTS OF ASSERTION
*            ARE INSERTED
*       X2 = SECOND ELEMENT OF FRAG - DETERMINES TYPE OF FRAGMENT
*       X3 = VERB BUILT FOR ASSERTION
*       X4 = TYPE OF OBJECT-TO-BE: OBJBE/VINGO/VENPASS
*       X5 = NEW ASSERTION, REPLACING FRAGMENT NODE.
*    STRATEGY:
*       FILL IN MISSING ELEMENTS OF ASSERTION [UNDER EXISTING FRAG NODE]
*       FROM LEFT TO RIGHT.
T-FRAG-TO-ASSRT = IN FRAGMENT:
      VERIFY X-SELATT:= LIST VBE-LIST; [WILL BE RESET IF IS H-BECONN]
      IF BOTH $SAVE-TFORM-ATT
         AND ONE OF $BESHOW, $VFORM, $ASTG-PN, $TVO, $VO, $VINGSTG
      THEN BOTH $RESTORE-TFORM-ATT
           AND TRANSFORM X5 [NEW ASSERTION].
  $SAVE-TFORM-ATT =
      IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE TFORM-ATT
     @THEN STORE IN X-TFORM.
  $RESTORE-TFORM-ATT =
      IF X-TFORM EXISTS
      THEN AT X5, ASSIGN NODE ATTRIBUTE TFORM-ATT WITH VALUE X-TFORM.
  $BESHOW =
      BOTH THE FOLLOWING-ELEMENT- X2 OF VALUE OF FRAGMENT X1
                IS BESHOW X-PRE
          [WHERE X-PRE HAS ELEMENT OBJBE OR VENPASS OR VINGO X4]
           WHERE BOTH X-PRE HAS ELEMENT- OBJBE OR VENPASS OR VINGO X4
                 AND IF THIRD ELEMENT X-COLON OF X-PRE IS ':'
                     THEN EITHER X-COLON HAS NODE
                                 ATTRIBUTE WORD-POS X-WDPOS
                          OR TRUE
      AND BOTH $CHECK-SEL
          AND EITHER BOTH X4 IS OBJBE
                     AND $OBJBE
              OR [BOTH $NOT-CHANGER-PHRASE AND] $VENPASS-VINGO.
  $CHECK-SEL =
      EITHER CORE-SELATT X-SELATT OF X2 EXISTS
      OR TRUE.
  $OBJBE =
      VALUE X-NSTG OF ELEMENT- BESUBJ X-SUBJ OF X2 EXISTS;
      IF PROC X-PROC OF X2 IS NOT EMPTY
      THEN IF X-SUBJ IS EMPTY
           THEN VALUE X-NSTG OF X-PROC EXISTS
           ELSE IF FIRST SA X-SA1 OF X1 IS EMPTY
               [THEN REPLACE X-SA1 BY <SA> (X-NSTG)]
                THEN REPLACE X-SA1 BY <SA> (VALUE OF X-PROC)
                ELSE AFTER LAST-ELEMENT- OF X-SA1
                     INSERT VALUE OF X-PROC;
      REPLACE X1 [FRAGMENT] BY
        <ASSERTION> X5
                    ( FIRST SA OF X1
                    + <SUBJECT> (X-NSTG)
                    + <SA> (<NULL>)
                    + <NEG> (<NULL>)
                    + <TENSE> (<NULL>)
                    + <SA> (<NULL>)
                    + <VERB> X-VERB (<NULL>)
                    + <SA> (<NULL>)
                    + <OBJECT> (<OBJECTBE> (X4))
                    + <RV> (ALL ELEMENTS OF SA OF X2)
                    + SECOND SA OF X1 );
      DO $BUILD-VERB.
  $VENPASS-VINGO =
      REPLACE X1 [FRAGMENT]
      BY <ASSERTION> X5
                    ( FIRST SA OF X1
                    + SUBJECT OF X2
                    + <SA> (<NULL>)
                    + <NEG> (<NULL>)
                    + <TENSE> (<NULL>)
                    + <SA> (<NULL>)
                    + <VERB> X-VERB (<NULL>)
                    + <SA> (<NULL>)
                    + <OBJECT> (<OBJECTBE> (X4))
                    + <RV> (<NULL>)
                    + <SA> (<NULL>) );
      DO $BUILD-VERB.
  $BUILD-VERB = AT X-VERB DO $BUILD-BECONN.
  $BUILD-BECONN =
      REPLACE PRESENT-ELEMENT- BY
         <VERB> X106
                ( <LV> (<NULL>)
                + <VVAR> (<V> X-EMPTYV = '[]': (VBE,H-BECONN))
                + <NEGV> (<NULL>)
                + <RV> (<NULL>));
      IF X-WDPOS EXISTS
      THEN BOTH REPLACE X-EMPTYV BY <V> X-V = ':': (VBE, H-BECONN)
           AND AT X-V ASSIGN NODE ATTRIBUTE WORD-POS WITH
                      VALUE X-WDPOS;
      AT CORE- OF X106 ASSIGN NODE ATTRIBUTE SELECT-ATT WITH
                       VALUE X-SELATT.
  $VFORM =
     X2 IS VINGO OR VENPASS OR PVO OR TOVO
     [WHERE DO $NOT-CHANGER-PHRASE] [Global in T-SA-VFORM];
     REPLACE X1 [FRAGMENT]
     BY <ASSERTION> X5
                    ( FIRST SA OF X1
                    + <SUBJECT> (<NULL>)
                    + <SA> (<NULL>)
                    + <NEG> (<NULL>)
                    + <TENSE> (<NULL>)
                    + <SA> (<NULL>)
                    + <VERB> X-VERB (<NULL>)
                    + <SA> (<NULL>)
                    + <OBJECT> (<OBJECTBE> (X2))
                    + <RV> (<NULL>)
                    + SECOND SA OF X1 );
     DO $BUILD-VERB.
  $ASTG-PN =
     EITHER X2 IS ASTGF OR NSTGF OR ASTGP OR NSTGP
            WHERE THE VALUE X4 EXISTS
     OR X2 IS PN X4 [* to avoid splitting up a PN without host *]
        WHERE CORE-ATT OF ELEMENT- P DOES NOT HAVE MEMBER H-CONN;
     REPLACE X1 [FRAGMENT] BY
        <ASSERTION>X5
                    ( FIRST SA OF X1
                    + <SUBJECT> (<NULL>)
                    + <SA> (<NULL>)
                    + <NEG> (<NULL>)
                    + <TENSE> (<NULL>)
                    + <SA> (<NULL>)
                    + <VERB> X-VERB (<NULL>)
                    + <SA> (<NULL>)
                    + <OBJECT> (<OBJECTBE> ( <OBJBE> (X4)))
                    + <RV> (<NULL>)
                    + SECOND SA OF X1 );
     DO $BUILD-VERB.
  $TVO =
     X2 IS TVO;
     REPLACE X1 [FRAGMENT] BY
        <ASSERTION> X5
                    ( FIRST SA OF X1
                    + <SUBJECT> (<NULL>)
                    + FIRST SA OF X2
                    + <NEG> (<NULL>)
                    + TENSE OF X2
                    + <SA> (<NULL>)
                    + VERB OF X2
                    + SECOND SA OF X2
                    + OBJECT OF X2
                    + <RV> (<NULL>)
                    + <SA> (ALL ELEMENTS OF THIRD SA OF X2
                           +ALL ELEMENTS OF SECOND SA OF X1)).
  $VO =
     X2 IS VO;
     REPLACE X1 [FRAGMENT]
     BY <ASSERTION> X5
                    ( FIRST SA OF X1
                    + <SUBJECT> (<NULL>)
                    + <SA> (<NULL>)
                    + <NEG> (<NULL>)
                    + <TENSE> (<NULL>)
                    + <SA> (<NULL>)
                    + <VERB> (ALL ELEMENTS OF LVR OF X2)
                    + <SA> (ALL ELEMENTS OF SECOND SA OF X2)
                    + OBJECT OF X2
                    + <RV> (<NULL>)
                    + <SA> (ALL ELEMENTS OF THIRD SA OF X2)).
  $VINGSTG =
     BOTH BOTH X2 IS VINGSTG
          @AND $CHECK-NSVINGO
     AND REPLACE X1 [FRAGMENT] BY
         <ASSERTION> X5
                     (FIRST SA OF X1
                     + <SUBJECT> (<NULL>)
                     + <SA> (<NULL>)
                     + <NEG> (<NULL>)
                     + <TENSE> (<NULL>)
                     + <SA> (<NULL>)
                     + <VERB> (<NULL>)
                     + <SA> (<NULL>)
                     + <OBJECT> (<OBJECTBE> (VINGO OF X7 [NSVINGO]))
                     + <RV> (<NULL>)
                     + <SA> (<NULL>) ).
  $CHECK-NSVINGO =
     BOTH ELEMENT- TPOS OF NSVINGO X7 OF X2 IS EMPTY
     AND ELEMENT- OBJECT OF ELEMENT- VINGO OF X7 IS NOT EMPTY.
* ***** *******************************************************
*
*          A D J A U X   T R A N S F O R M A T I O N S
*
* ***** *******************************************************
* T-RNSUBJ
*      MOVES RNSUBJ TO RN OF HOST
*      1. IN OBJECT IF SA OCCURS TO THE RIGHT OF OBJECT/PASSOBJ
*         WHICH HAS AN NSTG
*              E.G. 'HE DESCRIBED A PROCEDURE YESTERDAY WHICH WAS INTERESTING'
*                              ==>
*                   'HE DESCRIBED A PROCEDURE WHICH WAS INTERESTING YESTERDAY'
*      2. IN SUBJECT OTHERWISE,
*              E.G. 'A PROCEDURE WAS DESCRIBED WHICH WAS INTERESTING' ==>
*                   'A PROCEDURE WHICH WAS INTERESTING WAS DESCRIBED'
*      3.  IN NSTG OF FRAGMENT
*      4.  IN PN OF FRAGMENT
T-RNSUBJ = IN RNSUBJ:
     AT IMMEDIATE SA OF PRESENT-ELEMENT- X-PRE,
     IF ONE OF $LAST-N-IN-OBJ, $IN-SUBJECT, $IN-FRAGMENT
     THEN DO $MOVE
     ELSE DO $FRAGMENT-PN.
  $FRAGMENT-PN =
     COELEMENT- PN EXISTS
     [* post lumbar laminectomy, clinically stable *]
     [WHERE CORE- X1 OF ELEMENT- NSTG OF ELEMENT- NSTGO IS N OR PRO];
     REPLACE X-PRE BY ALL ELEMENTS OF X-PRE.
  $IN-SUBJECT = CORE- X1 OF ULTIMATE-SUBJECT IS N OR PRO.
  $IN-FRAGMENT =
     [for FRAGMENT which may have been created by T-NULLFRAG-TO-FRAG]
     EITHER EITHER CORE- X1 OF COELEMENT NSTG IS N OR PRO
            OR CORE- X1 OF COELEMENT EKGSTG IS N OR PRO
     OR EITHER CORE- X1 OF ELEMENT- LVENR OF COELEMENT- VENPASS IS VEN
        OR EITHER CORE- X1 OF COELEMENT- LVENR IS VEN
           OR EITHER CORE- X1 OF ELEMENT- ASTG OF COELEMENT- ASTGF IS ADJ
              OR CORE- X1 OF ELEMENT- NSTG OF COELEMENT- NSTGF
                 IS N OR PRO.
  $LAST-N-IN-OBJ =
     ITERATE GO LEFT
     UNTIL TEST FOR OBJECT OR PASSOBJ OR OBJBE SUCCEEDS;
     STORE IN X8;
     EITHER EITHER DESCEND TO NSTGO
                   WHERE CORE- X1 IS N OR PRO
            OR DESCEND TO EKGSTG
               WHERE CORE- X1 IS N OR PRO
     OR CORE- IS OF TYPE N-OBJ-IN-STR
        WHERE CORE- X1 OF LAST-ELEMENT- IS N OR PRO.
  $MOVE =
     BOTH RIGHT-ADJUNCT OF X1 EXISTS
          WHERE IMMEDIATE-NODE- X-RX EXISTS
     AND BOTH ITERATE
                AFTER LAST-ELEMENT- OF X-RX [RN OF IMMEDIATE LNR OF X1]
                         INSERT VALUE OF X-PRE [+ <NULL>]
              UNTIL X-RX HAS NODE ATTRIBUTE POSTCONJELEM X-RX FAILS
         AND REPLACE X-PRE BY <NULL>.
* T-SA-SUBSTG
*      TRANSFORMS SUB1 OR SUB9 OR SUB10 OR SUB5 INTO CSSTG.
T-SA-SUBSTG = IN SUB1, [SUB0 20011218] SUB2, SUB3, SUB5, SUB6, SUB9,
                 SUB10, SUB11, SUB12, SUB13:
     IF PRESENT-ELEMENT- X-SUB IS [SUB0 OR] SUB1 OR SUB2 OR SUB3 OR
           SUB5 OR SUB6 OR SUB9 OR SUB10 OR SUB11 OR SUB12 OR SUB13
     THEN BOTH REPLACE X-SUB BY
                  <LCS> (<NULL>)
                 +<CSSTG> X-CSSTG (X-SUB)
          AND TRANSFORM X-CSSTG.
* T-CSSTG-IF
*   OPERATES ON IF-PHRASE,
*   MOVES D='IF' H-MODAL TO LEFT OF THE CORE OF VERB,
*   BOTH IN IF-PHRASE AND MAIN PHRASE.
T-CSSTG-IF = IN CSSTG:
    IF VALUE OF PRESENT-ELEMENT- X-CSSTG IS SUB1
       WHERE CORE-ATT OF CORE- HAS MEMBER H-MODAL
    THEN BOTH $MOVE-MODAL-TO-PHRASE
         AND $MOVE-MODAL-TO-MAIN.
  $MOVE-MODAL-TO-PHRASE =
    IF $IF-VERB-CORE THEN $ADD-MODAL.
  $MOVE-MODAL-TO-MAIN =
    IF $MAIN-VERB-CORE THEN $ADD-MODAL.
  $IF-VERB-CORE =
    BOTH IMMEDIATE SA X-SA OF X-CSSTG EXISTS
    AND ELEMENT- ASSERTION X-ASSERT OF ELEMENT- SUB1 EXISTS;
    CORE- X-VCORE OF ELEMENT- VERB OF X-ASSERT EXISTS;
    LEFT-ADJUNCT-POS X-LV EXISTS.
  $MAIN-VERB-CORE =
    IMMEDIATE ASSERTION X-ASSERT OF X-SA EXISTS;
    CORE- X-VCORE OF ELEMENT- VERB OF X-ASSERT EXISTS;
    LEFT-ADJUNCT-POS X-LV EXISTS.
  $ADD-MODAL =
    IF X-LV IS EMPTY
    THEN REPLACE X-LV BY
         <LV> (<TENSE> (<LW> (<NULL>)
                        +<W> X-D = '[IF]':(H-MODAL)
                        +<RW> (<NULL>)))
    ELSE IF VALUE OF X-LV IS TENSE
            WHERE CORE-ATT OF CORE- X-D HAS MEMBER H-MODAL
         THEN TRUE
         ELSE BEFORE VALUE OF X-LV INSERT
              <TENSE> (<LW> (<NULL>)
                       +<W> X-D = '[IF]':(H-MODAL)
                       +<RW> (<NULL>));
    CORE-ATT X-MODAL OF X-D EXISTS;
    AT X-D IF PRESENT-ELEMENT- DOES NOT HAVE NODE ATTRIBUTE SELECT-ATT
           THEN ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE X-MODAL.
* T-CSSTG
*    OPERATES ON 3 CASES OF CSSTG:
*    1) SUBO:  OBJBE + SA.
*            E.G. 'WHILE IN THE ARMY, HE WAS DECORATED' ==>
*                 'WHILE HE BE IN THE ARMY, HE WAS DECORATED'
*    2) SUB2:  VENPASS.
*            E.G. 'AS REQUESTED, HE FILLED THE ORDER' ==>
*                 'AS HE BE REQUESTED, HE FILLED THE ORDER'
*    3) SUB3:  VINGO.
*            E.G. 'AFTER SLEEPING FOR THREE HOURS, HE AWOKE' ==>
*                 'AFTER HE BE SLEEPING FOR THREE HOURS, HE AWOKE'
*    IN CASES 1 - 3, IN ORDER TO CONVERT THESE STRINGS
*    INTO AN ASSERTION, THE SUBJECT AND VERB = 'BE' MUST BE BUILT.
*    IF THE SUBJECT OF THE HOST STRING IS A PERMISSIBLE ONE, IT IS
*    COPIED AS SUBJECT OF THE NEWLY-BUILT ASSERTION UNDER CSSTG;
*    OTHERWISE SUBJECT IS LEFT BLANK.
*    THE REMAINING CASES (ASSERTION, NSVINGO, SVINGO, SOBJBE, SVEN)
*    ARE HANDLED BY OTHER TRANSFORMATIONS.
T-CSSTG = IN CSSTG:
    IF PRESENT-ELEMENT- HAS ELEMENT- SUB0 OR SUB1 OR SUB2 OR SUB3 OR
               SUB5 OR SUB6 OR SUB9 OR SUB10 OR SUB11 OR SUB12 OR SUB13
       WHERE EITHER
             PRESENT-ELEMENT- DOES NOT HAVE NODE ATTRIBUTE PHRASE-ATT
             OR
             BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE PHRASE-ATT X-PHR-ATT
             AND X-PHR-ATT DOES NOT HAVE MEMBER TIME-PHRASE
                                         OR INFLUENCE-PHRASE OR SOURCE-PHRASE
    THEN BOTH $LCS
         AND AT PRESENT-ELEMENT- X10
             IF BOTH $CHECK-SUB AND $CHECK-COOC
             THEN $BUILD-ASSERT
             ELSE AT VALUE [SUB] TRANSFORM SECOND ELEMENT
    ELSE TRUE.
  $LCS = IF COELEMENT- LCS IS NOT EMPTY
        @THEN REPLACE VALUE [D] BY <DSTG> (VALUE).
  $TEST-FOR-CSSTG =
      IF PRESENT-ELEMENT- IS SA
      THEN IF PRESENT-ELEMENT- HAS ELEMENT- CSSTG X10
          @THEN IF BOTH $CHECK-SUB AND $CHECK-COOC
                THEN $BUILD-ASSERT.
  $CHECK-SUB =
      VALUE X1 IS SUB10 OR SUB9 OR SUB0 OR SUB2 OR SUB3 OR SUB5
               OR SUB6 OR SUB12
            WHERE SECOND ELEMENT X2 IS NOT ASSERTION.
  $CHECK-COOC = TRUE.
  $BUILD-ASSERT =
      IF X1 IS SUB9 OR SUB10
      THEN DO $SUB10
      ELSE DO $BUILD-ASSERT1.
  $SUB10 = [CS9+VO and CS10+VO]
      AFTER X2 INSERT
        <ASSERTION> X111
                    (<SA> X101 (<NULL>)
                    +<SUBJECT> X102 (<NULL>)
                    +<NEG> X-NEG (<NULL>)
                    +TENSE OF X2
                    + <SA> (<NULL>)
                    +<VERB> (LV OF LVR OF X2
                            +<VVAR> (V OF LVR OF X2)
                            +<NEGV> X-NEGV (<NULL>)
                            +RV OF LVR OF X2)
                    +FIRST SA OF X2
                    +OBJECT OF X2
                    +<RV> X-RV (<NULL>)
                    +SECOND SA OF X2);
     [DO $OTHER;]
      IF ELEMENT- RV OF X2 EXISTS
      THEN REPLACE X-RV BY ELEMENT- RV OF X2;
      IF ELEMENT- NEG OF X2 EXISTS
      THEN REPLACE X-NEG BY ELEMENT- NEG OF X2;
      IF ELEMENT- NEGV OF LVR OF X2 EXISTS
      THEN REPLACE X-NEGV BY ELEMENT- NEGV OF LVR OF X2;
      IF VALUE OF X1 IS CS9 ['IN ORDER TO'] [OR CS10] ['AFIN DE']
      THEN BOTH X-TENSE := SYMBOL FUTURE
           AND AT VERB OF X111 DO $ADD-TO-TENSE-ATT [GLOBAL T-TENSE];
      DELETE X2;
      TRANSFORM X111.
  $BUILD-ASSERT1 =
      DO $MAKE-ASSERT1;
      EITHER $SUB0 OR $OTHER;
      AT X106 [VERB] DO $BUILD-BE;
      TRANSFORM X111 [* ASSERTION under CSSTG *].
  $SUB0 =
      BOTH X1 IS SUB0
      AND ALL OF $COLLAPSE-SA, $FIND-S, $X-COPY-SUBJ.
  $OTHER = IF BOTH $FIND-S AND $FIND-V THEN $CHECK-SUBJ.
  $COLLAPSE-SA =
      REPLACE X110 [LAST SA] BY LAST-ELEMENT- X3 [SA] OF X1 [SUB];
      DELETE X3 [LAST SA IN SUB0].
  $FIND-S =
      EITHER ULTIMATE-SUBJECT X5 OF IMMEDIATE SA X-IMSA OF X10 [CSSTG]
                                IS NOT EMPTY
      OR COELEMENT- NSTG X5 OF X-IMSA EXISTS [FRAGMENT CASE].
  $FIND-V = CORE- X4 OF COELEMENT- [ELEMENT-] VERBAL OF X-IMSA EXISTS.
  $MAKE-ASSERT1 = AFTER X2 INSERT
      <ASSERTION> X111
                  (<SA> X101 (<NULL>)
                  + <SUBJECT> X102 (<NULL>)
                  + <SA> X103 (<NULL>)
                  + <NEG> X104 (<NULL>)
                  + <TENSE> X105 (<NULL>)
                  + <SA> (<NULL>)
                  + <VERB> X106 (<NULL>)
                  + <SA> X107 (<NULL>)
                  + <OBJECT> X108 (<OBJECTBE>(X2))
                  + <RV> X109 (<NULL>)
                  + <SA> X110 (<NULL>));
      IF NEG X-NEG OF X2 EXISTS
      THEN REPLACE X104 BY X-NEG;
      IF TENSE X-TENSE OF X2 EXISTS
      THEN REPLACE X105 BY X-TENSE; DELETE X2.
  $MAKE-ASSERT = AFTER PRESENT-ELEMENT- INSERT
      <ASSERTION> X111
                  (<SA> X101 (<NULL>)
                  + <SUBJECT> X102 (<NULL>)
                  + <SA> X103 (<NULL>)
                  + <NEG> X104 (<NULL>)
                  + <TENSE> X105 (<NULL>)
                  + <SA> (<NULL>)
                  + <VERB> X106 (<NULL>)
                  + <SA> X107 (<NULL>)
                  + <OBJECT> X108 (<NULL>)
                  + <RV> X109 (<NULL>)
                  + <SA> X110 (<NULL>));
      IF NEG X-NEG OF X2 EXISTS
      THEN REPLACE X104 BY X-NEG;
      IF TENSE X-TENSE OF X2 EXISTS
      THEN REPLACE X105 BY X-TENSE.        (GLOBAL)
  $CHECK-SUBJ =
       IF X1 IS SUB2 [VENPASS]
       THEN IF X4 [VERBAL] HAS ATTRIBUTE NOTNOBJ X6
            THEN IF LISTS X6 AND X7 [ATTRB. LIST OF SUBJ] HAVE
                             NO COMMON ATTRIBUTE
                 THEN $X-COPY-SUBJ
                 ELSE TRUE
            ELSE $X-COPY-SUBJ
       ELSE [SUB3 = VINGO]
            IF X4 [VERBAL] HAS ATTRIBUTE NOTNSUBJ X6
            THEN IF LISTS X6 AND X7 HAVE NO COMMON ATTRIBUTE
                 THEN $X-COPY-SUBJ
                 ELSE TRUE
            ELSE $X-COPY-SUBJ.
  $X-COPY-SUBJ =
       IF X5 IS SUBJECT
       THEN REPLACE X102 BY X5 [SUBJECT OF HOST], X-NEW
       ELSE REPLACE VALUE OF X102 BY X5 [NSTG OF HOST], X-NEW;
       IF X-NEW IS SUBJECT
       THEN VALUE X-NEW EXISTS;
       AT X-NEW DO $LN-RN-NULL [* Global in T-RN-WH *].
  $BUILD-BE =
       REPLACE PRESENT-ELEMENT- BY
          <VERB> X106 (<LV> (<NULL>)
                      + <VVAR> (<V> = '[]': (VBE))
                      + <NEGV> (<NULL>)
                      + <RV> (<NULL>)).                 [GLOBAL]
* ***** *********************************************************
*
*          S T R I N G    T R A N S F O R M A T I O N S
*
* ***** *********************************************************
* T-NPVO
*     CONVERTS NPVO INTO A FULL ASSERTION IN OBJECT AND SETS
*     A NODE ATTRIBUTE TFORM-ATT POINTING FROM ASSERTION TO
*     LIST CONTAINING THE ATTRIBUTE TNPVO.  THE NODE ATTRIBUTE
*     MARKS THE SOURCE OF THE ASSERTION.
*          E.G. 'THEY PERMITTED HER TO GO' ==>
*               'THEY PERMITTED HER GO'
T-NPVO = IN NPVO, NTOVO, NTOBE:
     ALL OF $SET-UP, $MODALIZE-NPVO, $ASSERT, $SET-TFORM-ATT.
  $SET-UP =
     BOTH IF RV OF PRESENT-ELEMENT- [NPVO OR NTOBE] X9 IS NOT EMPTY
          @THEN REPLACE LAST-ELEMENT-
                BY ALL ELEMENTS OF ELEMENT- SA OF X9 [NPVO, NTOBE]
     AND EITHER EITHER ELEMENT- VO X31 OF ELEMENT- PVO EXISTS
                OR ELEMENT- VO X31 OF ELEMENT- TOVO EXISTS
         OR EITHER ELEMENT- TOVO X31 EXISTS
            OR ELEMENT- TOBE X31 EXISTS;
     EITHER VERB X35 OF X31 [TOBE,PVO,VO,TOVO] EXISTS
     OR LVR X35 OF X31 [VO] EXISTS;
     DO $X-LV.
  $X-LV =
     IF LV OF X31 HAS ELEMENT- DSTG OR LDR X38
     THEN IF ELEMENT LV X-LV OF X35 HAS ELEMENT- DSTG
         @THEN BOTH ITERATE GO DOWN
              @AND AFTER PRESENT-ELEMENT- INSERT X38
          ELSE AT X-LV REPLACE PRESENT-ELEMENT- BY X-LV (X38)
     ELSE TRUE.
  $MODALIZE-NPVO =
     IF BOTH X9 IS OCCURRING IN OBJECT X-OBJECT
        AND COELEMENT- VERB X-VERB OF X-OBJECT EXISTS
            WHERE CORE-ATT OF CORE- OF X-VERB HAS MEMBER
                  H-MODAL OR H-NEG
     THEN BEFORE VALUE OF ELEMENT- LV OF X35
          INSERT [CORE- OF] X-VERB.
  $ASSERT =
     ONE OF $SHOW-NTOBE, $OTHERS.
  $SHOW-NTOBE =
     CORE-ATT OF CORE- OF COELEMENT- VERB OF X-OBJECT HAS MEMBER H-SHOW;
     CORE-ATT OF CORE- OF X35 [TOVO:LVR] HAS MEMBER VBE;
     ELEMENT- RN X-RN OF ELEMENT- LNR OF ELEMENT- NSTG OF
         ELEMENT- NSTGO OF X9 EXISTS;
     IF X-RN IS EMPTY
     THEN REPLACE X-RN BY <RN> (ELEMENT- TOVO OF X9)
     ELSE AFTER LAST-ELEMENT- OF X-RN
          INSERT ELEMENT- TOVO OF X9;
     REPLACE X9 BY VALUE OF X9, X-ASSRT;
     TRANSFORM X-ASSRT.
  $OTHERS =
     BOTH REPLACE X9 [NPVO, NTOBE]
          BY <ASSERTION> X-ASSRT
                (<SA> (<NULL>)
               [+ SUBJECT OF X31 or X9 NPVO]
                + <SUBJECT> X-SUBJ (VALUE OF X9 [NPVO])
                + <SA> X-RV (<NULL>)
                + <NEG> (<NULL>)
                + <TENSE> (<NULL>)
                + <SA> (<NULL>)
                + <VERB> (ALL ELEMENTS OF X35)
                + FIRST SA OF X31 [VO]
                + OBJECT OF X31 [VO]
                + <RV> (<NULL>) [OF X9 NPVO] [X31 VO]
                + SECOND SA OF X31 [VO])
     AND BOTH IF RV OF X31 EXISTS
              THEN REPLACE X-RV BY <SA> (ALL ELEMENTS OF RV OF X31)
         AND BOTH IF VALUE X-NSUBJ OF X-SUBJ IS NSTGO
                  THEN BOTH AFTER X-NSUBJ INSERT
                            ALL ELEMENTS OF X-NSUBJ
                       AND DELETE X-NSUBJ
             AND TRANSFORM X-ASSRT.
  $SET-TFORM-ATT =
     AT X-ASSRT
     BOTH X-TFORM := SYMBOL TNTOVO
     AND $ADD-TO-TFORM-ATT.
  $ADD-TO-TFORM-ATT =                                         [GLOBAL]
     DO $CHECK-TFORMATT.
  $CHECK-TFORMATT =
     IF PRESENT-ELEMENT- X-PE HAS NODE ATTRIBUTE
        TFORM-ATT X-TFORMLIST
     THEN AT X-PE DO $ADD-TO-TFORM-LIST
     ELSE BOTH X-TFORMLIST := NIL
          AND $ADD-TO-TFORM-LIST.
  $ADD-TO-TFORM-LIST =
     BOTH PREFIX X-TFORM TO X-TFORMLIST
     AND AT X-PE
         ASSIGN PRESENT ELEMENT NODE ATTRIBUTE
         TFORM-ATT WITH VALUE X-TFORMLIST.
* T-SOBJBE
*     CONVERTS SOBJBE INTO A FULL ASSERTION AND SETS NODE ATTRIBUTE
*     TFORM-ATT TO LIST CONTAINING ATTRIBUTE TSOBJBE WHICH MARKS
*     THE SOURCE OF THE ASSERTION.
*     E.G. 'FINDINGS SHOWED THE MASS SUSPICIOUS' ==>
*          'FINDINGS SHOWED (THE MASS BE SUSPICIOUS)'
T-SOBJBE = IN SOBJBE:
     AT PRESENT-ELEMENT- X10 DO $SOBJBE-TO-ASSN [GLOBAL].
  $SOBJBE-TO-ASSN =                                           [GLOBAL]
     ALL OF $ADJUST-SOBJBE, $SOBJBE-TO-ASSERT, $SET-TSOBJBE-ATT.
  $ADJUST-SOBJBE =
     BOTH BEFORE SUBJECT OF X10 INSERT <SA> (<NULL>)
     AND AFTER SUBJECT OF X10 INSERT <SA> (<NULL>).
  $SOBJBE-TO-ASSERT =
     BOTH REPLACE X10 [SOBJBE]
          BY <ASSERTION> X-ASSRT
              (<SA> (<NULL>)
              + SUBJECT OF X10  [SOBJBE]
              + FIRST SA OF X10  [SOBJBE]
              + <NEG> (<NULL>)
              + <TENSE> (<NULL>)
              + <SA> (<NULL>)
              + <VERB> (<LV> (<NULL>)
                       +<VVAR> (<NULL>)
                       +<NEGV> (<NULL>)
                       +<RV> (<NULL>))
              +<SA> (<NULL>)
              +<OBJECT> (<OBJECTBE> (OBJBE OF X10 [SOBJBE]))
              +<RV> (<NULL>)
              + SECOND SA OF X10 [SOBJBE])
     AND TRANSFORM X-ASSRT.
  $SET-TSOBJBE-ATT =
     AT X-ASSRT
     BOTH X-TFORM := SYMBOL TSOBJBE
     AND $ADD-TO-TFORM-ATT.
* T-SASOBJBE
*     CONVERTS SASOBJBE INTO A FULL ASSERTION WITH VERB = 'AS': (VBE).
*     IT ALSO SETS A NODE ATTRIBUTE TFORM-ATT POINTING FROM THE NEWLY
*     BUILT ASSERTION TO LIST CONTAINING THE ATTRIBUTE TSASOBJBE
*     MARKING THE SOURCE OF THE ASSERTION.
*        E.G. 'THEY TREATED THE CHILD AS A SERVANT' ==>
*              'THEY TREATED (THE CHILD AS(=VBE) A SERVANT'
T-SASOBJBE = IN SASOBJBE:
     AT PRESENT-ELEMENT- X10
     BOTH $ASSERT
     AND $SET-TFORM-ATT.
  $ASSERT =
     BOTH REPLACE X10 [SASOBJBE]
          BY <ASSERTION> X-ASSRT
              (<SA> (<NULL>)
              + SUBJECT OF X10
              + FIRST SA OF X10
              + <NEG> (<NULL>)
              + <TENSE> (<NULL>)
              + <SA> (<NULL>)
              + <VERB> (<LV> (<NULL>)
                       +<VVAR> (<V> X-V10 = 'AS' : (VBE))
                       +<NEGV> (<NULL>)
                       +<RV> (<NULL>))
              +<SA> (<NULL>)
              +<OBJECT> (<OBJECTBE> (OBJBE OF X10))
              +<RV> (<NULL>)
              + SECOND SA OF X10)
     AND TRANSFORM X-ASSRT.
  $SET-TFORM-ATT =
     IF SECOND ELEMENT OF X10 HAS NODE ATTRIBUTE WORD-POS X-WPOS
     THEN AT X-V10 ASSIGN NODE ATTRIBUTE WORD-POS WITH VALUE X-WPOS;
     AT X-ASSRT
     BOTH X-TFORM := SYMBOL TSASOBJBE
     AND $ADD-TO-TFORM-ATT.
* T-FORTOVO
*   converts FORTOVO into a complete ASSERTION and sets a node
*   attribute TFORM-ATT pointing from new ASSERTION to list
*   containing attribute TFORTOVO marking the source of
*   the ASSERTION.
*   E.G. 'PATIENT WISHES FOR HER TO KNOW' ==>
*        'PATIENT WISHES (HER KNOW)'
T-FORTOVO = IN FORTOVO:
     AT PRESENT-ELEMENT- X10
     IF IMMEDIATE-NODE- IS RA OR RN OR RV
        WHERE IMMEDIATE-NODE- X-LXR IS OF TYPE LXR
     THEN ALL OF $ASSERT, $SET-TFORM-ATT.
  $ASSERT =
     EITHER PVO X11 OF X10 [FORTOVO] EXISTS
     OR TOVO OF X10 EXISTS
        WHERE ELEMENT- VO X11 EXISTS;
     VALUE OF X10 HAS NODE ATTRIBUTE WORD-POS X-WPOS;
     AFTER X-LXR INSERT [REPLACE X10 FORTOVO BY]
        <LCS> (<NULL>)
       +<CSSTG>
            (<SUB1>
               (<CS1> X-CS1 = 'for': (CS1)
               + <ASSERTION> X-ASSRT
                     ( <SA> (<NULL>)
                     +SUBJECT OF X10 [FORTOVO]
                     +SA OF X10 [FORTOVO]
                     + <NEG> (<NULL>)
                     + <TENSE> (<NULL>)
                     + <SA> (VALUE OF LP OF TOVO OF X10)
                     + <VERB> (ALL ELEMENTS OF LVR OF X11 [VO|PVO])
                     +FIRST SA OF X11 [VO|PVO]
                     +OBJECT OF X11 [VO|PVO]
                     + <RV> (<NULL>) [RV OF X11 VO|PVO]
                     +SECOND SA OF X11 [VO|PVO])));
     AT X-CS1, ASSIGN NODE ATTRIBUTE WORD-POS WITH VALUE X-WPOS;
     BOTH DELETE X10
     AND TRANSFORM X-ASSRT.
  $SET-TFORM-ATT =
     AT X-ASSRT
     BOTH X-TFORM := SYMBOL TFORTOVO
     AND $ADD-TO-TFORM-ATT.
* T-PVO-IN-SA
*    TRANSFORMS A PVO IN SA INTO A CSSTG WITH 'IN ORDER TO' AS THE
*    SUBORDINATING CONJUNCTION, FOLLOWED BY AN ASSERTION.
*    THE SUBJECT OF THE ASSERTION IS COPIED FROM THE ASSERTION
*    CONTAINING THE SA, WHILE THE OTHER ELEMENTS, I.E. VERB, SA'S,
*    OBJECT, RV, ARE COPIED FROM PVO.  THE ENTIRE SUBJECT RATHER THAN
*    JUST THE CORE OF THE NSTG IN SUBJECT WAS COPIED BECAUSE THE
*    SUBJECT CAN HAVE OTHER VALUES, E.G. 'NSVINGO, VINGOFN, ETC.
*    FOR WHICH THE TRANSFORMATION IS ALSO VALID.
*         E.G. 'THE PATIENT WAS TRANSFERRED TO MEDICINE TO BEGIN
*               THERAPY'  ==>
*               'THE PATIENT WAS TRANSFERRED TO MEDICINE
*               IN ORDER TO PATIENT BEGIN THERAPY'
T-PVO-IN-SA = IN PVO, TOVO:
     IF BOTH BOTH IMMEDIATE SA X-SA [OF PRESENT-ELEMENT- X-PVO] EXISTS
             AND DO $IN-ASSERTION
        AND BOTH EITHER [TOVO] ELEMENT- VO X-PVO OF
                   PRESENT-ELEMENT- X-TOVO EXISTS
                OR [PVO] BOTH STORE IN X-PVO
                     AND STORE IN X-TOVO
            AND DO $GET-WORD-POS
     THEN BOTH ALL OF $MOVE-LP, $ASSRT
          AND TRANSFORM X-ASSRT.
   $IN-ASSERTION =
     EITHER COELEMENT- SUBJECT X-ULT-SUBJ OF X-SA EXISTS
     OR EITHER ULTIMATE-SUBJECT X-ULT-SUBJ OF X-SA EXISTS
        OR [IMMEDIATE FRAGMENT EXISTS]
           COELEMENT- NSTG X-ULT-SUBJ OF X-SA EXISTS.
   $GET-WORD-POS =
     SECOND ELEMENT HAS NODE ATTRIBUTE WORD-POS X-WPOS.
   $MOVE-LP =
     IF ELEMENT- LP X-TOVO-LP OF X-TOVO IS NOT EMPTY
     THEN BEFORE VALUE OF ELEMENT- LV OF ELEMENT- LVR OF X-PVO
          INSERT ALL ELEMENTS OF X-TOVO-LP.
   $ASSRT =
     BOTH AFTER [REPLACE X-PVO] X-TOVO INSERT [BY]
        <LCS> X-LCS (VALUE OF ELEMENT- LV OF ELEMENT- LVR OF X-PVO)
       +<CSSTG>
            (<SUB1>
               (<CS1> X-CS1 = 'to': (CS1 [FUT-IMP])
               +<ASSERTION> X-ASSRT
                      (<SA> (<NULL>)
                       + <SUBJECT> X-SUBJ-OF-SA (<NULL>)
                       + <SA> (<NULL>)
                       + <NEG> (<NULL>)
                       + <TENSE> (<LW> (<NULL>)
                                 +<W> X-TENSEW = '[to]'[:(FUT-IMP)]
                                 +<RW> (<NULL>))
                       + FIRST SA OF X-PVO
                       + <VERB> X-VERB (ALL ELEMENTS OF LVR OF X-PVO)
                       + SECOND SA OF X-PVO
                       + OBJECT OF X-PVO
                       + <RV> (<NULL>)
                       + THIRD SA OF X-PVO)))
     AND BOTH [* Dutch problem 1996 *]
              IF ELEMENT- DP X-DP OF X-PVO EXISTS
              THEN IF X-DP IS 'OM_OP_TE'
                   THEN REPLACE X-CS1 BY <CS1> = 'OM_OP_TE':(CS1)
                   ELSE IF X-DP IS 'OM_TE'
                        THEN REPLACE X-CS1 BY <CS1> = 'OM_TE':(CS1)
                        ELSE REPLACE X-CS1 BY <CS1> = 'OM':(CS1)
              ELSE TRUE
         AND BOTH AT X-VERB, DO $INSERT-FUT-IMP
             AND DELETE X-TOVO;
     BOTH EITHER COELEMENT- SUBJECT X-ULT-SUBJ OF X-SA EXISTS
          OR EITHER ULTIMATE-SUBJECT X-ULT-SUBJ OF X-SA EXISTS
             OR [IMMEDIATE FRAGMENT EXISTS]
                COELEMENT- NSTG X-ULT-SUBJ OF X-SA EXISTS
     AND REPLACE X-SUBJ-OF-SA BY X-ULT-SUBJ;
     BOTH AT X-TENSEW,
          ASSIGN NODE ATTRIBUTE WORD-POS WITH VALUE X-WPOS
     AND AT X-CS1,
         ASSIGN NODE ATTRIBUTE WORD-POS WITH VALUE X-WPOS.
  $INSERT-FUT-IMP =
     BOTH X-TENSE := SYMBOL FUT-IMP
     AND AT X-VERB DO $ADD-TO-TENSE-ATT.
* T-SA-VFORM
*    TRANSFORMS VENPASS OR VINGO IN SA OF ASSERTION-LIKE STRING INTO
*    SUB2 [VENPASS] WITH CS = 'IN-STATE' OR SUB3 [VINGO] WITH CS =
*    'WHILE' IN CSSTG UNDER THE SA. T-CSSTG WILL OPERATE ON THESE
*    STRINGS TO FILL THEM OUT INTO COMPLETE ASSERTIONS.
*      E.G. [VENPASS]
*            'ADMITTED TO HOSPITAL, PATIENT COMPLAINED OF HE'ADACHE' ==>
*            'IN-STATE ADMITTED TO HOSPITAL, PATIENT COMPLAINED...'
*           [VINGO]
*            'HAVING A SEVERE HEADACHE, PATIENT WAS ADMITTED'  ==>
*            'WHILE HAVING A SEVERE HEADACHE,...'
*           12/05/2001: change to
*            'PATIENT HAVING A SEVERE HEADACHE,...'
*    NOTE THAT T-SA-VFORM DOES NOT PICK UP THE VERBAL SA AND MOVE IT
*    INTO RN OF SUBJECT OR OBJECT OF THE ASSERTION DUE TO PROBLEM
*    WITH VINGO CONTAINING 'HAVE'.
*       E.G. 'HAVING A SEVERE HEADACHE, PATIENT WAS ADMITTED'  ==>
*           *'PATIENT SUCH THAT PATIENT BE HAVING A HEADACHE
*             WAS ADMITTED TO HOSPITAL'
T-SA-VFORM = IN VINGO, VENPASS:
     IF [BOTH $NOT-CHANGER-PHRASE $NOT-SCOPE-PHRASE]
        [AND] IMMEDIATE SA X-SA OF PRESENT-ELEMENT- X-VFORM EXISTS
     THEN $CSSTG.
  $NOT-CHANGER-PHRASE =                                        [GLOBAL]
     PRESENT-ELEMENT- DOES NOT HAVE NODE ATTRIBUTE TFORM-ATT
     WHERE PRESENT-ELEMENT- IS H-CHANGE.
  $NOT-SCOPE-PHRASE =
     NEITHER COELEMENT- NEG OF IMMEDIATE SA X-SA IS NOT EMPTY
     NOR BOTH ELEMENT- LV X-LV OF COELEMENT- VERBAL OF
             X-SA IS NOT EMPTY
        AND X-LV HAS ELEMENT- TENSE
            WHERE CORE-ATT OF CORE- HAS MEMBER H-MODAL.
  $CSSTG =
     ALL OF $ADD-SCOPE, $BUILD, $TRANSFORM-CSSTG.
  $ADD-SCOPE = [* Temporary *]
     IF COELEMENT- LDR X-LDR OF X-VFORM EXISTS
     THEN BOTH BEFORE VALUE OF ELEMENT- LV OF ELEMENT- VERBAL
               OF X-VFORM INSERT X-LDR, X-NEWLDR
          AND DELETE X-LDR;
     IF COELEMENT- NEG X-NEG OF X-SA IS NOT EMPTY
     THEN BEFORE ELEMENT- VERBAL OF X-VFORM
          INSERT X-NEG
     ELSE IF BOTH ELEMENT- LV X-LV OF COELEMENT- VERBAL OF
                  X-SA IS NOT EMPTY
             AND X-LV HAS ELEMENT- TENSE X-TENSE
                 WHERE CORE-ATT X-COREATT OF CORE- HAS MEMBER H-MODAL
          THEN BEFORE [VALUE OF ELEMENT- LV OF]
                      ELEMENT- VERBAL OF X-VFORM
               INSERT X-TENSE.
  $BUILD =
     IF X-VFORM IS VENPASS
     THEN REPLACE X-VFORM
          BY <LCS> (<NULL>)
             +<CSSTG> X-CSSTG
                      (<SUB2> (<CS2> = '[IN-STATE]': (CS2)
                              + X-VFORM))
     ELSE [VINGO]
          REPLACE X-VFORM BY
             <LCS> (<NULL>)
            +<CSSTG> X-CSSTG
                     (<SUB3> (<CS3> = '[WHILE]': (CS3)
                             + X-VFORM)).
  $TRANSFORM-CSSTG =
     TRANSFORM X-CSSTG.
* T-TIME-CONN-PN
*     IF A PN HAS P=H-CONN AND
*     IF IT IS ALSO A TIME WORD
*     THEN PRESERVE THE TIME IN LN OF NSTGO
* -- NTN 1/16/97
T-TIME-CONN-PN = IN PN:
   AT PRESENT-ELEMENT- X-PN
   IF BOTH CORE-ATT X-COREATT OF ELEMENT- P X-P HAS MEMBER H-CONN
      AND X-COREATT HAS MEMBER H-TMLOC [OR H-TMPREP]
   THEN DO $TIME-XFER.
  $TIME-XFER =
     AT ELEMENT- NSTGO
     ITERATE $REPLACE-TIME
     UNTIL COELEMENT- Q-CONJ OF X-LN EXISTS FAILS.
  $REPLACE-TIME =
     DESCEND TO LN;
     STORE IN X-LN;
     IF ELEMENT- TPOS X-TPOS IS NOT EMPTY
     THEN IF ELEMENT- LT X-LT OF ELEMENT- LTR OF X-TPOS IS EMPTY
          THEN REPLACE X-LT BY X-LT (<LDR> X-LDR)
          ELSE BEFORE VALUE OF X-LT INSERT <LDR> X-LDR
     ELSE REPLACE X-TPOS BY
            <TPOS> (<LTR> (<LT> (<LDR> X-LDR)
                          +<T> = '[]':(H-NULL)
                          +<RT> (<NULL>)));
     REPLACE X-LDR BY <LDR> (<LD> (<NULL>)
                            +CLASS D OF X-P, X-D
                            +<RD> (<NULL>));
     AT X-D, ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE X-COREATT.
* T-SANS
*     CHANGES 'SANS' PREPOSITIONAL PHRASES TO 'AVEC' + NEGATIVE:
*      (1) IF THE ARTICLE ON THE OBJECT OF THE PREPOSITION IS EMPTY
*             OR INDEFINITE
*          THEN TRANFORMATION FILLS IN THE ARTICLE WITH 'NO'.
*             E.G. 'SANS COMPLICATIONS' ==> 'AVEC AUCUN COMPLICATIONS'
*      (2) IF THE ARTICLE IS NOT EMPTY OR INDEFINITE, THEN '[NO]' IS
*          INSERTED AS ADJUNCT TO THE PREPOSITION 'AVEC'.
*             E.G. 'WITHOUT THE COMPLICATIONS'
*              ==> 'NOT WITH THE COMPLICATIONS'
*          IF 'NOT' IS ALREADY IN THE MODIFIER TO THE PREPOSITION,
*          THEN IT IS REPLACED BY NULL.
*             E.G. 'NOT WITHOUT THE COMPLICATIONS'
*              ==> 'WITH THE COMPLICATIONS'
* -- New structure:
*    Heart regular rate without skip or murmur.
*    BESHOW: BESUBJ:Heart OBJBE:regular rate ,
*                   Heart OBJBE:without skip or
*                   Heart OBJBE:without murmur
*    NECK : Supple without lymphadenopathy, thyromegaly or bruit.
*    XXXXX: OBJECT:OBJECTBE:OBJBE:
T-SANS = IN PN:
     AT PRESENT-ELEMENT- X-PN
     IF BOTH EITHER ELEMENT- P X9 IS 'SANS' OR 'WITHOUT' OR
                    'FREE'_'OF' OR 'WITHOUT'_'EVIDENCE'_'OF',
             OR [FRENCH] X9 IS P:'MAIS SANS'
             [* T-PSEUDO-CONJ-WITHOUT deals with OBJBE situation *]
        AND CORE-ATT OF X9 HAS MEMBER H-CONN 
     THEN IF X-PN IS NOT OCCURRING IN OBJBE
          THEN BOTH EITHER CORE-SELATT X-SELATT OF X9 EXISTS
                    OR ATTRIBUTE-LIST X-SELATT OF X9 EXISTS
               AND ALL OF $NEG, $WITH, $NO-X-AND-Y, $NO-X-OR-Y,
                          $NI-PHRASE
          ELSE BOTH DO $ERASE-SEL-CONN
               AND AT NSTGO OF X-PN
                   ITERATET $CHANGE-OR UNTIL $ORSTG FAILS
     ELSE TRUE.
  $ERASE-SEL-CONN =
     CORE-ATT X-SELATT OF X9 EXISTS;
     X-SUBLIST := LIST CONN-LIST;
     X-NEWATT := COMPLEMENT OF X-SELATT;
     AT X9, ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE X-NEWATT.
  $NI-PHRASE = TRUE.
  $NEG =
     AT ELEMENT- NSTGO
     ITERATE $REPLACE-NEG
     UNTIL AT X-LN, DO R(CONJ-NODE) [COELEMENT- CONJ-NODE OF X-LN EXISTS]
           WHERE ELEMENT- Q-CONJ EXISTS FAILS.
  $REPLACE-NEG =
     DESCEND TO LN;
     STORE IN X-LN;
     IF ELEMENT- TPOS IS EMPTY
     THEN BOTH REPLACE ELEMENT- TPOS BY
               <TPOS>X-TPOS (<LTR> (<LT> X-LT (<NULL>)
                                   +X9, X-D
                                   +<RT> (<NULL>)))
          AND DO $TRANSFER-NEG
     ELSE IF CORE- OF ELEMENT- TPOS X-TPOS IS 'AUCUN' OR 'AUCUNE'
             OR 'AN' OR 'ANY' OR 'THE' OR 'THIS' OR 'THESE'
          THEN BOTH REPLACE ELEMENT- LT OF ELEMENT- LTR OF X-TPOS
                    BY <LT> X-LT (<DSTG> (X9, X-D))
               AND DO $TRANSFER-NEG
          ELSE TRUE;
     IF ELEMENT- LP X-LP OF X-PN IS NOT EMPTY
     THEN BEFORE VALUE OF X-LT
          INSERT ALL ELEMENTS OF X-LP
    [THEN EITHER $LP OR $NO]
    [ELSE TPOS <> 'A', ETC.]
          [EITHER $LP OR $NOT]
    [IF X9 IS 'FREE'_'OF']
    [THEN BOTH REPLACE X-D BY <T> X-DX = 'FREE_OF':(NEGATIVE, H-NEG)]
    [     AND AT X-DX, STORE IN X-D]
    [ELSE IF X9 IS 'WITHOUT'_'EVIDENCE'_'OF']
    [     THEN BOTH REPLACE X-D BY]
    [             <T> X-DX = 'WITHOUT_EVIDENCE_OF':(NEGATIVE, H-NEG)]
    [          AND AT X-DX, STORE IN X-D;]
    [DO $ASSIGN-NEG].
  $ASSIGN-NEG =
     X-SEL:= LIST NEG-LIST;
     AT X-D ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE X-SEL. (GLOBAL)
  $LP =
     AT X-PN
     BOTH CORE- X-NOT OF ELEMENT- LP X-LP IS 'NOT'
     AND IF COELEMENT- DSTG X-DSTG OF X-NOT EXISTS
         THEN REPLACE ELEMENT- DSTG OF X-LP
              BY X-DSTG
         ELSE REPLACE X-LP
              BY X-LP (<NULL>).
  $NO =
     REPLACE CORE- OF X-TPOS BY
        <T> X-D = 'WITHOUT': (NEGATIVE, H-NEG);
     DO $TRANSFER-NEG
       [<T> X-D = 'NO': (NEGATIVE, H-NEG)]
     [DO $ASSIGN-NEG].
  $TRANSFER-NEG =
     IF X9 HAS NODE ATTRIBUTE SELECT-ATT X9-SEL
     THEN AT X-D, ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE X9-SEL;
     IF X9 HAS NODE ATTRIBUTE COMPUTED-ATT X9-SEL
     THEN AT X-D, ASSIGN NODE ATTRIBUTE COMPUTED-ATT WITH VALUE X9-SEL;
     IF X9 HAS NODE ATTRIBUTE WORD-POS X9-SEL
     THEN AT X-D, ASSIGN NODE ATTRIBUTE WORD-POS WITH VALUE X9-SEL;
     IF X9 HAS NODE ATTRIBUTE INDEX X9-SEL
     THEN AT X-D, ASSIGN NODE ATTRIBUTE INDEX WITH VALUE X9-SEL.
  $NOT =
     IF ELEMENT- LP X-LP OF X-PN IS EMPTY
     THEN REPLACE X-LP BY
          <LP> (<DSTG> (X9, X-D))
     ELSE BOTH VALUE OF DSTG X-DSTG1 OF X-LP IS DSTG
          AND REPLACE X-LP BY
              <LP> (<DSTG> (X-DSTG1)
                   + X9, X-D)
     [DO $ASSIGN-NEG].
  $WITH =
     BOTH [REPLACE X9] [P] AT X9, STORE IN X-P
          [BY <P> X-P = 'WITH': ('WITH')]
     AND AT X-P
         ASSIGN PRESENT ELEMENT NODE ATTRIBUTE SELECT-ATT
         WITH VALUE X-SELATT.
  $NO-X-AND-Y =
     AT NSTGO OF X-PN
     ITERATET $CHANGE-AND UNTIL $ANDSTG FAILS
    [IF $ANDSTG]
    [THEN BOTH $CHANGE-AND AND $NO-X-AND-Y].
  $ANDSTG =
     BOTH DESCEND TO ANDSTG PASSING THROUGH STRING
     @AND STORE IN X-ANDSTG.
  $CHANGE-AND =
       [* fails if 'NOT' is an element of ANDSTG *]
       [BOTH SECOND ELEMENT OF X-ANDSTG IS NULL AND]
     VALUE OF X-ANDSTG HAS NODE ATTRIBUTE WORD-POS X-WORD;
     REPLACE VALUE OF X-ANDSTG BY 'OR';
     AT VALUE OF X-ANDSTG,
        ASSIGN NODE ATTRIBUTE WORD-POS WITH VALUE X-WORD
        [REPLACE X-ANDSTG]
        [BY <ORSTG> ('OR']
        [           + <NOTOPT> (<NULL>)]
        [           + SECOND ELEMENT OF X-ANDSTG] [SACONJ]
        [           + THIRD ELEMENT OF X-ANDSTG] [Q-CONJ)].
  $NO-X-OR-Y =
     AT NSTGO OF X-PN
     ITERATET BOTH $CHANGE-OR AND $LINK-TPOS
     UNTIL $ORSTG FAILS
    [IF $ORSTG]
    [THEN BOTH $CHANGE-OR AND $NO-X-OR-Y].
  $ORSTG =
     BOTH DESCEND TO ORSTG PASSING THROUGH STRING
    @AND STORE IN X-ORSTG.
  $CHANGE-OR =
     VALUE OF X-ORSTG HAS NODE ATTRIBUTE WORD-POS X-WORD;
     REPLACE VALUE OF X-ORSTG BY 'AND';
     AT VALUE OF X-ORSTG,
        ASSIGN NODE ATTRIBUTE WORD-POS WITH VALUE X-WORD
    [REPLACE X-ORSTG]
    [BY <ANDSTG> ('AND']
    [            + <NOTOPT> (<NULL>)]
    [            + <SACONJ> (<NULL>)]
    [            + SECOND ELEMENT OF X-ORSTG] [Q-CONJ)].
  $LINK-TPOS =
    ITERATET REPLACE X-TPS BY X-TPOS
    UNTIL X-LN HAS NODE ATTRIBUTE POSTCONJELEM X-LN
          WHERE ELEMENT- TPOS X-TPS IS EMPTY FAILS.
* T-NOM-PREP-ARG
*     IDENTIFIES PREPOSITIONS WHICH "BELONG" TO A NOMINALIZED
*     VERB, E.G. 'ADMISSION', MARKING PREP ('TO') WITH NODE ATTRIBUTE
*     PVAL-ATT POINTING TO HOST (CONSISTENT WITH $PVAL IN WSEL-P-N IN
*     SELECTION).  THESE PREPOSITIONS ARE STATED IN THE
*     DICTIONARY ENTRY OF THE VERB WHICH IS RELATED TO THE
*     NOMINALIZATION.
*       E.G. 'FIRST ADMISSION TO HOSPITAL'  ==>
*            (PVAL-ATT POINTING FROM 'TO' TO 'ADMISSION')
* T-VERB-PREP-ARG
*     MARKS PREPOSITIONAL ARGUMENT OF VERB (E.G. 'ADMIT') WITH PVAL-ATT
*     POINTING FROM P TO VERB.
*          E.G. 'THE PATIENT WAS ADMITTED TO HOSPITAL'  ==>
*              (PVAL-ATT POINTING FROM 'TO' TO 'ADMIT')
T-VERB-PREP-ARG = IN PN, PVINGSTG:
     AT PRESENT-ELEMENT- X-PN
     IF BOTH ASCEND TO OBJECT OR PASSOBJ
             PASSING THROUGH N-OBJ-IN-STR
             NOT PASSING THROUGH RADJSET
       @AND BOTH CORE- X-V OF COELEMENT- VERBAL EXISTS
                 WHERE X-V IS NOT '[]'
            AND NOT $IN-CONNECTIVE-STRUCTURE
     THEN AT ELEMENT- P OF X-PN
          ASSIGN NODE ATTRIBUTE PVAL-ATT WITH VALUE X-V.
  $IN-CONNECTIVE-STRUCTURE =
      BOTH AT X-PN, DO $PN-CONN-TEST
      AND $MATCH-ARGUMENTS.
  $MATCH-ARGUMENTS =
      CORE-ATT X-ARG1 OF VALUE OF COELEMENT- SUBJECT EXISTS;
      CORE-ATT X-ARG2 OF ELEMENT- NSTG OF ELEMENT- NSTGO OF X-PN EXISTS;
      BOTH X-NEWLIST := X-ARG1
      AND INTERSECT X-INTERSECTION OF X-ARG2 IS NOT NIL.
  $PN-CONN-TEST =
      EITHER P X-HCONN HAS NODE ATTRIBUTE SELECT-ATT
             WHERE PRESENT-ELEMENT- HAS MEMBER CONN-LIST
      OR $IS-CONN-TYPE.
  $IS-CONN-TYPE =
      X-PN HAS NODE ATTRIBUTE ADVERBIAL-TYPE
           WHERE PRESENT-ELEMENT- HAS MEMBER CONN-TYPE;
      AT X-PN ELEMENT P X-HCONN EXISTS.
* T-WHATS-N
*     TRANSFORMS THE 'WHAT' OF NSTG INTO A 'THAT WHICH', WHICH CAN
*     BE HANDLED BY THE T-RN-WH TFORM.
*          E.G. 'I SAW WHAT HE HAD BOUGHT'  ==>
*               'I SAW THAT WHICH HE HAD BOUGHT'
T-WHATS-N = IN NWHSTG:
     IF VALUE IS WHATS-N
        WHERE PRESENT-ELEMENT- HAS NODE ATTRIBUTE DIDOMIT X-OMIT
     THEN BOTH $BUILD-LNR
          AND AT X30
              BOTH BOTH $ASSIGN-ATT AND $LN-MAKE
              AND TRANSFORM X-LNR [LNR].
  $BUILD-LNR =
     BOTH REPLACE NWHSTG
          BY <LNR> X-LNR
               (<LN> X15
               +<NVAR> (<PRO> = THAT)
               +<RN> (<WHS-N> X30
                              ('WHICH'
                              +ASSERTION OF WHATS-N)))
     AND $SET-TFORM-ATT.
  $SET-TFORM-ATT =
     AT X-LNR
     BOTH X-TFORM := SYMBOL TWHATSN
     AND $ADD-TO-TFORM-ATT.
  $ASSIGN-ATT =
     AT X30
     ASSIGN PRESENT STRING NODE ATTRIBUTE DIDOMIT
        WITH VALUE X-OMIT.
  $LN-MAKE = REPLACE X15 [LN] BY
               X15 [LN]
                   (<TPOS> (<LTR> (<LT> (<NULL>)
                                  +<NULL>
                                  +<RT> (<NULL>)))
                   +<QPOS> (<NULL>)
                   +<APOS> (<NULL>)
                   +<NPOS> (<NULL>)).
* T-RN-WH
*     FILLS IN NULLWH IN ASSERTION OF WHS-N, THATS-N, OR S-N;
*     IN THE CASE OF WHENS OR PWHS, IT COPIES A PN TO LAST SA OF
*     ASSERTION.  ASSERTION IS MOVED UP TO SAME LEVEL AS LNR, TO CREATE
*     STRUCTURE NSTG (LNR + ASSERTION).  TO FILL IN NULLWH, CORE
*     OF LNR HOST IS COPIED ALONG WITH ANY ADJUNCT INVOLVED IN A
*     COMPUTED-ATT CONTRUCTIONS (USING GLOBAL $TRIM-LN-RN).  THE
*     FILLED IN ASSERTION IS THEN TRANSFORMED (I.E. PUT ON THE
*     TRANSFORMATION STACK):
*          E.G. 'THE MAN WHO LEFT TOWN'  ==>
*               'THE MAN [THE MAN LEFT TOWN]'
*     A NODE ATTRIBUTE TFORM-ATT IS SET POINTING FROM THE NEWLY
*     CREATED ASSERTION TO A LIST CONTAINING THE ATTRIBUTE TRNWH.
T-RN-WH = IN THATS-N, S-N, WHS-N, SNWH, PWHS [RNWH], WHENS, WHERES:
     AT PRESENT-ELEMENT- X-PRE
     ONE OF $THATS-N, $WHENS, $PWHS, $PWHS-PN.
  $THATS-N =
     BOTH [EITHER] TEST FOR THATS-N OR S-N OR WHS-N
          [OR VALUE X-PRE IS WHS-N]
          WHERE EITHER X-PRE HAS NODE ATTRIBUTE DIDOMIT X-OMIT
                OR X-PRE HAS NODE ATTRIBUTE DIDOMPN X-OMIT
     AND ALL OF $COPY-HOST, $MOVE-ASSN-UP, [$FILLIN-WH,]
                $DELETE-X-PRE, $TRANSFORM-ASSRT.
  $COPY-HOST =
     IMMEDIATE LNR X-LNR OF X-PRE EXISTS;
     AFTER X-LNR INSERT <NSTG> X-NSTG (X-LNR, X-NEWLNR);
     AT X-NEWLNR, DO $TRIM-LN-RN;
     IF X-PRE HAS ELEMENT Q-OF X-QOF
     THEN IF ELEMENT- TPOS X-TPOS OF ELEMENT- LN
             OF X-NEWLNR IS EMPTY
          THEN REPLACE X-TPOS BY <TPOS> (ALL ELEMENTS OF X-QOF)
          ELSE IF ELEMENT- LT X-LT OF X-TPOS IS EMPTY
               THEN REPLACE X-LT BY <LT> (ALL ELEMENTS OF X-QOF)
               ELSE BEFORE VALUE OF X-LT
                    INSERT ALL ELEMENTS OF X-QOF;
     ITERATE AT IMMEDIATE-NODE- X-IMMEDIATE OF X-OMIT
             REPLACE X-OMIT [NULL WH]
             BY X-NSTG, X-NEWNSTG
     UNTIL BOTH X-IMMEDIATE HAS NODE ATTRIBUTE POSTCONJELEM
           @AND VALUE IS NULLWH X-OMIT FAILS;
     DELETE X-NSTG.
  $WHENS =
     BOTH X-PRE IS WHENS OR WHERES OR PWHERES
     AND EITHER DO $PDATE-TIME [* 12/2/2003 *]
         OR ALL OF $LOCATE-TIME-SA, $FILLIN-TIME-SA,
                [$DELETE-X-PRE,] $TRANSFORM-ASSRT.
  $LOCATE-TIME-SA = [* Ascending to the top-most Time expression *]
     AT IMMEDIATE LNR X-LNR OF X-PRE,
     EITHER DO $PQUANT-TIME [* 05/13/1999 *],
     OR EITHER ITERATET BOTH STORE IN X-LNR
                        AND ASCEND TO LNR PASSING THROUGH PN
                            WHERE STORE IN X-NLNR
               UNTIL CORE-ATT OF CORE- OF X-NLNR DOES NOT HAVE
                     MEMBER NTIME1 [OR H-TTGEN] SUCCEEDS
        OR TRUE;
     AFTER X-LNR INSERT ASSERTION OF X-PRE, X-ASSRT;
     DO $STORE-WH-WORD;
     LAST-ELEMENT- OF X-ASSRT IS SA X-SA;
     DO $SET-TFORM-ATT.
  $PDATE-TIME =
      [* He did well until 11/02/2000 when he had chest pain *]
     IMMEDIATE-NODE- OF X-PRE IS RDATE;
     ASCEND TO LDATER [ASCEND TO PDATE];
     STORE IN X-LNR;
     DO $MOVE-PDATE-TO-WHENS.
  $MOVE-PDATE-TO-WHENS =
     ELEMENT- ASSERTION OF X-PRE EXISTS;
     BEFORE VALUE OF ELEMENT- SA INSERT X-LNR, X-NEWDATE;
     REPLACE ELEMENT- RDATE OF X-NEWDATE BY <RDATE> (<NULL>);
     AFTER X-LNR INSERT ASSERTION OF X-PRE;
     AT X-LNR, GO RIGHT; STORE IN X-ASSRT;
     DO $STORE-WH-WORD;
     DO $SET-TFORM-ATT;
     REPLACE ELEMENT- RDATE OF X-LNR BY <RDATE> (<NULL>);
     TRANSFORM X-ASSRT.
  $PQUANT-TIME =
     ITERATE ASCEND TO PN OR PQUANT
     UNTIL BOTH DO $TEST-FOR-TIME-PHRASE
           AND EITHER IMMEDIATE LNR X-LNR EXISTS
               OR IMMEDIATE QN X-LNR EXISTS
     FAILS.
  $TEST-FOR-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.
  $FILLIN-TIME-SA =
     IF X-PRE IS WHENS
     THEN $MK-TIME-ADVERB;
     DO $DELETE-X-PRE;
     BEFORE LAST-ELEMENT- OF X-SA INSERT
        <PN> X-PN (<LP> (<NULL>)
                  +<P> X-P
                  +<NSTGO> (<NSTG> (X-LNR, X-NEWLNR)));
     IF IMMEDIATE PN X-TIME-PN OF X-LNR EXISTS
     THEN BOTH REPLACE X-P BY ELEMENT- P OF X-TIME-PN
          AND REPLACE ELEMENT- LP OF X-PN
              BY ELEMENT- LP OF X-TIME-PN
     ELSE IF X-PRE IS PWHERES [* 20000328 *]
          THEN REPLACE X-P BY ELEMENT- P OF X-PRE
          ELSE REPLACE X-P BY <P> = '[AT]': ('[AT]', H-TMPREP);
     IF X-TIME-ADV EXISTS
     THEN AT X-PN, ASSIGN NODE ATTRIBUTE ADVERBIAL-TYPE WITH
                   VALUE X-TIME-ADV.
  $PWHS =
     BOTH X-PRE IS PWHS
          WHERE EITHER EITHER VALUE IS P
                       OR VALUE IS 'DONT' [P French]
                OR SECOND ELEMENT IS 'WHICH' OR 'WHOM'
     AND ALL OF $LOCATE-SA, $FILLIN-SA, $DELETE-X-PRE, $TRANSFORM-ASSRT.
  $PWHS-PN =
     IF X-PRE IS PWHS-PN WHERE SECOND ELEMENT IS 'WHICH' OR 'WHOM'
     THEN ALL OF $MOVE-ASSN-UP, $FILLIN-WH-PN, $DELETE-X-PRE,
                 $TRANSFORM-ASSRT.
  $MOVE-ASSN-UP =
     AFTER IMMEDIATE LNR X-LNR OF X-PRE
           INSERT ASSERTION OF X-PRE;
     AT X-LNR, GO RIGHT; STORE IN X-ASSRT;
     DO $STORE-WH-WORD
    [EITHER X-PRE HAS NODE ATTRIBUTE DIDOMIT X-OMIT]
    [OR X-PRE HAS NODE ATTRIBUTE DIDOMPN X-OMIT]
     [X-OMIT now set at copy of NULLWH in the new ASSERTION];
     EITHER $SET-RNFILLIN OR $SET-TFORM-ATT.
  $STORE-WH-WORD = [* GRI *]
     BEFORE VALUE OF X-ASSRT INSERT VALUE OF X-PRE.
  $SET-RNFILLIN = [* added 11/9/95 to handle 'which was' CONN *]
     X-PRE IS WHS-N;
     EITHER ATTRIBUTE-LIST OF CORE- X-CORE OF VERB OF X-ASSRT
            HAS MEMBER H-CONN
     OR BOTH CORE-ATT X-CATT OF X-CORE HAS MEMBER VBE
        AND EITHER ATTRIBUTE-LIST OF DEEPEST-COVERB X-CORE OF
                   ELEMENT- OBJECT OF X-ASSRT HAS MEMBER H-CONN
            OR ATTRIBUTE-LIST OF ELEMENT- P X-CORE OF ELEMENT- PN
               OF ELEMENT- OBJBE OF ELEMENT- OBJECTBE OF
                  ELEMENT- OBJECT OF X-ASSRT HAS MEMBER H-CONN;
     CORE-ATT OF X-CORE DOES NOT HAVE MEMBER H-CONN;
      [* puts 'which were' into LP or LV of X-CORE *]
     AT X-CORE, IF GO LEFT WHERE PRESENT-ELEMENT- IS LV OR LP X-LP
                THEN IF X-LP IS EMPTY
                     THEN REPLACE X-LP BY
                          X-LP ('WHICH' + CORE- OF VERB OF X-ASSRT)
                     ELSE BEFORE VALUE OF X-LP INSERT
                          'WHICH' + CORE- OF VERB OF X-ASSRT;
     X-COREATT := LIST CONN-LIST;
     AT X-CORE, ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE X-COREATT;
     AT X-ASSRT, BOTH X-TFORM := SYMBOL TRNFILLIN
                 AND $ADD-TO-TFORM-ATT.
  $SET-TFORM-ATT =
     AT X-ASSRT, BOTH X-TFORM := SYMBOL TRNWH
                 AND $ADD-TO-TFORM-ATT.
  $FILLIN-WH =
     ITERATE AT IMMEDIATE-NODE- X-IMMEDIATE OF X-OMIT
             BOTH REPLACE X-OMIT [NULL WH]
                  BY <NSTG> (X-LNR [HOST LNR], X-NEWLNR)
             AND AT X-NEWLNR
                 DO $TRIM-LN-RN
     UNTIL BOTH X-IMMEDIATE HAS NODE ATTRIBUTE POSTCONJELEM
           @AND VALUE IS NULLWH X-OMIT FAILS.
  $TRIM-LN-RN =
     IF CORE- X-CORE [OF HOST LNR] HAS NODE ATTRIBUTE N-TO-LN-ATT
        X-COMP-ATT
     @THEN BOTH $LN-ATT AND $RN-NULL
     ELSE IF X-CORE HAS NODE ATTRIBUTE N-TO-RN-ATT X-COMP-ATT
          @THEN [BOTH] $RN-ATT [AND $LN-NULL]
          [* 10/22/96 -- keeps LN intact, and empties RN *]
          [* for 'the only one which lasted since May 22'*]
          [* 11/06/96 -- holds.                          *]
          ELSE $LN-RN-NULL [$RN-NULL].
  $LN-ATT =
     [* in LN at LXR causing COMPUTED ATTRIBUTE *]
     ASCEND TO TPOS OR APOS OR QPOS OR NPOS;
     STORE IN X-POS;
     IF BOTH X-POS IS NOT TPOS @AND COELEMENT- TPOS IS NOT EMPTY
     @THEN $TPOS-NULL;
     AT ELEMENT- QPOS OF IMMEDIATE LN OF X-POS
     ITERATE VERIFY IF PRESENT-ELEMENT- IS NOT X-POS
                    THEN REPLACE VALUE BY <NULL>
     UNTIL GO RIGHT FAILS;
     IF X-COMP-ATT IS LAR1 OR LQNR THEN $ADJADJ
     ELSE IF X-COMP-ATT IS NNN
          THEN $NPOS.
  $ADJADJ =
     BOTH REPLACE VALUE OF VALUE [ADJADJ] OF X-POS
          BY X-COMP-ATT
     AND DELETE X-COMP-ATT.
  $NPOS =
     REPLACE VALUE OF X-POS
     BY X-COMP-ATT.
  $TPOS-NULL =
     REPLACE VALUE [OF TPOS]
     BY <LTR> (<LT> (<NULL>)
              +<NULL>
              +<RT> (<NULL>)).
  $RN-NULL =
     AT X-NEWLNR
     IF ELEMENT- RN X-RN IS NOT EMPTY
     THEN REPLACE X-RN BY <RN> (<NULL>).
  $RN-ATT =
     ITERATE BOTH STORE IN X-IN-RN
             AND GO UP
     UNTIL PRESENT-ELEMENT- IS RN X-RN SUCCEEDS;
     REPLACE X-RN BY <RN> (<NULL>).
  $LN-NULL =
     AT X-NEWLNR
     IF ELEMENT- LN X-LN IS NOT EMPTY
     THEN REPLACE X-LN
          BY <LN> (<TPOS> (<LTR> (<LT> (<NULL>)
                                 +<NULL>
                                 +<RT> (<NULL>)))
                   +<QPOS> (<NULL>)
                   +<APOS> (<NULL>)
                   +<NPOS> (<NULL>)).
  $DELETE-X-PRE =
    [IF X-PRE IS WHS-N]
    [THEN DELETE IMMEDIATE-NODE OF X-PRE]
    [ELSE]
     DELETE X-PRE.
  $TRANSFORM-ASSRT =
     TRANSFORM X-ASSRT.
  $LOCATE-SA =
     AFTER IMMEDIATE LNR X-LNR OF X-PRE
     INSERT ASSERTION OF X-PRE, X-ASSRT;
     DO $STORE-WH-WORD;
     LAST-ELEMENT- OF X-ASSRT IS SA X-SA;
     DO $SET-TFORM-ATT.
  $FILLIN-SA =
     BEFORE LAST-ELEMENT- OF X-SA INSERT
       <PN> X-PN (<LP> (<NULL>)
                 +<P> X-P
                 +<NSTGO> (<NSTG> (X-LNR, X-NEWLNR)));
     IF X-PRE HAS ELEMENT- P X-COPYP
     THEN REPLACE X-P BY X-COPYP
     ELSE BOTH REPLACE X-P BY <P> = '[AT]': ('[AT]')
          AND DO $SA-TIME-ADV;
     AT X-NEWLNR, DO $TRIM-LN-RN.
  $SA-TIME-ADV = [*GRI*]
     IF BOTH CORE-ATT X-CORE OF CORE- OF X-NEWLNR HAS MEMBER
             NTIME1 OR H-TTGEN
        AND X-PRE IS WHENS [OR SUB1]
     THEN BOTH $MK-TIME-ADVERB
          AND AT X-PN, ASSIGN NODE ATTRIBUTE ADVERBIAL-TYPE WITH
                   VALUE X-TIME-ADV.
  $MK-TIME-ADVERB =
     X-TIME := SYMBOL TIME-ADVERBIAL;
     X-TIME-ADV := NIL;
     PREFIX X-TIME TO X-TIME-ADV.
  $FILLIN-WH-PN =
     REPLACE X-OMIT [NULLWH] BY
        <PN> (<LP> (<NULL>)
             + P OF X-PRE
             +<NSTGO> (<NSTG> (X-LNR, X-NEWLNR)));
     AT X-NEWLNR, DO $TRIM-LN-RN.
  $LN-RN-NULL =
     EITHER PRESENT-ELEMENT- IS LNR OR LWVR
     OR EITHER ELEMENT- LNR EXISTS
        OR ELEMENT- LWVR EXISTS;
     BOTH EITHER IF ELEMENT- RN IS NOT EMPTY
                @THEN REPLACE PRESENT-ELEMENT- BY <RN> (<NULL>)
          OR IF ELEMENT- RWV IS NOT EMPTY
            @THEN REPLACE PRESENT-ELEMENT- BY <RWV> (<NULL>)
     AND IF ELEMENT- LN IS NOT EMPTY
        @THEN REPLACE PRESENT-ELEMENT- BY
            <LN> (<TPOS> (<LTR> (<LT> (<NULL>)
                                +<NULL>
                                +<RT> (<NULL>)))
                 +<QPOS> (<NULL>)
                 +<APOS> (<NULL>)
                 +<NPOS> (<NULL>)).
* T-SIMPLIFY-PVINGO
*   PVINGO can be simplified if it is of the form
*      a history of [VINGO [VING increasing] [OBJECT dyspnea]...]
*   => a history of [LNR [ADJ increasing] dyspnea...]
*   where RV in LVINGR and LN in OBJECT:NSTGO:NSTG:LNR are empty.
*   to simply: PN:NSTGO of OBJECT, with LN:APOS:ADJADJ:LAR:AVAR:VING.
* --- To do:
*   ... she had one episode of coughing it up which was slightly pink.
T-SIMPLIFY-PVINGO = IN PVINGO:
    AT PRESENT-ELEMENT- X-PVINGO
    IF ALL OF $EMPTY-LVINGR-RN, $EMPTY-OBJECT-LN
    THEN ALL OF $MAKE-LAR, $MAKE-PN, $TRANSFER-ATTS, $DELETE-PVINGO.
 $EMPTY-LVINGR-RN =
    ELEMENT- RV OF ELEMENT- LVINGR X-VERB OF
             ELEMENT- VINGO X-VINGO IS EMPTY;
    CORE- X-VING OF X-VERB IS NOT EMPTY.
 $EMPTY-OBJECT-LN =
    ELEMENT- OBJECT X-OBJECT OF X-VINGO IS NOT EMPTY;
    EITHER VALUE OF X-OBJECT IS NSTGO X-NSTGO
    OR VALUE OF X-OBJECT IS DP3
       WHERE BOTH ELEMENT- DP X-DP EXISTS
             AND ELEMENT- NSTGO X-NSTGO EXISTS;
    ELEMENT- LN X-LN OF ELEMENT- LNR OF ELEMENT- NSTG IS EMPTY.
 $MAKE-LAR =
    REPLACE ELEMENT- APOS OF X-LN
    BY <APOS> (<ADJADJ> (<LAR> (<LA> (<NULL>)
                               +<AVAR> (X-VING)
                               +<RA> X-RA (<NULL>))));
    IF X-DP EXISTS THEN REPLACE X-RA BY X-RA (X-DP).
 $MAKE-PN =
    AFTER X-PVINGO INSERT <PN> X-PN (<LP> (<NULL>)
                                    + ELEMENT- P OF X-PVINGO
                                    + X-NSTGO).
 $TRANSFER-ATTS =
    IF X-PVINGO HAS NODE ATTRIBUTE PHRASE-ATT X-PHR-ATT
    THEN AT X-PN, ASSIGN NODE ATTRIBUTE PHRASE-ATT WITH VALUE X-PHR-ATT;
    IF X-PVINGO HAS NODE ATTRIBUTE ADVERBIAL-TYPE X-PHR-ATT
    THEN AT X-PN, ASSIGN NODE ATTRIBUTE ADVERBIAL-TYPE
         WITH VALUE X-PHR-ATT.
 $DELETE-PVINGO =
    BOTH DELETE X-PVINGO AND TRANSFORM X-PN.
* T-ONE-ANAPHORA
*    10/21/1996 FOR
*    "HE HAD A GENERALIZED SEIZURE WHICH INDEED IS THE ONLY ONE
*     HE HAD SINCE 05/22/00".
T-ONE-ANAPHORA = IN ASSERTION:
    IF $X-IS-THE-ONE
    THEN REPLACE X-OBJ BY X-SUBJ.
  $X-IS-THE-ONE =
    CORE- X-OBJ OF ELEMENT- OBJECT OF PRESENT-ELEMENT- X-ASSN
    IS 'ONE';
    CORE- OF ELEMENT- VERB OF X-ASSN IS VBE;
    CORE- X-SUBJ OF ELEMENT- SUBJECT OF X-ASSN IS N.
* ***** **********************************************************
*
*              S A   T R A N S F O R M A T I O N S
*
* ***** **********************************************************
* T-WHETHS
*    TRANSFORMS WHETHS IN SA TO A CSSTG IN WHICH WHETHS IS
*    EXPANDED INTO A CONJOINED ASSERTION WITH NEGATION ON THE SECOND
*    ASSERTION.
*  E.G. 'SHE BOUGHT THE BOOK WHETHER SHE NEEDED IT OR NOT' ==>
*       'SHE BOUGHT THE BOOK WHETHER SHE NEEDED IT OR NOT SHE NEEDED IT'
*    NODE ATTRIBUTE TFORM-ATT IS SET TO CONTAIN LIST WITH MEMBER
*    TWHETHS.
T-WHETHS = IN SA:
     AT PRESENT-ELEMENT- X-SA
     IF $TEST-FOR-WHETHS
     THEN ALL OF [$BUILD-ORSTG,] $BUILD-CSSTG, $SET-TFORM-ATT.
  $TEST-FOR-WHETHS =
     ELEMENT- WHETHS X-WHETHS OF ELEMENT- SAWH X-SAWH EXISTS.
  $BUILD-ORSTG =
     IF ELEMENT- ORNOT OF X-WHETHS EXISTS
    @THEN DELETE PRESENT-ELEMENT-;
     AFTER LAST-ELEMENT- OF X-WHETHS INSERT
       <ORSTG> X-ORSTG
               ('OR'
               +<SACONJ>
                  (<SA> (<DSTG> (<D>X-D='NOT':(NEGATIVE, H-NEG)
                                   ^((('NOT', D:(NEGATIVE, H-NEG))))
                                + ALL ELEMENTS OF X-WHETHS))));
     DO $ASSIGN-NEG [GLOBAL IN T-SANS];
     DELETE THIRD ELEMENT OF X-ORSTG.
  $BUILD-CSSTG =
     REPLACE X-SAWH
     BY <LCS> (<NULL>)
        +<CSSTG> X-CSSTG
              (<SUB13> X-SUB1
                       (<SUB1-PHRASE> (ALL ELEMENTS OF X-WHETHS)
                       +LAST-ELEMENT- [ASSERTION/TOVO] OF X-WHETHS));
    [REPLACE VALUE OF X-SUB1]
    [BY <CS1> X-CS1 = 'WHETHER':(CS1);]
    [IF FIRST ELEMENT OF X-WHETHS HAS NODE ATTRIBUTE WORD-POS X-WPOS]
    [THEN AT X-CS1 ASSIGN NODE ATTRIBUTE WORD-POS WITH VALUE X-WPOS]
     DELETE LAST-ELEMENT- OF ELEMENT- SUB1-PHRASE OF X-SUB1.
  $SET-TFORM-ATT =
     AT ELEMENT- ASSERTION OF X-SUB1
     BOTH X-TFORM := SYMBOL TWHETHS
     AND $ADD-TO-TFORM-ATT [GLOBAL IN T-NPVO].
* T-SAWHICHSTG
*    TRANSFORMS SAWHICHSTG INTO AN ASSERTION IN SA, DELETING
*    'WHICH' AND REPLACING THE NULLWH WITH THE HIGHER ASSERTION.  THE
*    LAST SA OF THE LOWER ASSERTION IS DELETED TO PREVENT REPETITION
*    OF SAWHICHSTG.
*       E.G. 'HE ARRIVES EARLY, WHICH IS USUAL' ==>
*            'HE ARRIVES EARLY, HE ARRIVES EARLY IS USUAL'
*    NODE ATTRIBUTE TFORM-ATT IS SET TO CONTAIN LIST WITH MEMBER TRNWH.
T-SAWHICHSTG = IN SA:
     AT PRESENT-ELEMENT- X-SA
     IF SAWHICHSTG X-SAWHICHSTG OF SAWH X-SAWH EXISTS
     THEN BOTH $SET-REGS
          AND ALL OF $BUILD-NEWASSERT,
                     $SET-TFORM-ATT,
                     $TRANSFORM-XASSERT.
  $SET-REGS =
     IMMEDIATE ASSERTION X-ASSERTHIGH EXISTS.
  $BUILD-NEWASSERT =
     X-SAWHICHSTG HAS NODE ATTRIBUTE DIDOMIT X-NULLWH;
     DO $FILLIN-NULLWH;
     DELETE VALUE OF X-SAWHSTG;
     REPLACE X-SAWH
     BY ALL ELEMENTS OF X-SAWHSTG;
     AT VALUE OF X-SA
     STORE IN X-ASSERT.
  $FILLIN-NULLWH =
     ITERATE AT IMMEDIATE-NODE- X-IMMED OF NULLWH
       BOTH REPLACE X-NULLWH
            BY X-ASSERTHIGH, X-TEMP
       AND DELETE 5TH SA OF X-TEMP
     UNTIL BOTH X-IMMED HAS NODE ATTRIBUTE POSTCONJELEM
          @AND VALUE IS NULLWH X-NULLWH  FAILS.
  $SET-TFORM-ATT =
     AT X-ASSERT, BOTH X-TFORM := SYMBOL TRNWH
                  AND $ADD-TO-TFORM-ATT [GLOBAL IN T-NPVO].
  $TRANSFORM-XASSERT =
     TRANSFORM X-ASSERT.
* ***** *****************************************************
*
*           L X R   T R A N S F O R M A T I O N S
*
* ***** *****************************************************
* T-NTIME1-EVENT
*      CONVERTS A 'NTIME1 OF EVENT' PHRASE
*      TO A       'EVENT FOR NTIME1' PHRASE.
*      I.E.       '2 DAYS OF FEVER' => 'FEVER [FOR] 2 DAYS'
*
T-NTIME1-EVENT = IN LNR:
       IF BOTH CORE-SELATT X-S OF CORE- X-CORE OF PRESENT-ELEMENT-
                 X-PRE HAS MEMBER NTIME1
          AND $RN-IS-EVENT
       THEN $TRANSFORM.
  $RN-IS-EVENT = RIGHT-ADJUNCT OF X-CORE IS PN X-PN;
        P X-PREP IS 'OF' OR 'DE';
        CORE-ATT X-ATT OF CORE- X-C OF NSTGO OF X-PN EXISTS;
        AT X-ATT DO IS-EVENT [IS A MED EVENT SUCH AS 'FEVER'];
        AT X-C IMMEDIATE LNR X-LXR EXISTS.
  $TRANSFORM = LN X-LN OF X-LXR EXISTS;
       BEFORE VALUE OF RN OF X-LXR INSERT
         <PN> (<P> = '[FOR]':('FOR')
              + <NSTGO>(<NSTG>(X-PRE, X-MOVED)));
        AT RN OF X-MOVED REPLACE PRESENT-ELEMENT- BY
         <RN>(<NULL>);
        IF IMMEDIATE-NODE- OF X-PRE IS NSTG WHERE IMMEDIATE-NODE- IS
            NSTGT
       @THEN REPLACE PRESENT-ELEMENT- BY <NSTG>(X-LXR, X-NEW)
             [remove NSTGT]
        ELSE REPLACE X-PRE BY X-LXR, X-NEW;
        TRANSFORM X-NEW.
* T-NOUN
*     STRIPS OFF PLURAL INTO A MARKER APPENDED AFTER THE N;  IT ALSO
*     REPLACES THE NOUN BY ITS CANONICAL FORM, SO THAT E.G. 'ADM' WILL
*     BE REPLACED BY 'ADMISSION'.
T-NOUN = IN LNR, NNN, QN, QNREP:
      IF ALL OF $FIND-N, $NO-PREFIXES
      THEN BOTH IF X10 HAS ATTRIBUTE PLURAL
                THEN $CHECK-FOR-Q
           AND EITHER $CLASS-REP OR TRUE.
  $CHECK-FOR-Q =
     IF X10 IS OCCURRING IN LNR
     THEN DO $CHK-LT.
  $CHK-LT=
      IF TPOS X12 OF LEFT-ADJUNCT X-LN OF X10 IS NOT EMPTY
      THEN IF VALUE OF LT OF LTR OF X12 IS LQR X-LQR
           THEN BOTH BEFORE VALUE OF QPOS OF X-LN INSERT X-LQR
                AND DELETE X-LQR [MOVE TO QPOS].
  $CLASS-REP =
     X-FREE := X10;
     DO $SET-REG-ATT [;]
    [REPLACE X10 BY CLASS N OF X10, X-CANON;]
    [DO $REASSIGN-ATT 20030805] [GLOBAL].
  $NO-PLURAL =
     IF R(N) OF X10 EXISTS
     @THEN PRESENT-ELEMENT- IS NOT 'PLURAL'.
  $FIND-N =
     EITHER PRESENT-ELEMENT- IS QN WHERE ELEMENT- N X10 EXISTS
     OR EITHER PRESENT-ELEMENT- IS QNREP
               WHERE Q-CONJ HAS ELEMENT- N X10
        OR CORE- X10 IS N.
  $NO-PREFIXES =
     IT IS NOT THE CASE THAT X10 HAS ATTRIBUTE PREFX.     (GLOBAL)
* T-LCDVA-N
*      CONVERTS AN N IN LCDVA OF AVAR IN LAR OR LAR1 INTO LNR.
*          E.G. 'TEETH CHATTERING CHILLS'
T-LCDVA-N = IN LAR1, LAR:
     IF VALUE OF ELEMENT- LCDVA X10 OF ELEMENT- AVAR IS N X11
     THEN BOTH REPLACE X10 [LCDVA]
               BY X10 (<LNR> (<LN> X15
                             +<NVAR> (X11 [N])
                             +<RN> (<NULL>)))
          AND BOTH $LN-MAKE [GLOBAL IN T-WHATS-N]
              AND TRANSFORM X10 [LCDVA].
* T-AFFIX-EXPAND
*    STRIPS NEGATIVE AFFIX AND MODAL AFFIX FROM ADJECTIVE OR VEN
*
T-AFFIX-EXPAND = IN LNR, LAR, LAR1:
     IF CORE X-CORE IS MORPH OR MODAL-AFFIX X-AFFIX
     THEN ALL OF $SAVE-ATTS, $MORPH-AFFIX [, $MODAL-AFFIX]
                 [$REASSIGN-ATT 20030805] [GLOBAL]
     ELSE IF BOTH X-CORE IS H-POST
             AND PRESENT-ELEMENT- IS NOT H-TMLOC
          THEN DO $POST-AFFIX.
  $SAVE-ATTS =
      X-FREE := X-CORE;
      DO $SET-REG-ATT [DO $GET-CLASS;].
  $POST-AFFIX =
     EITHER BOTH X-CORE IS N
            AND $TPOS-POST
     OR BOTH X-CORE IS ADJ
        AND $LAR-POST.
  $LAR-POST =
     X-CORE IS ADJ;
     AT X-CORE, LEFT-ADJUNCT-POS EXISTS WHERE STORE IN X-LA;
     IF X-LA IS EMPTY
     THEN REPLACE X-LA BY <LA> (<LDR> (<LD> (<NULL>)
                                      +<D> X-POST = 'POST-':(H-TMLOC)
                                      +<RD> (<NULL>)))
     ELSE AT ELEMENT- LDR OF X-LA
          BOTH AFTER LAST-ELEMENT- OF ELEMENT- LA
               INSERT CORE-
          AND REPLACE CORE- BY <D> X-POST = 'POST-':(H-TMLOC);
     DO $POST-SEL-ATT.
  $TPOS-POST =
     AT X-CORE, LEFT-ADJUNCT-POS EXISTS WHERE ELEMENT- TPOS EXISTS;
     IF PRESENT-ELEMENT- IS EMPTY
     THEN REPLACE PRESENT-ELEMENT-
          BY <TPOS> (<LTR> (<LT> (<NULL>)
                           +<T> X-POST = 'POST-':(H-TMLOC)
                           +<RT> (<NULL>)))
     ELSE AFTER CORE- OF ELEMENT- LTR
          INSERT <RT> (<D> X-POST = 'POST-':(H-TMLOC));
     DO $POST-SEL-ATT.
  $POST-SEL-ATT =
     X-MOD-ATTRB := NIL;
     X-TMLOC := SYMBOL H-TMLOC;
     PREFIX X-TMLOC TO X-MOD-ATTRB;
     AT X-POST, ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE
                   X-MOD-ATTRB.
  $MORPH-AFFIX =
     X-MORPH := ATTRIBUTE-LIST OF X-AFFIX;
     X-SECOND-MORPH := SUCCESSORS OF X-MORPH;
     X-SUBLIST := X-SECOND-MORPH;
     X-FIRST-MORPH := COMPLEMENT OF X-MORPH;
     ONE OF $NEG-AFFIX, $PT-AFFIX.
  $NEG-AFFIX =
     IF EITHER BOTH AT X-FIRST-MORPH DO $IT-IS-NEG
               AND X-HEAD := X-SECOND-MORPH
        OR BOTH AT X-SECOND-MORPH DO $IT-IS-NEG
           AND X-HEAD := X-FIRST-MORPH
     THEN ONE OF $LNR-NEG, $LAR-NEG.
  $IT-IS-NEG =
     STORE IN X-MOD;
     BOTH ATTRIBUTE-LIST X-MOD-ATTRB OF X-MOD EXISTS
     AND X-MOD-ATTRB HAS MEMBER H-NEG.
  $LNR-NEG =
     X-CORE IS N;
     BOTH DO $PYREXIA
     AND DO $TPOS-NEG.
  $PYREXIA =
     BOTH X-HEAD HAS MEMBER 'PYREXIA'
     AND REPLACE X-CORE BY <N> X-NCORE = 'PYREXIA':(H-INDIC).
  $TPOS-NEG =
     AT X-NCORE, LEFT-ADJUNCT-POS EXISTS WHERE ELEMENT- TPOS EXISTS;
     IF PRESENT-ELEMENT- IS EMPTY
     THEN REPLACE PRESENT-ELEMENT-
          BY <TPOS> (<LTR> (<LT> (<NULL>)
                           +<T> X-T = 'NIL'
                           +<RT> (<NULL>)))
     ELSE AFTER CORE- OF ELEMENT- LTR
          INSERT <RT> (<D> X-T = 'NIL');
     ONE OF $A, $AN, $UN, $NON, $FREE, $LESS;
     AT X-NEG, ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE
                   X-MOD-ATTRB.
  $A = X-MOD HAS MEMBER 'A-';
       IF X-T IS T
       THEN REPLACE X-T BY <T> X-NEG = 'A-': (H-NEG)
       ELSE REPLACE X-T BY <D> X-NEG = 'A-': (H-NEG).
  $AN = X-MOD HAS MEMBER 'AN-';
        IF X-T IS T
        THEN REPLACE X-T BY <T> X-NEG = 'AN-': (H-NEG)
        ELSE REPLACE X-T BY <D> X-NEG = 'AN-': (H-NEG).
  $UN = X-MOD HAS MEMBER 'UN-';
        IF X-T IS T
        THEN REPLACE X-T BY <T> X-NEG = 'UN-': (H-NEG)
        ELSE REPLACE X-T BY <D> X-NEG = 'UN-': (H-NEG).
  $NON = X-MOD HAS MEMBER 'NON-' OR 'NON' OR 'NON_';
         IF X-T IS T
         THEN REPLACE X-T BY <T> X-NEG = 'NON-': (H-NEG)
         ELSE REPLACE X-T BY <D> X-NEG = 'NON-': (H-NEG).
  $FREE = X-MOD HAS MEMBER '-FREE';
          IF X-T IS T
          THEN REPLACE X-T BY <T> X-NEG = '-FREE': (H-NEG)
          ELSE REPLACE X-T BY <D> X-NEG = '-FREE': (H-NEG).
  $LESS = X-MOD HAS MEMBER '-LESS';
          IF X-T IS T
          THEN REPLACE X-T BY <T> X-NEG = '-LESS': (H-NEG)
          ELSE REPLACE X-T BY <D> X-NEG = '-LESS': (H-NEG).
  $PT-AFFIX =
     IF X-FIRST-MORPH IS NOT NIL
     THEN DO $AFFIX-MOD.
  $AFFIX-MOD =
     X-MOD-ATTRB := ATTRIBUTE-LIST OF X-FIRST-MORPH;
     X-CORE IS N;
     LEFT-ADJUNCT-POS EXISTS WHERE ELEMENT- NPOS X-NPOS EXISTS;
     EITHER BOTH CORE- X-NNN EXISTS
            AND REPLACE X-NPOS BY
                <NPOS> (<NNN> (ALL ELEMENTS OF X-NPOS)
                       +<N> X-NNN = 'NIL')
     OR REPLACE PRESENT-ELEMENT- BY <NPOS> (<N> X-NNN = 'NIL');
     BOTH ONE OF $HSM, $RRR
     AND AT X-NMOD, ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE
                   X-MOD-ATTRB.
  $HSM =
     BOTH X-FIRST-MORPH HAS MEMBER 'LIVER,SPLEEN'
     AND REPLACE X-NNN BY <N> X-NMOD = 'LIVER,SPLEEN':(H-PTPART).
  $RRR =
     BOTH X-FIRST-MORPH HAS MEMBER 'RATE,RHYTHM'
     AND REPLACE X-NNN BY <N> X-NMOD = 'RATE,RHYTHM':(H-PTFUNC).
  $LAR-NEG =
     X-CORE IS ADJ;
     X-HEAD-ATTR := ATTRIBUTE-LIST OF X-HEAD;
     ONE OF $DYSPLASTIC, $EDENTULOUS, $EROSIVE, $FEBRILE, $INFLAMED,
            $ICTERIC, $INVASIVE, $LABORED, $OBSTRUCTED, $OBSTRUCTIVE,
            $PAINFUL, $PATHOGENIC, $PRURITIC, $PYREXIA, $PYREXIAL,
            $SYMPTOMATIC, $TRAUMATIC, $TENDER, $SEIZURE, $ANGINA,
              [* from glcb texts *]
            $PO, $CYANOSED, $DEFORMING, $DISTENDED, $INFECTIOUS;
     AT X-ACORE, BOTH ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE
                      X-HEAD-ATTR
                 AND LEFT-ADJUNCT-POS EXISTS WHERE STORE IN X-LA;
     IF X-LA IS EMPTY
     THEN REPLACE X-LA BY <LA> (<LDR> (<LD> (<NULL>)
                                      +<D> X-T = 'NIL'
                                      +<RD> (<NULL>)))
     ELSE
          AT ELEMENT- LDR OF X-LA
          BOTH AFTER LAST-ELEMENT- OF ELEMENT- LA
               INSERT CORE-
          AND REPLACE CORE- BY <D> X-T = 'NIL';
     ONE OF $A, $AN, $UN, $NON, $FREE, $LESS;
     AT X-NEG, ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE
               X-MOD-ATTRB.
  $ANGINA =
    BOTH X-HEAD HAS MEMBER 'ANGINA'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'ANGINA':(H-INDIC).
  $CYANOSED =
    BOTH X-HEAD HAS MEMBER 'CYANOSED'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'CYANOSED':(H-INDIC).
  $DEFORMING =
    BOTH X-HEAD HAS MEMBER 'DEFORMING'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'DEFORMING':(H-INDIC).
  $DISTENDED =
    BOTH X-HEAD HAS MEMBER 'DISTENDED'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'DISTENDED':(H-INDIC).
  $INFLAMED =
    BOTH X-HEAD HAS MEMBER 'INFLAMED'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'INFLAMED':(H-INDIC).
  $INFECTIOUS =
    BOTH X-HEAD HAS MEMBER 'INFECTIOUS'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'INFECTIOUS':(H-INDIC).
  $PO =
    BOTH X-HEAD HAS MEMBER 'P.O.' OR 'PO'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'P.O.':(H-INDIC).
  $DYSPLASTIC =
    BOTH X-HEAD HAS MEMBER 'DYSPLASTIC'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'DYSPLASTIC':(H-INDIC).
  $EROSIVE =
    BOTH X-HEAD HAS MEMBER 'EROSIVE'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'EROSIVE':(H-INDIC).
  $EDENTULOUS =
    BOTH X-HEAD HAS MEMBER 'EDENTULOUS'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'EDENTULOUS':(H-INDIC).
  $FEBRILE =
    BOTH X-HEAD HAS MEMBER 'FEBRILE'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'FEBRILE':(H-INDIC).
  $ICTERIC =
    BOTH X-HEAD HAS MEMBER 'ICTERIC'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'ICTERIC':(H-INDIC).
  $INVASIVE =
    BOTH X-HEAD HAS MEMBER 'INVASIVE'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'INVASIVE':(H-INDIC).
  $LABORED =
    BOTH X-HEAD HAS MEMBER 'LABORED'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'LABORED':(H-INDIC).
  $OBSTRUCTIVE =
    BOTH X-HEAD HAS MEMBER 'OBSTRUCTIVE'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'OBSTRUCTIVE':(H-INDIC).
  $OBSTRUCTED =
    BOTH X-HEAD HAS MEMBER 'OBSTRUCTED'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'OBSTRUCTED':(H-INDIC).
  $PAINFUL =
    BOTH X-HEAD HAS MEMBER 'PAINFUL'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'PAINFUL':(H-INDIC).
  $PATHOGENIC =
    BOTH X-HEAD HAS MEMBER 'PATHOGENIC'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'PATHOGENIC':(H-INDIC).
  $PRURITIC =
    BOTH X-HEAD HAS MEMBER 'PRURITIC'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'PRURITIC':(H-INDIC).
  $PYREXIAL =
    BOTH X-HEAD HAS MEMBER 'PYREXIAL'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'PYREXIAL':(H-INDIC).
  $SYMPTOMATIC =
    BOTH X-HEAD HAS MEMBER 'SYMPTOMATIC'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'SYMPTOMATIC':(H-INDIC).
  $SEIZURE =
    BOTH X-HEAD HAS MEMBER 'SEIZURE'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'SEIZURE':(H-INDIC).
  $TENDER =
    BOTH X-HEAD HAS MEMBER 'TENDER'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'TENDER':(H-INDIC).
  $TRAUMATIC =
    BOTH X-HEAD HAS MEMBER 'TRAUMATIC'
    AND REPLACE X-CORE BY <ADJ> X-ACORE = 'TRAUMATIC':(H-INDIC).
* T-TIME-PREFIX
*    CHECKS FOR TIME EXPRESSION ADJUNCTS (E.G. 'NEONATAL'
*    OR 'POST-OPERATIVELY'); WHEN IT FINDS ONE, IT LOOKS
*       1.  FOR DSTG - FOR IMMEDIATE RV OR SA WHICH CAN ACCOMODATE A PN
*       2.  FOR LAR1 - FOR RN OF HOST, WHICH CAN ACCOMODATE A PN
*       3.  FOR LAR IN ADJINRN - FOR IMMEDIATE RN
*       4.  FOR LAR IN ASTG - FOR IMMEDIATE OBJBE WHICH CAN HAVE A PN
*     IT THEN ADDS TO THE RN OR OBJBE OR RV OR SA (STORED IN X2)
*     A PN WHERE PREP = PREFIX (MARKED AS H-TMPREP FOR FORMATTING)
*     AND N = CLASS NOUN OF THE ADJ OR D; THE ORIGINAL PREFIXED WORD
*     IS THEN DELETED.
*          E.G. 'NEONATAL' ==> (P ='NEO') 'BIRTH'
*               'POST-OPERATIVE' ==>  (P = 'POST') 'OPERATION'
T-TIME-PREFIX = IN LAR1, LAR, DSTG:
     IF BOTH CORE- X5 IS TIME-PREFIX
        AND BOTH IMMEDIATE-NODE IS NOT ADJADJ
            AND IF ELEMENT- LCDA OF AVAR EXISTS
               @THEN PRESENT-ELEMENT IS EMPTY
                ELSE NOT ELEMENT- DSTG EXISTS
     THEN ALL OF $FIND-HOST, $MAKE-PN, $PREFIX, $ERASE.
  $FIND-HOST =
     EITHER PRESENT-ELEMENT- IS DSTG
            WHERE PRESENT-ELEMENT- HAS IMMEDIATE RN OR SA X2
     OR EITHER BOTH PRESENT-ELEMENT- IS LAR1
               AND COELEMENT- RN X2 OF IMMEDIATE LN EXISTS
        OR EITHER IMMEDIATE ADJINRN EXISTS
                  WHERE IMMEDIATE RN X2 EXISTS
           OR IMMEDIATE ASTG HAS IMMEDIATE OBJBE X2.
  $MAKE-PN =
     BEFORE LAST-ELEMENT- OF X2 [RN OR OBJBE]
     INSERT <PN> X-PN (<LP> (<NULL>)
                      +<P> X4
                      +<NSTGO> (<NSTG> (<LNR> (<LN> X15
                                              +<NVAR> (X5, X-FREE)
                                              +<RN> (<NULL>)))));
     DO $LN-MAKE [GLOBAL IN T-WHATS-N];
     DO $SET-NODE-ATT;
     EITHER $REPLACE-CLASS OR TRUE.
  $REPLACE-CLASS =
     DO $SET-REG-ATT [;]
    [REPLACE X-FREE BY CLASS N OF X-FREE, X-CANON;]
    [DO $REASSIGN-ATT 20030805] [GLOBAL].
  $SET-NODE-ATT =
     X-ADVATT := NIL;
     X-RNATT := SYMBOL TIME-ADVERBIAL;
     PREFIX X-RNATT TO X-ADVATT;
     AT X-PN ASSIGN PRESENT ELEMENT NODE ATTRIBUTE
                    ADVERBIAL-TYPE WITH VALUE X-ADVATT.
  $PREFIX =
     IF X5 IS TIME-PREFIX: PRE
     THEN REPLACE X4 [P] BY <P> = PRE: (H-TMPREP)
     ELSE IF X5 IS TIME-PREFIX: POST
          THEN REPLACE X4 [P] BY <P> = POST: (H-TMPREP)
          ELSE REPLACE X4 [P] BY <P> = NEO: (H-TMPREP).
  $ERASE = DELETE PRESENT-ELEMENT.
* T-ADJ
*     REPLACES ADJECTIVE BY ITS CANONICAL FORM.
T-ADJ = IN LAR, LAR1:
     IF BOTH CORE- X10 IS ADJ AND $NO-PREFIXES
     THEN EITHER $CLASS-REP OR TRUE.
   $CLASS-REP = TRUE
    [X-FREE := X10;]
    [DO $SET-REG-ATT;]
    [REPLACE X10 BY CLASS ADJ OF X10, X-CANON;]
    [DO $REASSIGN-ATT 20030805] [GLOBAL].
* T-VENAPOS
*     FLIPS VEN'S IN APOS INTO AN ADJINRN IN RN SO T-RN-FILLIN
*     CAN EXPAND THE HOST NOUN + VEN INTO AN ASSERTION.
*     E.G. 'HIS INJURED FOOT' ==> 'HIS FOOT INJURED'
*             LATER BY T-RN-FILLIN:
*          'HIS FOOT INJURED' ==> 'HIS FOOT (FOOT BE INJURED)'
T-VENAPOS = IN LAR1:
     AT PRESENT-ELEMENT- X1
     IF BOTH CORE- X2 IS VEN AND $CHECK-COOC
     THEN BOTH $LCDVA AND $PUT-IN.
  $CHECK-COOC =
     [VEN IN APOS NOT INVOLVED IN COMPUTED-ATT CONSTRUCTION]
     IT IS NOT THE CASE THAT HOST- HAS NODE ATTRIBUTE N-TO-LN-ATT
        WHERE PRESENT-ELEMENT- [LAR1] IS IDENTICAL TO X1.
  $LCDVA =
     IF COELEMENT- LCDVA X3 OF X2 IS NOT EMPTY
     THEN BOTH LA X4 OF X1 [LAR1] IS EMPTY
          AND REPLACE VALUE OF X4 BY <DSTG> (VALUE OF X3 [LCDVA]).
  $PUT-IN =
       IF CORE-SELATT X-SEL OF X2 HAS MEMBER H-TMBEG OR H-TMEND OR
                      H-CHANGE OR H-CHANGE-MORE OR H-CHANGE-LESS OR
                      H-CHANGE-SAME
       THEN $CHANGE-TO-N-RN
       ELSE IF $IS-SIG [*** SUBLANGUAGE DEPENDENT ***]
                       [DO NOT CREATE XTRA ASSERTION FOR MODS ONLY]
            THEN $MOVE-TO-RN
            ELSE TRUE.
  $IS-SIG = BOTH X-SEL HAS MEMBER SIG-CLASS
            AND IF X-SEL HAS MEMBER MOD-CLASS
                THEN BOTH X-SUBLIST:= LIST MOD-CLASS
                     AND COMPLEMENT OF X-SEL IS NOT NIL [THERE IS ANOTHER
                       SIGN. SUBCLASS OTHER THAT MOD ONE].
  $MOVE-TO-RN =
     ASCEND TO LNR PASSING THROUGH LN;
     BEFORE LAST-ELEMENT- OF ELEMENT- RN
     INSERT <VENPASS>
              (<LVSA> (<NULL>)
              +<LVENR> (<LV> (VALUE OF ELEMENT- LA OF X1 [LAR1])
                       +X2 [VEN]
                       +<RV> (VALUE OF RA1 OF X1))
              +<SA> (<NULL>)
              +<PASSOBJ> (<NULLOBJ>)
              +<RV> (<NULL>)
              +<SA> (<NULL>));
     REPLACE X1 BY <NULL>.
  $CHANGE-TO-N-RN = ['NO INCREASED PAIN' => 'NO INCREASE IN PAIN']
       AT IMMEDIATE LN X-LN, IMMEDIATE LNR X-LNR EXISTS;
       AT X-LN DO R(RN);
       REPLACE PRESENT-ELEMENT- BY
         <RN> X-RN (<PN> (<LP> (<NULL>)
                         +<P> = '[IN]':('[IN]')
                         +<NSTGO> (<NSTG> (X-LNR, X-NEWLNR))));
       AT X-NEWLNR, ELEMENT LN X15 EXISTS;
       DO $LN-MAKE [GLOBAL IN T-WHATS-N, MAKE LN EMPTY];
       AT X-LN DO R(NVAR);
       CORE- X10 EXISTS [REPLACE BY CLASS V OF VEN];
       X-FREE:= X2;
       DO $SET-REG-ATT [;]
      [REPLACE X10 BY CLASS V OF X2, X-CANON;]
      [DO $REASSIGN-ATT 20030805] [GLOBAL];
       REPLACE X2 BY <NULL>;
       AT X-CANON, ASSIGN NODE ATTRIBUTE N-TO-RN-ATT WITH VALUE
                     X-NEWLNR;
       IF CORE-ATT X-TEMP OF CORE- OF X-NEWLNR IS NOT NIL
       THEN AT X-CANON, ASSIGN NODE ATTRIBUTE COMPUTED-ATT WITH
                      VALUE X-TEMP.
* ***** ********************************************************
*
*             L N   T R A N S F O R M A T I O N S
*
* ***** ********************************************************
* T-MOVE-ADJ
*     REPLACES T-COMPOUND-ADJ
*     MOVES ADJECTIVES IN LN TO ADJINRN IF -
*       (1) THE HOST IS H-PT, H-PTPART, OR H-PTAREA,
*       (2) THE ADJECTIVE IS NOT PART OF A COMPUTED ATTRIBUTE,
*       (3) IT IS ON THE SIG-CLASS LIST.
*     ADJECTIVES ARE FLIPPED SO THAT THEIR ORDERING IS THE SAME.
*     EX.  'ANXIOUS, NERVOUS, DEPRESSED PATIENT' =>
*          'PATIENT ANXIOUS, NERVOUS, DEPRESSED'
*     T-RN-FILLIN WILL EXPAND THESE ADJECTIVES LATER.
T-MOVE-ADJ = IN ADJADJ:
      AT PRESENT-ELEMENT- X1
      IF BOTH IMMEDIATE LNR X3 OF IMMEDIATE LN EXISTS
         AND $OK-CONDITIONS
      THEN BOTH ITERATE $CHK-MOVE
                UNTIL VALUE OF X1 IS ADJADJ X1 FAILS
           AND $FIXUP-ADJADJ.
  $OK-CONDITIONS =
      BOTH $HOST-TYPE AND $CHECK-TOP.
  $HOST-TYPE = CORE-SELATT X-SEL OF CORE- X6 OF X3 [LNR] HAS MEMBER
                                      H-PT OR H-PTPART OR H-PTAREA.
  $CHECK-TOP = [TOPMOST ADJADJ HANDLES ALL ADJ]
      IMMEDIATE-NODE IS NOT ADJADJ.
  $CHK-MOVE =
      IF ALL OF $CHECK-LAR1, $NOT-COMP-ATT, $IS-SIG-CLASS,
                $NOT-FAIL-SEL, $NOT-ADJUNCT-TYPE
      THEN $CREATE-ADJINRN.
  $CHECK-LAR1 = ELEMENT- LAR1 X2 OF X1 [ADJADJ] EXISTS.
  $NOT-COMP-ATT=
      IF X6 HAS NODE ATTRIBUTE N-TO-LN-ATT X-CA
      THEN IF X2 [LAR1] IS IDENTICAL TO X-CA
           THEN $CHK-HOST-OF-LNR.
  $CHK-HOST-OF-LNR =
      IF X-SEL HAS MEMBER H-PTPART
      THEN BOTH IMMEDIATE PN OF X3 EXISTS
                WHERE CORE-SELATT X-SEL OF HOST- EXISTS
           AND X-SEL HAS MEMBER H-TXVAR OR H-TTSURG OR H-TXPROC.
  $IS-SIG-CLASS =
      IF CORE-SELATT X-S OF CORE- X-ADJ-CORE OF X2 EXISTS
      THEN BOTH X-S HAS MEMBER SIG-CLASS
           AND X-S DOES NOT HAVE MEMBER H-PTPART OR
                             H-PTAREA OR H-PTLOC OR NUNIT.
  $NOT-FAIL-SEL =
      X-ADJ-CORE DOES NOT HAVE NODE ATTRIBUTE FAIL-SEL.
  $NOT-ADJUNCT-TYPE =
      X-ADJ-CORE DOES NOT HAVE NODE ATTRIBUTE ADVERBIAL-TYPE
      WHERE PRESENT-ELEMENT HAS MEMBER ADJUNCT-TYPE.
  $CREATE-ADJINRN =
      BEFORE VALUE OF ELEMENT- RN OF X3 [LNR] INSERT
          <ADJINRN> (<LAR> X-NEW (ALL ELEMENTS OF X2));
      DO $RA1-TO-RA;
      REPLACE X2 BY <NULL>.
  $RA1-TO-RA =
      REPLACE RA1 X-RA OF X-NEW BY
           <RA> (ALL ELEMENTS OF X-RA).
  $FIXUP-ADJADJ =
      EITHER ITERATE ASCEND TO ADJADJ
      OR TRUE [START AT TOPMOST];
      STORE IN X1;
      DO $CHK-ADJADJ.
  $CHK-ADJADJ =
      IF AT VALUE OF X1 COELEMENT- NULL EXISTS
     @THEN DELETE PRESENT-ELEMENT;
      IF X1 HAS VALUE NULL
      THEN IMMEDIATE-NODE- X1 OF X1 EXISTS
           WHERE AT VALUE DELETE PRESENT-ELEMENT- X1;
      IF VALUE OF X1 IS ADJADJ X1
      THEN $CHK-ADJADJ
      ELSE IF VALUE OF X1 IS NULL
           THEN REPLACE X1 BY <NULL>.
* T-CONN-LN-N
*    IF CORE- OF NPOS OR APOS HAS NODE ATTRIBUTE CONN-TYPE,
*    CREATE AN RN=PN=P=('PREP-CONN':H-CONN)
*                    +NSTGO = (CONTENTS OF LN)
*    FROM IT AND DELETES APOS OR NPOS.
*    'PENICILLIN REACTION' IS CHANGED TO 'REACTION PREP-CONN PENICILLIN';
*    'HEADACHE MEDICATION' IS CHANGED TO 'MEDICATION PREP-CONN HEADACHE'.
*    THE NODE ATTRIBUTE CONN-TYPE IS ASSIGNED TO CORE- OF NPOS, APOS BY
*    SELECTION TSEL-NVAR-NPOS USING LIST N-NPOS, OR TSEL-NVAR-APOS
*       USING N-ADJ LIST.
T-CONN-LN-N = IN LN:
       PRESENT-ELEMENT- X-PRE EXISTS;
       IF EITHER AT CORE OF APOS DO $CONN-TYPE-CHK
          OR AT CORE OF NPOS DO $CONN-TYPE-CHK
       THEN $LN-TO-PN [MOVE LN TO LN IN LNR IN NEW PN].
  $CONN-TYPE-CHK =
       BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE ADVERBIAL-TYPE
                WHERE PRESENT-ELEMENT- HAS MEMBER CONN-TYPE
       AND ERASE NODE ATTRIBUTE ADVERBIAL-TYPE
               [REMOVE PRESENT-ELEMENT BEFORE MAKING INTO PN].
  $LN-TO-PN =
       RIGHT-ADJUNCT-POS X-RN OF HOST- EXISTS;
       BEFORE VALUE OF X-RN INSERT
              <PN>X-PN (<P> = 'PREP-CONN' : (H-CONN)
                       +<NSTGO> (<NSTG>
                                    (<LNR>X-LNR
                                        (<LN>(ALL ELEMENTS OF X-PRE)
                                        +<NVAR> (<NULLN>)
                                        +<RN> (<NULL>)))));
       AT APOS OF X-PRE REPLACE VALUE BY <NULL>;
       X-CONN-TYPE := LIST CONN-TYPE-LIST;
       AT X-PN ASSIGN NODE ATTRIBUTE ADVERBIAL-TYPE
                      WITH VALUE X-CONN-TYPE;
       TRANSFORM X-PN.
* T-QUANT-OF
*     TRANSFORM STRUCTURES OF THE TYPE 'MANY OF THE PATIENTS',
*     'SOME OF THE NEW PEOPLE', ETC. REARRANGING STRUCTURE SO THAT
*     THE QUANTIFIER BECOMES A MODIFIER IN LN OF THE REAL HEAD N
*     (E.G. 'PATIENTS', 'PEOPLE').
*     1. IF THE NOUN IS NULLN, IT SEARCHES FOR 'SOME' OR Q IN LN AND
*        RN = OF + N;
*    2. $CHECK-EMPTY CHECKS THAT ALL OTHER POSITIONS IN LN ARE EMPTY;
*        ASSUMES THERE IS NO INFORMATION IN UPPER LN OTHER THAN
*        QUANTIFIER INFORMATION (E.G. '*SEVERAL NEW OF THE PATIENTS).
*        IT WILL FAIL IF THIS IS NOT TRUE--WITH THE EXCEPTION OF 'A' IN
*        IN TPOS WHERE Q = 'FEW'; IN THIS CASE, 'A' IS INSERTED BEFORE 'FEW';
*    3.  IT MOVES THE QUANTIFIER + OF FOUND IN STEP 1 TO QPOS OF THE LNR
*        IN RN;
*        IF QPOS IS FILLED [E.G. 'SOME OF THE 10 PEOPLE], $MOVE-QPOS MOVES
*        MATERIAL IN QPOS INTO A SEPARATE SENTENCE:
*        'SOME OF THE PEOPLE SUCH THAT PEOPLE NUMBER 10', WHERE OBJECT
*        IS ASTG(LQR).
*     4.  IT PROMOTES THE LNR IN PN TO A HIGHER LEVEL TO REPLACE THE
*         ORIGINAL LNR = NULLN.
T-QUANT-OF = IN LN:
     IF BOTH CORE- OF COELEMENT- NVAR X7 IS NULLN
        AND BOTH EITHER LTR X8 OF TPOS X6 SUBSUMES 'SOME' OR 'QUELQUES'
                        OR 'QUELQUE'
                 OR LQR X8 OF QPOS X6 EXISTS
            AND $CHECK-PN
     THEN BOTH $CHECK-EMPTY AND $X-MOVE.
  $CHECK-PN = COELEMENT- RN X9 HAS ELEMENT- PN X10
              WHERE ELEMENT- P IS 'DE' OR 'OF'.
  $CHECK-EMPTY =
     AT VALUE
     ITERATE VERIFY EITHER TEST FOR X6
                    OR EITHER PRESENT-ELEMENT- IS EMPTY
                       OR PRESENT-ELEMENT- IS TPOS X5
                              WHERE CORE- X-A IS 'UN' OR 'UNE' OR 'A'
     UNTIL GO RIGHT FAILS.
  $X-MOVE =
     AT NSTGO OF X10 [PN IN RN]
     DESCEND TO LNR;
     STORE IN X11;
     ALL OF $TPOS, $QPOS, $REPLACE-NSTG.
  $TPOS =
     IF BOTH EITHER CORE- X-TCORE OF TPOS X-TPOS
                    OF ELEMENT- LN X-LN IS NULL
             OR X-TCORE IS 'THE' OR 'LE' OR 'LA' OR 'LES'
        AND EITHER X-A IS 'A' OR 'UN' OR 'UNE' OR 'DE'
            OR X6 SUBSUMES 'SOME'
     THEN BOTH COELEMENT- LT OF X-TCORE IS EMPTY
          AND IF X-A EXISTS
              THEN REPLACE X-TPOS [lower TPOS]
                   BY X5 [higher TPOS]
              ELSE [X6 is 'SOME']
                   REPLACE X-TCORE BY <NULL>
     [ELSE]
     [* CORE- OF TPOS IS TPOSS AND DO NOT REPLACE      *]
     [* ARTICLE; ORIGINAL ARTICLE 'A' WILL BE DELETED  *]
     [* WHEN NSTG REPLACED *].
  $QPOS =
     IF QPOS X12 OF X-LN IS NOT EMPTY
     THEN $X-MOVE-QPOS;
     REPLACE VALUE OF X12 [QPOS]
     BY <LQR> X13 (ALL ELEMENTS OF X8);
     AFTER CORE- OF X13
     INSERT <N> = '[OF]'.
  $REPLACE-NSTG =
     AT IMMEDIATE NSTG X14 OF X7 [NVAR = NULLN]
     REPLACE VALUE BY ALL ELEMENTS OF IMMEDIATE-NODE- OF X11
     [LNR IN PN];
     TRANSFORM VALUE OF X14 [NSTG].
  $X-MOVE-QPOS =
     AFTER X11 [LNR]
     INSERT <ASSERTION> X16
              ( <SA> (<NULL>)
              + <SUBJECT> (<NSTG> (X11, X17 [HOST LNR]))
              + <SA> (<NULL>)
              + <NEG> (<NULL>)
              + <TENSE> (<NULL>)
              + <SA> (<NULL>)
              + <VERB> (<LV> (<NULL>)
                       +<VVAR> (<V> = '[NUMBER]')
                       +<NEGV> (<NULL>)
                       +<RV> (<NULL>))
              + <SA> (<NULL>)
              + <OBJECT> (<ASTG> (LQR OF X12 [QPOS]))
              + <RV> (<NULL>)
              + <SA> (<NULL>));
     REPLACE VALUE OF ELEMENT- QPOS OF ELEMENT- LN OF X17 [SUBJECT
                   LNR OF NEW ASSERTION]
     BY <NULL>;
     BOTH $SET-TFORM-ATT
     AND TRANSFORM X16 [NEW ASSERTION].
  $SET-TFORM-ATT =
     AT X16 [NEW ASSERTION]
     BOTH X-TFORM := SYMBOL TRNFILLIN
     AND $ADD-TO-TFORM-ATT.
* T-LCDN-A
*     CONVERTS AN ADJECTIVE IN LCDN OF NNN TO LAR1.
T-LCDN-A = IN NNN:
    IF VALUE OF ELEMENT- LCDN X-LCDN IS ADJ X-ADJ
    THEN BOTH REPLACE X-ADJ
              BY <LAR1> (<LA> (<NULL>)
                        +<AVAR> (X-ADJ)
                        +<RA1> (<NULL>))
         AND TRANSFORM X-LCDN.
* T-MONTH
*     REPLACES NOUN IN DAYYREAR WITH CLASS NOUN.
T-MONTH = IN LDATER:
     IF  VALUE OF ELEMENT DAYYEAR IS N X10
     @THEN EITHER $CLASS-REP OR TRUE.
  $CLASS-REP =
     X-FREE := X10;
     DO $SET-REG-ATT;
     REPLACE X10 BY CLASS N OF X10, X-CANON;
     DO $REASSIGN-ATT [GLOBAL].
* T-D
*     REPLACES D (ADVERB) BY ITS CANONICAL FORM.
*          E.G. '2ND' FOR 'SECOND'
T-D = IN DSTG, RXMODE:
     IF BOTH ELEMENT- D X10 EXISTS
        AND $NO-PREFIXES  [GLOBAL IN T-NOUN]
     THEN $REPLACE-BY-CLASS.
  $REPLACE-BY-CLASS = EITHER $CLASS-REP OR TRUE.
  $CLASS-REP =
     X-FREE := X10;
     DO $SET-REG-ATT;
     REPLACE X10 BY CLASS D OF X10, X-CANON;
     DO $REASSIGN-ATT [GLOBAL].
* T-Q
*     REPLACES Q BY ITS CANONICAL FORM.
*          E.G. 'THE DIGIT '2' REPLACES 'TWO'.
T-Q = IN NQ, QN, LQR:
     IF CORE- X10 OF LQR IS Q
     THEN EITHER $CLASS-REP OR TRUE.
   $CLASS-REP =
     X-FREE := X10;
     DO $SET-REG-ATT;
     REPLACE X10 BY CLASS Q OF X10, X-CANON;
     DO $REASSIGN-ATT [GLOBAL].
* ***** **********************************************************
*
*              R N   T R A N S F O R M A T I O N S
*
* ***** **********************************************************
* T-DISTRIBUTE-TIME
*   for 'congestive heart failure with hemoptysis several months
*        prior to this admission'.
T-DISTRIBUTE-TIME = IN RN, RA:
    IF BOTH PRESENT-ELEMENT- X-PRE IS NOT EMPTY
       AND ALL OF $PN-WITH-CONN, $HOST-FINDING, $TIME-PHRASE
    THEN AFTER LAST-ELEMENT- OF X-PRE INSERT X-PN-TIME.
 $PN-WITH-CONN =
    ELEMENT- PN X-PN EXISTS;
    EITHER X-PN HAS NODE ATTRIBUTE ADVERBIAL-TYPE
           WHERE PRESENT-ELEMENT- HAS MEMBER CONN-TYPE
    OR BOTH ELEMENT- P X-P IS 'WITH'
       AND CORE-ATT OF X-P HAS MEMBER H-CONN.
 $HOST-FINDING =
    CORE-ATT OF HOST- OF X-PN HAS MEMBER H-DIAG OR H-INDIC.
 $TIME-PHRASE =
    ELEMENT- RN X-RN OF ELEMENT- LNR OF ELEMENT- NSTG OF
        ELEMENT- NSTGO OF X-PN IS NOT EMPTY;
    VALUE X-PN-TIME OF X-RN EXISTS;
    EITHER X-PN-TIME HAS NODE ATTRIBUTE PHRASE-ATT
           WHERE PRESENT-ELEMENT- HAS MEMBER TIME-PHRASE
    OR X-PN-TIME HAS NODE ATTRIBUTE ADVERBIAL-TYPE
           WHERE PRESENT-ELEMENT- HAS MEMBER TIME-ADVERBIAL.
* T-RN-FILLIN
*     EXPANDS CERTAIN RNS INTO A FULL ASSERTION, WITH SUBJECT =
*     HOST; IT IS THEN TREATED SIMILARLY TO AN EXPANDED RELATIVE CLAUSE.
*     $CHECK-COOC LIMITS ACTION OF THIS TFORM TO CASES WHERE THE RN
*     CONTAINS AN H-CONN WORD E.G. 'ANEMIA CAUSED BY/ DUE TO/ SCD' WILL
*     BE EXPANDED, BUT 'ANEMIA NOTED BY MOTHER' WILL NOT BE.
*     A NODE ATTRIBUTE TFORM-ATT IS SET POINTING FROM THE NEWLY CREATED
*     ASSERTION TO A LIST CONTAINING THE ELEMENT TRNFILLIN.
*           E.G. 'ANEMIA DUE TO SCD' ==>
*                'ANEMIA (ANEMIA BE DUE TO SCD)'
T-RN-FILLIN = IN RN, RA, RV:
     IF PRESENT-ELEMENT- X-PRE IS NOT EMPTY
     THEN AT VALUE ITERATE $REPLACE-BY-ASSERT
                   UNTIL GO RIGHT FAILS.
  $REPLACE-BY-ASSERT =
     STORE IN X8;
     VERIFY X-WITH := NIL;
     VERIFY X-CONN := NIL;
     IF DO $NOT-EXPANDED-FRAGMENT
     THEN TRUE
     ELSE IF BOTH $NOT-TESTENV-PHRASE
             AND ONE OF [$ADJINRN,] $V-FORM, $APPOS, $WITH,
                        $CHECK-PN-CONN
          THEN BOTH ALL OF $MOVE-OBJ, $FILL-IN, $DEL-COPY, $WITH-CHK
               AND IF X9 IS ASSERTION
                   THEN AT X-NEWLNR DO $LN-RN-NULL [T-RN-WH]
                   ELSE TRUE
          ELSE IF $CHK-PT-STATE
               THEN BOTH ALL OF $MOVE-OBJ, $FILL-IN, $DEL-COPY
                    AND AT X-NEWLNR DO $LN-RN-NULL [T-RN-WH];
     DO $NEXT.
  $NOT-EXPANDED-FRAGMENT =
       [ Skip this transformation for an expanded assertion ]
       [ 'Heart () regular rate without skip or murmur'.    ]
     BOTH VALUE OF X-PRE IS PN
     AND PRESENT-ELEMENT- IS OCCURRING IN OBJECT X-XPD-OBJ;
     CORE- OF COELEMENT- VERBAL OF X-XPD-OBJ IS '[]';
     COELEMENT- SUBJECT OF X-XPD-OBJ IS NOT EMPTY.
  $NOT-TESTENV-PHRASE =
     [ Skip this transformation for         ]
     [ 'PO2 6.5 breathing air on admission' ]
     BOTH PRESENT-ELEMENT- IS VINGO X8
     AND IT IS NOT THE CASE THAT
         X8 HAS NODE ATTRIBUTE PHRASE-ATT
         WHERE PRESENT-ELEMENT- DOES NOT HAVE MEMBER TESTENV-PHRASE.
  $CHK-PT-STATE =
       [* If host is PSTATE-SUBJ            *]
       [*    LN:APOS contains a PSTATE-DATA *]
       [*    X8 contains a PSTATE-DATA.     *]
       [* then split the RN from host.      *]
     ALL OF $PSTATE-SUBJ, $LN-PSTATE-DATA, $RN-PSTATE-DATA.
  $PSTATE-SUBJ =
     HOST- X-PT OF X8 IS H-PT OR H-PTPART OR H-PTMEAS OR H-PTFUNC.
  $LN-PSTATE-DATA =
     BOTH ELEMENT- APOS X-APOS OF COELEMENT- LN OF X-PRE IS NOT EMPTY
     AND AT X-APOS DO $LOOK-FOR-PSTATE.
  $LOOK-FOR-PSTATE =
     EITHER BOTH VALUE X-LAR OF ELEMENT- ADJADJ IS LAR
            AND AT CORE- OF X-LAR DO $CHK-PSTATE-DATA
     OR BOTH ELEMENT- APOS IS NOT EMPTY
        AND AT ELEMENT- APOS DO $LOOK-FOR-PSTATE.
  $RN-PSTATE-DATA =
     EITHER $PSTATE-ADJ OR $PSTATE-PN.
  $PSTATE-ADJ =
     BOTH X8 IS ADJINRN
     AND AT CORE- OF VALUE DO $CHK-PSTATE-DATA.
  $PSTATE-PN =
     BOTH X8 IS PN
     AND AT CORE- OF LNR OF NSTG OF NSTGO DO $CHK-PSTATE-DATA.
  $CHK-PSTATE-DATA =
     PRESENT-ELEMENT- IS H-DIAG OR H-INDIC OR H-NORMAL OR
                         H-TXRES OR H-RESP.
  $APPOS = BOTH X-PRE HAS ELEMENT- APPOS X8 WHERE VALUE IS LNR X7
           AND IF $SIG-CHECK
               THEN REPLACE X8 BY
                <OBJBE> X8 (<NSTG> (X7))
               ELSE NOT TRUE.
  $SIG-CHECK = [ MEDICAL FORMATTING ONLY ]
     CORE-SELATT X-HOSTATT OF HOST OF X-PRE EXISTS;
     X-SUBLIST := LIST MOD-CLASS;
     BOTH CORE-ATT X-ATT OF CORE- OF X7 HAS MEMBER SIG-CLASS
     AND COMPLEMENT OF X-ATT IS NOT NIL;
     IF X-HOSTATT HAS MEMBER H-STATUS OR H-RESP
     THEN AT X-ATT NOT $SAME-FRMT
     ELSE IF X-ATT HAS MEMBER H-STATUS OR H-RESP
          THEN AT X-ATT NOT $SAME-FRMT.
  $SAME-FRMT =
    EITHER PRESENT-ELEMENT- HAS MEMBER H-INDIC OR H-DIAG OR H-NORMAL,
    OR PRESENT-ELEMENT- HAS MEMBER MOD-CLASS.
  $WITH =
     BOTH PRESENT-ELEMENT- IS PN X7
          WHERE P X1 EXISTS
     AND $CHECK-SEL;
     X-WITH := X-PRE [SET FLAG TO TRIGGER $CHANGE-V];
     REPLACE X7 [PN] BY
        <OBJBE> X8 (X7).
  $CHECK-SEL =
     X7 HAS NODE ATTRIBUTE VHAVE-TYPE.
  $CHANGE-V =
     IF BOTH OBJBE X8 OF X18 [OBJECTBE] EXISTS
        AND P OF PN X-PN OF X8 IS 'SANS' OR 'WITHOUT'
     THEN AT X-PN DO $REPLACE-NEG [GLOBAL IN T-SANS];
     IF LP X-LP OF X-PN IS NOT EMPTY
     THEN REPLACE LV OF VERB OF X9 [NEW ASSERTION]
            BY <LV> (ALL ELEMENTS OF X-LP);
     REPLACE CORE- OF VERB OF X9 [NEW ASSERTION]
     BY <V> = HAVE: (VHAVE);
     REPLACE X18 [OBJECTBE IN NEW ASSERTION]
     BY NSTGO OF PN OF VALUE OF X18 [OBJECTBE].
  $MOVE-OBJ =
     AT X-PRE EITHER ASCEND TO NSTG PASSING THROUGH ADJINRN
                     WHERE STORE IN X-STG
              OR IMMEDIATE ASTG X-STG EXISTS;
     AFTER X-STG INSERT X8 [OBJBE], X-OBJ;
     DO $TAKE-OUT-VALUE.
  $TAKE-OUT-VALUE =
     AT X8 REPLACE PRESENT-ELEMENT- BY <NULL> X8.
  $FILL-IN =
     AT X-STG EITHER LNR X5 EXISTS
              OR LAR X5 EXISTS;
     IF X-CONN IS NOT NIL THEN $BUILD-FRAG
     ELSE $BUILD-ASSERT;
     IF X-OBJ IS ADJINRN [T-RN-FILLIN expects LAR below OBJECT]
     THEN AT X9 [NEW ASSERTION]
          REPLACE ELEMENT- OBJECT BY
               <OBJECT> (<OBJECTBE>
                          (<ASTG> X-NEWOBJ (ALL ELEMENTS OF X-OBJ)))
     ELSE IF X-OBJ IS VINGO [T-VERBAL-OBJECT expects VINGO in OBJECT]
          THEN AT X9 [ASSERTION]
               REPLACE ELEMENT- OBJECT BY <OBJECT> (X-OBJ);
     BOTH $SET-TFORM-ATT
     AND TRANSFORM X9 [NEW ASSERTION].
  $BUILD-FRAG =
     AT X5 [LNR] EITHER ITERATE GO RIGHT OR TRUE;
     AFTER PRESENT-ELEMENT-
     INSERT <FRAGMENT> X9
              (<SA> (<NULL>)
              + X-OBJ
              + <SA> (<NULL>));
     X-CONN := NIL.
  $BUILD-ASSERT =
     AT X5 [LNR] EITHER ITERATE GO RIGHT OR TRUE;
     AFTER PRESENT-ELEMENT-
     INSERT <ASSERTION> X9
              ( <SA> (<NULL>)
              + <SUBJECT> (<NSTG> X13 (X5, X-NEWLNR [HOST LNR]))
              + <SA> (<NULL>)
              + <NEG> (<NULL>)
              + <TENSE> (<NULL>)
              + <SA> (<NULL>)
              + <VERB> (<LV> (<NULL>)
                       +<VVAR> (<NULL>)
                       +<NEGV> (<NULL>)
                       +<RV> (<NULL>))
              + <SA> (<NULL>)
              + <OBJECT> (<OBJECTBE> (X-OBJ))
              + <RV> (<NULL>)
              + <SA> (<NULL>)).
  $FRAG-TO-ASSERT-CHK =
     BOTH X5 [LNR] IS OCCURRING IN FRAGMENT X-FRAG WHERE NSTG EXISTS
     AND X-FRAG DOES NOT HAVE NODE ATTRIBUTE DEL-ATT.
  $DEL-COPY =
    [AT X-OBJ REPLACE PRESENT-ELEMENT- BY <SA> (<NULL>)]
    DELETE X-OBJ.
  $WITH-CHK = IF X-WITH IS NOT NIL
              THEN BOTH $CHANGE-V [VERB -> HAVE]
                   AND X-WITH := NIL.
  $SET-TFORM-ATT =
     AT X9 [NEW ASSERTION]
     BOTH X-TFORM := SYMBOL TRNFILLIN
     AND $ADD-TO-TFORM-ATT.
  $V-FORM =
     BOTH PRESENT-ELEMENT- IS VINGO OR VENPASS X8
          WHERE BOTH ELEMENT- VERBAL X7 EXISTS
                AND IF X8 HAS ELEMENT- PASSOBJ X9
                    THEN EITHER X9 IS NOT EMPTY
                         OR VALUE OF ELEMENT- RV OF X7 IS PN
                            WHERE ELEMENT- P IS 'BY'
                    ELSE IF X8 HAS ELEMENT- OBJECT X9
                         THEN X9 IS NOT NULLOBJ [* lone VING *]
     AND CORE-ATT OF CORE- OF X7 DOES NOT HAVE MEMBER H-CONN OR
         H-TMBEG OR H-TMEND OR H-TMLOC [* time verb *].
  $ADJINRN =
     BOTH PRESENT-ELEMENT- IS ADJINRN X7 WHERE VALUE IS LAR
    @AND $ADJ-COOC;
     IF $SIG-CHECK [SHOULD BE MADE INTO NEW ASSERTION]
     THEN AT X7 REPLACE PRESENT-ELEMENT- BY
          <OBJBE> X8 (<ASTG> (ALL ELEMENTS OF X7))
     ELSE NOT TRUE.
  $ADJ-COOC =
     CORE- X2 IS NOT ASCALE.
  $CHECK-PN-CONN =
     AT PRESENT-ELEMENT- X-PN
     BOTH $NOT-COMPUTED-STRUCT
     AND EITHER BOTH $CHECK-P
                AND X-CONN := X-PRE [NON-NIL VALUE]
         OR $CHECK-EQUIV.
  $NOT-COMPUTED-STRUCT =
        [* Do not build connective structure out of N-PN *]
        [* if host N has a computed attribute from the   *]
        [* the object N of PN.                           *]
      IF BOTH HOST- HAS NODE ATTRIBUTE N-TO-RN-ATT X-ARG
         AND LNR X-PN-ARG OF NSTG OF NSTGO OF X-PN EXISTS
      THEN X-PN-ARG IS NOT IDENTICAL TO X-ARG.
  $CHECK-P =
     AT ELEMENT- P ALL OF $NOT-PVAL-ATT,
                          $NOT-WITH-CONJ,
                          $GET-CONN [GLOBAL IN T-REMOVE-THERE].
  $NOT-PVAL-ATT = [TRUE] [*GRI*]
      IT IS NOT THE CASE THAT PRESENT-ELEMENT- [P]
         HAS NODE ATTRIBUTE PVAL-ATT.
  $NOT-WITH-CONJ =
     IF PRESENT-ELEMENT- IS 'AVEC' OR 'SANS' OR 'WITH' OR 'WITHOUT'
        OR 'FREE'_'OF' OR 'WITHOUT'_'EVIDENCE'_'OF'
     THEN CORE-SELATT DOES NOT HAVE MEMBER CONJ-LIKE [OR H-CONN].
  $CHECK-EQUIV = NOT TRUE
    [BOTH CORE-ATT X-N2 OF CORE- OF NSTGO OF X-PN EXISTS]
    [AND CORE-SELATT X-N1 OF HOST- OF X-PN EXISTS;]
    [X-EQUIV := LIST FORMAT-EQUIV-CLASS;]
    [ITERATET SUCCESSORS X-EQUIV OF X-EQUIV IS NOT NIL]
    [UNTIL $CHECK-EQUIV-LIST SUCCEEDS].
  $CHECK-EQUIV-LIST =
     X-NEWLIST := HEAD OF X-EQUIV;
     BOTH INTERSECT OF X-N1 IS NOT NIL
     AND INTERSECT OF X-N2 IS NOT NIL.
  $CHECK-CLASS = PRESENT-ELEMENT- IS H-CONN OR H-INDIC OR H-DESCR OR
                        H-NORMAL OR H-TTGEN OR H-TTCOMP.
  $NEXT =
     GO TO X8 [NEXT POSITION IN RN].
* T-FIXUP-LNR
*   (A) OPERATES WHEN AN LNR HAS TWO OR MORE ASSERTIONS (ASSERT A, ASSERT B,
*   ETC. ) AS RIGHT SISTERS.  ASSERT A AND ASSERT B ARE CREATED BY
*   ENGLISH TFORMS T-RN-WH AND/OR T-RN-FILLIN.
*   THE FOLLOWING SITUATIONS ARE COVERED BY T-ASSERT-TO-CONJ:
*         (1) LNR + ASSERT A + ASSERT B
*         (2) LNR + ASSERT A + ASSERT B + CONJ-NODE OF B
*         (3) LNR + ASSERT A + CONJ-NODE OF A + ASSERT B
*         (4) LNR + ASSERT A + CONJ-NODE OF A + ASSERT B + CONJ-NODE OF B
*     T-ASSERT-TO-CONJ TRANSFORMS ASSERT B INTO ANDSTG = CONJ-NODE OF A
*     (SITUATIONS (1) AND (2)).  IF CONJ-NODE OF ASSERT A ALREADY EXISTS,
*     ANDSTG IS BUILT CONTAINING ASSERT B.  THIS ANDSTG IS INSERTED AFTER
*     $POSTCONJ OF ASSERT A (3,4).
*     WHEN CONJ-NODE OF B EXISTS, IT IS INSERTED AFTER $POSTCONJ
*     OF A (= COPY OF B IN NEWLY CREATED ANDSTG) (4).
*     ORIGINAL ASSERT B AND ITS CONJ-NODES ARE DELETED IN ALL SITUATIONS.
*     IN ADDITION, NODE ATTRIBUTES PRECONJELEM AND POSTCONJELEM ARE SET
*     TO AND FROM ELEMENTS IN NEWLY CREATED CONJ-NODES.
*
*     (B)  WHEN LNR IS IN AN NSTG FRAGMENT WHICH HAS BEEN MARKED REDUNDANT
*     (WITH NODE ATTRIBUTE DEL-ATT) BY T-RN-FILLIN THEN IT- REMOVES THE
*     REDUNDANT FRAGMENT.
*     EX.
*         SWELLING WITH FEVER -> SWELLING. SWELLING IS WITH FEVER
*     THE FRAGMENT "SWELLING" IS REDUNDANT, AND IS DELETED.
T-FIXUP-LNR = IN RN:
     IMMEDIATE-NODE IS LNR X-LNR;
     BOTH $CREATE-CONJ-CHK
     AND $DEL-FRAGMENT.
  $CREATE-CONJ-CHK =
     IF GO RIGHT
     @THEN BOTH STORE IN X-FIRST [1ST ASSERTION]
           AND EITHER ITERATE $FIND-NEXT
               OR TRUE.
  $FIND-NEXT =
     AT X-FIRST GO RIGHT;
     EITHER $INSERT-ASSERT
     OR $INSERT-CONJ.
  $INSERT-ASSERT =
     TEST FOR ASSERTION;
     STORE IN X-MOVE;
     DO $CREATE-CONJ.
  $INSERT-CONJ =
     TEST FOR CONJ-NODE;
     BOTH GO RIGHT
    @AND IF TEST FOR CONJ-NODE
        @THEN AT PRESENT-ELEMENT- X-MOVE DO $CREATE-CONJ
         ELSE $INSERT-ASSERT.
  $CREATE-CONJ =
     AT X-FIRST EITHER ITERATE $POSTCONJ
                OR TRUE;
     STORE IN X-ADDTOCONJ;
     IF X-MOVE IS ASSERTION
     THEN $BUILD-CONJ
     ELSE X-MOVE IS OF TYPE CONJ-NODE
                    WHERE DO $CONJ-MOVE.
  $BUILD-CONJ =
     AFTER X-ADDTOCONJ
     INSERT <ANDSTG> X-NEWCONJ ('AND'
                              [+ <NULL>] [NOT]
                               + <SACONJ> (<NULL>)
                               + <Q-CONJ> (X-MOVE ));
     DELETE X-MOVE;
     AT X-NEWCONJ
     DO PRE-POST-CONJELEM [ROUTINE SETS PRE- AND POST- CONJELEMS].
  $CONJ-MOVE =
     AFTER X-ADDTOCONJ
     INSERT X-MOVE, X-NEWCONJ;
     DELETE X-MOVE;
     AT X-NEWCONJ
     DO PRE-POST-CONJELEM [ROUTINE SETS PRE- AND POST- CONJELEMS].
  $DEL-FRAGMENT =
     IF PRESENT-ELEMENT- IS OCCURRING IN NSTG X-NSTG
         WHERE BOTH IMMEDIATE-NODE- IS FRAGMENT X-FRAG
              @AND PRESENT-ELEMENT- HAS NODE ATTRIBUTE DEL-ATT
     THEN AT X-FRAG ALL OF $MOVE-1ST-SA, $MOVE-L-SA, $DEL-FRAG.
  $MOVE-1ST-SA =
     IF VALUE X-SA OF X-FRAG IS SA WHERE PRESENT-ELEMENT- IS NOT EMPTY
     THEN BEFORE VALUE OF FIRST SA OF COELEMENT ASSERTION OF X-LNR
          INSERT X-SA.
  $MOVE-L-SA =
     IF LAST-ELEMENT OF X-FRAG IS SA WHERE VALUE X-SA IS NOT EMPTY
     THEN BEFORE VALUE OF LAST-ELEMENT OF COELEMENT ASSERTION OF X-LNR
          INSERT X-SA.
  $DEL-FRAG =
     DELETE X-LNR;
     REPLACE X-FRAG BY ALL ELEMENTS OF X-NSTG.
* T-PARENSTG
*     REMOVES PARENS AND REPLACES CENTER BY ITS VALUE.
T-PARENSTG = IN PARENSTG:
   AT PRESENT-ELEMENT- X1
   BOTH REPLACE X1 BY X1 (SECOND ELEMENT OF X1,X2)
   AND IF X2 IS CENTER
       THEN BOTH REPLACE X2 BY VALUE OF X2
            @AND TRANSFORM VALUE OF X1 [PARENSTG].
* T-PN-PARENSTG
*     MOVES A PN FROM PARENSTG INTO THE RN OF ITS HOST LNR
*        E.G. 'TOOTHACHE (LIKE PAIN) IN THE RT. SUPERIOR ALVEOLAR
*             BUCCAL SULCUS'
T-PN-PARENSTG = IN PARENSTG:
  AT PRESENT-ELEMENT- X1
  IF BOTH COELEMENT- RN X2 EXISTS
     AND VALUE OF X1 [PARENSTG] IS PN X3
  THEN BOTH BEFORE FIRST ELEMENT OF X2 [RN]
            INSERT X3 [PN]
       AND DELETE X1 [PARENSTG].
* ***** ***********************************************************
*
*                   SEQUENCING TRANFORMATIONS
*
* ***** ***********************************************************
TSEQ-SENTENCE = IN SENTENCE: TRANSFORM TEXTLET.
TSEQ-TEXTLET = IN TEXTLET:
      BOTH TRANSFORM ONESENT
      AND IF MORESENT IS NOT EMPTY
         @THEN TRANSFORM TEXTLET.
TSEQ-ONESENT = IN ONESENT:
      BOTH TRANSFORM ELEMENT CENTER
      AND IF ELEMENT INTRODUCER IS NOT EMPTY [value LINTRO or ADJINTRO]
         @THEN TRANSFORM PRESENT-ELEMENT.
TSEQ-CENTER = IN CENTER:
      IF CENTER HAS ELEMENT ASSERTION OR FRAGMENT [OR IMPERATIVE]
     @THEN TRANSFORM PRESENT-ELEMENT.
TSEQ-FRAGMENT = IN FRAGMENT:
      IF SECOND ELEMENT [NSTG,VENPASS,VINGO] EXISTS
     @THEN TRANSFORM PRESENT-ELEMENT-.
TSEQ-ASSERTION = IN ASSERTION:
      BOTH IF VERB IS NOT EMPTY
           THEN TRANSFORM VERB
      AND BOTH IF OBJECT IS NOT EMPTY
               THEN TRANSFORM VALUE OF OBJECT
          AND IF SUBJECT IS NOT EMPTY
              THEN TRANSFORM VALUE OF SUBJECT.
TSEQ-SA = IN ASSERTION, FRAGMENT:
      AT LAST-ELEMENT
      ITERATE IF PRESENT-ELEMENT IS SA OR RV WHERE
                   PRESENT-ELEMENT- IS NOT EMPTY
              THEN TRANSFORM PRESENT-ELEMENT
      UNTIL GO LEFT FAILS.
TSEQ-OBJ-IN-PVO = IN OBJECT:
     IF IMMEDIATE-NODE- IS PVO OR TOVO
     THEN IF PRESENT-ELEMENT- IS NOT EMPTY
          THEN TRANSFORM VALUE [OF OBJECT].
TSEQ-OBJ2 = IN OBJECTBE, OBJBE:
     AT VALUE ITERATE IF PRESENT-ELEMENT- IS NOT EMPTY
                      THEN TRANSFORM PRESENT-ELEMENT
              UNTIL GO RIGHT FAILS.
TSEQ-OBJ3 = IN THATS, PVO, TOVO:
     AT LAST-ELEMENT-
     BOTH ITERATE IF TEST FOR SA OR RV
                     WHERE PRESENT-ELEMENT- IS NOT EMPTY
                  THEN TRANSFORM PRESENT-ELEMENT
          UNTIL GO LEFT FAILS
     AND ITERATE IF BOTH NOT TEST FOR SA OR RV
                    AND GO DOWN
                 THEN IF PRESENT-ELEMENT IS NOT EMPTY
                      THEN ITERATE TRANSFORM PRESENT-ELEMENT-
                           UNTIL PRESENT-ELEMENT- HAS NODE ATTRIBUTE
                                 POSTCONJELEM FAILS
         UNTIL GO LEFT FAILS.
TSEQ-SN = IN SN:
     TRANSFORM VALUE.
TSEQ-VINGSTG = IN VINGSTG:
     TRANSFORM VALUE.
TSEQ-MULT-OBJ = IN N-OBJ-IN-STR, PVINGSTG, PSVINGO, PSNWH, PVINGO,
                   C1SHOULD [ *new* 2000/05/17]:
     BOTH AT LAST-ELEMENT- IF PRESENT-ELEMENT- IS NOT EMPTY
                           THEN TRANSFORM PRESENT-ELEMENT-
     AND IF EITHER FIRST ELEMENT IS NOT DP
            OR FIRST ELEMENT IS NOT P
        @THEN IF PRESENT-ELEMENT- IS NOT EMPTY
              THEN TRANSFORM PRESENT-ELEMENT-.
TSEQ-SAVALUE = IN SA:
     AT VALUE ITERATE IF PRESENT-ELEMENT- IS NOT EMPTY
                      THEN TRANSFORM PRESENT-ELEMENT-
              UNTIL GO RIGHT FAILS.
TSEQ-ADJUNCT = IN RV, LVSA, LV, RA, LA, RW, RN, LP, RDATE:
     AT VALUE ITERATE IF PRESENT-ELEMENT- IS NOT EMPTY
                      THEN TRANSFORM PRESENT-ELEMENT-
              UNTIL GO RIGHT FAILS.
TSEQ-NSTG1 = IN NSTGO:
             TRANSFORM VALUE [NSTG/QUANT].
TSEQ-NSTG2 = IN NSTG, EKGSTG:
     IF PRESENT-ELEMENT- IS NOT EMPTY
     THEN EITHER TRANSFORM LNR
          OR EITHER TRANSFORM LWVR
             OR TRANSFORM NWHSTG.
TSEQ-NSTG3 = IN NSTGT, PAREN-NSTG:
             TRANSFORM [NSTG] VALUE [NSTG/QUANT/PERUNIT/VO].
* TSEQ-LXR
*   11/13/96 CHANGE SEQUENCING OF RN AND LN IN LNR
TSEQ-LXR = IN LXR:
     BOTH IF ELEMENT RADJSET EXISTS
             WHERE BOTH PRESENT-ELEMENT- IS NOT RN
                   AND PRESENT-ELEMENT- IS NOT EMPTY
         @THEN TRANSFORM PRESENT-ELEMENT-
     AND BOTH IF ELEMENT LADJSET IS NOT EMPTY
             @THEN TRANSFORM PRESENT-ELEMENT-
         AND BOTH IF ELEMENT RN EXISTS
                     WHERE PRESENT-ELEMENT- IS NOT EMPTY
                  @THEN TRANSFORM PRESENT-ELEMENT-
             AND AT VALUE
                 ITERATE IF TEST FOR PARENSTG OR DASHSTG
                        @THEN TRANSFORM PRESENT-ELEMENT
                 UNTIL GO RIGHT FAILS.
TSEQ-ASTG1 = IN ASTG: TRANSFORM VALUE.
TSEQ-LN1 = IN LN:
     AT LAST-ELEMENT-
     ITERATE VERIFY IF VALUE IS NOT EMPTY
                   @THEN TRANSFORM PRESENT-ELEMENT
     UNTIL GO LEFT FAILS.
TSEQ-LN2 = IN ADJADJ:
     DO $TRANSFORM-ELS.
  $TRANSFORM-ELS =
     BOTH IF COELEMENT APOS X-APOS IS NOT EMPTY
          THEN AT VALUE OF X-APOS DO $TRANSFORM-ELS
     AND IF PRESENT-ELEMENT- HAS ELEMENT- LAR OR LAR1 OR LQNR OR QN
        @THEN TRANSFORM PRESENT-ELEMENT.
TSEQ-LN3 = IN ADJADJ: IF ELEMENT- ADJADJ IS NOT EMPTY
                      @THEN TRANSFORM PRESENT-ELEMENT.
TSEQ-LCDN = IN LCDN: AT VALUE
     ITERATE IF PRESENT-ELEMENT- IS LAR1
             THEN TRANSFORM PRESENT-ELEMENT-
     UNTIL GO RIGHT FAILS.
TSEQ-LCDVA = IN LCDVA:
     AT VALUE IF PRESENT-ELEMENT- IS LNR
             @THEN TRANSFORM PRESENT-ELEMENT-.
TSEQ-RNVALUE = IN ADJINRN: TRANSFORM VALUE.
TSEQ-PQUANT = IN PQUANT:
     TRANSFORM ELEMENT- QUANT.
TSEQ-PDATE = IN PDATE:
     BOTH IF MOREDATE IS NOT EMPTY
         @THEN TRANSFORM VALUE [LDATER]
     AND TRANSFORM LDATER.
TSEQ-LQNR = IN LQNR:
     IF CORE- IS NOT EMPTY [QN OR NQ]
    @THEN TRANSFORM PRESENT-ELEMENT-.
TSEQ-DOSE = IN MEDDOSE:
     AT VALUE,
     ITERATE IF PRESENT-ELEMENT- IS NOT EMPTY
            @THEN TRANSFORM PRESENT-ELEMENT-
     UNTIL GO RIGHT FAILS.
TSEQ-RXMODE = IN RXMODE:
     IF ELEMENT- RXMODE IS NOT EMPTY
    @THEN TRANSFORM PRESENT-ELEMENT-.
TSEQ-QN = IN QUANT, QN, NQ:
     AT VALUE ITERATE BOTH IF TEST FOR LQR OR QNREP OR QN
                          @THEN TRANSFORM PRESENT-ELEMENT
                      AND IF ELEMENT- RQ [IN QN] IS NOT EMPTY
                         @THEN TRANSFORM VALUE
              UNTIL GO RIGHT FAILS.
TSEQ-QNREP = IN QNREP:
     AT VALUE [Q-CONJ] BOTH GO DOWN
                       @AND ITERATE IF TEST FOR LQR
                                    @THEN TRANSFORM PRESENT-ELEMENT
                            UNTIL GO RIGHT FAILS.
* T-ADJUST-SACONJ
*  *TEMPORARY SOLUTION*
*   MOVES SACONJ INTO RESPECTIVE CONJUNCTS.
* -- 2/5/97
T-ADJUST-SACONJ = IN CENTER, SUB1:
    IF ELEMENT- CONJ-NODE EXISTS
       WHERE ELEMENT- SACONJ X-SACONJ IS NOT EMPTY
    THEN BOTH EITHER $MOVE-TO-SA
              OR $MOVE-TO-LX
         AND REPLACE X-SACONJ BY <SACONJ> (<NULL>).
  $MOVE-TO-SA =
    PRESENT-ELEMENT- HAS ELEMENT- ASSERTION OR FRAGMENT;
    ELEMENT- SA X-SA EXISTS;
    IF X-SA IS NOT EMPTY
    THEN REPLACE X-SA BY
         <SA> (ALL ELEMENTS OF VALUE OF X-SACONJ
              +ALL ELEMENTS OF X-SA)
    ELSE REPLACE X-SA BY ALL ELEMENTS OF X-SACONJ.
  $MOVE-TO-LX =
    VALUE X-LX IS OF TYPE LADJSET;
    BEFORE VALUE OF X-LX INSERT ALL ELEMENTS OF VALUE OF X-SACONJ.
* T-PNCH-TREE
T-PNCH-TREE = IN SENTENCE: TRUE
    [WRITE ON INFO IDENTIFICATION;]
    [WRITE ON INFO SENTEXT SOURCE;]
    [WRITE ON INFO PARSE TREE WITH WORD FORMS;]
    [WRITE ON INFO END OF LINE].
* END-XFORMS
*CLOSE(A)

