MLP Regularization Grammar Source
 
— -- DECOMPILED FROM EREG12 SAT JUL 20 16:16:16 EDT 2002
<ASOBJBE> ::= NULL.
<ADJN> ::= NULL.
<DP1PN> ::= NULL.
<DP1P> ::= NULL.
<DP2PN> ::= NULL.
<DP3PN> ::= NULL.
<DP4PN> ::= NULL.
<DSTG> ::= NULL.
<DPSN> ::= NULL.
<FORTOVO> ::= NULL.
<NASOBJBE> ::= NULL.
<NINRN> ::= NULL.
<NGEV> ::= NULL.
<NPVINGO> ::= NULL.
<NPVINGSTG> ::= NULL.
<NSVINGO> ::= NULL.
<NPSNWH> ::= NULL.
<NTHATS> ::= NULL.
<PSNWH> ::= NULL.
<PSVINGO> ::= NULL.
<SECTION> ::= NULL.
<SECT-NAME> ::= NULL.
<SOBJBE> ::= NULL.
<NPSVINGO> ::= NULL.
<NSNWH> ::= NULL.
<PNHOWS> ::= NULL.
<PNSNWH> ::= NULL.
<PNVINGSTG> ::= NULL.
<PSTG> ::= NULL.
<TOBE> ::= NULL.
<VINGSTGPN> ::= NULL.
<PNN> ::= NULL.
<PNTHATS> ::= 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.
<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.
<PAREN-FRAG> ::= NULL.
<PAREN-RV> ::= NULL.
<PARENSTG> ::= NULL.
<PART> ::= NULL.
<PARTICULARLY-STG> ::= NULL.
<PNPVO> ::= NULL.
<PNSNWH> ::= NULL.
<PNTHATSVO> ::= NULL.
<PNVINGSTG> ::= NULL.
<PNVO> ::= NULL.
<PROPOS> ::= NULL.
<PROSENT> ::= NULL.
<PSNWH> ::= NULL.
<PSVINGO> ::= NULL.
<PTIME> ::= NULL.
<PUISSTG> ::= NULL.
<PVO-N> ::= NULL.
<PVO> ::= NULL.
<PWHNQ-PN> ::= NULL.
<PWHNQ> ::= NULL.
<PWHNS-PN> ::= NULL.
<PWHNS> ::= NULL.
<PWHQ-PN> ::= NULL.
<PWHQ> ::= NULL.
<PWHS-PN> ::= NULL.
<PWHS> ::= NULL.
<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.
<SUB4> ::= NULL.
<SUB6> ::= NULL.
<SUB7> ::= NULL.
<SUB10> ::= NULL.
<SUB13> ::= 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.
<YESNOQ> ::= NULL.
— BNF DEFINITIONS

— 1. SENTENCE
<SENTENCE> ::= <TEXTLET> .
<TEXTLET> ::= <ONESENT> <MORESENT> .
<ONESENT> ::= <SECTION> <INTRODUCER> <CENTER> <ENDMARK> .
<MORESENT> ::= <*NULL> / <TEXTLET> .
<INTRODUCER> ::= AND / OR / BUT / <INT-PHRASE> (':'/ '-')
        / <*NULL>.
<INT-PHRASE> ::= FAMILY HISTORY / PREOPERATIVE DIAGNOSIS
        / POSTOPERATIVE DIAGNOSIS / <*ADJ> / <LNR>.
<CENTER> ::= (<ASSERTION> / <SEGADJ> / <QUISEG> / <FRAGMENT>
        / <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> .
<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> .
— 5. SUBJECT STRINGS
<SUBJECT> ::= THERE / <EKGSTG> / <NSTG> / <*NULLWH> / <*NULLC> / <WHATS-N> .
<EKGSTG> ::= <LWVR>.
<LWVR> ::= <LN> <WVVAR> <RWV>.
<WVVAR> ::= <*N>.
<RWV> ::= <RWVOPTS> <RWV> / <*NULL>.
<RWVOPTS> ::= <IN-LEADS> / <PN>.
<IN-LEADS> ::= (<*P> / - <*NULL>) <LLEADR>.
<LLEADR> ::= <LN> <LEADVAR> <RLEAD>.
<LEADVAR> ::= <*EKGLEAD> '-' <*EKGLEAD> /
        <*EKGLEAD> THROUGH <*EKGLEAD> /
        <*EKGLEAD> '-' <*Q> /
        <*EKGLEAD> THROUGH <*Q> / <*EKGLEAD> .
<RLEAD> ::= <*D> / <*NULL>.
<NSTG> ::= <LNR> .
<LNR> ::= <LN> <NVAR> <RN> .
<NVAR> ::= <*N> / <*PRO> / <*VING> / <*DS> / <QN>/ <NQ> / <Q10S> .
<Q10S> ::= <*Q>.
— 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> / <PQUANT> / <PSVINGO> /
        <DP2> / <DP3> / <DP1>/ <TOVO> / <PN> / <VO> /
        <NPVINGO> / <ND> / <DSTG> / <THATS> /
        <VINGO> / <NTOBE> / <OBJECTBE> /
        <OBJBE> / <SVEN> / <VENPASS> / <NTHATS> / <ASTG> /
        <NN> / <SOBJBE> / <WHETHS> / <ASSERTION> /
        <C1SHOULD> / <SVO> / <NA> / <*NULLOBJ> .
<PASSOBJ> ::= <ASTG> / <ASOBJBE> / <PVINGO> / <PN> / <PDOSE> / <NSTGO> /
        <TOVO> / <P1> / <DP1> / <*NULLOBJ> / <THATS> /
        <OBJBE> / <DSTG> / <ASSERTION> <DP1PN> .
<OBJECTBE> ::= <VINGO> / <VENPASS> / <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> (<*NULL>) <PERUNIT> <SCALESTG> .
<SCALESTG> ::= <*ADJ> / <IN-DIM> / <*D> / <*NULL>.
<IN-DIM> ::= (IN / OF) <*N> .
<Q-AGE> ::= <*Q> .
<PQUANT> ::= <*P> <QUANT> .
<ASTG> ::= <LAR> .
<NSTGO> ::= <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> .
<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>) .
— 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> ::= <LTIME> <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>.
<SUB6> ::= <*CS6> <SOBJBE>.
<SUB8> ::= AS (WAS / WERE /DID) <SUBJECT> .
<SUB9> ::= <*CS9> <VO>.
<SUB11> ::= <TM-PHRASE> <ASSERTION>.
<SUB12> ::= SHOULD <SVO>.
<SVINGO> ::= <SUBJECT> <SA> <VINGO> .
<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> .
<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> / - <QPERUNIT> / <NQ>
        / <ADJADJ> (<LAR> / <QN> / <QPERUNIT> / <NQ>).
<LAR> ::= <LA> <AVAR> <RA> .
<AVAR> ::= <*ADJ> / <*VEN> /<*VING> .
<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> / <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>) .
<WITHSTG> ::= WITH <SACONJ> <Q-CONJ> .
<ORSTG> ::= OR <Q-CONJ> .
<NORSTG> ::= NOR <Q-CONJ> .
<INCLUDINGSTG> ::= INCLUDING <Q-CONJ> .
<BUTSTG> ::= BUT <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>.
<Q-CONJ> ::= <*NULL> .
<LAUX> ::= NULL.
— TRANSFORMATIONAL DUMMIES
<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.
— REGULARIZATION MARKERS:
—       DUMMY BNF DEFINITIONS
<AGE> ::= NULL.
<AREA-MOD> ::= NULL.
<BP-MOD> ::= NULL.
<CHANGE-OF-STATE> ::= NULL.
<CONJOINED> ::= NULL.
<EMBEDDED> ::= NULL.
<EVENT-TIME> ::= NULL.
<HEADCONN> ::= NULL.
<LCONN> ::= NULL.
<LCONNR> ::= NULL.
<LPR> ::= NULL.
<MODS> ::= NULL.
<PARSE-CONN> ::= NULL.
<PREP-CONN> ::= NULL.
<QUANTITY> ::= NULL.
<RCONN> ::= NULL.
<REL-CLAUSE> ::= NULL.
<RELATION> ::= NULL.
<RP> ::= NULL.
<SUB-CONJ> ::= NULL.
<TIME> ::= NULL.
<TIME-CONJ> ::= NULL .
<UNIT> ::= NULL.
<Y-OF> ::= NULL.
— ATTRIBUTE LISTS
—       1. BASE ATTRIBUTES USED IN DICTIONARY AND PARSING GRAMMAR.
—       MISSING DIDOMPN. UNUSED PT1.
—       2. SELECTION COMPONENT ADDS: PASS-SEL, LINKC, N-OMITSTG,
—       START-HGRAPH, STAY-HGRAPH, TRY-ATT.
—       3. TRANSFORMATION COMPONENT ADDS:
—       PREFX, DEL-ATT, INDEX, TENSE-ATT, TFORM-ATT,
—       [** ATTRIBUTES ASSIGNED TO TENSE-ATT **]
—       CONDITIONNEL, FUTURE, IMPARFAIT, IMPERTVE, PERF, PRESNT, PROG,
—       [** ATTRIBUTES ASSIGNED TO TFORM-ATT **]
—       TFORTOVO, TNPVINGO, TNPVO, TNSVINGO, TPVO, TRNFILLIN,
—       TRNWH, TSASOBJBE, TSOBJBE, TSVINGO, TTHATS, TWHATSN,
—       TWHETHS.
—       4. REGULARIZATION COMPONENT ADDS: FORMAT-ATT, EMBED-OBJ,
—       EMBED-SUBJ, REFPT-ATT, TYPE-ATT, PT2, SEM-CORE,
—       [** ATTRIBUTES ASSIGNED TO FORMAT-ATT **]
—       FRMT-UNIT, FRMT00, FRMT0, FRMT1, FRMT2, FRMT3, FRMT4,
—       FRMT1-3, FRMT13-MED, FRMT5-MISC, FRMT5-EKG,
—       FRMT4-5, FRMT5, FRMT5F, FRMT5-ALG, 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,
        FRMT13-MED, FRMT5-MISC [* 2000 Oct 26 *], FRMT5-EKG,
        FRMT4, FRMT4-5, FRMT5, FRMT5F, FRMT5-ALG, 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 [EKG axis], E-EKGPROC [EKG test], E-INTVL [EKG interval],
        E-LEAD [EKG leads], E-WV [EKG wave], 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 = FRMT1-3 [New combined F1+F2+F3+F5+F5F],
        FRMT345 [Ambiguous FRMT1-3, FORMAT4 and FRMT5, FRMT5-ALG, FRMT5F],
        FRMT45 [Ambiguous FRMT4, FRMT5-ALG *** not used ***],
        FRMT3-5 [Ambiguous FRMT1-3 and FRMT5, FRMT5-ALG, FRMT5F],
        FRMT5-PTFAM [Ambiguous FRMT5 and FRMT5-ALG, FRMT5F],
        SEM-CORE [NEW NAME FOR HOST-ASP],
        PATHIF [* snopath *], FUT-IMP.
ATTRIBUTE = [* EKG ATTRIBUTES *]
        E-AX [axis], E-LEAD [EKG leads], E-INTVL [interval],
        E-WV [EKG wave].
ATTRIBUTE = ANTECEDENT, ANALINK, MARK, QLINK, FUT-IMP.
ATTRIBUTE = ASSN-SELATTS [* all SELECT-ATT in ASSERTION *].
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.
— 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-CLASSES *].
— 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].
— GLOBAL-REGS
GLOBAL = $ADD-TO-SELATT [T-SEM-CORE-OF-LXR, T-SETUP-NEG-MEAN,]
        [T-SETUP-TENSE],
   $ASSIGN-FRMT0 [T-LXR-FORMAT-TYPE,T-SUBJECT-CHK],
   $ASSIGN-HOST [T-SEM-CORE-OF-LXR, T-SEM-CORE-OF-PSTG, -QN],
   $BUILD-CONJOINED [T-CONJ-IN-CENTER, T-CONJ-IN-NSTG],
   $BUILD-FRAGMENT [T-EXPAND-REFPT, T-CHANGE-OF-STATE,]
        [T-WITH-CONJ],
   $BUILD-HEADCONN [T-CONJ-IN-CENTER, T-SAWH, T-CSSTG,]
        [T-SA-PNCONN],
   $BUILD-LCONNR [T-CONJ-IN-CENTER, T-SAWH, T-CSSTG],
   $BUILD-LCONN-RCONN [T-FIND-CONN, T-CHANGE-OF-STATE,]
        [T-WITH-CONJ],
   $BUILD-PCONN [T-SA-PNCONN, T-RADJ-CONN, T-REL-CLAUSE],
   $BUILD-RELATION [T-SA-PNCONN, T-FIND-CONN],
   $BUILD-RELCLAUSE [T-REL-CLAUSE, T-EXPAND-REFPT,]
        [T-CHANGE-OF-STATE, T-WITH-CONJ],
   $COPY-NEG-MODAL [T-CONJ-IN-CENTER, T-SA-PNCONN],
   $FIND-ASSERT [T-REL-CLAUSE, T-EXPAND-REFPT,]
        [T-CHANGE-OF-STATE, T-WITH-CONJ],
   $FIND-HOST [T-SEM-CORE-OF-LXR, T-HOST-AGE-UNIT],
   $HAS-FAIL-SEL [T-SEM-CORE-OF-LXR, T-LXR-FORMAT-TYPE],
   $HAS-ADJ-TYPE [T-SEM-CORE-OF-LXR, T-LXR-FORMAT-TYPE],
   $HOST-IS-OBJ [T-SEM-CORE-OF-LXR, T-MOVE-S-UP],
   $HOST-OF-PN [T-SEM-CORE-OF-LXR, T-SEM-CORE-OF-PSTG],
   $LNR-HOST [T-SEM-CORE-OF-LXR, T-HOST-AGE-UNIT],
   $IS-A-TYPE [T-LXR-FORMAT-TYPE, T-CHK-FORMAT-TYPE],
   $MOVE-CONJ [T-CONJ-IN-CENTER, T-CONJ-IN-ASSERTION],
   $PN-CONN-TEST [T-SA-PNCONN, T-RADJ-CONN],
   $PRINT-LIST-INFO [T-SEM-CORE-OF-LXR, T-SEM-CORE-OF-REPT],
   $PRINT-NODE-INFO [T-SEM-CORE-OF-LXR, T-SEM-CORE-OF-REPT],
   $PRINT-RESTR [T-SEM-CORE-OF-LXR, T-SEM-CORE-OF-REPT],
   $SET-SEM-CORE [T-SEM-CORE-OF-LXR, T-SETUP-NEG-MEAN,]
        [T-SETUP-TENSE],
   $TIME-PHRASE [T-SEM-CORE-OF-PSTG, T-SEM-CORE-OF-LXR],
   $TRANSFORM-TO-RIGHT [T-MOVE-S-UP, T-REL-CLAUSE].
— GLOBAL-SEQUENCE
GLOBAL = $DESCENT-TYPE [TSEQ-STRING, TSEQ-ADJUNCT,TSEQ-OBJ],
   $ITERATE-CONJ [TSEQ2,TSEQ3],
   $LXR-TYPE [TSEQ-STRING, TSEQ-ADJUNCT],
   $STRING-TYPE [TSEQ-STRING, TSEQ-ADJUNCT],
   $TFORM-LADJ-RADJ [TSEQ-NSTG3A, TSEQ-DSTG-NNN].
— 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 EKGSTG],
        H-AGE, H-ALLERGY, 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]).
LIST MAJOR-EQUIV-CLASSES =
        H-CHEM, 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.
— WITH-EQUIV-CLASSES
—       USED IN T-PSEUDO-CONJ-WITH SERIES FOR 'WITH' THAT ACTS
—       LIKE A CONJUNCTION.
—       E.G. CHEST EXAMINATION REVEALED EXTENSIVE WHEEZING *WITH* PROLONGED
—       EXPIRATORY PHASE .
—       WHERE 'PROLONGED EXPIRATORY PHASE' IS ALSO REVEALED BY CHEST EXAM.
LIST WITH-EQUIV-CLASSES =
        (H-INDIC, H-DIAG, H-TXRES, H-RESULT, H-NORMAL,
        E-WV, E-INTVL, E-AX).
LIST WITH-RESULT = H-RESULT.
— 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.
LIST SIGN-SYMP = H-INDIC, H-DIAG.
— LIST NON-PRONOUN-CLASSES
—       CLASSES IN SUBLANGUAGE-ATTS THAT ARE NOT PRONOUNS.
— -- 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, [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.
LIST NAME-N-PQUANT = 'N-PQUANT'.
LIST WORD-POS-LIST =
        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.
— 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).
— INCLUSION OF EMREGTBL_100.TXT AT TUE JAN 31 17:22:09 2006
— SUBLANGUAGE REGULARIZATION LISTS
LIST FRMT-CLASS =
        H-AGE, H-ALLERGY, [H-BEH,] H-DIAG, H-DEVMED,
        [H-CELLTYPE,] H-CHEM, [H-NOCLASS,]
        H-CHANGE,H-CHANGE-MORE,H-CHANGE-LESS,H-CHANGE-SAME,
        H-ETHNIC, H-FAMILY, [H-GROW,]
        H-INDIC, H-NORMAL, H-ORG, H-PTSPEC,
        H-PTDESCR, H-PTFUNC, H-PTMEAS, H-PTLOC, H-PTPART,
        H-DIET, H-RESP, [H-STATUS,]
        H-TTSURG, H-TTCOMP, H-TTGEN, H-TTMED, H-TTMODE,
        H-TXCLIN, H-TXPROC, H-TXRES, H-TXSPEC, H-TXVAR,
        E-AX, E-EKGPROC, E-WV, E-INTVL, EMPTY-SET, FEM, MASC.
LIST FORMAT-TYPE =
        FRMT0:(H-AGE,H-FAMILY,H-ETHNIC,H-RECORD),
        FRMT1-3:(H-TTCOMP,H-TTGEN[,H-TTMED,H-TTMODE,H-DEVMED]),
        FRMT13-MED:(H-TTMED,H-TTMODE),
        FRMT4:(H-PTSPEC,H-TXVAR,H-TXSPEC,H-ORG),
        FRMT5-PTFAM:(H-FAMILY,H-TXPROC,H-TXCLIN,H-PTDESCR,H-PTMEAS,
        E-EKGPROC,H-SHOW),
        FRMT5-ALG:(H-ALLERGY),
        FRMT5-EKG:(E-WV,E-AX,E-LEAD,E-INTVL),
        FRMT3-5:(H-DEVMED,[H-DIAG,H-INDIC,] H-RESP,
        [H-CHANGE,H-CHANGE-MORE,H-CHANGE-LESS,H-CHANGE-SAME,]
        [H-PTFUNC,H-PTAREA,]
        [H-STATUS,]H-PT,H-DESCR,EMPTY-SET,H-DIET,H-CONN),
        FRMT345:(H-AMT,H-TXRES,H-TTSURG,
        H-CHANGE,H-CHANGE-MORE,H-CHANGE-LESS,H-CHANGE-SAME,
        H-DIAG,H-INDIC,H-NORMAL,
        H-PTLOC,H-PTPART,H-PTAREA,H-PTFUNC [GRI])
        [FRMT6:(H-BEH)].
LIST PATHIF-LIST = PATHIF.
LIST FRMT0-LIST = FRMT0.
LIST FRMT00-LIST = FRMT00.
LIST FRMT1-LIST = FRMT1.
LIST FRMT2-LIST = FRMT2.
LIST FRMT3-LIST = FRMT3.
LIST FRMT4-LIST = FRMT4.
LIST FRMT5-LIST = FRMT5.
LIST FRMT5F-LIST = FRMT5F.
LIST FRMT5-ALG-LIST = FRMT5-ALG [2004/04/20].
LIST FRMT5-EKG-LIST = FRMT5-EKG [2001/02/20].
LIST FRMT5-MISC-LIST = FRMT5-MISC [2000/10/26].
LIST FRMT6-LIST = FRMT6.
LIST FRMT1-3-LIST = FRMT1-3.
LIST FRMT13-MED-LIST = FRMT13-MED [2000/10/26].
LIST FRMT3-5-LIST = FRMT3-5.
LIST FRMT345-LIST = FRMT345.
LIST FRMT-UNIT-LIST = FRMT-UNIT.
LIST NOFRMT-LIST = NOFRMT.
LIST MODIFIER-CLASSES =
        TIME: (H-TMBEG, H-TMEND, H-TMDUR, H-TMREP, H-TMLOC,
        H-CHANGE,H-CHANGE-MORE,H-CHANGE-LESS,H-CHANGE-SAME,
        NTIME1, NTIME2),
        MODS: (H-MODAL, H-NEG, H-EVID),
        Y-OF: (H-TRANSP),
        AREA-MOD: (H-PTAREA),
        BP-MOD: (H-PTAREA, H-PTPART, H-PTLOC),
        QUANTITY: (H-AMT, QNUMBER),
        UNIT: (NUNIT),
        AGE: (H-AGE),
        EVENT-TIME: (H-TMLOC).
LIST NOT-HOST-CLASSES =
        TIME: (H-PTAREA, H-PTPART, H-FAMILY, H-INST, H-PTLOC,
        H-PT [,H-BEH]),
        MODS: (H-PTAREA, H-PTPART, H-FAMILY, H-PTLOC, H-PT),
        BP-MOD:(H-PTAREA),
        UNIT: (VBE, H-NEG, QNUMBER),
        EVENT-TIME: (H-PTAREA, H-PTPART, H-FAMILY,
        [H-INST,GRI] H-PTLOC, H-PT,NTIME1,NTIME2,H-TMLOC).
LIST HOST-CLASSES =
        AGE:(H-PT,H-FAMILY,H-DIAG,H-INDIC,H-TTMED,H-TXVAR,H-TXSPEC),
        AREA-MOD:(H-PTAREA,H-PTPART),
        BP-MOD:([H-BEH,] H-PTFUNC,H-PTMEAS,H-PTPART,H-PTLOC,H-PTDESCR,
        H-DIAG,H-TXCLIN,H-INDIC,H-INST,E-EKGPROC,
        EMPTY-SET,H-NORMAL,H-TTMED,[H-STATUS,]
        H-TXRES,H-TXPROC,H-TXSPEC,H-TXVAR,H-RESP).
LIST H-AGE-LIST = H-AGE.
LIST DOCTOR-LIST = H-INST [H-DOCTOR].
LIST PT-FAM = H-PT, H-FAMILY.
LIST CHANGEMK-LIST = H-CHANGEMK.
LIST REPT-LIST =
        [H-TTGEN,] H-PTVERB [H-TTCOMP, H-TXPROC, H-TTCHIR].
LIST OPERATOR-LIST = [NSENT1,NSENT2,NSENT3,ASENT1,ASENT3,VSENT1,]
        VSENT2,VSENT3,VSENT4.
LIST TRANSP-LIST =
        H-AMT, H-TMBEG, H-CHANGE, H-CHANGE-MORE, H-CHANGE-LESS,
        H-CHANGE-SAME, H-TMEND, H-EVID,
        H-MODAL, H-NEG, H-OBSERVE, H-TMDUR, H-TMREP, H-TRANSP.
LIST TIME-MOD-NODES =
        H-TTGEN,H-PTVERB,H-TTCOMP,H-VTEST,H-CONN,H-TXSPEC,H-TXVAR,[H-GROW,]
        H-TXCLIN, H-PTFUNC, H-PTMEAS, H-TXRES, H-INDIC,H-TXPROC,
        [H-BEH,] H-PTDESCR, H-DIAG, VBE, VHAVE, H-SHOW, H-TTMED,H-ORG,
        H-INST, [H-DOCTOR,] H-NORMAL, H-AMT, H-NEG, NUNIT, QNUMBER,
        H-RECORD, H-RESULT, H-BECONN.
LIST TIME-ADVERB-LIST = TIME-ADVERBIAL.
— 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.
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).
— END-OF-SELECTION-LISTS USED BY SUBLANGUAGE SELECTION RESTRICTIONS

— TYPE LISTS

TYPE ADJSET =
        LA, LCDA, LCDN, LCDVA, LCS, LD, LDATE, LN, LNAME, LP, LPRO, LQ,
        LT, LTIME, LV, LVSA, LW, LAUX,
        RA, RA1, RD, RDATE, RN, RNAME, RQ, RV, RW, RWV,
        SA,
        [** CONN GRAMMAR NODES **]
        LCONN, RCONN, RP.
TYPE ADJSET1 =
        AND-ORSTG, ANDSTG, ASSTG, [AS-WELL-AS-STG,] BOTHSTG, BUTSTG,
        COLONSTG, COMMASTG, DASHSTG, EGSTG, EITHERSTG, ESPECIALLY-STG,
        LA, LCDA, LCDN, LCDVA, LCS, LD, LDATE, LN, LNAME, LP, LPRO, LQ,
        LT, LV, LVSA, LW, LAUX,
        NEITHERSTG, NORSTG, ORSTG, PARENSTG, PARTICULARLY-STG,
        QNREP, QUOTESTG,
        RA, RA1, RD, RDATE, RN, RNAME, RQ, RV, RW, RWV,
        SA,
        THANSTG, TOSTG, VERSUSSTG,
        [** CONN GRAMMAR NODES **]
        LCONN, RCONN, RP.
TYPE RNOPTSET = 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, LCDA, LCDN, LCDVA, LCS, LDATE, LN, LNAME, LP, LPRO, LQ,
        LT, LTIME, LV, LVSA, LW, LAUX,
        [** CONN GRAMMAR NODES **]
        LCONN, LD.
TYPE LXR =
        LAR, LAR1, LDATER, LDR, LNAMER, LNR, LNSR, LQR, LQNR, LTR,
        LTVR, LVENR, LVINGR, LVR, TENSE, VERB, LLEADR [ekg], LWVR [ekg],
        [** CONN GRAMMAR NODES **]
        LCONNR, LPR.
TYPE MINLIST = PN, D, SUB1, NSTGT, INT, PDATE, TOVO, PVO.
TYPE N-OBJ-IN-STR = [N OR PN OBJECTS OF TYPE STRING]
        ADJN, DP2, DP3, DP4, DP1PN, DP2PN, DP3PN, DP4PN, NA, NASOBJBE,
        ND, NN, NPDOSE, NPN, NPSNWH, NPSVINGO, NPVINGO, NPVINGSTG,
        NSNWH, NTHATS, PN, PNN, PNSNWH, PNTHATS, PNTHATSVO, PNVINGSTG,
        VINGSTGPN, PNX2.
TYPE PSTRING =
        PD, PN, PQUANT, PVINGSTG, PSVINGO, PSNWH, PVINGO.
— MED TYPES.
TYPE ADJAUX = RNWH, NSTGT, CSSTG, RSUBJ, RNSUBJ, SAWH, SN, SNWH.
TYPE N-OMITTING-WH-STRING =
        FORTOVO-N, SAWHICHSTG, S-N, THATS-N, TOVO-N, WHATS-N, WHEVERS-N,
        WHNQ-N, WHNS-N, WHQ-N, WHS-N.
— MED UPDATE
TYPE PDPOBJECT =
        DP1, DP2, DP3, DP4, DPSN,
        DP1PN, DP2PN, DP3PN, DP4PN, DP1P,
        NPN, NPSNWH, NPSVINGO, NPVINGO, NPVINGSTG,
        P1, PN, PNN, PNX2, PNTHATS, PNTHATSVO, PNSNWH, PNVINGSTG,
        PSNWH, PSVINGO, PVINGO, PVINGSTG,
        VINGSTGPN.
TYPE PN-OMITTING-WH-STG =
        PWHNQ-PN, PWHNS-PN, PWHQ-PN, PWHS-PN.
TYPE RADJSET=
        RA, RA1, RD, RDATE, RN, RNAME, RNOPTS, RQ, RT, RV, RW,
        [** CONN GRAMMAR NODES **]
        RCONN, RP, 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,
        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 STATEMENT-EQV-NODES =
        [* Nodes which are equivalent to a format statement *]
        NPWHS, PVO, PVO-N, PWHS, QUANT, VINGO, WHENS, WHS-N.
— 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 LEADVAR OR
        WVVAR OR DATEVAR OR HEADCONN OR LNAMER OR NQ;
        IF PRESENT-ELEMENT- IS LNAMER OR NQ
        THEN IMMEDIATE-NODE OF IMMEDIATE-NODE IS NVAR.
   $STACK-CORE-TEST = IF $POSTCONJ THEN $STACK-CONJUNCTS.
   $POSTCONJ = THE PRESENT-ELEMENT- HAS NODE ATTRIBUTE POSTCONJELEM.
   $STACK-CONJUNCTS = VERIFY ITERATE $STACK-CORES.
   $STACK-CORES = DO $POSTCONJ;
        STORE IN XX-CORE;
        DO $CORE-PATH;
        STACK;
        GO TO XX-CORE.
ROUTINE DOWN1-(X) =
        [* TESTS WHETHER X IS AN ELEMENT WHICH IS ONE LEVEL BELOW THE ]
        [* NODE THE PROGRAM IS CURRENTLY 'LOOKING AT'.]
        GO DOWN;
        ITERATET GO RIGHT UNTIL TEST FOR X SUCCEEDS.
ROUTINE DOWN1(X) =
        [* DOWN1 IS THE STACKING COUNTERPART OF DOWN1-. IF X HAS ]
        [* CONJUNCTS THEY ARE PLACED ON A RE-EXECUTION STACK.]
        DO DOWN1-(X); DO $STACK-TEST.
   $STACK-TEST = IF $POSTCONJ THEN $STACK-CONJUNCTS.
   $STACK-CONJUNCTS = VERIFY ITERATE $STACK-X.
   $STACK-X = DO $POSTCONJ; STACK.
ROUTINE ELEMENT-(X) =
        [* TESTS WHETHER X IS AN ELEMENT ONE LEVEL BELOW THE NODE THE ]
        [* PROGRAM IS CURRENTLY 'LOOKING AT'. IF NOT, AND A STRING ]
        [* SEGMENT IS ONE LEVEL BELOW THE CURRENT NODE THE SEARCH ]
        [* CONTINUES ONE LEVEL BELOW THE STRING SEGMENT NODE.]
        EITHER DO DOWN1-(X) OR $STRING-SEGMENT.
   $STRING-SEGMENT = DO DOWN1-(STGSEG); DO DOWN1-(X).
ROUTINE ELEMENT(X) =
        [* ELEMENT(X) IS THE STACKING COUNTERPART OF ELEMENT-(X). IF ]
        [* ELEMENT X GOES TO X1 AND X1 HAS CONJUNCTS X2,X3,ETC THEN X2, ]
        [* X3, ETC ARE PLACED ON THE RE-EXECUTION STACK.IF X1 IS ]
        [* IN A STRING SEGMENT S AND S HAS CONJUNCTS THEN THEY ]
        [* ARE PLACED IN THE RE-EXECUTION STACK.]
        EITHER DO DOWN1(X) OR $STRING-SEGMENT.
   $STRING-SEGMENT = DO DOWN1(STGSEG); DO DOWN1(X).
ROUTINE FOLLOWING-ELEMENT- =
        [* GOES RIGHT TO THE FIRST NODE WHICH IS NOT SP-NODE.]
        DO $RIGHT-TO-HOST [HOST-ELEMENT].
ROUTINE FOLLOWING-ELEMENT =
        [* FOLLOWING-ELEMENT IS THE STACKING COUNTERPART OF ]
        [* FOLLOWING-ELEMENT-. IT GOES TO THE ]
        [* FOLLOWING-ELEMENT- AND STACKS IT'S CONJUNCTS.]
        STORE IN X200;
        DO $RIGHT-TO-HOST [HOST-ELEMENT];
        DO STACK-FOR-RIGHT.
ROUTINE HOST- =
        [* GOES TO THE CORE OF HOST-ELEMENT ]
        CORE- OF HOST-ELEMENT EXISTS.
ROUTINE HOST =
        EITHER TEST FOR ADJSET OR ASCEND TO ADJSET;
        ONE OF $IN-LADJSET, $IN-RADJSET, $IN-RNSUBJ;
        DO $CORE-PATH .
   $IN-LADJSET =
        DO $AT-LADJ [HOST-ELEMENT];
        DO STACK-FOR-RIGHT.
   $IN-RADJSET =
        DO $AT-RADJ [HOST-ELEMENT];
        DO STACK-FOR-LEFT.
   $IN-RNSUBJ =
        DO $ATRNSUBJ[HOST-ELEMENT];
        DO $STACK-TEST [STARTAT].
ROUTINE HOST-ELEMENT =
        [* STARTS AT OR ASCENDS TO LADJSET OR RADJSET OR RNSUBJ Y. ]
        [* IF Y IS OF TYPE RADJSET OR LADJSET IT GOES TO THE CORE ]
        [* ELEMENT X (TO X IN AN LXR TYPE NODE). IF Y IS RNSUBJ IT ]
        [* ASCENDS TO SA AND THEN GOES TO COELEMENT SUBJECT. ]
        [* ** FRENCH CHANGE IN $AT-RADJ ** *]
        EITHER TEST FOR ADJSET OR ASCEND TO ADJSET PASSING THROUGH ADJINRN;
        ONE OF $AT-LADJ, $AT-RADJ, $ATRNSUBJ IS TRUE.
   $AT-LADJ =
        TEST FOR LADJSET;
        STORE IN X200;
        DO $RIGHT-TO-HOST .
   $RIGHT-TO-HOST =
        EITHER $GO-RIGHT-PAST-C
        OR ITERATE $TO-PRECONJUNCTION-Y [COEL1-]
        UNTIL $GO-RIGHT-PAST-C SUCCEEDS.
   $GO-RIGHT-PAST-C = ITERATE GO RIGHT UNTIL TEST FOR SP-NODE FAILS.
   $AT-RADJ =
        EITHER $IN-RN OR $IN-OTHERS;
        STORE IN X200;
        EITHER $RV-TEST OR $LEFT-TO-HOST.
   $IN-RN =
        TEST FOR RN;
        STORE IN X100;
        GO LEFT;
        IF PRESENT-ELEMENT- IS RNOPTS THEN DO $1;
        GO TO X100.
   $1 = GO UP; DO $IN-RN.
   $IN-OTHERS = TEST FOR RADJSET.
   $RV-TEST =
        TEST FOR RV;
        STORE IN X100;
        ONE OF $L-VVAR, $L-V, $L-VING, $L-VEN.
   $L-VVAR = DO L(VVAR).
   $L-V = DO L(V).
   $L-VING = DO L(VING).
   $L-VEN = DO L(VEN).
   $LEFT-TO-HOST =
        EITHER $LEFT-PAST-C OR ITERATE $TO-PRECONJUNCTION-Y [COEL1]
        UNTIL $LEFT-PAST-C SUCCEEDS.
   $LEFT-PAST-C = ITERATE GO LEFT UNTIL TEST FOR SP-NODE FAILS.
   $ATRNSUBJ =
        BOTH VALUE OF SA IS RNSUBJ
        AND PRESENT-ELEMENT- HAS COELEMENT- SUBJECT OR BESUBJ.
— IMMEDIATE(X) ASCENDS TO X. NODES ON THE STRING LIST ARE NOT
—       PASSED THROUGH.IF THIS ROUTINE STARTS AT Q-CONJ IT WILL GO
—       TO THE HOST NODE(UP TWICE FROM TOP OF Q NEST).

ROUTINE IMMEDIATE (X) =
        DO $UP-THROUGH-Q;
        ASCEND TO X PASSING THROUGH Q-CONJ.
   $UP-THROUGH-Q = ITERATET $GO-UP-TWICE UNTIL
        TEST FOR Q-CONJ FAILS. (GLOBAL)
   $GO-UP-TWICE = GO UP; GO UP.
ROUTINE IMMEDIATE-NODE- = GO UP.
ROUTINE IMMEDIATE-NODE =
        EITHER ITERATE $UP-CONJ [IN LEFT-ADJUNCT ROUTINE] OR TRUE ;
        GO UP.
ROUTINE IMMEDIATE-STRING = ASCEND TO STRING ;
        IF PRESENT-ELEMENT- IS Q-CONJ THEN DO IMMEDIATE-STRING.
ROUTINE INITIALRT =
        [* TESTS THAT THERE IS NO NODE TO THE LEFT OF THE ]
        [* NODE THE PROGRAM IS CURRENTLY 'LOOKING AT'.]
        VERIFY NOT DO PREVIOUS-ELEMENT-.
ROUTINE L (X) = ITERATE GO LEFT UNTIL TEST FOR X SUCCEEDS.
ROUTINE LAST-COELEMENT = EITHER ITERATE GO RIGHT OR TRUE.
ROUTINE LAST-ELEMENT- =
        [* GOES TO LEVEL BELOW THE NODE THE PROGRAM IS CURRENTLY ]
        [* 'LOOKING AT' AND GOES TO THE RIGHTMOST NODE ON THAT LEVEL. ]
        GO DOWN;
        EITHER ITERATE GO RIGHT OR TRUE.
ROUTINE LAST-ELEMENT =
        [* LAST-ELEMENT IS THE STACKING COUNTERPART OF LAST-ELEMENT-. ]
        [* IT GOES TO THE LAST-ELEMENT- AND STACKS IT'S CONJUNCTS.]
        DO LAST-ELEMENT-;
        DO $STACK-TEST [STARTAT].
ROUTINE LEFT-ADJUNCT =
        EITHER $ASCNT [IN CORE] OR TRUE;
        EITHER $LEFT-TO-LADJ OR $UP-AND-LEFT.
   $LEFT-TO-LADJ =
        DO L (LADJSET); EITHER TEST FOR LN OR DO CORE.
   $UP-AND-LEFT =
        ITERATET $UP-CONJ UNTIL $LEFT-TO-LADJ SUCCEEDS
        [GO UP TO CONJUNCTION AND TRY TO GO LEFT].
   $UP-CONJ =
        IMMEDIATE-NODE- IS Q-CONJ; GO UP [WILL BE AT CONJ-NODE].
ROUTINE LEFT-ADJUNCT-POS =
        [* STARTS AT A CORE NODE Y WHERE Y IS AN ELEMENT OF AN LXR ]
        [* TYPE NODE OR FROM THE CORE ASCENDS TO Y IF Y = AVAR, QVAR ]
        [* OR NVAR. IT THEN GOES LEFT UNTIL IT FINDS A NODE WHICH IS ]
        [* ON THE LADJSET LIST. IF IT FINDS LNAME IN NVAR, IT WILL GO ]
        [* FROM LNAME TO LN.]
        EITHER $ASCNT [CORE] OR TRUE;
        STORE IN X200;
        EITHER DO L(LADJSET) OR ITERATE $TO-PRECONJUNCTION-Y [COEL1-]
        UNTIL DO L(LADJSET) SUCCEEDS.
ROUTINE LOOKAHEAD(X) =
        GO TO THE CURRENT WORD;
        ITERATET GO TO THE NEXT WORD UNTIL DO X SUCCEEDS.
ROUTINE NELEMRT =
        [* CALLED AFTER AN OPERATOR HAS GONE TO THE NTH ELEMENT OF ]
        [* A STRING (IGNORING SPECIAL PROCESS NODES). IT STACKS THE ]
        [* CONJUNCTS OF THAT ELEMENT.]
        DO $STACK-TEST [STARTAT].
ROUTINE NONSEG-IMMSTG =
        DO IMMEDIATE-STRING;
        EITHER $UP-THRU-SEG OR TRUE.
   $UP-THRU-SEG = TEST FOR STGSEG; DO IMMEDIATE-NODE; TEST FOR STRING.
ROUTINE PRESENT-ELEMENT =
        ITERATET $HOST-OF-CONJ UNTIL TEST FOR Q-CONJ FAILS.
   $HOST-OF-CONJ =
        GO UP [TO CONJ-NODE];
        GO UP [TO HOST OF CONJ-NODE].
ROUTINE PRESENT-ELEMENT- = TRUE.
ROUTINE PREVIOUS-ELEMENT- =
        [* PREVIOUS-ELEMENT- SIMPLIFIED THE PREVIOUS-ELEMENT- IN MDPAR6]
        GO LEFT.
ROUTINE R (X) = ITERATE GO RIGHT UNTIL TEST FOR X SUCCEEDS.
ROUTINE RIGHT-ADJUNCT =
        EITHER $ASCNT OR TRUE;
        EITHER $RIGHT-TO-RADJ OR $UP-AND-RIGHT.
   $RIGHT-TO-RADJ=
        DO R(RADJSET); DO CORE.
   $UP-AND-RIGHT =
        ITERATE $UP-CONJ [IN LEFT-ADJUNCT ] UNTIL $RIGHT-TO-RADJ SUCCEEDS.
ROUTINE RIGHT-ADJUNCT-POS =
        EITHER $ASCNT [CORE] OR TRUE;
        STORE IN X200;
        EITHER DO R(RADJSET)
        OR ITERATE $TO-PRECONJUNCTION-Y [ COEL1- ]
        UNTIL DO R(RADJSET) SUCCEEDS;
        IF PRESENT-ELEMENT- IS RNAME
        THEN AT IMMEDIATE NVAR DO RIGHT-ADJUNCT-POS.
ROUTINE STACK-FOR-LEFT =
        [* STACK-FOR-LEFT ROUTINES WHICH GO FROM ONE ELEMENT OF A ]
        [* STRING TO ANOTHER ELEMENT OF THE STRING BY GOING LEFT CALL ]
        [* STACK-FOR-LEFT TO HANDLE STACKING. GIVEN THAT X AND Y ARE ]
        [* ELEMENTS OF A STRING, STACK-FOR-LEFT IS ASSUMED TO START AT ]
        [* X AFTER THE ROUTINE WHICH CALLED IT GOES FROM Y TO X. ]
        [* IN STRUCTURE (X1 CONJ X2) Y, STACK-FOR-LEFT WILL STACK X2. ]
        [* IN STRUCTURE X1 Y1 CONJ X2 Y2, STACK-FOR-LEFT WILL NOT STACK X2.]
        IF $POSTCONJ THEN VERIFY $STACK-IF-NO-Y-RGHT.
   $STACK-IF-NO-Y-RGHT =
        IF $POSTCONJ
        @THEN EITHER ALL OF $NO-Y-TO-RIGHT,
   $DO-STACK,
   $STACK-IF-NO-Y-RGHT
        OR TRUE.
   $NO-Y-TO-RIGHT =
        NOT ITERATE GO RIGHT UNTIL TEST FOR X200 SUCCEEDS.
   $DO-STACK = STACK.
ROUTINE STACK-FOR-RIGHT =
        [* STACK-FOR-RIGHT ROUTINES WHICH GO FROM ONE ELEMENT OF A ]
        [* STRING TO ANOTHER ELEMENT OF THE STRING BY GOING RIGHT ]
        [* CALL STACK-FOR-RIGHT TO HANDLE STACKING. GIVEN THAT X AND ]
        [* Y ARE ELEMENTS OF A STRING, STACK-FOR-RIGHT IS ASSUMED TO ]
        [* START AT Y AFTER THE ROUTINE WHICH CALLED IT GOES FROM X ]
        [* TO Y. IN A SITUATION X1 Y1 CONJ Y2, STACK-FOR-RIGHT ]
        [* STARTING AT Y1 WILL STACK Y2. IN A SITUATION X1 Y1 CONJ X2 ]
        [* Y2, STACK-FOR-RIGHT STARTING AT Y1 WILL NOT STACK Y2.]
        IF $POSTCONJ THEN VERIFY $STACK-IF-NO-Y-LEFT.
   $STACK-IF-NO-Y-LEFT =
        IF $POSTCONJ
        @THEN EITHER ALL OF $NO-Y-TO-LEFT,
   $DO-STACK,
   $STACK-IF-NO-Y-LEFT
        OR TRUE.
   $NO-Y-TO-LEFT =
        NOT ITERATE GO LEFT UNTIL TEST FOR X200 SUCCEEDS.
   $DO-STACK = STACK.
ROUTINE STARTAT (X) = EITHER TEST FOR X OR DO DOWN1-(X).
ROUTINE SUBSUMERT(X) 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 TOVO OR
        VINGO OR PVO OR VO OR Q-CONJ.
   $COELSUBJ = PRESENT-ELEMENT HAS COELEMENT SUBJECT OR BESUBJ OR TPOS.
ROUTINE VERB-COELEMENT- = DO $NEXT-VERB- .
   $NEXT-VERB- = DO $1. (GLOBAL)
   $1 = THE PRESENT-ELEMENT- HAS COELEMENT- VERB OR LVINGR OR
        LVENR OR LVR.
ROUTINE VERB-COELEMENT = DO $NEXT-VERB.
   $NEXT-VERB = DO $1. (GLOBAL)
   $1 = THE PRESENT-ELEMENT- HAS COELEMENT VERB OR LVINGR OR
        LVENR OR LVR.
— FIRST-FILLED-ATOM
—       AT THE PRESENT LOCATION, LOOK DOWN THE SUBSTREE TO FIND THE
—       FIRST ATOM THAT IS LEXICALLY FILLED.
ROUTINE FIRST-FILLED-ATOM =
        ITERATET $GO-TO-NEXT-NODE
        UNTIL BOTH PRESENT-ELEMENT- IS OF TYPE ATOM
        AND PRESENT-ELEMENT- IS NOT EMPTY SUCCEEDS.
   $GO-TO-NEXT-NODE =
        EITHER GO DOWN
        OR ITERATET GO UP
        UNTIL GO RIGHT SUCCEEDS.
— LAST-FILLED-ATOM
—       AT THE PRESENT LOCATION, LOOK DOWN THE SUBTREE TO FIND THE
—       LAST ATOM THAT IS LEXICALLY FILLED.
ROUTINE LAST-FILLED-ATOM =
        ITERATET $GO-TO-NEXT-NODE
        UNTIL BOTH PRESENT-ELEMENT- IS OF TYPE ATOM
        AND PRESENT-ELEMENT- IS NOT EMPTY SUCCEEDS.
   $GO-TO-NEXT-NODE =
        EITHER DO $LAST-NODE
        OR ITERATET GO UP
        UNTIL GO LEFT SUCCEEDS.
   $LAST-NODE =
        GO DOWN;
        EITHER ITERATE GO RIGHT OR TRUE.
— ********** **************************************** **********
—       *
—       CONJUNCTION ROUTINES *
—       *
— ********** **************************************** **********

ROUTINE CO-CONJ(X) 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)
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.
— ***** ****************************************************************

—       CONNECTIVE TRANSFORMATIONS

— ***** ****************************************************************
— THIS COMPONENT IS EXECUTED USING OUTPUT TREES FROM THE ENGLISH
— DECOMPOSITION COMPONENT. EACH TRANSFORMATION IN THE CONNECTIVE
— COMPONENT (WITH THE EXCEPTION OF T-FIND-HOST) CREATES A
— CONNECTIVE --PARSE-CONN-- CONNECTING ONE ASSERTION/FRAGMENT
— TO ANOTHER ASSERTION/FRAGMENT. PARSE-CONN HAS THE FOLLOWING
— STRUCTURE:
—       PARSE-CONN = X = SA + LCONNR + SA.
—       WHERE X IS THE NAME OF THE TYPE OF CONNECTIVE SUCH AS
—       'CONJOINED', 'EMBEDDED', ETC.
—       LCONNR = LCONN + HEADCONN + RCONN.
— LCONN AND RCONN ARE THE LEFT AND RIGHT ADJUNCTS OF THE CONECTIVE
— HEADCONN. THE SUBSTRUCTURE OF HEADCONN DEPENDS ON THE TYPE OF
— CONNECTIVE. IT WILL BE DESCRIBED IN EACH TRANSFORMATION.
—       IN GENERAL, WHEN ONE OF THE TRANSFORMATIONS FINDS A RELEVANT
— SUBSTRUCTURE IN AN ASSERTION 'A', IT ATTACHES A CONNECTIVE
— 'PARSE-CONN' TO THE LEFT OF 'A' AND CREATES AN ASSERTION/FRAGMENT
— 'B' FROM 'A' AND ATTACHES IT TO THE RIGHT OF 'A'. 'A' MAY BE
— CHANGED TO 'A1' IN THE PROCESS. WHEN A SUCCESSFUL CONNECTIVE
— TRANSFORMATION IS COMPLETED IN ASSERTION 'A', THE STRUCTURE
—       PARSE-CONN + A1 + B + CONJ-NODE
— REPLACES 'A'. WHEN AN ASSERTION IN 'A' IS MOVED UP, ITS CONJUNCT (IF
— IT HAS ONE) IS ALSO MOVED UP ALONG WITH CONJ-NODE SO THAT WHEN THE
— TRANSFORMATION IS COMPLETED WE HAVE:
—       PARSE-CONN + A1 + B + CONJ-NODE
—       WHERE CONJ-NODE = CONJ + CONJUNCT OF B.
— WHEN TRANSFORMING ASSERTION 'B', THE FIRST TRANSFORMATION IS
— T-CONJ-IN-ASSERTION WHICH WILL CREATE A CONNECTIVE 'PARSE-CONN' =
— 'CONJOINED' TO THE LEFT OF 'B' AND THE CONJUNCT OF 'B' WILL BE ATTACHED
— TO THE RIGHT OF 'B'. THE ABOVE STRUCTURE WILL THEN BE:
—       PARSE-CONN + A1 + PARSE-CONN + B + CONJUNCT OF B.
T-CONJ-IN-ONESENT = IN SENTENCE:
        AT VALUE OF ELEMENT ONESENT OF TEXTLET
        DO $MOVE-CONJ [T-CONJ-IN-CENTER].
— T-CONJ-IN-CENTER
—       OPERATES WHEN THE VALUE V1 OF ONESENT/CENTER HAS A CONJUNCT
— V2. PARSE-CONN IS ATTACHED TO THE LEFT OF V1. V2 IS MOVED TO THE RIGHT
— OF V1 SO THAT WE HAVE: PARSE-CONN + V1 + V2 .
—       PARSE-CONN = CONJOINED = SA + LCONNR + SA
—       HEADCONN = FIRST ELEMENT OF CONJ-NODE.
— IF SACONJ IS NOT EMPTY, ITS VALUE SA IS MOVED TO THE FIRST SA OF
— CONJOINED. IF 'NOT' IS IN CONJ-NODE, DSTG = D = NOT IS CREATED
— AND ALSO MOVED TO THE FIRST SA OF CONJOINED.
T-CONJ-IN-CENTER = IN CENTER:
        AT VALUE DO $MOVE-CONJ.
   $MOVE-CONJ =
        ITERATET $TRANSFORM-CONJ UNTIL $NEXT-CONJ FAILS. (GLOBAL)
   $NEXT-CONJ =
        DO R(CONJ-NODE);
        STORE IN X-PCONN;
        VERIFY $GO-LEFT-ONE.
   $GO-LEFT-ONE =
        GO LEFT;
        STORE IN X-ARG1.
   $TRANSFORM-CONJ =
        DO $BUILD-CONJOINED;
        DO $ASSRT-FRAG-UP [MOVE CONJUNCTION TO LEVEL OF FRAG OR ASSERT].
   $BUILD-CONJOINED =
        BEFORE X-ARG1 INSERT
        <PARSE-CONN> (<CONJOINED> (<SA> X-SA (<NULL>)
        +<LCONNR> X-CONN
        +<SA> X-SA2 (<NULL>)));
        DO $BUILD-X-SA;
        DO $BUILD-LCONNR;
        AT FIRST ELEMENT X-HCONN OF X-PCONN DO $BUILD-HEADCONN;
        DELETE X-HCONN;
        DO $BUILD-NOT. (GLOBAL)
   $ASSRT-FRAG-UP =
        REPLACE X-PCONN BY ALL ELEMENTS OF Q-CONJ OF X-PCONN;
        AT X-ARG1 GO RIGHT [* first ASSN/FRAG of Q-CONJ *];
        BOTH DO $COPY-NEG-MODAL
        AND TRANSFORM PRESENT-ELEMENT-.
   $COPY-NEG-MODAL = [GLOBAL]
        [* distribute NEG and MODAL *]
        IF $NEG-MODAL-IN-CONN
        THEN BOTH $COPY-NEG-MOD AND $ASSIGN-H-NEG.
   $NEG-MODAL-IN-CONN =
        IN X-CONN,
        EITHER ELEMENT- LCONN HAS ELEMENT- LDR
        WHERE CORE- X-CONN-NEG IS H-NEG
        OR EITHER CORE- X-CONN-NEG IS 'NOR'
        OR CORE X-CONN-NEG IS H-NEG.
   $COPY-NEG-MOD =
        IF PRESENT-ELEMENT- IS ASSERTION
        WHERE ELEMENT- NEG X-SA EXISTS
        THEN REPLACE X-SA BY <NEG> (X-CONN-NEG, X-NEG)
        [REPLACE X-SA BY <NEG> (<NG> X-NEG = 'NEG':(H-NEG))]
        ELSE BOTH ELEMENT- SA X-SA EXISTS
        AND IF X-SA IS EMPTY
        THEN REPLACE X-SA BY
        <SA> (<DSTG> (X-CONN-NEG, X-NEG))
        [<SA> (<DSTG> (<D> X-NEG = 'NEG':(H-NEG)))]
        ELSE BEFORE VALUE OF X-SA
        [INSERT <DSTG> (<D> X-NEG = 'NEG':(H-NEG))]
        INSERT <DSTG> (X-CONN-NEG, X-NEG).
   $ASSIGN-H-NEG =
        BOTH X-NEG-LIST := LIST NEG-LIST
        AND AT X-NEG, ASSIGN NODE ATTRIBUTE SELECT-ATT
        WITH VALUE X-NEG-LIST.
   $REPLACE-CENTER =
        IF PRESENT-ELEMENT- IS ONESENT
        THEN AT VALUE ITERATET $MAKE-ASSERT-FRAG
        UNTIL DO R(CENTER) FAILS.
   $MORE =
        ITERATET GO RIGHT UNTIL TEST FOR FRAGMENT OR ASSERTION SUCCEEDS.
   $BUILD-LCONNR =
        AT X-CONN REPLACE PRESENT-ELEMENT- BY
        <LCONNR>X-CONN ( <LCONN> (<NULL>)
        + <HEADCONN>
        + <RCONN> (<NULL>)). (GLOBAL)
   $BUILD-HEADCONN =
        AT X-CONN
        IF X-PCONN IS [FRENCH] AINSIQUESTG
        THEN REPLACE HEADCONN BY
        <HEADCONN> (<P> = 'AINSI_QUE':(H-CONN))
        ELSE REPLACE HEADCONN BY <HEADCONN> (X-HCONN). (GLOBAL)
   $MAKE-ASSERT-FRAG =
        REPLACE PRESENT-ELEMENT- BY ALL ELEMENTS OF PRESENT-ELEMENT-.
   $BUILD-NOT =
        IN X-PCONN
        IF EITHER ELEMENT- 'NOT' X2 EXISTS
        OR ELEMENT- NOTOPT X2 EXISTS
        WHERE PRESENT-ELEMENT IS NOT EMPTY
        THEN BOTH AT ELEMENT NULL X1 OF X-SA
        DO $BUILD-DSTG
        AND DELETE X2.
   $BUILD-DSTG =
        REPLACE X1 BY <DSTG> ( <D> = 'NOT' ).
   $BUILD-X-SA =
        AT X-PCONN
        IF SACONJ X1 IS NOT EMPTY
        THEN BOTH AT VALUE OF X-SA
        REPLACE PRESENT-ELEMENT-
        BY VALUE OF VALUE OF X1 [SACONJ=SA=...]
        AND BOTH TRANSFORM X-SA
        AND DELETE X1 [SACONJ].
— T-CONJ-IN-ASSERTION
—       IS SIMILAR TO T-CONJ-IN-CENTER. IT OPERATES WHEN
—       ASSERTION HAS A CONJUNCT.
—       IT HANDLES SITUATIONS WHERE CONJOINED ASSERTIONS OR
—       FRAGMENTS ARE NOT UNDER CENTER.
T-CONJ-IN-ASSERTION = IN ASSERTION, FRAGMENT:
        AT PRESENT-ELEMENT- X-PRE
        BOTH DO $MOVE-CONJ [Global in T-CONJ-IN-CENTER]
        AND IF BOTH AT VALUE OF X-PRE, DO R(CONJ-NODE)
        WHERE STORE IN X-CONJNODE
        AND ELEMENT- Q-CONJ X-QCONJ OF X-CONJNODE EXISTS
        THEN BOTH DO $MOVE-CONJS-UP
        AND AT X-PRE DO $MOVE-CONJ.
   $MOVE-CONJS-UP =
        IF X-PRE IS ASSERTION
        THEN REPLACE X-QCONJ
        BY <Q-CONJ> (<ASSERTION> (ALL ELEMENTS OF X-QCONJ))
        ELSE REPLACE X-QCONJ
        BY <Q-CONJ> (<FRAGMENT> (ALL ELEMENTS OF X-QCONJ));
        AFTER X-PRE INSERT X-CONJNODE, X-NEWCONJNODE;
        DELETE X-CONJNODE.
— T-CONJ-IN-FRAGMENT = IN FRAGMENT:
—       OPERATES WHEN AN NSTG IN FRAGMENT1 HAS A CONJUNCTION NSTG2.
—       WE CREATE PARSE-CONN + FRAGMENT1 + FRAGMENT2
—       HEAD OF PARSE-CONN = FIRST ELEMENT OF CONJ-NODE
—       FRAGMENT2 = SA (SAME AS FRAGMENT1)
—       + NSTG2
—       + SA (SAME AS 2ND SA OF FRAGMENT1)
T-CONJ-IN-FRAGMENT = IN FRAGMENT:
        PRESENT-ELEMENT- X-ARG1 EXISTS;
        AT VALUE DO $CONJ-CHK.
   $CONJ-CHK = ITERATET $TRANSFORM-CONJ UNTIL $NEXT-CONJ FAILS.
   $NEXT-CONJ = DO R(CONJ-NODE);
        STORE IN X-PCONN;
        ELEMENT- Q-CONJ EXISTS [* this is not punctuation *].
   $TRANSFORM-CONJ = [CREATE FRAGMENT2 = CONJOINED NSTG]
        DO $BUILD-CONJOINED [GLOBAL IN T-CONJ-IN-CENTER];
        DO $MAKE-NEW-FRAG.
   $MAKE-NEW-FRAG =
        AFTER X-ARG1 INSERT
        <FRAGMENT> X-NEW (ALL ELEMENTS OF Q-CONJ OF X-PCONN);
        DO $GET-SAS [GET SAS OF FRAGMENT1 FOR FRAGMENT2];
        DELETE X-PCONN [DELETE OLD FORM OF CONJUNCTION];
        AT X-ARG1 GO RIGHT [TO NEW FRAGMENT];
        TRANSFORM PRESENT-ELEMENT-.
   $GET-SAS =
        VALUE OF X-ARG1 EXISTS;
        EITHER PRESENT-ELEMENT- IS SA X-SA1 OR X-SA1:= NIL;
        EITHER $RIGHT-TO-SA OR X-SA2:= NIL;
        IF X-SA2 IS NOT NIL
        THEN AFTER VALUE OF X-NEW INSERT X-SA2 [ADD 2ND SA ];
        IF X-SA1 IS NOT NIL
        THEN BEFORE VALUE OF X-NEW INSERT X-SA1 [ADD 1ST SA].
   $RIGHT-TO-SA = DO R(SA);
        STORE IN X-SA2.
— T-CSSTG
—       OPERATES WHEN AN SA IN ASSERTION A = LCS + CSSTG.
—       PARSE-CONN = SUB-CONJ IS ATTACHED TO THE LEFT OF A.
—       THE ASSERTION(S) OF CSSTG IS(ARE) MOVED TO THE RIGHT OF A.
—       HEADCONN = CS (I.E., THE FIRST ELEMENT OF CSSTG).
—       LCONN = ELEMENTS OF LCS.
—       CSSTG IS REPLACED IN A BY NULL.
T-CSSTG = IN SA, LNR, VERB [ASSERTION, FRAGMENT]:
        IF PRESENT-ELEMENT- IS LNR OR VERB
        THEN DO $BUILD-LNR-CSSTG
        ELSE IF BOTH IMMEDIATE-NODE X-PRE IS ASSERTION OR FRAGMENT
        AND $NOT-PHRASE-ATTS
        THEN DO $SA-CSSTG.
   $NOT-PHRASE-ATTS =
        BOTH ELEMENT- CSSTG EXISTS WHERE VALUE X-SUBX EXISTS
        AND EITHER X-SUBX DOES NOT HAVE NODE ATTRIBUTE PHRASE-ATT
        OR BOTH X-SUBX HAS NODE ATTRIBUTE PHRASE-ATT X-PHR-ATT
        AND X-PHR-ATT DOES NOT HAVE MEMBER TIME-PHRASE OR SOURCE-PHRASE
        OR INFLUENCE-PHRASE.
   $BUILD-LNR-CSSTG =
        IF DO R(CSSTG) WHERE
        STORE IN X-SA
        THEN BOTH AT X-SA, VALUE X-PCONN EXISTS
        AND ALL OF $LOOK-FOR-ASSN, $BUILD-SUBCONN.
   $LOOK-FOR-ASSN =
        AT X-SA, ASCEND TO ASSERTION OR FRAGMENT PASSING THROUGH STRING;
        STORE IN X-PRE.
   $SA-CSSTG =
        IF ELEMENT CSSTG X-SA EXISTS WHERE VALUE X-PCONN EXISTS
        THEN $BUILD-SUBCONN.
   $BUILD-SUBCONN =
        BEFORE X-PRE INSERT
        <PARSE-CONN> (<SUB-CONJ> (<SA> (<NULL>)
        +<LCONNR> X-CONN
        +<SA> (<NULL>)) ) ;
        DO $BUILD-LCONNR [GLOBAL IN T-CONJ-IN-CENTER];
        AT FIRST ELEMENT X-HCONN OF X-PCONN DO $BUILD-HEADCONN;
        DELETE X-HCONN;
        DO $BUILD-LCONN;
        DO $MOVE-ASSERT.
   $BUILD-LCONN =
        REPLACE LCONN OF X-CONN
        BY <LCONN> (ALL ELEMENTS OF COELEMENT- LCS X-LCS OF X-SA);
        DELETE X-LCS.
   $MOVE-ASSERT =
        AFTER X-PRE INSERT ALL ELEMENTS OF X-PCONN;
        AT X-PRE DO $TRANSFORM-TO-RIGHT [GLOBAL IN T-MOVE-S-UP];
        DELETE X-SA.
— T-SA-PNCONN
—       OPERATES WHEN SA IN ASSERTION A (OR SA IN OBJECT OF A = NN/NPN/
— PNN) = PN WHERE P = H-CONN.
—       PARSE-CONN = RELATION IS ATTACHED TO THE LEFT OF A.
—       HEADCONN = P OF PN.
—       LCONN = ELEMENTS OF LP OF PN.
—       FRAGMENT B = NSTG [WHICH IS COPIED FROM NSTG OF NSTGO OF PN]
—       IS ATTACHED TO LEFT OF A.
—       PN IS REPLACED BY NULL IN A.
T-SA-PNCONN = IN ASSERTION, FRAGMENT:
        AT PRESENT-ELEMENT- X-PRE,
        EITHER BOTH $SA-IN-LEVEL [TEST SA IN ASSERTION],
        AND $SA-IN-OBJECT [SA IN OBJ = NPN, NN, PNN]
        OR TRUE.
   $SA-IN-LEVEL =
        AT VALUE ITERATE $FIND-SAPCONN
        UNTIL DO R(SA) FAILS.
   $FIND-SAPCONN =
        PRESENT-ELEMENT- X-SA EXISTS;
        AT VALUE ITERATE IF $SA-HAS-PCONN
        THEN $BUILD-PCONN
        UNTIL DO R(PN) FAILS;
        GO TO X-SA.
   $SA-HAS-PCONN =
        BOTH PRESENT-ELEMENT- X-PN IS PN
        AND [EITHER] $PN-CONN-TEST
        [OR $P-IS-HCONN].
   $PN-CONN-TEST =
        EITHER BOTH P X-HCONN HAS NODE ATTRIBUTE SELECT-ATT
        @AND PRESENT-ELEMENT- HAS MEMBER CONN-LIST
        OR $IS-CONN-TYPE.
   $IS-CONN-TYPE =
        BOTH X-PN HAS NODE ATTRIBUTE ADVERBIAL-TYPE
        @AND PRESENT-ELEMENT- HAS MEMBER CONN-TYPE;
        AT X-PN ELEMENT P X-HCONN EXISTS.
   $SA-IN-OBJECT =
        VALUE OF ELEMENT OBJECT IS NN OR NPN OR PNN;
        DO $SA-IN-LEVEL.
   $BUILD-PCONN =
        DO $BUILD-RELATION;
        DO $BUILD-LCONN;
        IF DO $IN-RELCLAUSE
        THEN DO $MOVE-PCONN
        ELSE DO $MAKE-FRAG. [GLOBAL]
   $IN-RELCLAUSE =
        AT X-PRE, DO L(PARSE-CONN);
        STORE IN X-PCONN;
        DO $FOUND-RELCLAUSE.
   $FOUND-RELCLAUSE =
        [* FIND PARSE-CONN REL-CLAUSE *]
        DO L(PARSE-CONN);
        STORE IN X-REL;
        VALUE IS REL-CLAUSE;
        CORE- HAS NODE ATTRIBUTE INDEX X-NDX;
        CORE- OF NSTG OF NSTGO OF X-PN HAS NODE ATTRIBUTE INDEX X-PNDX;
        X-NDX IS IDENTICAL TO X-PNDX.
   $MOVE-PCONN =
        [* REVERSE THE ORDER OF OPERANDS *]
        BEFORE X-REL INSERT <PARSE-CONN> (ALL ELEMENTS OF X-PCONN);
        AT X-PN REPLACE PRESENT-ELEMENT- BY <NULL>;
        BOTH BEFORE X-REL INSERT X-PRE
        AND DELETE X-PRE;
        BOTH DELETE X-REL
        AND DELETE X-PCONN.
   $BUILD-RELATION =
        BEFORE X-PRE INSERT
        <PARSE-CONN> (<RELATION> (<SA> X-SA1 (<NULL>)
        +<LCONNR> X-CONN
        +<SA> X-SA2 (<NULL>)));
        DO $BUILD-LCONNR [GLOBAL IN T-CONJ-IN-CENTER];
        DO $BUILD-HEADCONN. (GLOBAL)
   $BUILD-LCONN =
        IF LP X-LA OF X-PN IS NOT EMPTY
        THEN REPLACE LCONN OF X-CONN BY <LCONN> (ALL ELEMENTS OF X-LA).
   $MAKE-FRAG =
        AFTER X-PRE INSERT
        <FRAGMENT> X-FRAG ( <SA> (<NULL>)
        + ALL ELEMENTS OF NSTGO OF X-PN);
        AT X-PN REPLACE PRESENT-ELEMENT- BY <NULL>;
        AT X-FRAG, DO $COPY-NEG-MODAL [Global in T-CONJ-IN-CENTER];
        TRANSFORM X-FRAG.
— T-FIND-CONN
—       OPERATES WHEN THERE IS A CONNECTIVE OR H-BECONN IN ASSERTION A.
— IT FINDS H-CONN/H-BECONN AND ITS TWO ARGUMENTS. A IS REPLACED BY
— PARSE-CONN + FRAGMENT1 + FRAGMENT2 WHERE:
—       PARSE-CONN = RELATION = SA. + LCONNR + SA.
—       AND FRAGMENT1 = NSTG (THE FIRST ARGUMENT OF H-CONN/H-BECONN).
—       AND FRAGMENT2 = NSTG (THE SECOND ARGUMENT OF H-CONN/H-BECONN).
—       HEADCONN = ATOM CORRESPONDING TO WORD WHICH IS H-CONN/H-BECONN.
— THE SEARCH FOR H-CONN/H-BECONN AND ITS ARGUMENTS IS AS FOLLOWS:
—       1) CORE-SELATT OF CORE OF VERB HAS MEMBER CONN-LIST.
—       FRAGMENT1 = NSTG OF SUBJECT.
—       FRAGMENT2 = NSTG OF OBJECT.
—       CONTENTS OF RV IN ASSERTION ARE MOVED TO RV OF VERB.
—       HEADCONN = V
—       LCONN = ELEMENTS OF LV
—       RCONN = ELEMENTS OF RV
—       ALL SA'S TO THE LEFT OF VERB ARE MOVED INTO THE FIRST SA OF
—       RELATION. ALL SA'S TO THE RIGHT OF VERB ARE MOVED INTO THE
—       LAST SA OF RELATION.
—       EX.: 'FEVER CAUSES HEADACHE.'
—       FRAGMENT1 = 'FEVER'
—       FRAGMENT2 = 'HEADACHE'
—       HEADCONN = V = 'CAUSE'
—       2) VERB IS VBE/BEREP AND OBJECT = ASTG WHERE:
—       CORE-SELATT OF ADJ = H-CONN/C-BECONN AND
—       RA = PN
—       FRAGMENT1 = NSTG OF SUBJECT
—       FRAGMENT2 = NSTG OF NSTGO OF PN
—       HEADCONN = ADJ + LPR
—       WHERE LPR = LP = ELEMENTS OF LP OF PN + P OF PN.
—       EX.: 'FEVER IS COMPATABLE WITH HEADACHE.'
—       FRAGMENT1 = 'FEVER'
—       FRAGMENT2 = 'HEADACHE'
—       HEADCONN = 'COMPATABLE WITH'
—       3) VERB IS VBE/BEREP AND
—       OBJECT = NSTG WHERE
—       CORE N = H-CONN/H-BECONN AND
—       RN = PN
—       FRAGMENT1 = NSTG OF SUBJECT
—       FRAGMENT2 = NSTG OF PN
—       HEADCONN = N + LPR
—       EX.: 'FEVER IS CAUSE OF HEADACHE.'
—       FRAGMENT1 = 'FEVER'
—       FRAGMENT2 = 'HEADACHE'
—       HEADCONN = 'CAUSE OF'.
—       4) VERB IS VBE/BEREP AND
—       OBJECT = PN WHERE
—       P = H-CONN/H-BECONN
—       FRAGMENT1 = NSTG O F SUBJECT
—       FRAGMENT2 = NSTG O F PN
—       HEADCONN = P
—       EX.: 'HEADACHE IS DUE TO FEVER.'
—       FRAGMENT1 = 'HEADACHE'
—       FRAGMENT2 = 'FEVER'
—       HEADCONN = 'DUE : TO'.
—       5) VERB IS VBE/BEREP AND
—       SUBJECT = NSTG WHERE
—       N IS H-CONN/BECONN AND
—       RN = PN
—       FRAGMENT1 = NSTG OF OBJECT
—       FRAGMENT2 = NSTG OF PN
—       HEADCONN = N + LPR
—       EX.: 'CAUSE OF HEADACHE IS FEVER.'
—       FRAGMENT1 = 'FEVER'
—       FRAGMENT2 = 'HEADACHE'
—       HEADCONN = 'CAUSE OF'
T-FIND-CONN = IN ASSERTION:
        PRESENT-ELEMENT- X-PRE EXISTS;
        EITHER $VERB-CONN-CHK
        OR IF X-VERB HAS MEMBER H-BECONN
        THEN BOTH $OBJ-SUB-CONN AND $CHANGE.
   $VERB-CONN-CHK =
        BOTH BOTH BOTH $GET-VERB-CORE
        AND X-HCONN HAS NODE ATTRIBUTE SELECT-ATT X-VERB
        AND X-VERB HAS MEMBER H-CONN
        AND $VERB-CHECK.
   $GET-VERB-CORE =
        BOTH CORE X-HCONN OF VERB X-VB IS '[]'
        AND ITERATE GO RIGHT
        UNTIL PRESENT-ELEMENT- IS VING OR VEN OR TV FAILS;
        STORE IN X-HCONN.
   $CHANGE =
        [* Remove this substatement and next if T-CHANGE-OF-STATE *]
        [* is reinstituted. *]
        IF CORE-SELATT OF CORE- OF X-CONN HAS MEMBER H-TMBEG OR
        H-TMEND OR H-CHANGE OR H-CHANGE-MORE OR H-CHANGE-LESS OR
        H-CHANGE-SAME
        THEN $BUILD-CHANGE-CONN.
   $BUILD-CHANGE-CONN =
        AT IMMEDIATE RELATION X-RELATION OF X-CONN
        REPLACE X-RELATION
        BY <CHANGE-OF-STATE> (ALL ELEMENTS OF X-RELATION).
   $OBJ-SUB-CONN =
        IF VALUE OF VALUE OF VALUE OF OBJECT IS ASTG X-ARG2
        THEN IF EITHER $OBJ-IS-CONN
        OR $OBJ-IS-EVENT
        THEN $BUILD-CONNFRAG
        ELSE TRUE [DO NOT SPLIT]
        ELSE EITHER $OBJ-OTHER-CONN
        OR TRUE [do not split].
   $OBJ-IS-CONN =
        CORE-SELATT OF CORE- X-TEMP OF X-ARG2 HAS MEMBER CONNECTIVE-LIST;
        X-HCONN:= X-TEMP;
        DO $SUBJ-ARG1;
        DO $ARG2-N [GET 'FEVER' IN 'HEADACHE IS CAUSE-OF FEVER'].
   $OBJ-IS-EVENT = ALL OF $SUBJ-ARG1, $ARE-EQUIV
        [2 INDEPENDENT EVENTS SUCH AS 'HEADACHE WAS PAINFUL'].
   $OBJ-OTHER-CONN =
        IF AT OBJECT
        BOTH CORE IS PN X-PN
        AND EITHER CORE-SELATT OF P X-TEMP HAS MEMBER
        CONNECTIVE-LIST WHERE BOTH X-HCONN:= X-TEMP
        AND $SUBJ-ARG1
        OR ALL OF $ARG2-PN, $SUBJ-ARG1, $ARE-EQUIV
        THEN BOTH $ARG2-PN AND $BUILD-CONNFRAG
        [SPLIT INTO 2 FRAGMENTS]
        ELSE $SUBJ-N-CONN [SEE IF SUBJECT IS CONNECTIVE].
   $OBJ-N-CONN =
        IF AT OBJECT BOTH CORE X-HCONN IS N
        @AND BOTH CORE-SELATT X-S EXISTS
        AND ALL OF $ARG2-N, $SUBJ-ARG1, $ARE-EQUIV
        THEN $BUILD-CONN-N-N
        ELSE $SUBJ-N-CONN.
   $SUBJ-N-CONN =
        IF EITHER BOTH CORE-SELATT OF CORE- X-TEMP OF SUBJECT HAS
        MEMBER CONNECTIVE-LIST
        AND BOTH X-HCONN:= X-TEMP
        AND $OBJ-ARG1
        OR AT X-TEMP BOTH RIGHT-ADJUNCT IS PN X-PN
        WHERE NSTGO X-ARG2 EXISTS
        AND BOTH $OBJ-ARG1
        AND $ARE-EQUIV
        THEN $BUILD-CONNFRAG
        ELSE IF X-VERB HAS MEMBER H-BECONN
        WHERE [X-HCONN := CORE OF X-VB] DO $GET-VERB-CORE
        THEN $VERB-CHECK.
   $ARE-EQUIV =
        EITHER X-S HAS MEMBER CONNECTIVE-LIST
        OR $ARE-FRMT-EQUIV.
   $ARE-FRMT-EQUIV =
        DO $SETUP-X1-X2;
        X-LISTOFLISTS := LIST FORMAT-EQUIV-CLASS;
        ITERATET SUCCESSORS X-LISTOFLISTS OF X-LISTOFLISTS IS NOT NIL
        UNTIL BOTH X-NEWLIST := HEAD OF X-LISTOFLISTS
        AND $CHK-X1-X2 SUCCEEDS.
   $SETUP-X1-X2 =
        BOTH CORE-ATT X1 OF CORE- OF X-ARG1 EXISTS
        AND CORE-ATT X2 OF CORE- OF X-ARG2 EXISTS.
   $CHK-X1-X2 =
        BOTH INTERSECT OF X1 IS NOT NIL
        AND INTERSECT OF X2 IS NOT NIL.
   $OBJ-ARG1 = AT X-PRE BOTH CORE IS N
        @AND IMMEDIATE NSTG X-ARG1 EXISTS.
   $VERB-CHECK =
        IF X-VERB HAS MEMBER H-CHANGE OR H-CHANGE-MORE OR H-CHANGE-LESS
        OR H-CHANGE-SAME
        THEN $SUBJ-TO-FRAG
        ELSE $VERB-CONN.
   $SUBJ-TO-FRAG = VALUE OF SUBJECT OF X-PRE IS NSTG X-ARG2;
        PRESENT-ELEMENT- IS NOT EMPTY;
        DO $BUILD-RELATION;
        DO $BUILD-FRAG2;
        DO $BUILD-CHANGE-CONN.
   $BUILD-FRAG2 = AFTER X-PRE INSERT
        <FRAGMENT>X-FRAG (<SA> (<NULL>) + X-ARG2);
        REPLACE X-ARG2 BY <NULL>;
        TRANSFORM X-FRAG.
   $VERB-CONN =
        BOTH EITHER VALUE OF SUBJECT IS NSTG X-ARG1
        OR VALUE X-ARG1 OF SUBJECT IS NOT NULL [6.12.97]
        AND EITHER VALUE OF OBJECT IS NSTGO X-ARG2
        OR VALUE OF OBJECT IS OBJECTBE WHERE VALUE X-ARG2 EXISTS;
        DO $MOVE-STRING-RV;
        DO $BUILD-CONNFRAG.
   $MOVE-STRING-RV =
        AT X-PRE [ASSERTION]
        IF RV X1 IS NOT EMPTY
        THEN IF RV X-RV OF VERB IS NOT EMPTY
        THEN AFTER LAST-ELEMENT OF X-RV
        INSERT VALUE OF X1
        ELSE REPLACE X-RV BY X1;
        REPLACE VALUE OF X1 BY <NULL>.
   $ARG2-PN =
        NSTGO X-ARG2 OF X-PN EXISTS.
   $SUBJ-ARG1 =
        AT X-PRE VALUE OF SUBJECT IS NSTG X-ARG1 .
   $BUILD-CONNFRAG =
        ALL OF $BUILD-RELATION ,
   $BUILD-FRAGS, $BUILD-LCONN-RCONN,
   $MOVE-SAS, $REPLCE-ASSRT ARE TRUE .
   $BUILD-FRAGS =
        BEFORE X-PRE INSERT <FRAGMENT> X1 ( <SA> (<NULL>)
        + X-ARG1
        + <SA> (<NULL>) )
        + <FRAGMENT> X2 ( <SA> (<NULL>)
        + ALL ELEMENTS OF X-ARG2
        + <SA> (<NULL>) );
        TRANSFORM X2;
        IF $IS-NMOD-FRAG THEN $ERASE-X1
        ELSE TRANSFORM X1.
   $IS-NMOD-FRAG =
        [* Verify if the present structure is an NMOD structure *]
        [* created by T-REL-CLAUSE. In which case, X1 is *]
        [* duplicated from x and should be erased. The structure *]
        [* *]
        [* PARSE-CONN----x----PARSE-CONN----X1----X2 *]
        [* | | *]
        [* ...NMOD ...H-CONN *]
        [* *]
        [* is simply: *]
        [* *]
        [* PARSE-CONN----x----X2 *]
        [* | *]
        [* ...H-CONN *]
        [* *]
        AT X1, GO LEFT;
        PRESENT-ELEMENT- X1-CONN IS PARSE-CONN;
        GO LEFT;
        PRESENT-ELEMENT- IS ASSERTION OR FRAGMENT;
        GO LEFT;
        PRESENT-ELEMENT- X-NMOD IS PARSE-CONN;
        EITHER BOTH VALUE IS REL-CLAUSE
        AND CORE- OF LCONNR OF VALUE IS '[NMOD]'
        OR BOTH VALUE IS SUB-CONJ
        AND CORE- OF LCONNR OF VALUE IS '[WHILE]'.
   $ERASE-X1 =
        AT X-NMOD, REPLACE PRESENT-ELEMENT- BY X1-CONN, XNEW-CONN;
        AT VALUE OF XNEW-CONN, BOTH LCONNR X-CONN EXISTS
        AND BOTH FIRST SA X-SA1 EXISTS
        AND SECOND SA X-SA2 EXISTS;
        BOTH DELETE X1-CONN
        AND DELETE X1.
   $BUILD-LCONN-RCONN =
        IF LEFT-ADJUNCT-POS X-LA [???] OF X-HCONN IS NOT EMPTY
        THEN AT X-CONN REPLACE LCONN BY <LCONN> (ALL ELEMENTS OF X-LA);
        IF RIGHT-ADJUNCT-POS X-RA OF X-HCONN IS NOT EMPTY
        THEN AT X-CONN REPLACE RCONN BY <RCONN> (ALL ELEMENTS OF X-RA).
   $MOVE-SAS =
        AT VALUE OF X-PRE ITERATE VERIFY $MOVE-TO-SA1
        UNTIL $TEST-FOR-SA FAILS;
        AT VERB OF X-PRE ITERATET $MOVE-TO-SA2
        UNTIL $TEST-FOR-SA FAILS.
   $MOVE-TO-SA1 =
        BOTH X-MOVE := X-SA1
        AND $MOVE-TO-SA.
   $MOVE-TO-SA =
        IF PRESENT-ELEMENT X1 IS NOT EMPTY
        THEN IF X-MOVE IS EMPTY
        THEN REPLACE X-MOVE BY X-MOVE (ALL ELEMENTS OF X1)
        ELSE AFTER LAST-ELEMENT OF X-MOVE INSERT ALL ELEMENTS OF X1.
   $TEST-FOR-SA =
        GO RIGHT;
        PRESENT-ELEMENT- IS NOT VERB;
        IF PRESENT-ELEMENT- IS NOT SA THEN $TEST-FOR-SA.
   $MOVE-TO-SA2 =
        BOTH X-MOVE := X-SA2
        AND $MOVE-TO-SA.
   $REPLCE-ASSRT =
        DELETE X-PRE.
   $ARG2-N =
        AT X-HCONN RIGHT-ADJUNCT IS PN X-PN
        WHERE NSTGO X-ARG2 EXISTS.
   $BUILD-CONN-N-N =
        DO $BUILD-RELATION;
        DO $BUILD-FRAGS;
        AFTER LAST-ELEMENT OF HEADCONN OF X-CONN
        INSERT <LPR> ( <LP> (ALL ELEMENTS OF LP OF X-PN)
        + P OF X-PN
        + <RP> (<NULL>));
        DELETE X-PN;
        ALL OF $BUILD-LCONN-RCONN, $MOVE-SAS, $REPLCE-ASSRT ARE TRUE.
— T-RVEN-CONN
—       OPERATES WHEN RIGHT-ADJUNCT = VENPASS WHERE VEN = H-CONN.
—       PARSE-CONN = RELATION IS ATTACHED TO LEFT OF IMMEDIATE ASSERTION
—       OR FRAGMENT A.
—       HEADCONN = VEN OF VENPASS
—       LCONN = ELEMENTS OF LV OF LVENR
—       FRAGMENT B = NSTG [WHICH IS A COPY OF NSTG OF NSTGO OF SA:PN]
—       IS ATTACHED TO RIGHT OF A.
—       VENPASS IN A IS REPLACED BY NULL.
T-RVEN-CONN = IN VENPASS:
        PRESENT-ELEMENT- X-VENP EXISTS;
        IF BOTH ASCEND TO RADJSET
        WHERE AT X-VENP DO $VEN-CONN-TEST
        AND NONE OF $HAS-FAIL-SEL, $HAS-ADJ-TYPE
        THEN $SPLIT.
   $VEN-CONN-TEST =
        BOTH CORE- X-HCONN OF LVENR HAS NODE ATTRIBUTE SELECT-ATT
        WHERE PRESENT-ELEMENT- HAS MEMBER CONN-LIST
        AND EITHER BOTH LAST-ELEMENT- X-SA OF X-VENP IS NOT EMPTY
        AND VALUE X-SUBJ OF X-SA IS PN
        WHERE ELEMENT P IS 'PAR' OR 'BY'
        OR EITHER BOTH ELEMENT- PASSOBJ X-SUBJ IS NOT EMPTY
        AND IF VALUE OF X-SUBJ IS PN
        @THEN STORE IN X-SUBJ
        OR BOTH RIGHT-ADJUNCT-POS X-RV OF X-HCONN IS NOT EMPTY
        AND VALUE X-SUBJ OF X-RV IS PN
        WHERE ELEMENT- P IS 'DE' OR 'PAR' OR 'BY' OR 'OF'.
   $SPLIT =
        AT X-VENP ASCEND TO ASSERTION OR FRAGMENT
        PASSING THROUGH STRING;
        STORE IN X-PRE;
        DO $BUILD-VENCONN.
   $BUILD-VENCONN =
        ALL OF $BUILD-RELATION [GLOBAL IN T-SA-PNCONN],
   $BUILD-CONN-ADJ,
   $MAKE-FRAG.
   $BUILD-CONN-ADJ =
        IF LV X-LV OF X-HCONN IS NOT EMPTY
        THEN REPLACE LCONN OF X-CONN BY <LCONN> (ALL ELEMENTS OF X-LV);
        IF BOTH X-SA EXISTS
        AND P OF X-SUBJ IS NOT EMPTY
        THEN REPLACE RCONN OF X-CONN BY <RCONN> (P OF X-SUBJ).
   $MAKE-FRAG =
        AFTER X-PRE INSERT
        <FRAGMENT>X-FRAG ( <SA> (<NULL>)
        + ALL ELEMENTS OF NSTGO OF X-SUBJ);
        AT X-VENP REPLACE PRESENT-ELEMENT- BY <NULL>;
        TRANSFORM X-FRAG.
— T-RVING-CONN
—       OPERATES WHEN RIGHT-ADJUNCT = VINGO WHERE VING = H-CONN.
—       PARSE-CONN = RELATION IS ATTACHED TO LEFT OF IMMEDIATE ASSERTION
—       OR FRAGMENT A.
—       HEADCONN = VING OF VINGO
—       LCONN = ELEMENTS OF LV OF LVINGR
—       FRAGMENT B = NSTG [WHICH IS A COPY OF NSTG OF NSTGO OF SA:PN]
—       IS ATTACHED TO RIGHT OF A.
—       VINGO IN A IS REPLACED BY NULL.
T-RVING-CONN = IN VINGO:
        PRESENT-ELEMENT- X-VINGP EXISTS;
        IF BOTH ASCEND TO RADJSET
        WHERE AT X-VINGP DO $VING-CONN-TEST
        AND NONE OF $HAS-FAIL-SEL, $HAS-ADJ-TYPE
        THEN $SPLIT.
   $VING-CONN-TEST =
        BOTH CORE- X-HCONN OF LVINGR HAS NODE ATTRIBUTE SELECT-ATT
        WHERE BOTH PRESENT-ELEMENT- HAS MEMBER CONN-LIST
        AND PRESENT-ELEMENT- DOES NOT HAVE MEMBER H-SHOW
        OR H-PTLOC
        AND EITHER BOTH ELEMENT- OBJECT X-SUBJ IS NOT EMPTY
        AND IF VALUE OF X-SUBJ IS PN
        @THEN STORE IN X-SUBJ
        OR BOTH RIGHT-ADJUNCT-POS X-RV OF X-HCONN IS NOT EMPTY
        AND VALUE X-SUBJ OF X-RV IS PN
        WHERE ELEMENT- P IS 'TO'.
   $SPLIT =
        AT X-VINGP ASCEND TO ASSERTION OR FRAGMENT
        PASSING THROUGH STRING;
        STORE IN X-PRE;
        DO $BUILD-VINGCONN.
   $BUILD-VINGCONN =
        ALL OF $BUILD-RELATION [GLOBAL IN T-SA-PNCONN],
   $BUILD-CONN-ADJ,
   $MAKE-FRAG.
   $BUILD-CONN-ADJ =
        IF LV X-LV OF X-HCONN IS NOT EMPTY
        THEN REPLACE LCONN OF X-CONN BY <LCONN> (ALL ELEMENTS OF X-LV);
        IF P OF X-SUBJ IS NOT EMPTY
        THEN REPLACE RCONN OF X-CONN BY <RCONN> (P OF X-SUBJ).
   $MAKE-FRAG =
        EITHER BOTH VALUE OF X-SUBJ IS NSTGO
        AND AFTER X-PRE INSERT
        <FRAGMENT>X-FRAG ( <SA> (<NULL>)
        + ALL ELEMENTS OF NSTGO OF X-SUBJ)
        OR BOTH VALUE OF X-SUBJ IS NPN X-NPN
        AND AFTER X-PRE INSERT
        <ASSERTION>X-FRAG
        (<SA> (<NULL>)
        +<SUBJECT> (ALL ELEMENTS OF NSTGO OF X-NPN)
        +<SA> (<NULL>)
        +<NEG> (<NULL>)
        +<TENSE> (<NULL>)
        +<SA> (<NULL>)
        +<VERB> (<LV> (<NULL>)
        +<VVAR> (<V> = '[]' : (VBE))
        +<NEGV> (<NULL>)
        +<RV> (<NULL>))
        +<SA> (<NULL>)
        +<OBJECT> (<OBJECTBE> (ALL ELEMENTS OF PN OF X-NPN))
        +<RV> (<NULL>)
        +<SA> (<NULL>));
        AT X-VINGP REPLACE PRESENT-ELEMENT- BY <NULL>;
        TRANSFORM X-FRAG.
— T-RADJ-CONN
—       OPERATES WHEN RIGHT-ADJUNCT = PN WHERE P = H-CONN.
—       PARSE-CONN = RELATION IS ATTACHED TO LEFT OF IMMEDIATE ASSERTION
—       OR FRAGMENT A.
—       HEADCONN = P OF PN
—       LCONN = ELEMENTS OF LN OF PN
—       FRAGMENT B = NSTG [WHICH IS A COPY OF NSTG OF NSTGO OF PN]
—       IS ATTACHED TO RIGHT OF A.
—       PN IN A IS REPLACED BY NULL.
T-RADJ-CONN = IN PN:
        PRESENT-ELEMENT- X-PN EXISTS
        WHERE STORE IN X-CORE;
        IF BOTH ONE OF $PN-IN-OBJECTBE, $PN-IN-RADJ
        AND NONE OF $HAS-FAIL-SEL, $HAS-ADJ-TYPE
        THEN EITHER $SHARE-CONNECTIVE
        OR $SPLIT.
   $PN-IN-RADJ =
        ASCEND TO OBJECT OR RV OR FRAGMENT PASSING THROUGH N-OBJ-IN-STR
        WHERE AT X-PN DO $PN-CONN-TEST [GLOBAL IN T-SA-PNCONN].
   $PN-IN-OBJECTBE =
        AT X-PN, BOTH IMMEDIATE OBJECTBE EXISTS
        AND DO $PN-CONN-TEST [GLOBAL IN T-SA-PNCONN].
   $SHARE-CONNECTIVE =
        BOTH ELEMENT- P X-P OF X-PN HAS NODE ATTRIBUTE
        SHARED-CONNECTIVE X-CONN
        AND BOTH AFTER X-CONN INSERT X-P
        AND $MAKE-FRAG.
   $MAKE-FRAG =
        AT X-PN ASCEND TO ASSERTION OR FRAGMENT
        PASSING THROUGH STRING;
        STORE IN X-PRE;
        AFTER X-PRE INSERT
        <FRAGMENT> X-FRAG ( <SA> (<NULL>)
        + ALL ELEMENTS OF NSTGO OF X-PN);
        [AT X-PN REPLACE PRESENT-ELEMENT- BY <NULL>;]
        DELETE X-PRE;
        TRANSFORM X-FRAG.
   $SPLIT =
        IF X-PN IS OCCURRING IN ADJSET
        THEN $1
        ELSE IF IMMEDIATE OBJECT EXISTS
        WHERE BOTH CORE- OF COELEMENT- VERBAL IS VBE OR H-TTGEN
        AND COELEMENT- SUBJECT X-SUBJ EXISTS
        THEN $2.
   $2 = AT X-SUBJ ASCEND TO ASSERTION OR FRAGMENT
        PASSING THROUGH STRING;
        STORE IN X-PRE;
        ALL OF $BUILD-PCONN, $IMPLICIT-FUTURE.
   $1 = AT X-PN BOTH HOST- X-PNHOST EXISTS
        AND ASCEND TO ASSERTION OR FRAGMENT
        PASSING THROUGH STRING;
        STORE IN X-PRE;
        BOTH DO $BUILD-PCONN
        AND DO $IMPLICIT-FUTURE.
   $IMPLICIT-FUTURE =
        [* Structure "TTGEN pour TTT" (in order to) implies FUTURE *]
        [* Structure "TTGEN for TXCLIN" (in order to) implies FUTURE *]
        IF BOTH BOTH X-PNHOST IS H-TTGEN
        AND CORE- OF X-CONN IS 'POUR' OR 'POUR QUE'
        OR 'AFIN QUE' OR 'AFIN DE'
        OR 'IN ORDER TO' OR 'IN ORDER FOR' OR 'FOR'
        AND CORE- OF NSTG OF X-FRAG IS H-TTSURG OR H-TTMED
        OR H-TTCOMP OR H-TTGEN OR H-TXCLIN [OR H-INST]
        THEN DO $BUILD-FUTURE.
   $BUILD-FUTURE =
        X-TENSEATT := SYMBOL FUT-IMP;
        X-TENSELIST := NIL;
        BOTH PREFIX X-TENSEATT TO X-TENSELIST
        AND AT CORE- OF NSTG OF X-FRAG
        ASSIGN PRESENT ELEMENT NODE ATTRIBUTE TENSE-ATT
        WITH VALUE X-TENSELIST.
— T-OBJBE-CONN
—       OPERATES WHEN OBJECT = PN WHERE P = H-CONN.
—       PARSE-CONN = RELATION IS ATTACHED TO LEFT OF IMMEDIATE ASSERTION
—       OR FRAGMENT A.
—       HEADCONN = P OF PN
—       LCONN = ELEMENTS OF LN OF PN
—       FRAGMENT B = NSTG [WHICH IS A COPY OF NSTG OF NSTGO OF PN]
—       IS ATTACHED TO THE RIGHT OF A
—       PN IN A IS REPLACED BY NULL.
T-OBJBE-CONN = IN PN:
        PRESENT-ELEMENT- X-PN EXISTS
        WHERE STORE IN X-CORE;
        IF BOTH ASCEND TO OBJECT OR RV PASSING THROUGH N-OBJ-IN-STR
        WHERE AT X-PN
        EITHER DO $PN-CONN-TEST [GLOBAL IN T-SA-PNCONN]
        OR $P-IS-BECONN
        AND NONE OF $HAS-FAIL-SEL, $HAS-ADJ-TYPE
        THEN ITERATET DO $MAKE-FRAG
        UNTIL DO $CONJ-IN-PN FAILS.
   $CONJ-IN-PN =
        AT ELEMENT- NSTGO OF X-PN ELEMENT- CONJ-NODE X-CONJ EXISTS.
   $P-IS-BECONN = ATTRIBUTE-LIST OF X-HCONN HAS MEMBER BECONN-LIST.
   $MAKE-FRAG =
        AT X-PN ASCEND TO ASSERTION OR FRAGMENT
        PASSING THROUGH STRING;
        STORE IN X-PRE;
        BEFORE X-PRE INSERT
        <PARSE-CONN> (<CONJOINED> (<SA> X-SA (<NULL>)
        +<LCONNR> X-CONN
        +<SA> X-SA2 (<NULL>)));
        DO $BUILD-LCONNR;
        AT FIRST ELEMENT X-HCONN OF X-CONJ DO $BUILD-HEADCONN;
        AFTER X-PRE INSERT
        <FRAGMENT> X-FRAG ( <SA> (<NULL>)
        + ALL ELEMENTS OF Q-CONJ OF X-CONJ);
        DELETE X-CONJ;
        TRANSFORM X-FRAG.
— T-MOVE-S-UP
—       OPERATES WHEN VALUE OF SUBJECT/OBJECT OF ASSERTION A IS AN
—       ASSERTION B.
—       PARSE-CONN = EMBEDDED IS ATTACHED TO THE LEFT OF A.
—       B IS MOVED TO THE RIGHT OF A.
—       IN A, ASSERTION B IS REPLACED BY , WHICH IS ASSIGNED NODE
—       ATTRIBUTE EMBED-SUBJ/EMBED-OBJ.
T-MOVE-S-UP = IN ASSERTION:
        BOTH $EMBEDDED-SUBJ
        AND $EMBEDDED-OBJ.
   $EMBEDDED-SUBJ =
        IF VALUE OF SUBJECT X-ELEM OF PRESENT-ELEMENT- X-PRE IS SN X-S
        WHERE ELEMENT- ASSERTION X-ASSERT EXISTS
        THEN $MOVE-UP.
   $MOVE-UP =
        BEFORE X-PRE INSERT
        <PARSE-CONN> (<EMBEDDED> (<SA> (<NULL>)
        +<LCONNR> X-CONN
        +<SA> (<NULL>)));
        DO $BUILD-LCONNR [GLOBAL IN T-CONJ-IN-CENTER];
        EITHER $EMBED-OBJ OR $EMBED-SUBJ;
        DO $MOVE-S.
   $EMBED-SUBJ =
        IF X-ELEM IS SUBJECT
        THEN AT X-CONN REPLACE HEADCONN BY
        <HEADCONN> X-HEADCONN (<GRAM-NODE> = '[EMBEDDED-SUBJ]').
   $EMBED-OBJ =
        IF X-ELEM IS OBJECT
        THEN AT X-CONN REPLACE HEADCONN BY
        <HEADCONN> X-HEADCONN (<GRAM-NODE> = '[EMBEDDED-OBJ]').
   $MOVE-S =
        AFTER X-PRE INSERT ALL ELEMENTS OF IMMEDIATE-NODE- OF X-ASSERT;
        AT X-ASSERT BOTH REPLACE PRESENT-ELEMENT BY <NULL>X-NULL
        AND IF COELEMENT- CONJ-NODE X-TEMP OF X-NULL EXISTS
        [WHERE ELEMENT- Q-CONJ IS EMPTY]
        THEN DELETE X-TEMP;
        AT X-PRE IF FOLLOWING-ELEMENT IS NOT ASSERTION OR FRAGMENT
        @THEN DELETE PRESENT-ELEMENT-;
        AT X-PRE DO $TRANSFORM-TO-RIGHT;
        DO $SET-NODE-ATTS.
   $TRANSFORM-TO-RIGHT =
        BOTH FOLLOWING-ELEMENT- EXISTS
        @AND TRANSFORM PRESENT-ELEMENT-.
   $DELETE = AT X-DEL REPLACE PRESENT-ELEMENT- BY <NULL>.
   $SET-NODE-ATTS =
        EITHER BOTH X-HEADCONN SUBSUMES '[EMBEDDED-SUBJ]'
        AND AT X-NULL
        ASSIGN PRESENT ELEMENT NODE ATTRIBUTE EMBED-SUBJ
        OR BOTH X-HEADCONN SUBSUMES '[EMBEDDED-OBJ]'
        AND AT X-NULL
        ASSIGN PRESENT ELEMENT NODE ATTRIBUTE EMBED-OBJ.
   $EMBEDDED-OBJ =
        BOTH $WRITE-ELEMTRACE
        AND
        IF BOTH ELEMENT- OBJECT X-ELEM EXISTS
        AND EITHER ELEMENT- ASSERTION X-ASSERT OF OBJECT X-S EXISTS
        OR EITHER CORE- X-S OF X-S HAS ELEMENT- ASSERTION X-ASSERT
        OR EITHER X-S IS NTHATS OR PNTHATS
        WHERE BOTH ELEMENT- THATS X-S EXISTS
        AND X-S HAS ELEMENT- ASSERTION X-ASSERT
        OR $VSENT-VERB
        THEN $MOVE-UP.
   $WRITE-ELEMTRACE =
        WRITE ON DIAG '*** ELEMENT- TRACE ***'; WRITE ON DIAG END OF LINE;
        WRITE ON DIAG IDENTIFICATION;
        WRITE ON DIAG SENTEXT [SOURCE];
        [WRITE ON DIAG PARSE TREE WITH WORD FORMS;]
        WRITE ON DIAG END OF LINE.
   $VSENT-VERB =
        [EITHER]CORE-SELATT OF CORE- OF VERB OF X-PRE HAS MEMBER VSENT3
        [OR ATTRIBUTE-LIST OF CORE- OF VERB OF X-PRE HAS MEMBER VSENT3];
        X-OBJ:= X-ELEM;
        DO $HOST-IS-OBJ [get OBJECT of VERB];
        AT X-HOST [CORE of OBJECT] IMMEDIATE NSTG X-ARG1 EXISTS;
        REPLACE PRESENT-ELEMENT- BY
        [* make it into a separate FRAGMENT and move up *]
        <FRAGMENT> (<SA>(<NULL>)
        + X-ARG1
        +<SA>(<NULL>)).
— T-SENTENTIAL-OP
—       OPERATES WHEN 1. SUBJECT NOUN IS USED AS AN NSENT1,NSENT2 OR NSENT3.
—       2. VERB IS USED AS A VSENT1,VSENT2,VSENT3,VSENT4.
—       3. OBJECT ADJ IS A VSENT1, ASENT1, ASENT3.
—       IT ASSIGNS ASSERTION FORMAT-ATT WITH VALUE FRMT00 SIGNIFYING
—       THAT ASSERTION IS A SENTENTIAL OPERATOR.

T-SENTENTIAL-OP = IN ASSERTION:
        IF BOTH PRESENT-ELEMENT- DOES NOT HAVE ATTRIBUTE PHRASE-ATT
        [* special phrases e.g. INFO-SOURCE *]
        AND ONE OF $SUBJ-OP, $VERB-OP, $OBJ-OP
        THEN $ASSIGN-00.
   $SUBJ-OP = AT CORE- OF SUBJECT DO $OPERATOR-CHK.
   $VERB-OP = AT CORE- OF VERB DO $OPERATOR-CHK.
   $OBJ-OP = AT CORE- OF OBJECT DO $OPERATOR-CHK.
   $OPERATOR-CHK =
        BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE SELECT-ATT
        @AND PRESENT-ELEMENT- HAS MEMBER OPERATOR-LIST.
   $ASSIGN-00 = BOTH X-TYPE:= LIST FRMT00-LIST
        AND ASSIGN NODE ATTRIBUTE FORMAT-ATT WITH VALUE X-TYPE.
— T-ASSERT-TO-CONJ
—       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.
T-ASSERT-TO-CONJ = IN LNR, LAR:
        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 OR FRAGMENT;
        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;
        [* Adjust the case when X-ADDTOCONJ is just *]
        [* an argument of CONJ-NODE X-MOVE, in this *]
        [* case, (pre)conjunct is the desired node. *]
        IF VALUE OF ELEMENT- Q-CONJ OF X-MOVE
        IS IDENTICAL TO X-ADDTOCONJ
        THEN X-ADDTOCONJ HAS NODE ATTRIBUTE PRECONJELEM X-ADDTOCONJ;
        IF X-MOVE IS ASSERTION OR FRAGMENT
        THEN $BUILD-CONJ
        ELSE X-MOVE IS OF TYPE CONJ-NODE
        WHERE DO $CONJ-MOVE.
   $BUILD-CONJ =
        AFTER X-ADDTOCONJ
        INSERT <ANDSTG> X-NEWCONJ ('[&]'
        + <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];
        AT X-ADDTOCONJ GO RIGHT WHERE STORE IN X-NEWCONJ;
        DELETE X-MOVE;
        AT X-NEWCONJ
        DO PRE-POST-CONJELEM [ROUTINE SETS PRE- AND POST- CONJELEMS].
— T-EXPAND-REFPT
—       OPERATES ON PN WHEN:
—       1) THERE IS A NODE ATTRIBUTE TIME-ADVERBIAL ON PN AND
—       N IS PN IS NOT NTIME1/NTIME2/H-TMLOC/H-AGE
—       OR 2) HOST OF PN IS NTIME1/NTIME2/H-TMLOC
— ASSERTION A IS FOUND BY GOING UP TO ASSERTION FROM PN.
—       PARSE-CONN = REL-CLAUSE IS ATTACHED TO THE LEFT OF A.
—       HEADCONN = 'T-EXPAND-REFPT'.
—       FRAGMENT B = NSTG OF PN IS ATTACHED TO THE RIGHT OF A. IF N IS
—       *H-HOSP THERE IS A FURTHER CHECK - SEE $CHECK-H-HOSP.
T-EXPAND-REFPT = IN PN: TRUE.
   $SPLIT =
        ALL OF $MARKIT-REFPT, $BUILD-RELCONN, $BUILD-FRAGMENT,
   $SET-LN-RN-NULL.
   $MARKIT-REFPT =
        AT X-PN ASSIGN NODE ATTRIBUTE REFPT-ATT.
   $HAVE-TIME-PN =
        PRESENT-ELEMENT- X-PN EXISTS;
        CORE-SELATT X-P OF P EXISTS;
        EITHER BOTH X-PN HAS NODE ATTRIBUTE ADVERBIAL-TYPE
        @AND PRESENT-ELEMENT- HAS MEMBER TIME-ADVERBIAL
        OR X-P HAS MEMBER H-TMPREP;
        X-P DOES NOT HAVE MEMBER NTIME1 OR NTIME2 OR H-TMLOC OR
        H-AGE.
   $HOST-IS-TIME =
        HOST X-N OF X-PN IS NTIME1 OR NTIME2 OR H-TMLOC.
   $CHECK-NSTGO-CLASSES =
        DO $CHECK-SELATT [AND $CHECK-H-HOSP].
   $CHECK-SELATT =
        AT X-PN
        CORE-SELATT X-S OF CORE X-N OF NSTG X2 OF NSTGO DOES NOT
        HAVE MEMBER NTIME1 OR NTIME2 OR H-TMLOC OR H-AGE
        OR H-FAMILY OR H-PT.
   $BUILD-RELCONN =
        AT X-PN DO $FIND-ASSERT [GLOBAL IN T-REL-CLAUSE];
        DO $BUILD-RELCLAUSE [GLOBAL IN T-REL-CLAUSE];
        AT X-CONN REPLACE HEADCONN
        BY <HEADCONN> (<GRAM-NODE> = '[EXPAND-REFPT]').
   $SET-LN-RN-NULL =
        AT LEFT-ADJUNCT-POS OF X-N DO $SET-LN-NULL;
        AT RIGHT-ADJUNCT-POS [RN] OF X-N REPLACE VALUE BY <NULL> .
   $SET-LN-NULL =
        REPLACE PRESENT-ELEMENT- BY <LN> (<TPOS>(<NULL>)
        +<QPOS> (<NULL>)
        +<APOS> (<NULL>)).
   $CHECK-H-HOSP =
        IF X-S HAS MEMBER H-HOSP
        THEN ONE OF $CHECK-TPOS, $CHECK-OTHER-LN, $CHECK-RN.
   $CHECK-TPOS =
        AT TPOS OF LEFT-ADJUNCT-POS X-LN OF X-N
        BOTH CORE- IS NOT NULL
        @ AND PRESENT-ELEMENT- IS NOT 'THIS' [* English *]
        OR 'CE' OR 'CES' OR 'CETTE' OR 'CETTES' [* French *].
   $CHECK-OTHER-LN =
        QPOS OF X-LN IS EMPTY;
        BOTH COELEMENT- APOS OF X-LN IS NOT EMPTY
        @AND CORE IS 'PRESENT' OR 'CURRENT'.
   $CHECK-RN = RIGHT-ADJUNCT OF X-N IS NOT EMPTY .
— T-CHANGE-OF-STATE
—       OPERATES WHEN CORE OF LXR IS H-CHANGE/H-TMBEG/H-TMEND.
— ASSERTION A IS FOUND BY GOING UP TO ASSERTION FROM LXR.
—       PARSE-CONN = CHANGE-OF STATE IS INSERTED TO LEFT OF A.
—       HEADCONN = LXR CONTAINING H-CHANGE/H-TMBEG/H-TMEND.
— IF HOST OF CORE OF LXR [FOUND BY GOING TO POINTER IN N.A. SEM-CORE
— ASSIGNED BY T-FIND-HOST] IS:
—       A) A NOUN
—       INSERT FRAGMENT B TO THE RIGHT OF A.
—       FRAGMENT B = IMMEDIATE NSTG OF HOST.
—       B) A VERB
—       ASSERTION B IS A COPY OF ASSERTION A. REPLACE LXR IN B
—       CONTAINING H-CHANGE/H-TMBEG/H-TMEND BY .
— IF X = 'BEGIN' SET SA [OF B] = DSTG = D = 'NOT'.
[T-CHANGE-OF-STATE = IN LTR, LNR, VERBAL, DSTG, LAR, LAR1,]
[ NNN, LQR:]
[ IF BOTH CORE-SELATT X-S OF CORE X-CORE HAS MEMBER H-CHANGE]
[ OR H-TMBEG OR H-TMEND]
[ AND PRESENT-ELEMENT- HAS NODE ATTRIBUTE SEM-CORE X-HOST]
[ THEN BOTH $SETUP]
[ AND EITHER $HOST-IS-N]
[ OR $HOST-IS-V.]
   $HOST-IS-N =
        IF X-HOST IS N
        THEN BOTH $NSTG-FRAG AND $CHNGE-OF-STATE.
   $HOST-IS-V =
        IF X-HOST IS V
        THEN BOTH $COPY-ASSRT AND $CHNGE-OF-STATE .
   $NSTG-FRAG =
        AT X-HOST IMMEDIATE NSTG X2 EXISTS;
        DO $BUILD-FRAGMENT [GLOBAL- IN T-EXPAND-REFPT];
        DO $TEST-FOR-BEGIN.
   $SETUP =
        PRESENT-ELEMENT- X-LXR EXISTS;
        DO $FIND-ASSERT [GLOBAL IN T-REL-CLAUSE].
   $COPY-ASSRT =
        AT X-PRE ASSIGN NODE ATTRIBUTE PT1 WITH VALUE X-LXR;
        AFTER X-PRE INSERT <NULL> X-NULL;
        REPLACE X-NULL BY X-PRE ;
        AT X-PRE FOLLOWING-ELEMENT- X1 EXISTS;
        X1 HAS NODE ATTRIBUTE PT1 [GO TO LXR IN NEW ASSERTION];
        REPLACE PRESENT-ELEMENT- BY <NULL>;
        DO $TEST-FOR-BEGIN.
   $CHNGE-OF-STATE = BEFORE X-PRE INSERT
        <PARSE-CONN> (<CHANGE-OF-STATE> (<SA>(<NULL>)
        +<LCONNR> X-CONN
        +<SA>(<NULL>)));
        DO $BUILD-LCONNR [GLOBAL IN T-CONJ-IN-CENTER];
        AT CORE- X-HCONN OF X-LXR
        DO $BUILD-HEADCONN [GLOBAL IN T-CONJ-IN-CENTER];
        DO $BUILD-LCONN-RCONN [GLOBAL IN T-FIND-CONN].
   $TEST-FOR-BEGIN = IF X-CORE IS 'BEGIN'
        THEN $BUILD-NOT.
   $BUILD-NOT = AT X1 ELEMENT SA EXISTS;
        AT ELEMENT NULL [OF SA] REPLACE PRESENT-ELEMENT- BY
        <DSTG>(<D> ='NOT') .
— T-WITH-CONJ
—       OPERATES ON PN WHERE
—       P IS 'WITH' AND
—       P HAS NODE ATTRIBUTE SELECT-ATT WITH VALUE CONJ-LIKE.
—       PARSE-CONN = PREP-CONN
—       HEADCONN = 'WITH'
— ASSERTION A IS FOUND BY GOING UP FROM PN.
— FRAGMENT B = NSTG OF PN IS ATTACHED TO THE RIGHT OF A.
T-WITH-CONJ = IN PN:
        IF EITHER BOTH P X-CORE IS 'AVEC' OR 'WITH' OR '[AVEC]' OR '[WITH]'
        AND BOTH X-CORE DOES NOT HAVE NODE ATTRIBUTE PVAL-ATT
        AND BOTH X-CORE HAS NODE ATTRIBUTE SELECT-ATT
        @AND TEST FOR CONJ-LIKE
        OR PRESENT-ELEMENT- X-PN HAS NODE ATTRIBUTE ADVERBIAL-TYPE
        WHERE PRESENT-ELEMENT- HAS MEMBER CONN-TYPE
        THEN ALL OF $SETUP, $BUILD-FRAGMENT,
   $BUILD-PREPCONN, $DELETE-PN.
   $SETUP =
        PRESENT-ELEMENT- X-PN EXISTS;
        NSTG X2 OF NSTGO EXISTS;
        DO $FIND-ASSERT [GLOBAL - IN T-REL-CLAUSE].
   $DELETE-PN = REPLACE X-PN BY <NULL> .
   $BUILD-FRAGMENT =
        AFTER X-PRE INSERT
        <FRAGMENT>X1 ( <SA> (<NULL>)
        + X2
        + <SA> (<NULL>));
        TRANSFORM X1. (GLOBAL)
   $BUILD-PREPCONN =
        BEFORE X-PRE INSERT
        <PARSE-CONN> (<PREP-CONN> (<SA> (<NULL>)
        +<LCONNR> X-CONN
        +<SA> (<NULL>)));
        DO $BUILD-LCONNR [GLOBAL IN T-CONJ-IN-CENTER];
        AT X-CORE
        STORE IN X-HCONN;
        DO $BUILD-HEADCONN [GLOBAL IN T-CONJ-IN-CENTER];
        DO $BUILD-LCONN-RCONN.
— T-SETUP-PN-PDATE
T-SETUP-PN-PDATE = IN NSTGT, PDATE:
        IF PRESENT-ELEMENT- X-PRE IS NSTGT
        THEN $SETUP-PN
        ELSE DO $FIX-P [PRESENT-ELEMENT- IS PDATE].
   $FIX-P =
        [IF DATEPREP IS EMPTY]
        [THEN REPLACE VALUE BY <P> = 'P':(H-TMPREP);]
        X-LIST := LIST TIME-ADVERB-LIST;
        AT X-PRE ASSIGN NODE ATTRIBUTE ADVERBIAL-TYPE WITH VALUE X-LIST.
   $SETUP-PN =
        AFTER X-PRE [NSTGT]
        INSERT <PN> X-PN
        ( <LP> (<NULL>)
        + <P> = '[P]' : (H-TMPREP)
        + <NSTGO> (NSTG));
        X-LIST := LIST TIME-ADVERB-LIST;
        IF ELEMENT- LTIME OF X-PRE EXISTS
        THEN REPLACE ELEMENT- LP OF X-PN BY <LP> (VALUE OF LTIME);
        AT X-PN ASSIGN NODE ATTRIBUTE ADVERBIAL-TYPE WITH VALUE X-LIST;
        DELETE X-PRE;
        TRANSFORM X-PN.
— T-SETUP-NEG-MEAN
— [OBSOLETE] DICTIONARY NO LONGER HAS NEG-MEAN.
T-SETUP-NEG-MEAN = IN LXR, NNN, DSTG:
        IF $CHK-FOR-NEG-MEAN
        THEN BOTH $ADD-NEG-MEAN
        AND $SET-SELATT-NEG.
   $CHK-FOR-NEG-MEAN =
        BOTH CORE-SELATT OF CORE- X-HOST HAS MEMBER H-CHANGE OR
        H-CHANGE-MORE OR H-CHANGE-LESS OR H-CHANGE-SAME OR
        H-MODAL OR H-TMEND OR H-TMBEG OR H-CONN
        AND X-HOST IS H-CHANGE OR H-CHANGE-MORE OR H-CHANGE-LESS
        OR H-CHANGE-SAME OR H-MODAL OR H-TMEND OR H-TMBEG
        OR H-CONN: NEG-MEAN;
        AT X-HOST NOT $NEGMEAN-DONE.
   $NEGMEAN-DONE = ITERATE DO R(N)
        UNTIL PRESENT-ELEMENT- IS '[NEG-MEAN]' SUCCEEDS.
   $ADD-NEG-MEAN =
        AFTER LAST-COELEMENT OF X-HOST
        INSERT <GRAM-NODE> X-NEGMEAN = '[NEG-MEAN]'.
   $SET-SELATT-NEG =
        X-TYPE := SYMBOL MODS;
        AT X-NEGMEAN
        BOTH X-ADDATT := SYMBOL H-NEG
        AND BOTH $ADD-TO-SELATT [GLOBAL IN T-SEM-CORE-OF-LXR]
        AND $SET-SEM-CORE [T-SEM-CORE-OF-LXR].
— T-SETUP-FUT-TENSE
—       BUILDS TENSE FOR AUXILIARY FUTURE TENSE.
—       BY ASSIGNING SELECT-ATT H-VTENSE, TYPE-ATT TENSE AND
—       SEM-CORE TO VERB CORE.
T-SETUP-FUT-TENSE = IN TENSE:
        IF BOTH CORE- X-CORE OF PRESENT-ELEMENT- X-PRE IS W:FUT
        AND BOTH X-CORE IS NOT H-MODAL
        AND X-CORE IS NOT H-NEG
        THEN ALL OF $ASSIGN-SELECT-ATT, $ASSIGN-TYPE-ATT, $HOST-VERB.
   $ASSIGN-SELECT-ATT =
        X-SEL := SYMBOL H-VTENSE;
        X-SELATT := NIL;
        PREFIX X-SEL TO X-SELATT;
        AT X-CORE, ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE X-SELATT.
   $ASSIGN-TYPE-ATT =
        X-SEL := SYMBOL TENSE;
        X-SELATT := NIL;
        PREFIX X-SEL TO X-SELATT;
        AT X-CORE, ASSIGN NODE ATTRIBUTE TYPE-ATT WITH VALUE X-SELATT.
   $HOST-VERB =
        [* TENSE is now under LV of VERB *]
        EITHER HOST- X-HOST OF X-PRE EXISTS
        OR CORE- X-HOST OF COELEMENT- VERBAL EXISTS;
        AT X-CORE, ASSIGN NODE ATTRIBUTE SEM-CORE WITH VALUE X-HOST.
— T-SETUP-TENSE
—       FORMATS TENSE AS MODIFIER TO VERBAL (NODE ATTRIBUTE TENSE-ATT)
—       OR NEAREST HOST-.
T-SETUP-TENSE = IN VERBAL, LNR, LCONNR:
        IF BOTH $CHK-FOR-TENSEATT AND NOT $DONE-ALREADY
        THEN $ADD-TENSE.
   $DONE-ALREADY = X-HOST EXISTS;
        ITERATE DO R(GRAM-NODE)
        UNTIL VERIFY CORE-SELATT HAS MEMBER H-VTENSE SUCCEEDS.
   $CHK-FOR-TENSEATT =
        CORE- X-HOST HAS NODE ATTRIBUTE TENSE-ATT X-TENSELIST.
   $ADD-TENSE =
        ALL OF $IMP, $PRES, $PAST, $FUT, $FUTURE, $FUT-IMP, $PERF, $PROG.
   $PROG =
        IF X-TENSELIST HAS MEMBER PROG
        THEN BOTH AFTER LAST-COELEMENT OF X-HOST
        INSERT <GRAM-NODE> X-TENSE = '[PROG]'
        AND $SET-SELATT-VTENSE.
   $PERF =
        IF X-TENSELIST HAS MEMBER PERF
        THEN BOTH AFTER LAST-COELEMENT OF X-HOST
        INSERT <GRAM-NODE> X-TENSE = '[PERF]'
        AND $SET-SELATT-VTENSE.
   $FUT =
        IF X-TENSELIST HAS MEMBER FUT
        THEN BOTH AFTER LAST-COELEMENT OF X-HOST
        INSERT <GRAM-NODE> X-TENSE = '[FUT]'
        AND $SET-SELATT-VTENSE.
   $FUTURE =
        IF X-TENSELIST HAS MEMBER FUTURE
        THEN BOTH AFTER LAST-COELEMENT OF X-HOST
        INSERT <GRAM-NODE> X-TENSE = '[FUTURE]'
        AND $SET-SELATT-VTENSE.
   $FUT-IMP =
        IF X-TENSELIST HAS MEMBER FUT-IMP [FUTURE]
        THEN BOTH AFTER LAST-COELEMENT OF X-HOST
        INSERT <GRAM-NODE> X-TENSE = '[FUT-IMP]'
        AND $SET-SELATT-VTENSE.
   $PAST =
        IF X-TENSELIST HAS MEMBER PAST
        THEN BOTH AFTER LAST-COELEMENT OF X-HOST
        INSERT <GRAM-NODE> X-TENSE = '[PAST]'
        AND $SET-SELATT-VTENSE.
   $PRES =
        IF X-TENSELIST HAS MEMBER PRESNT
        THEN BOTH AFTER LAST-COELEMENT OF X-HOST
        INSERT <GRAM-NODE> X-TENSE = '[PRESENT]'
        AND $SET-SELATT-VTENSE.
   $IMP =
        IF X-TENSELIST HAS MEMBER IMPERTVE
        THEN BOTH AFTER LAST-COELEMENT OF X-HOST
        INSERT <GRAM-NODE> X-TENSE = '[IMPERATIVE]'
        AND $SET-SELATT-VTENSE.
   $SET-SELATT-VTENSE =
        X-TYPE := SYMBOL TENSE;
        AT X-TENSE
        BOTH X-ADDATT := SYMBOL H-VTENSE
        AND BOTH $ADD-TO-SELATT [GLOBAL IN T-SEM-CORE-OF-LXR]
        AND $SET-SEM-CORE [T-SEM-CORE-OF-LXR].
— T-NAMESTG
T-NAMESTG = IN NAMESTG:
        AT PRESENT-ELEMENT X-PRE
        IF CORE- OF TITLE OF LEFT-ADJUNCT-POS OF CORE- X-CORE IS
        NOT EMPTY
        @THEN IF PRESENT-ELEMENT- IS 'DR.' OR 'DR' OR 'DOCTOR' OR
        'DOCTORS' OR 'MD' OR 'M.D.' OR 'MDS'
        THEN $ASSIGN-DOCTOR
        ELSE $REMOVE-DR;
        IF CORE- OF RNAME OF LNAMER OF X-PRE IS NOT EMPTY
        @THEN IF PRESENT-ELEMENT- IS 'M.D.' OR 'MD'
        THEN $ASSIGN-DOCTOR.
   $ASSIGN-DOCTOR =
        X-TEMP := LIST DOCTOR-LIST;
        DO $ASSIGN-SELECTATT.
   $ASSIGN-SELECTATT =
        AT X-CORE
        ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE X-TEMP.
   $REMOVE-DR =
        X-TEMP := LIST PT-FAM;
        DO $ASSIGN-SELECTATT.
— T-SEM-CORE-OF-REPT
T-SEM-CORE-OF-REPT = IN LNR:
        AT CORE- X-CORE OF PRESENT-ELEMENT- X-PRE
        DO $NOUN-PLURAL-REPT.
   $NOUN-PLURAL-REPT =
        IF BOTH $LOOK-FOR-PLURAL
        AND $REPT
        THEN $SET-SELATT-REP.
   $LOOK-FOR-PLURAL =
        BOTH X-CORE IS NOT NULLN
        AND BOTH X-CORE IS NOT NUNIT OR NTIME1
        WHERE ONE OF $LQR-PLURAL, $LAR-PLURAL,
   $N-PLURAL, $LTR-PLURAL
        AND AT X-CORE STORE IN X-HOST.
   $LQR-PLURAL =
        AT LQR X-PLURAL OF QPOS OF LEFT-ADJUNCT X-LN OF X-CORE
        DO $LQR-CHECK.
   $LQR-CHECK =
        CORE- IS NOT '1'.
   $LAR-PLURAL =
        EITHER AT LAR [LAR1] X-PLURAL OF ADJADJ OF APOS OF X-LN
        DO $LAR-CHECK
        OR AT LAR X-PLURAL OF ADJINRN OF RIGHT-ADJUNCT OF X-CORE
        DO $LAR-CHECK.
   $LAR-CHECK =
        BOTH CORE- IS NTH
        @AND PRESENT-ELEMENT- IS NOT '1ST'.
   $N-PLURAL =
        X-CORE HAS COELEMENT- N X-PLURAL
        WHERE PRESENT-ELEMENT- IS 'PLURAL'.
   $LTR-PLURAL =
        CORE- OF ELEMENT- LTR X-PLURAL OF ELEMENT- TPOS OF X-LN
        HAS ATTRIBUTE EACHEVRY.
   $REPT =
        ALL OF $NOT-NULLN, $HOST-CHECK, $NO-REP.
   $HOST-CHECK =
        CORE-SELATT OF X-HOST HAS MEMBER REPT-LIST.
   $NOT-NULLN =
        X-HOST IS NOT NULLN.
   $NO-REP =
        AT X-CORE
        IF CORE-SELATT OF PRESENT-ELEMENT- HAS MEMBER H-TTGEN OR H-TXVAR
        THEN PRESENT-ELEMENT- IS NOT H-TTGEN OR H-TXVAR:NO-REP.
   $SET-SELATT-REP =
        AT CORE- [N, Q, T, ADJ] OF X-PLURAL
        BOTH X-ADDATT := SYMBOL H-TMREP
        AND BOTH $ADD-TO-SELATT
        AND $ADD-HOSTATT.
   $ADD-HOSTATT =
        VERIFY X-TYPE := SYMBOL TIME;
        VERIFY X-HOST := X-CORE;
        DO $SET-SEM-CORE [T-SEM-CORE-OF-LXR].
   $ADD-TO-SELATT =
        AT PRESENT-ELEMENT- X-PE
        DO $CHECK-SELATT.
   $CHECK-SELATT =
        IF CORE-SELATT OF X-PE EXISTS
        THEN EITHER $SEL-ATT
        OR $ATTRIBUTE
        ELSE BOTH X-SELATT-LIST := NIL
        AND $ADD-TO-SELATT-LIST.
   $SEL-ATT =
        BOTH X-PE HAS NODE ATTRIBUTE SELECT-ATT X-SELATT-LIST
        AND $ADD-TO-SELATT-LIST.
   $ATTRIBUTE =
        BOTH $CREATE-SELATT-LIST
        AND $ADD-TO-SELATT-LIST.
   $CREATE-SELATT-LIST =
        ATTRIBUTE-LIST X-NEWLIST EXISTS;
        X-SUBLANGUAGE-ATTS := LIST SUBLANGUAGE-ATTS;
        INTERSECT OF X-SUBLANGUAGE-ATTS EXISTS;
        X-SELATT-LIST := X-INTERSECTION [X-SELATT-LIST MAY BE NIL].
   $ADD-TO-SELATT-LIST =
        BOTH EITHER $ATT-ALREADY-ON-LIST
        OR PREFIX X-ADDATT TO X-SELATT-LIST
        AND AT X-PE
        ASSIGN PRESENT ELEMENT NODE ATTRIBUTE SELECT-ATT
        WITH VALUE X-SELATT-LIST.
   $ATT-ALREADY-ON-LIST =
        X-SELATT-LIST HAS MEMBER X-ADDATT
        [DO NOT ADD ATTRIBUTE TO LIST IF ALREADY ON LIST].
— T-HOST-AGE-UNIT
T-HOST-AGE-UNIT = IN QN, LQR, LNR:
        ONE OF $LNR-CHK, $QN-CHK, $LQR-CHK.
   $LNR-CHK = PRESENT-ELEMENT- X-PRE IS LNR;
        VERIFY X-HOST:= NIL;
        IF CORE-SELATT OF CORE- X-CORE HAS MEMBER NTIME1
        THEN $AGE-CHK [CHECK IF LNR IS AN AGE MOD]
        ELSE IF X-S HAS MEMBER NUNIT
        THEN $FIND-UNIT-HOST [IS LNR A UNIT MOD-3 DEGREES]
        ELSE IF X-CORE IS NULLN WHERE CORE-ATT HAS MEMBER NUNIT
        THEN IF $LNR-HOST [T-SEM-CORE-OF-LXR-HOST IN X-HOST]
        THEN IF $IS-PT-FAM ['PT OF 3]
        THEN BOTH $SET-N-TO-YEAR
        AND $SET-AGE-MK [SET RN TO ADJ=OLD]
        ELSE IF $HOST-IS-AGE [AGE OF 3, AGE IS 3]
        THEN BOTH $SET-N-TO-YEAR
        AND $UNIT-TO-AGE-MK
        ELSE $SET-UNIT-HOST [FEVER OF 103].
   $AGE-CHK = [IS LNR AN AGE MODIFIER]
        IF AT RIGHT-ADJUNCT X-HOST OF X-CORE DO $AGE-MK-CHK
        THEN $UNIT-TO-AGE-MK [SET UNIT HOST TO AGE MARKER]
        ELSE IF AT X-PRE BOTH $FIND-HOST
        AND $HOST-IS-AGE
        THEN $UNIT-TO-AGE-MK.
   $UNIT-TO-AGE-MK = [X-HOST POINTS TO AGE MARKER]
        X-TYPE:= SYMBOL UNIT;
        AT X-CORE DO $SET-SEM-CORE.
   $FIND-UNIT-HOST = [FIND HOST OF UNIT OF MEASUREMENT-'103 DEGREES']
        X-HOST := NIL;
        AT X-PRE EITHER $FIND-HOST OR TRUE;
        DO $SET-UNIT-HOST.
   $SET-UNIT-HOST = X-TYPE:= SYMBOL UNIT;
        AT X-CORE DO $ASSIGN-HOST.
   $SET-AGE-HOST = X-TYPE:= SYMBOL AGE;
        AT X-CORE DO $ASSIGN-HOST.
   $IS-PT-FAM = X-HOST HAS MEMBER H-PT OR H-FAMILY.
   $HOST-IS-AGE = X-HOST IS H-AGE.
   $SET-AGE-MK = [ADD AGE MARKER TO RN]
        BEFORE VALUE OF RIGHT-ADJUNCT-POS OF X-CORE
        INSERT <ADJINRN> (<LAR> (<LA> (<NULL>)
        +<AVAR> (<ADJ> X-AGE = '[OLD]':(H-AGE))
        +<RA> (<NULL>)));
        DO $SET-AGE-HOST
        [Set HOST-AGE pointing to X-HOST at AGE MARKER];
        X-HOST:= X-AGE;
        DO $UNIT-TO-AGE-MK [SET UNIT-HOST POINTING TO AGE MARKER].
   $SET-N-TO-YEAR = AT X-CORE REPLACE PRESENT-ELEMENT-
        BY <N>X-TEMP = '[YEAR]':(NTIME1);
        X-CORE:= X-TEMP.
   $SCALESTG-AGE = ['3 DAYS OLD','3 DAYS OF AGE']
        AT CORE- OF SCALESTG DO $AGE-MK-CHK.
   $AGE-MK-CHK =
        EITHER BOTH PRESENT-ELEMENT- X-HOST IS 'OLD'
        AND $SET-AGE-ATT
        OR PRESENT-ELEMENT- IS PN
        WHERE BOTH ELEMENT- P IS 'DE' OR 'OF'
        AND CORE- X-HOST OF NSTGO IS 'A3GE' OR 'AGE'.
   $SET-AGE-ATT = VERIFY X-TEMP:= LIST H-AGE-LIST;
        ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE X-TEMP.
   $LQR-CHK = X-PRE IS LQR;
        IF PRESENT-ELEMENT- IS OCCURRING IN LN OR QN OR NQ
        THEN TRUE [DO NOT CHECK FOR AGE]
        ELSE IF PRESENT-ELEMENT- IS OCCURRING IN RN
        WHERE HOST- X-HOST EXISTS
        THEN BOTH $SETUP-QN [CHANGE LQR TO QN]
        AND $QN-CHK.
   $SETUP-QN = [REPLACE LQR IN RN BY QN FOR REGULARITY]
        AT X-PRE REPLACE PRESENT-ELEMENT- BY
        <QN>X-TEMP (X-PRE
        +<N>='NULLN'
        +<SCALESTG>(<NULL>));
        X-PRE:= X-TEMP;
        IF EITHER $IS-PT-FAM ['PT 3' CHANGED TO 'PT 3 YEAR']
        OR $HOST-IS-AGE ['AGE 3' CHANGED TO 'AGE 3 YEAR']
        THEN $SET-N-TO-YEAR;
        DO $QN-CHK.
   $QN-CHK = X-PRE IS QN;
        IF ELEMENT- N X-CORE IS NTIME1
        THEN IF $SCALESTG-AGE
        THEN BOTH $SET-UNIT-HOST [UNIT points to AGE MARKER]
        AND BOTH X-CORE:= X-HOST
        AND $FIND-AGE-HOST
        ELSE $HOST-CHK
        ELSE $FIND-UNIT-HOST.
   $FIND-AGE-HOST = X-HOST:= NIL;
        AT X-PRE EITHER $FIND-HOST OR TRUE;
        DO $SET-AGE-HOST.
   $HOST-CHK =
        IF $FIND-HOST
        THEN IF $HOST-IS-AGE
        THEN $SET-UNIT-HOST
        ELSE IF X-HOST IS H-PT OR H-FAMILY [$IS-PT-FAM] [*GRI*]
        THEN BOTH $SET-SCALESTG-AGEMK
        AND $QN-CHK.
   $SET-SCALESTG-AGEMK = [Change NULL SCALESTG to ADJ=OLD]
        BEFORE VALUE OF SCALESTG OF X-PRE
        INSERT <ADJ> = 'OLD':(H-AGE).
— T-DISTRIBUTE-INTRO
—       DISTRIBUTES INTRODUCER TO ALL ITS ARGUMENTS, I.E.
—       ASSERTION AND/OR FRAGMENT.
— *** THIS WILL REMOVE THE NEED FOR T-FORMAT-INTRO.
— *** FOR SOME REASONS, THIS RULE IS PUT ON
—       THE TRANSFORMATION STACK TWICE.
T-DISTRIBUTE-INTRO = IN ASSERTION, FRAGMENT:
        IF ALL OF $ADD-SA, $NOT-ALREADY-DONE, $INTRO-NOT-EMPTY
        THEN DO $DISTRIBUTE-INTRO.
   $ADD-SA =
        IF VALUE OF PRESENT-ELEMENT- IS NOT SA
        THEN BEFORE VALUE OF PRESENT-ELEMENT-
        INSERT <SA> (<NULL>).
   $NOT-ALREADY-DONE =
        CORE- OF SA OF PRESENT-ELEMENT- IS NOT ':'.
   $INTRO-NOT-EMPTY =
        AT IMMEDIATE CENTER OF PRESENT-ELEMENT- X-ASSERT, GO LEFT;
        CORE- OF PRESENT-ELEMENT- X-PRE [IS NOT EMPTY] IS ':'.
   $DISTRIBUTE-INTRO =
        IF VALUE OF PRESENT-ELEMENT- IS NOT SA
        THEN BEFORE VALUE OF PRESENT-ELEMENT-
        INSERT <SA> (ALL ELEMENTS OF X-PRE)
        ELSE IF SA X-SA OF PRESENT-ELEMENT- IS EMPTY
        THEN REPLACE X-SA BY <SA> (ALL ELEMENTS OF X-PRE)
        ELSE BEFORE VALUE OF X-SA INSERT ALL ELEMENTS OF X-PRE.
— T-FORMAT-INTRO
—       ASSIGNS PATHIF TO ASSERTION AND FRAGMENT.
T-FORMAT-INTRO = IN ASSERTION, FRAGMENT:
        IF ALL OF $INTRO-NOT-EMPTY, $CHK-N-ATTS, $SAVE-SELATTS,
        THEN $FIND-TYPE.
   $INTRO-NOT-EMPTY =
        AT IMMEDIATE CENTER OF PRESENT-ELEMENT- X-ASSERT, GO LEFT;
        PRESENT-ELEMENT- X-PRE IS NOT EMPTY;
        CORE- X-CORE OF VALUE [LAR/LNR] EXISTS.
   $SAVE-SELATTS = [* puts this SELECT-ATTs on the ASSN-SELATTS *]
        IF X-ASSERT HAS NODE ATTRIBUTE ASSN-SELATTS X-ASSNSELS
        THEN DO $STORE-ASSNSELS
        ELSE BOTH X-ASSNSELS := NIL
        AND DO $STORE-ASSNSELS.
   $STORE-ASSNSELS =
        X-UNION := CORE-ATT OF X-CORE;
        X-ASSNSELS := UNION OF X-ASSNSELS;
        AT X-ASSERT, ASSIGN NODE ATTRIBUTE ASSN-SELATTS WITH
        VALUE X-ASSNSELS.
   $CHK-N-ATTS = NONE OF $HAS-FAIL-SEL, $HAS-ADJ-TYPE
        [$HAS-COMPUTED-HOST].
   $FIND-TYPE = IF $CHECK-IT THEN DO $FIND-FORMAT-TYPE.
   $CHECK-IT =
        CORE-SELATT X-S OF X-CORE EXISTS;
        X-NEWLIST:= LIST FRMT-CLASS;
        INTERSECT X-SIG OF X-S IS NOT NIL.
   $FIND-FORMAT-TYPE = X-LIST:= LIST FORMAT-TYPE;
        ITERATE $THROUGH-LIST
        UNTIL SUCCESSORS X-LIST OF X-LIST IS NIL SUCCEEDS.
   $THROUGH-LIST = ATTRIBUTE-LIST X-NEWLIST OF X-LIST EXISTS;
        IF INTERSECT OF X-SIG IS NOT NIL
        THEN $IS-A-TYPE.
— T-LXR-FORMAT-TYPE
—       ASSIGNS TYPE OF FORMATS TO A SENTENCE.
T-LXR-FORMAT-TYPE = IN LXR, NNN, DSTG:
        IF ALL OF $GET-REG, $CHK-N-ATTS, $IN-ASSRT, $SAVE-SELATTS,
   $NOT-IN-TIME, $NOT-IN-ADJUNCT, $NOT-FRMT00
        THEN $FIND-TYPE.
   $GET-REG = CORE- X-CORE OF PRESENT-ELEMENT- X-PRE EXISTS.
   $SAVE-SELATTS = [* puts this SELECT-ATTs on the ASSN-SELATTS *]
        IF X-ASSERT HAS NODE ATTRIBUTE ASSN-SELATTS X-ASSNSELS
        THEN DO $STORE-ASSNSELS
        ELSE BOTH X-ASSNSELS := NIL
        AND DO $STORE-ASSNSELS.
   $STORE-ASSNSELS =
        X-UNION := CORE-ATT OF X-CORE;
        X-ASSNSELS := UNION OF X-ASSNSELS;
        AT X-ASSERT, ASSIGN NODE ATTRIBUTE ASSN-SELATTS WITH
        VALUE X-ASSNSELS.
   $CHK-N-ATTS = NONE OF $HAS-FAIL-SEL, $HAS-ADJ-TYPE
        [$HAS-COMPUTED-HOST].
   $IN-ASSRT =
        ASCEND TO ASSERTION OR FRAGMENT PASSING THROUGH STRING;
        STORE IN X-ASSERT.
   $NOT-IN-TIME =
        IF ASCEND TO PN PASSING THROUGH STRING
        @THEN PRESENT-ELEMENT- DOES NOT HAVE NODE ATTRIBUTE REFPT-ATT
        [* is TMREFPT - not significant in this decision *].
   $NOT-IN-ADJUNCT =
        [* Bypass adverbial ADJUNCT or TIME or TESTENV *]
        IF ASCEND TO PN PASSING THROUGH STRING
        @THEN IF PRESENT-ELEMENT- X-PHR-PN HAS NODE ATTRIBUTE
        ADVERBIAL-TYPE X-PHRASE-ATT
        THEN X-PHRASE-ATT DOES NOT HAVE MEMBER ADJUNCT-TYPE
        OR TIME-ADVERBIAL
        ELSE IF X-PHR-PN HAS NODE ATTRIBUTE PHRASE-ATT X-PHRASE-ATT
        THEN X-PHRASE-ATT DOES NOT HAVE MEMBER TIME-PHRASE
        OR TESTENV-PHRASE.
   $NOT-FRMT00 = NOT $IS-FRMT00.
   $IS-FRMT00 =
        BOTH X-ASSERT HAS NODE ATTRIBUTE FORMAT-ATT
        @AND PRESENT-ELEMENT- HAS MEMBER FRMT00.
   $ASSIGN-FRMT0 = X-LIST:= LIST FRMT0-LIST;
        DO $IS-A-TYPE. (GLOBAL)
   $HAS-FAIL-SEL = X-CORE HAS NODE ATTRIBUTE FAIL-SEL. (GLOBAL)
   $HAS-COMPUTED-HOST =
        EITHER X-CORE HAS NODE ATTRIBUTE LN-TO-N-ATT
        OR X-CORE HAS NODE ATTRIBUTE RN-TO-N-ATT.
   $HAS-ADJ-TYPE =
        BOTH X-CORE HAS NODE ATTRIBUTE ADVERBIAL-TYPE
        @AND PRESENT-ELEMENT- HAS MEMBER ADJUNCT-TYPE. (GLOBAL)
   $FIND-TYPE = IF $CHECK-IT THEN DO $FIND-FORMAT-TYPE.
   $CHECK-IT =
        CORE-SELATT X-S OF X-CORE EXISTS;
        X-NEWLIST:= LIST FRMT-CLASS;
        INTERSECT X-SIG OF X-S IS NOT NIL.
   $CORE-ATT-SIG = X-CORE HAS NODE ATTRIBUTE COMPUTED-ATT X-S;
        DO $CHECK-IT.
   $FIND-FORMAT-TYPE = X-LIST:= LIST FORMAT-TYPE;
        ITERATE $THROUGH-LIST
        UNTIL SUCCESSORS X-LIST OF X-LIST IS NIL SUCCEEDS.
   $THROUGH-LIST = ATTRIBUTE-LIST X-NEWLIST OF X-LIST EXISTS;
        IF INTERSECT OF X-SIG IS NOT NIL
        THEN $IS-A-TYPE.
   $IS-A-TYPE = X-HEAD:= HEAD OF X-LIST [TYPE OF FORMAT];
        IF X-ASSERT HAS NODE ATTRIBUTE FORMAT-ATT X-TYPE-LIST
        THEN $ADD-ON-TYPE
        ELSE $SETUP-TYPE-ATT. (GLOBAL)
   $ADD-ON-TYPE = EITHER X-TYPE-LIST HAS MEMBER X-HEAD
        OR BOTH PREFIX X-HEAD TO X-TYPE-LIST
        AND AT X-ASSERT ASSIGN NODE ATTRIBUTE FORMAT-ATT
        WITH VALUE X-TYPE-LIST.
   $SETUP-TYPE-ATT = X-TYPE-LIST:= NIL;
        PREFIX X-HEAD TO X-TYPE-LIST;
        AT X-ASSERT ASSIGN NODE ATTRIBUTE FORMAT-ATT WITH VALUE
        X-TYPE-LIST.
— T-SEM-CORE-OF-LXR
—       THIS IS THE ONLY TRANSFORMATION (OTHER THAN SEQUENCING ONES) THAT
—       DOES NOT CREATE A CONNECTIVE. ITS FUNCTION IS TO FIND THE HOST OF
—       A CERTAIN LXR NODE AND TO ASSIGN TO IT A NODE ATTRIBUTE SEM-CORE
—       POINTING TO THE HOST.
—       T-SEM-CORE-OF-LXR OPERATES WHERE THE CORE X OF AN LXR
—       A) HAS NODE ATTRIBUTE N-TO-LN-ATT/N-TO-RN-ATT POINTING TO Y. THIS
—       MEANS THAT X IS PART OF A PHRASE WHICH HAS A COMPUTED ATTRIBUTE.
—       IN THIS CASE, THE CORE OF Y IS THE 'HOST' OF X.
—       EX.: IN 'THE END OF FEVER...', 'FEVER' IS THE HOST OF 'END'.
—       OR B) X HAS AN ATTRIBUTE ON LIST TRANSP-LIST.
—       OR C) X IS AN NTIME1 OR NTIME2 WORD.
—       OR D) X IS AN LNR IN A PN WHICH HAS THE NODE ATTRIBUTE TIME-ADVERBIAL.
—       THE HOST FOR CASES (B),(C),(D) ARE FOUND AS FOLLOWS:
—       1) IF LXR IS IN SA OR RV, HOST MAY BE ONE OF FOLLOWING:
—       A) VERB COELEMENT.
—       B) NSTG/ASTG IN FRAGMENT.
—       C) HEADCONN IN LCONNR.
—       D) VERB COELEMENT OF IMMEDIATE OBJECT (PASSING THROUGH STRINGS
—       WITH COMPOUND OBJECTS).
—       OR 2) IF LXR IS LAR OR LAR1 OR LQNR, HOST MAY BE ONE OF FOLLOWING:
—       A) REGULAR HOST
—       B) COELEMENT SUBJECT OF IMMEDIATE OBJECT.
—       OR 3) IF LXR IS VERBAL, HOST MAY BE ONE OF FOLLOWING:
—       A) CORE N OF COELEMENT OBJECT (PASSING THROUGH OBJECTS WITH
—       COMPOUND OBJECT STRINGS).
—       B) CORE OF COELEMENT SUBJECT IF OBJECT IS NULLOBJ.
—       OR 4) IF LXR IS LNR, HOST MAY BE ONE OF FOLLOWING:
—       A) IF IN PN, EITHER HOST OF PN
—       OR IF PN IS IN SA OR RV SEE (1) ABOVE FOR
—       B) AT IMMEDIATE OBJECT (PASSING THROUGH COMPOUND OBJECT STRINGS)
—       GO TO COELEMENT SUBJECT.
—       C) AT IMMEDIATE SUBJECT, EITHER COELEMENT OBJECT
—       HAS VALUE OBJBE- HOST IS CORE OF OBJECT
—       OTHERWISE COELEMENT VERB IS HOST.
—       OR 5) IF IN LP, GO TO COELEMENT P.
—       OR 6) IF IN LV OR RV OF VERB WHICH ITSELF HAS A SEM-CORE, SEM-CORE
—       IS THE SAME AS SEM-CORE OF VERB.
—       OR 7) GOT TO REGULAR HOST (IT SHOULD NOT BE EMPTY).
—       $ASSIGN-HOST CHECKS THAT THE SEM-CORE CAN SUPPORT A TIME OR MOD
—       NODE. IF IT CANNOT THEN $WRONG-HOST TRIES TO FIND ANOTHER
—       SEM-CORE THAT CAN. LQNR IS AN EXCEPTION- IT ALWAYS GETS A
—       SEM-CORE WHICH IS USED BY VARIOUS FORMATTING TRANSFORMATIONS.
—       $WRONG-HOST TRIES TO FIND ANOTHER HOST:
—       1) IF INCORRECT HOST IS P, THEN NEW SEM-CORE POINTS TO LNR IN
—       NSTGO OF PN.
—       2) IF INCORRECT HOST IS OCCURRING IN LNR IN PN, THEN NEW SEM-CORE
—       WILL POINT TO HOST OF PN.
—       3) IF ALL OTHER ATTEMPTS FAIL, GO UP TO STRING CONTAINING VERBAL
—       ELEMENT, WHICH WILL BE THE NEW VALUE OF SEM-CORE.
T-SEM-CORE-OF-LXR = IN LXR, DSTG, NNN :
        CORE- X-CORE OF PRESENT-ELEMENT- X-PRE EXISTS;
        X-PRE EXISTS;
        EITHER $EXCLUDE
        OR $SEM-CORE-CHK;
        IF X-PRE IS LNR THEN $PLURAL-CHK.
   $SEM-CORE-CHK =
        IF ALL OF $NOT-TIME-PHRASE, $IS-MODIFIER-CHK, $NOT-TRANSP-HGRAPH
        THEN ONE OF $MOD-AND-SIG-CHK, $COMP-ATT, $FIND-AND-ASSGN.
   $NOT-TRANSP-HGRAPH =
        [* Erase H-TRANSP homograph from SELECT-ATT of core *]
        IF BOTH CORE-SELATT X-SELATT OF X-CORE HAS MEMBER H-TRANSP
        AND NEITHER X-CORE HAS NODE ATTRIBUTE N-TO-RN-ATT
        NOR X-CORE HAS NODE ATTRIBUTE N-TO-LN-ATT
        THEN BOTH $ERASE-TRANSP AND FALSE.
   $ERASE-TRANSP =
        X-SUBLIST := NIL;
        BOTH X-TEMP := SYMBOL H-TRANSP
        AND PREFIX X-TEMP TO X-SUBLIST;
        X-SELATT := COMPLEMENT OF X-SELATT;
        AT X-CORE, ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE X-SELATT.
   $FIND-AND-ASSGN =
        IF $FIND-HOST
        THEN $ASSIGN-HOST
        ELSE BOTH AT X-CORE DO $ADD-TO-TYPE-ATT [ASSIGN TYPE]
        AND $MESS2 [CANNOT FIND HOST-WRITE OUT MESSAGE].
   $MOD-AND-SIG-CHK =
        X-SUBLIST:= LIST MOD-CLASS;
        COMPLEMENT OF X-S IS NOT NIL [X-S HAS SIG. CLASSES ALSO];
        X-HOST:= X-CORE [HOST IS ITSELF];
        DO $HOST-IS-OK
        [IF X-S HAS MEMBER H-CHANGE]
        [* H-CHANGE becomes H-CHANGEMK when there is *]
        [* another component of change *]
        [THEN $CHANGE-TO-MK].
   $CHANGE-TO-MK = [* remove H-CHANGE, add H-CHANGEMK]
        [X-SUBLIST:= LIST CHANGE-LIST;]
        COMPLEMENT X-S OF X-S EXISTS [REMOVE H-CHANGE];
        X-UNION:= LIST CHANGEMK-LIST;
        UNION X-S OF X-S EXISTS [ADD H-CHANGEMK];
        AT X-CORE ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE X-S.
   $IS-MODIFIER-CHK =
        CORE-SELATT X-S OF X-CORE EXISTS;
        DO $ISIT-OTHER-MODFR.
   $ISIT-OTHER-MODFR =
        X-MODIF-CLASSES := LIST MODIFIER-CLASSES;
        ITERATET SUCCESSORS X-MODIF-CLASSES OF X-MODIF-CLASSES
        IS NOT NIL
        UNTIL $IS-MOD-CLASS SUCCEEDS.
   $IS-MOD-CLASS =
        X-NEWLIST := ATTRIBUTE-LIST [LIST OF SUBCLASSES FOR TYPE];
        INTERSECT OF X-S IS NOT NIL;
        X-TYPE := HEAD OF X-MODIF-CLASSES.
   $CLASSFR-LQR =
        X-TYPE := SYMBOL MODS;
        AT X-CORE DO $SET-SEM-CORE.
   $PLURAL-CHK =
        IF BOTH $PLURAL-EXISTS AND NOT $LQR-PLURAL
        [IF HAVE LQR QUANTITY, PLURAL QUANTFR IS REDUNDANT]
        THEN BOTH X-TYPE:= SYMBOL QUANTITY
        AND BOTH AT X-CORE DO $SET-SEM-CORE
        AND $SET-SELATT-QNUMBER.
   $LQR-PLURAL =
        LQR OF QPOS OF LEFT-ADJUNCT OF X-HOST IS NOT EMPTY.
   $PLURAL-EXISTS = X-HOST := X-CORE;
        X-CORE HAS COELEMENT- N X-CORE
        WHERE PRESENT-ELEMENT- IS 'PLURAL'.
   $SET-SELATT-QNUMBER =
        AT X-CORE ['PLURAL']
        BOTH X-ADDATT := SYMBOL QNUMBER
        AND $ADD-TO-SELATT.
   $EXCLUDE =
        EITHER X-PRE [PRESENT-ELEMENT-] IS LCONNR OR LQNR,
        OR EITHER X-PRE IS LQR
        WHERE PRESENT-ELEMENT- IS OCCURRING IN QN OR NQ,
        OR ONE OF $HAS-FAIL-SEL [T-LXR-FORMAT-TYPE],
   $HAS-ADJ-TYPE [T-LXR-FORMAT-TYPE].
   $COMP-ATT =
        AT CORE- X-CORE EITHER $GET-RN-ATT
        OR $GET-LN-ATT;
        AT CORE- [OF X-TEMP] STORE IN X-HOST;
        AT X-CORE DO $SET-SEM-CORE.
   $GET-LN-ATT =
        [* CANNOT USE ATTRIBUTE N-TO-LN-ATT ONLY BECAUSE IF LNR *]
        [* IS CONJOINED,VALUE OF N-TO-LN-ATT MAY BE POINTING TO *]
        [* WRONG NODE DUE TO EXPANSION -- WHEN NODE WITH *]
        [* N-TO-LN-ATT IS COPIED ITS VALUE IS COPIED ALSO -- *]
        [* HOWEVER, THE VALUE OF THE COPY SHOULD POINT TO ITS *]
        [* OWN N-TO-LN-ATT AND NOT TO THE VALUE OF THE ORIGINAL.*]
        [* FOR EX., IN OR 'AGE''NO HISTORY OF DIARRHEA OR *]
        [* OTHER FOCAL SIGNS', LTR = 'NO' IS VALUE OF N-TO-LN-ATT *]
        [* FOR ORIGINAL 'HISTORY' AND COPY OF 'HISTORY'. HOWEVER, *]
        [* THERE ARE 2 DIFFERENT LTR'S AND EACH N-TO-LN-ATT *]
        [* SHOULD POINT TO ITS CORRESPONDING LTR. *]
        PRESENT-ELEMENT- HAS NODE ATTRIBUTE N-TO-LN-ATT X-LNATT;
        DO $TEST-IT.
   $TEST-IT =
        LEFT-ADJUNCT-POS X-LN OF X-CORE EXISTS;
        EITHER X-LNATT IS OCCURRING IN LN X-LN1 [POINTING TO CORRECT LN]
        WHERE BOTH X-LN1 IS IDENTICAL TO X-LN
        AND X-LNATT EXISTS [IT IS THE CORRECT HOST]
        OR $REASSIGN-NLN-ATT [WRONG LN - GET CORRECT ONE].
   $REASSIGN-NLN-ATT =
        IF X-LNATT IS LQR THEN AT QPOS OF X-LN DESCEND TO LQR
        WHERE DO $SAVE-IN-XTEMP
        ELSE IF X-LNATT IS LTR
        THEN AT TPOS OF X-LN DESCEND TO LTR
        WHERE DO $SAVE-IN-XTEMP
        ELSE IF X-LNATT IS LAR [LAR1]
        THEN BOTH AT APOS OF X-LN DESCEND TO LAR [LAR1]
        WHERE DO $SAVE-IN-XTEMP
        AND ITERATET $ANOTHER-LAR1
        UNTIL $AT-WRONG-LAR1 FAILS
        [ LAR1 IS RECURSIVE- MUST FIND THE CORRECT ONE ]
        ELSE IF X-LNATT IS NNN
        THEN BOTH AT NPOS OF X-LN DESCEND TO N WHERE
        DO $SAVE-IN-XTEMP
        AND ITERATET $ANOTHER-N
        UNTIL $AT-WRONG-N FAILS;
        AT X-CORE ASSIGN PRESENT ELEMENT NODE ATTRIBUTE N-TO-LN-ATT
        WITH VALUE X-TEMP;
        X-TEMP EXISTS.
   $SAVE-IN-XTEMP = STORE IN X-TEMP.
   $ANOTHER-LAR1 =
        AT X-TEMP DO L(ADJADJ);
        ELEMENT LAR [LAR1] X-TEMP EXISTS.
   $ANOTHER-N = AT X-TEMP DO L(NNN);
        ELEMENT N X-TEMP EXISTS.
   $AT-WRONG-LAR1 =
        IMMEDIATE-NODE OF X-OLD EXISTS;
        DO R(LAR) [R(LAR1)];
        STORE IN X-OLD.
   $AT-WRONG-N = IMMEDIATE-NODE OF X-OLD EXISTS;
        DO R(N);
        STORE IN X-OLD.
   $GET-RN-ATT =
        [* CANNOT USE ONLY ATTRIBUTE N-TO-RN-ATT BECAUSE IF *]
        [* LNR IS CONJOINED, POINTER WILL BE POINTING TO *]
        [* WRONG NODE DUE TO EXPANSION. *]
        [* 'STIFF AND PAINFUL ARMS'. *]
        [* RESET N-TO-RN-ATT TO APPROPRIATE RIGHT-ADJUNCT. *]
        PRESENT-ELEMENT- HAS NODE ATTRIBUTE N-TO-RN-ATT;
        EITHER LNR OF NSTG OF NSTGO OF RIGHT-ADJUNCT OF X-CORE EXISTS
        OR LAR OF RIGHT-ADJUNCT OF X-CORE EXISTS;
        STORE IN X-TEMP;
        AT X-CORE ASSIGN NODE ATTRIBUTE N-TO-RN-ATT WITH VALUE X-TEMP;
        X-TEMP EXISTS [RETURN TO X-TEMP].
   $NOT-TIME-PHRASE =
        NOT $IN-TIME-PHRASE.
   $IN-TIME-PHRASE =
        VERIFY CORE- IS NOT H-TMLOC;
        IF PRESENT-ELEMENT- IS LQR OR NNN OR LAR [LAR1]
        THEN EITHER ASCEND TO LN,
        OR TRUE;
        ASCEND TO PN OR PDATE;
        DO $TIME-PHRASE [T-SEM-CORE-OF-PSTG].
   $FIND-HOST =
        ONE OF $SA-RV-HOST, $ADJ-HOST, $VERB-HOST,
   $LNR-HOST, $P-HOST, $REGULAR-HOST . (GLOBAL)
   $REGULAR-HOST =
        EITHER X-PRE IS NOT LNR OR LAR OR LAR1 OR LQNR OR PN ,
        OR X-PRE IS NOT OF TYPE VERBAL;
        DO $REG-HOST.
   $REG-HOST =
        HOST X-HOST EXISTS WHERE PRESENT-ELEMENT- IS NOT EMPTY.
   $SA-RV-HOST =
        IMMEDIATE-NODE- IS SA OR RV;
        ONE OF $COEL-VERB, $N-IN-FRAG-N, $COEL-BESHOW,
   $CONN-IN-LCONNR, $UP-TO-VERB;
        CORE- X-HOST EXISTS WHERE PRESENT-ELEMENT- IS NOT EMPTY.
   $COEL-VERB =
        BOTH COELEMENT VERBAL EXISTS
        @AND EITHER PRESENT-ELEMENT- IS NOT EMPTY
        OR COELEMENT SUBJECT EXISTS
        WHERE PRESENT-ELEMENT- IS NOT EMPTY.
   $UP-TO-VERB =
        IMMEDIATE-NODE IS OF TYPE N-OBJ-IN-STR
        WHERE AT IMMEDIATE OBJECT DO $COEL-VERB.
   $COEL-BESHOW = [* new structure FRAGMENT BESHOW 12/94 *]
        IMMEDIATE-NODE IS FRAGMENT;
        ELEMENT- BESHOW EXISTS;
        ELEMENT- NSTG OF ELEMENT BESUBJ EXISTS.
   $N-IN-FRAG-N =
        IMMEDIATE-NODE IS FRAGMENT
        WHERE ELEMENT- NSTG EXISTS.
   $CONN-IN-LCONNR =
        CORE- X-HOST OF COELEMENT LCONNR EXISTS.
   $ADJ-HOST =
        EITHER $LAR1-AREA-LOC OR $OTHER-ADJ.
   $LAR1-AREA-LOC =
        [* in 'LOWER EXTREMITY SYMPTOM', *]
        [* 'EXTREMITY' is the HOST of 'LOWER' *]
        BOTH PRESENT-ELEMENT- IS LAR [LAR1]
        WHERE CORE-SELATT OF CORE- HAS MEMBER H-PTAREA OR H-PTLOC
        AND $NPOS-IS-HOST
        [IF CORE OF NPOS IS H-PTPART OR H-PTAREA].
   $NPOS-IS-HOST = AT IMMEDIATE APOS, CORE-SELATT OF CORE X-HOST OF
        COELEMENT NPOS HAS MEMBER H-PTPART OR H-PTAREA.
   $OTHER-ADJ =
        PRESENT-ELEMENT- IS LAR OR LAR1 OR LQNR
        WHERE EITHER HOST X-HOST EXISTS
        OR EITHER AT IMMEDIATE ADJINRN HOST X-HOST EXISTS
        OR $PRED-ADJ.
   $LNR-HOST = [* 'condition' IN 'improvement of condition' *]
        PRESENT-ELEMENT- IS LNR;
        EITHER BOTH X-S HAS MEMBER H-PTAREA
        AND $HOST-OF-AREA
        OR EITHER BOTH X-S HAS MEMBER H-PTPART
        AND $HOST-OF-BP
        OR IF CORE OF RN IS PN XX-PN
        WHERE P IS 'DE' OR '[DE]' OR 'OF' OR '[OF]'
        THEN CORE X-HOST OF LNR OF NSTG OF NSTGO OF XX-PN EXISTS
        ELSE IF IMMEDIATE PN X-PN EXISTS
        THEN $HOST-OF-PN.
   $HOST-OF-BP =
        BOTH RIGHT-ADJUNCT OF X-CORE IS PN XX-PN
        WHERE P IS 'AVEC' OR '[AVEC]' OR 'WITH' OR 'IN'
        AND CORE- X-HOST OF NSTGO OF XX-PN EXISTS.
   $PRED-ADJ = IMMEDIATE OBJECT OF IMMEDIATE OBJBE EXISTS;
        CORE X-HOST OF COELEMENT SUBJECT EXISTS.
   $VERB-HOST =
        PRESENT-ELEMENT- IS OF TYPE VERBAL;
        COELEMENT- OBJECT X-OBJ EXISTS;
        ONE OF $HOST-IS-OBJ, $SUBJ.
   $HOST-IS-OBJ =
        X-OBJ IS NOT EMPTY;
        CORE X-HOST OF X-OBJ EXISTS;
        BOTH X-HOST IS NOT EMPTY
        AND IF PRESENT-ELEMENT- IS OF TYPE N-OBJ-IN-STR
        [for compound objects]
        THEN EITHER $GET-NSTG-OBJ
        OR AT LAST-ELEMENT- OF ELEMENT- PSTRING DO $IN-OBJ
        ELSE AT X-HOST DO $NOT-NHUMAN. (GLOBAL)
   $GET-NSTG-OBJ = AT ELEMENT- NSTGO OF X-HOST
        [ITERATET COELEMENT- NSTGO EXISTS]
        [UNTIL AT CORE- X-HOST DO $NOT-NHUMAN SUCCEEDS]
        ITERATET GO RIGHT [ fails if cannot go right ]
        UNTIL BOTH PRESENT-ELEMENT- X-PREELEM IS NSTGO
        WHERE AT CORE- X-HOST DO $NOT-NHUMAN
        AND GO TO X-PREELEM SUCCEEDS.
   $NOT-NHUMAN = PRESENT-ELEMENT- IS NOT NHUMAN.
   $HOST-OF-AREA = ONE OF $LN-HOST, $RN-HOST.
   $LN-HOST =
        LEFT-ADJUNCT X-LN OF X-CORE EXISTS;
        EITHER $APOS-HOST OR $NPOS-HOST.
   $APOS-HOST =
        APOS OF X-LN IS NOT EMPTY;
        DO $BP-HOST.
   $BP-HOST =
        CORE-SELATT OF CORE- X-HOST HAS MEMBER H-PTPART OR H-PTAREA.
   $NPOS-HOST = NPOS OF X-LN IS NOT EMPTY;
        DO $BP-HOST.
   $RN-HOST =
        RIGHT-ADJUNCT OF X-CORE EXISTS;
        IF PRESENT-ELEMENT- IS PN
        THEN BOTH P IS 'DE' OR 'OF' OR '[DE]' AND NSTGO EXISTS;
        DO $BP-HOST.
   $BP-MISSING = X-HOST:= NIL [BODY-PART IS MISSING].
   $IN-OBJ = PRESENT-ELEMENT- IS OF TYPE STRING
        WHERE ELEMENT- VERBAL EXISTS;
        AT CORE X-HOST , DO $NOT-NHUMAN.
   $SUBJ = CORE OF X-OBJ IS EMPTY;
        AT X-OBJ CORE X-HOST OF COELEMENT SUBJECT IS N OR VING.
   $HOST-OF-OBJ =
        IF ASCEND TO OBJBE PASSING THROUGH TYPE N-OBJ-IN-STR
        THEN AT IMMEDIATE OBJECT
        CORE- X-HOST OF COELEMENT SUBJECT IS NOT EMPTY
        ELSE ASCEND TO OBJECT PASSING THROUGH TYPE N-OBJ-IN-STR
        WHERE DO $VERB-IS-HOST.
   $HOST-OF-SUBJ = IMMEDIATE SUBJECT EXISTS;
        EITHER $OBJ-IS-HOST OR $VERB-IS-HOST.
   $OBJ-IS-HOST = AT COELEMENT- OBJECT X-OBJ, DESCEND TO OBJBE;
        DO $HOST-IS-OBJ.
   $VERB-IS-HOST =
        DO $COEL-VERB;
        CORE- X-HOST EXISTS WHERE PRESENT-ELEMENT- IS NOT EMPTY.
   $P-HOST = COELEMENT- P X-HOST OF IMMEDIATE LP EXISTS.
   $HOST-OF-PN =
        AT X-PN ONE OF $REG-HOST, $SA-RV-HOST, $HOST-OF-OBJ. (GLOBAL)
   $ASSIGN-HOST =
        ONE OF $NO-HOST, $HOST-IS-OK, $SEM-CORE-OF-HOST,
   $WRONG-HOST, $MESS1.
   $NO-HOST = BOTH X-HOST IS NIL [COULD NOT FIND HOST]
        AND $SET-SEM-CORE [ASSIGN TYPE-SIGNAL COULD NOT FIND HOST].
   $SEM-CORE-OF-HOST =
        [FOR PN, PDATE, DSTG IN LV OR RV OF VERBAL]
        EITHER AT X-HOST DO $CHECK-ITS-SEM-CORE
        OR AT IMMEDIATE VERBAL OF X-HOST DO $CHECK-ITS-SEM-CORE.
   $CHECK-ITS-SEM-CORE = VERIFY X-OLDHOST:= X-HOST;
        EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE SEM-CORE X-HOST
        OR BOTH EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE N-TO-RN-ATT
        OR PRESENT-ELEMENT- HAS NODE ATTRIBUTE N-TO-RN-ATT
        @AND CORE- X-HOST EXISTS;
        EITHER $HOST-IS-OK
        OR BOTH AT X-OLDHOST STORE IN X-HOST
        [SET X-HOST BACK TO ORIGINAL]
        AND NOT TRUE [FAIL $SEM-CORE-OF-HOST AND TRY $WRONG-HOST].
   $HOST-IS-OK =
        ONE OF $H-NULL-HOST, $HOST-OF-LQR, $LCONNR-HOST, $HOST-CHK.
   $H-NULL-HOST =
        EITHER CORE-ATT X-HOST-CORE-ATT OF X-HOST IS NIL
        OR X-HOST-CORE-ATT HAS MEMBER H-NULL OR H-TRANSP.
   $LCONNR-HOST = BOTH X-HOST IS OCCURRING IN LCONNR
        AND $SET-SEM-CORE.
   $HOST-CHK =
        PRESENT-ELEMENT- X-IT EXISTS; [SAVE PRESENT NODE]
        IF CORE-ATT [CORE-SELATT] X-S OF X-HOST EXISTS
        THEN BOTH $CHK-NOT-HOST
        AND $CHK-IS-HOST
        ELSE X-HOST IS OCCURRING IN VERBAL;
        AT X-IT DO $SET-SEM-CORE.
   $HOST-OF-LQR =
        EITHER X-PRE IS LQR
        OR X-S HAS MEMBER H-AMT OR H-TRANSP;
        AT X-PRE DO $SET-SEM-CORE.
   $CHK-NOT-HOST =
        X-NEWLIST := LIST NOT-HOST-CLASSES;
        IF X-NEWLIST HAS MEMBER X-TYPE
        WHERE ATTRIBUTE-LIST X-TEMP EXISTS
        [LIST OF SUBCLASSES NOT PERMITTED AS HOST]
        [OF THIS TYPE OF MODIFIER]
        THEN X-S DOES NOT HAVE MEMBER X-TEMP.
   $CHK-IS-HOST =
        [FIND LIST OF ALLOWABLE HOSTS FOR MODIFIER TYPE]
        X-NEWLIST := LIST HOST-CLASSES;
        IF X-NEWLIST HAS MEMBER X-TYPE
        WHERE ATTRIBUTE-LIST X-TEMP EXISTS
        THEN EITHER X-S HAS MEMBER X-TEMP
        OR X-HOST IS 'POUR-CENT' OR 'PERCENT'
        OR 'PER' OR 'REQUIRE'.
   $SET-SEM-CORE =
        IF X-HOST IS NOT IDENTICAL TO X-IT
        THEN BOTH $ADD-TO-TYPE-ATT [ASSIGN OR ADD TO TYPE-ATT N.A.]
        AND IF X-HOST IS NOT NIL
        THEN ASSIGN NODE ATTRIBUTE SEM-CORE WITH VALUE X-HOST.
   $ADD-TO-TYPE-ATT =
        EITHER PRESENT-ELEMENT- X-IT HAS NODE ATTRIBUTE TYPE-ATT X-TEMP
        OR X-TEMP:= NIL;
        IF X-TEMP DOES NOT HAVE MEMBER X-TYPE
        THEN $ADD-TYPE-ATT.
   $ADD-TYPE-ATT =
        BOTH PREFIX X-TYPE TO X-TEMP
        AND AT X-IT ASSIGN NODE ATTRIBUTE TYPE-ATT WITH VALUE X-TEMP.
   $INIT-TYPE-REG = X-TEMP := NIL.
   $WRONG-HOST =
        ONE OF $N-TO-RIGHT, $NEXT-N, $GO-TO-SUBJ, $VERB-OF-STRING.
   $N-TO-RIGHT =
        VERIFY BOTH X-HOST IS P
        AND CORE- X-HOST OF COELEMENT- NSTGO OF X-HOST EXISTS;
        EITHER $HOST-IS-OK
        OR AT IMMEDIATE LXR
        DO $WRONG-HOST.
   $NEXT-N = AT PRESENT-ELEMENT- X-PN ITERATE $NEXT-PN
        UNTIL $HOST-IS-OK SUCCEEDS.
   $NEXT-PN = IMMEDIATE PN X-PN OF X-PN EXISTS;
        DO $HOST-OF-PN.
   $GO-TO-SUBJ =
        X-PRE IS OF TYPE VERBAL;
        CORE- X-HOST OF COELEMENT SUBJECT OF X-OBJ [COEL OBJ OF X-PRE]
        IS NOT EMPTY;
        AT X-PRE, DO $HOST-IS-OK.
   $VERB-OF-STRING =
        AT PRESENT-ELEMENT- X-TEMP
        ITERATE $NEXT-STRING-V
        UNTIL AT X-PRE DO $HOST-IS-OK SUCCEEDS.
   $NEXT-STRING-V =
        IMMEDIATE-STRING X-TEMP OF X-TEMP EXISTS;
        ELEMENT VERBAL EXISTS WHERE PRESENT-ELEMENT- IS NOT EMPTY;
        CORE X-HOST EXISTS;
        DO $SET-XHOST.
   $SET-XHOST =
        IF PRESENT-ELEMENT- IS IDENTICAL TO X-CORE
        [* SEM-CORE of VERB is itself *]
        THEN EITHER $HAS-SIG-CLASS
        [IF VERB HAS SIG CLASS OTHER THAN MOD]
        OR $NEXT-STRING-V [GO UP TO NEXT STRING].
   $HAS-SIG-CLASS = X-NEWLIST:= LIST SIG-CLASS;
        X-SIG := INTERSECT OF X-S [MED SUBCLASS LIST OF VERB];
        X-SUBLIST:= LIST MOD-CLASS [MODIFIER SUBCLASSES];
        COMPLEMENT OF X-SIG IS NOT NIL [LIST WITHOUT MODIFIER].
   $MESS1 =
        DO $PRINT-ERROR;
        DO $PRINT-RESTR;
        IF X-HOST EXISTS
        @THEN $PRINT-NODE-INFO;
        IF X-S EXISTS
        @THEN $PRINT-LIST-INFO;
        WRITE ON DIAG ' HOST is not on list: assign to NIL';
        WRITE ON DIAG END OF LINE;
        X-HOST:= NIL [* cannot find HOST *];
        AT X-CORE DO $SET-SEM-CORE.
   $MESS2 =
        DO $PRINT-ERROR;
        DO $PRINT-RESTR;
        WRITE ON DIAG ' cannot find HOST for ';
        AT X-PRE DO $PRINT-NODE-INFO;
        WRITE ON DIAG END OF LINE;
        X-HOST:= NIL [NO HOST FOR MODIFIER];
        IF X-CORE EXISTS
        @THEN $SET-SEM-CORE.
   $PRINT-NODE-INFO =
        VERIFY WRITE ON DIAG ' ';
        VERIFY WRITE ON DIAG NODE NAME;
        VERIFY WRITE ON DIAG ' = ';
        WRITE ON DIAG WORDS SUBSUMED. (GLOBAL)
   $PRINT-LIST-INFO =
        WRITE ON DIAG LIST ELEMENT;
        WRITE ON DIAG '.'. (GLOBAL)
   $PRINT-ERROR =
        WRITE ON DIAG ' *** WARNING';
        WRITE ON DIAG ' CONDITION ***';
        WRITE ON DIAG END OF LINE. (GLOBAL)
   $PRINT-RESTR =
        WRITE ON DIAG 'Transformation in ';
        VERIFY WRITE ON DIAG NODE NAME;
        WRITE ON DIAG ' = ';
        VERIFY WRITE ON DIAG WORDS SUBSUMED;
        WRITE ON DIAG END OF LINE.
— T-SEM-CORE-OF-PSTG
—       FOR PDATE AND PN WITH ADVERBIAL-TYPE:TIME-ADVERBIAL.
T-SEM-CORE-OF-PSTG = IN PN, PDATE, PD:
        AT PRESENT-ELEMENT- X-PRE
        IF $TIME-PHRASE
        THEN ALL OF $SET-TYPE, $HOST-OF-TIME,
   $ASSIGN-HOST [T-SEM-CORE-OF-LXR].
   $TIME-PHRASE =
        EITHER PRESENT-ELEMENT- X-PN IS PDATE OR PD
        OR EITHER PRESENT-ELEMENT- IS PN
        WHERE BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE
        ADVERBIAL-TYPE
        @AND PRESENT-ELEMENT- HAS MEMBER TIME-ADVERBIAL
        OR EITHER BOTH CORE-SELATT OF CORE- OF NSTGO OF X-PN
        HAS MEMBER NTIME1
        AND ELEMENT- P OF X-PN IS H-TMPREP
        OR EITHER X-PN HAS NODE ATTRIBUTE REFPT-ATT
        OR CORE-SELATT OF HOST- OF X-PN HAS MEMBER NTIME1
        OR NTIME2 OR H-TMLOC
        [* Note that we still need to set ADVERBIAL-TYPE *]
        [* on X-PN to have member TIME-ADVERBIAL global *].
   $HOST-OF-TIME =
        EITHER DO $HOST-OF-PDATE
        OR DO $HOST-OF-PN [T-SEM-CORE-OF-LXR].
   $HOST-OF-PDATE =
        IMMEDIATE-NODE- OF X-PN IS SA [OR RV];
        IMMEDIATE-NODE- IS FRAGMENT
        WHERE ELEMENT- PN EXISTS;
        CORE- X-HOST OF ELEMENT- NSTGO EXISTS.
   $SET-TYPE =
        X-TYPE := SYMBOL EVENT-TIME;
        X-CORE:= X-PN.
— T-SEM-CORE-OF-QN
—       FINDS SEM-CORE FOR TIME QN

T-SEM-CORE-OF-QN = IN QN:
        IF BOTH AT PRESENT-ELEMENT- X-PRE ELEMENT N IS NTIME1
        AND X-PRE DOES NOT HAVE NODE ATTRIBUTE SEM-CORE
        THEN IF ALL OF $SET-TYPE, $FIND-HOST
        THEN $ASSIGN-HOST.
   $SET-TYPE = X-TYPE:= SYMBOL EVENT-TIME;
        X-CORE:= X-PRE.
— T-FROM-TO-TIME
—       OPERATES ON PN -PN1- WHEN IT HAS THE NODE ATTRIBUTE TIME-ADVERBIAL
—       AND P IS 'FROM'/'BETWEEN'/'SINCE'/'POST'/'AFTER'.
—       THE FOLLOWING CONSTRUCTION IS SEARCHED FOR:
—       1) A NESTED PN - I.E., A PN2 IN PN1 WHERE
—       P OF PN2 = 'TO'/'TIL'/'UNTIL' AND
—       N OF PN2 IS NTIME1 [OR H-EVENT] OR H-AGE
—       OR IS A TIME NOUN - I.E., H-TMBEG, H-CHANGE, H-TMEND, H-TMDUR,
—       OR H-TMREP
—       OR IS A NOMINAL NOUN - I.E., NVN
—       AND H-TTMED, H-TTGEN, H-TTCOMP
—       E.G., 'FROM ADMISSION TO DISCHARGE'.
—       2) P IS 'BETWEEN' AND THERE IS A CONJUNCTION IN PN, E.G., 'BETWEEN
—       ADMISSION AND DISCHARGE'. THE CONJUNCTION IS EXPANDED UP TO PN
—       SO THERE IS A PN1 AND PN2. THE P OF PN2 IS REPLACED BY 'TO'.
—       3) P IS 'BETWEEN', AND N IS PLURAL AND *H-EVENT
—       OR NVN AND H-TTMED/H-VMO/H-TTCOMP.
— ASSERTION A IS FOUND BY GOING UP FROM PN.
—       PARSE-CONN = TIME-CONN IS ATTACHED TO THE LEFT OF A.
—       HEADCONN = P OF PN1.
— ASSERTION B IS CREATED AND ATTACHED TO THE RIGHT OF A AS FOLLOWS:
—       FOR (1) AND (2) ABOVE, ASSERTION B IS A COPY OF ASSERTION A, BUT
—       IN IT, PN2 REPLACES PN1. IN ASSERTION A, PN2 (AND CONJ-NODE) IS
—       DELETED.
—       FOR (3) ABOVE, 'PLURAL' OF N IN PN IN ASSERTION A IS REMOVED.
—       ASSERTION B IS A COPY OF 'A'. P IN 'B' IS CHANGED TO 'TO'.
—       EX.: IN 'BETWEEN ADMISSION AND DISCHARGE'
—       ASSERTION A CONTAINS 'BETWEEN ADMISSION' AND
—       ASSERTION B CONTAINS 'TO DISCHARGE'.
—       IN 'BETWEEN ADMISSIONS'
—       'A' CONTAINS - 'BETWEEN ADMISSION' AND
—       'B' CONTAINS - 'TO ADMISSION'.
T-FROM-TO-TIME = IN PN:
        IF BOTH ELEMENT- P X-HCONN IS
        [ENGLISH] 'FROM' OR 'BETWEEN' OR 'SINCE' OR
        'POST' OR 'AFTER' OR
        [FRENCH] 'DE' OR ['DEPUIS' OR 'APRE2S' OR] 'ENTRE'
        AND BOTH PRESENT-ELEMENT- X1 HAS NODE ATTRIBUTE
        ADVERBIAL-TYPE
        @AND PRESENT-ELEMENT- HAS MEMBER [IS] TIME-ADVERBIAL
        THEN ONE OF $NESTED-PN, $CONJOINED, $DE-SEULE, $PASS.
   $DE-SEULE =
        X-HCONN IS 'DE'.
   $PASS = TRUE
        [* glcb2: since starting, after treatment, after discharge *].
   $NESTED-PN = DO $FIND-NEXT.
   $CONJOINED = X-HCONN IS 'BETWEEN';
        EITHER AT X1 BOTH $FIND-CONJUNCT AND $EXPAND-CONJ
        OR $PLURAL-NOUN.
   $FIND-CONJUNCT = DESCEND TO Q-CONJ PASSING THROUGH PN OR LN;
        STORE IN X-CONJ;
        ITERATE GO UP UNTIL TEST FOR PN SUCCEEDS.
   $EXPAND-CONJ =
        AT IMMEDIATE-NODE- OF X-CONJ
        ITERATE AT IMMEDIATE-NODE DO EXPAND
        UNTIL TEST FOR PN SUCCEEDS;
        X1 HAS CONJUNCT X2 WHERE FIRST ELEMENT X3 OF
        IMMEDIATE-NODE OF IMMEDIATE Q-CONJ EXISTS;
        DO $MAKE-P-TO.
   $MAKE-P-TO = REPLACE P OF X2 BY <P> = '[A2]' : ('A2') [TO].
   $PLURAL-NOUN =
        BOTH CORE- X-CORE OF ELEMENT- NSTGO OF X1 HAS
        COELEMENT N X3 WHERE N IS 'PLURAL'
        AND $NOMINAL [??? 'BOTH' ADDED. WAS NOT IN WRITTEN RESTRICTION].
   $FIND-NEXT = AT ELEMENT- NSTGO OF X1
        ITERATE NEXT-ADJUNCT PN X2 EXISTS
        UNTIL VERIFY BOTH $CHECK-P2 AND $CHECK-N SUCCEEDS.
   $CHECK-N = EITHER CORE-SELATT X-S OF CORE- X-CORE OF ELEMENT-
        NSTGO HAS MEMBER NTIME1
        OR ONE OF $TIME-NOUN, $NOMINAL, $EVENT-AGE.
   $TIME-NOUN = X-S HAS MEMBER H-TMBEG
        [OR H-CHANGE OR H-TMEND OR H-TMDUR OR H-TMREP].
   $NOMINAL = X-CORE IS NVN;
        X-S HAS MEMBER H-TTMED [ OR H-TTGEN OR H-TTCOMP].
   $EVENT-AGE =
        BOTH X-S HAS MEMBER H-AGE
        [* add PN : QUANT *]
        AND IF BOTH X-S HAS MEMBER H-AGE
        AND RIGHT-ADJUNCT-POS OF X-CORE EXISTS
        WHERE VERIFY $PN-QUANT
        THEN AT X-PN-AGE ASSIGN NODE ATTRIBUTE ADVERBIAL-TYPE
        WITH VALUE X-ADJ-TYPE.
   $PN-QUANT =
        VALUE IS PN X-PN-AGE;
        BOTH ELEMENT- P EXISTS
        AND ELEMENT- P IS 'OF';
        VALUE OF X-PN-AGE IS QUANT;
        X-ADJ-TYPE := NIL;
        X-ADJ := SYMBOL ADJUNCT-TYPE;
        PREFIX X-ADJ TO X-ADJ-TYPE.
   $CHECK-P2 =
        AT X2 ELEMENT- P X3 IS 'A2' OR 'UNTIL' OR 'TO' OR 'TIL'.
   $BUILD-TIME-CONJ =
        DO $FIND-ASSERT [T-REL-CLAUSE];
        BEFORE X-PRE INSERT
        <PARSE-CONN> (<TIME-CONJ> (<SA> (<NULL>)
        +<LCONNR> X-CONN
        +<SA> (<NULL>)));
        DO $BUILD-LCONNR [GLOBAL IN T-CONJ-IN-CENTER];
        DO $BUILD-HEADCONN [GLOBAL IN T-CONJ-IN-CENTER];
        AFTER LAST-ELEMENT OF HEADCONN OF X-CONN
        INSERT <NULL> X-NULL;
        REPLACE X-NULL BY X3 ;
        LAST-ELEMENT- X4 OF HEADCONN OF X-CONN EXISTS;
        DO $ASSIGN-PTRS;
        AFTER X-PRE INSERT <NULL> X-NULL;
        REPLACE X-NULL BY X-PRE ;
        AT X-PRE FOLLOWING-ELEMENT- X-NEW EXISTS;
        IF X4 IS P
        THEN $FIX-PS
        ELSE IF X4 IS N [IT IS PLURAL]
        THEN $FIX-PLURAL
        ELSE $FIX-AND.
   $ASSIGN-PTRS =
        AT X-PRE ASSIGN NODE ATTRIBUTE PT1 WITH VALUE X1;
        IF X2 EXISTS
        THEN AT X-PRE ASSIGN NODE ATTRIBUTE PT2 WITH VALUE X2.
   $FIX-PS = REPLACE X2 BY <NULL>;
        X-NEW HAS NODE ATTRIBUTE PT1 X1;
        X-NEW HAS NODE ATTRIBUTE PT2 X2;
        REPLACE X1 BY X2.
   $FIX-PLURAL = DELETE X3 [REMOVE PLURAL FROM ORIGINAL ASSERTION];
        X-NEW HAS NODE ATTRIBUTE PT1 X2;
        DO $MAKE-P-TO.
   $FIX-AND = DELETE X3 [REMOVE CONJ-NODE FROM ORIGINAL ASSERTION].
— ***** *************************************************************

—       SEQUENCING TRANSFORMATIONS

— ***** *************************************************************
TSEQ-STRING = IN STRING, CENTER:
        EITHER $EXCEPTION [DO NOT TRANSFORM]
        OR BOTH IF DO DOWN1-(VERBAL)
        WHERE PRESENT-ELEMENT- IS NOT EMPTY
        @THEN TRANSFORM PRESENT-ELEMENT-
        [PUT VERB IN TRANSFORM STACK FIRST,]
        [IT WILL BE TRANSFORMED LAST]
        AND $TRANSFORM-ELEMENTS.
   $TRANSFORM-ELEMENTS =
        AT VALUE EITHER ITERATE GO RIGHT OR TRUE;
        IF PRESENT-ELEMENT- IS EMPTY
        THEN IF $LEFT-NOT-MTY
        @THEN ITERATE VERIFY $WHAT-TO-DO
        UNTIL $LEFT-NOT-MTY FAILS
        ELSE TRUE
        ELSE ITERATE VERIFY $WHAT-TO-DO
        UNTIL $LEFT-NOT-MTY FAILS.
   $LEFT-NOT-MTY = ITERATE GO LEFT
        UNTIL BOTH PRESENT-ELEMENT- IS NOT OF TYPE VERBAL
        AND PRESENT-ELEMENT- IS NOT EMPTY SUCCEEDS.
   $WHAT-TO-DO =
        IF ONE OF $VERBAL-TYPE, $ATOM-TYPE, $IS-TEXTLET
        THEN TRUE [DO NOT TRANSFORM]
        ELSE IF $TRANSFORM-TYPE
        @THEN TRANSFORM PRESENT-ELEMENT-.
   $EXCEPTION = ONE OF $IS-EMPTY,$HAS-Q-CONJ, $IS-LN, $HAS-FAIL-SEL
        [T-FIXUP-ATOMS], $HAS-ADJ-TYPE [T-FIXUP-ATOMS].
   $IS-EMPTY = PRESENT-ELEMENT- IS EMPTY.
   $HAS-Q-CONJ = PRESENT-ELEMENT- HAS ELEMENT- Q-CONJ.
   $IS-LN = PRESENT-ELEMENT- IS LN [TRANSFORMED BY TSEQ-ADJUNCT].
   $TRANSFORM-TYPE =
        ONE OF $STRING-TYPE, $LXR-TYPE, $ADJSET-TYPE,
   $CONJ-TYPE, $OBJ-TYPE, $IS-CENTER, $DESCENT-TYPE.
   $IS-TEXTLET =
        PRESENT-ELEMENT- IS TEXTLET X-TXT;
        ITERATE $TRANS-TEXT
        UNTIL VALUE OF COELEMENT MORESENT OF X-TEMP IS TEXTLET
        X-TXT FAILS.
   $TRANS-TEXT =
        AT ONESENT X-TEMP OF X-TXT
        BOTH TRANSFORM ELEMENT CENTER
        AND TRANSFORM ELEMENT INTRODUCER.
   $IS-CENTER = PRESENT-ELEMENT- IS CENTER.
   $VERBAL-TYPE = PRESENT-ELEMENT- IS OF TYPE VERBAL.
   $ATOM-TYPE = PRESENT-ELEMENT- IS OF TYPE ATOM.
   $STRING-TYPE = PRESENT-ELEMENT- IS OF TYPE STRING.
   $ADJSET-TYPE = PRESENT-ELEMENT- IS OF TYPE ADJSET.
   $LXR-TYPE = EITHER PRESENT-ELEMENT- IS OF TYPE LXR
        OR PRESENT-ELEMENT- IS DSTG.
   $CONJ-TYPE = PRESENT-ELEMENT- HAS ELEMENT- Q-CONJ X1;
        IF COELEMENT SACONJ IS NOT EMPTY
        @THEN TRANSFORM VALUE;
        X1 EXISTS.
   $OBJ-TYPE = PRESENT-ELEMENT- IS OBJECT OR OBJBE OR PASSOBJ
        WHERE PRESENT-ELEMENT- IS NOT EMPTY.
   $DESCENT-TYPE = EITHER DESCEND TO LXR
        OR EITHER DESCEND TO STRING NOT PASSING THROUGH LXR
        OR DESCEND TO DSTG NOT PASSING THROUGH LXR;
        IF PRESENT-ELEMENT- IS OF TYPE STRING
        THEN VERIFY NONE OF $HAS-FAIL-SEL, $HAS-ADJ-TYPE
        ELSE VERIFY AT CORE NONE OF $HAS-FAIL-SEL, $HAS-ADJ-TYPE.
— TSEQ-OBJ
TSEQ-OBJ = IN OBJECT, OBJBE, PASSOBJ:
        IF PRESENT-ELEMENT- IS NOT EMPTY
        THEN EITHER PRESENT-ELEMENT- IS OBJBE
        WHERE PRESENT-ELEMENT- IS OCCURRING IN OBJECT
        [TRANSFORMED ALREADY]
        OR IF $DESCENT-TYPE [GLOBLA IN TSEQ-STRING]
        @THEN TRANSFORM PRESENT-ELEMENT-.
— TSEQ-ADJUNCT
TSEQ-ADJUNCT = IN ADJSET:
        IF PRESENT-ELEMENT- IS NOT EMPTY
        THEN AT VALUE
        ITERATE VERIFY IF $NOT-EMPTY
        THEN EITHER $IS-ADJADJ
        OR IF ONE OF $STRING-LXR-TYPE,
   $DESCENT-TYPE,
   $NNN-TYPE
        @THEN TRANSFORM PRESENT-ELEMENT-
        UNTIL GO RIGHT FAILS.
   $STRING-LXR-TYPE = EITHER $STRING-TYPE
        OR $LXR-TYPE;
        VERIFY NONE OF $HAS-FAIL-SEL, $HAS-ADJ-TYPE.
   $IS-ADJADJ = VALUE IS ADJADJ;
        ITERATET VERIFY $TRANSFORM-LAR1
        UNTIL VALUE IS ADJADJ FAILS [TRANSFORM ALL];
        IF VALUE IS NOT EMPTY [ BOTTOMMOST ADJADJ]
        @THEN TRANSFORM PRESENT-ELEMENT-.
   $TRANSFORM-LAR1 = GO RIGHT;
        IF PRESENT-ELEMENT- IS OF TYPE LXR
        THEN TRANSFORM PRESENT-ELEMENT-.
   $NOT-EMPTY = PRESENT-ELEMENT IS NOT EMPTY.
   $NNN-TYPE =
        EITHER BOTH ELEMENT- N EXISTS
        WHERE VERIFY NONE OF $HAS-FAIL-SEL, $HAS-ADJ-TYPE
        AND BOTH TRANSFORM ELEMENT- N
        AND ELEMENT- ADJ EXISTS
        OR DESCEND TO NNN NOT PASSING THROUGH LXR;
        VERIFY NONE OF $HAS-FAIL-SEL, $HAS-ADJ-TYPE.
TSEQ-DSTG-NNN = IN DSTG,NNN:
        IF VALUE IS DSTG OR NNN
        @THEN TRANSFORM PRESENT-ELEMENT-.
TSEQ-LXR = IN LXR:
        BOTH IF CORE IS OF TYPE STRING
        @THEN TRANSFORM PRESENT-ELEMENT-
        AND BOTH IF ELEMENT RADJSET IS NOT EMPTY
        @THEN TRANSFORM PRESENT-ELEMENT-
        AND BOTH IF ELEMENT LADJSET 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.
   $IS-EMPTY = PRESENT-ELEMENT- IS EMPTY.
— T-REL-CLAUSE
—       OPERATES WHEN AN LNR HAS AN ASSERTION B TO ITS RIGHT. THE ASSERTION
— WAS CREATED BY AN ENGLISH TRANSFORMATION WHICH ASSIGNED TO B THE
— NODE ATTRIBUTE TFORM-ATT, POINTING TO A LIST.THE LIST CONTAINS THE
— NAME OF THE TRANSFORMATION CREATING THE ASSERTION - IN THIS CASE
— WHMOD OR NMOD [T-RN-WH OR TRN-FILLIN].
—       ASSERTION A IS FOUND BY GOING UP FROM B.
—       PARSE-CONN = REL-CLAUSE IS ATTACHED TO THE LEFT OF A.
—       B IS MOVED TO THE RIGHT OF A.
—       B IS DELETED FROM A.
—       HEADCONN = GRAM-NODE = '[WHMOD] / [NMOD]' [TRN-WH/TRN-FILLIN].
T-REL-CLAUSE = IN LNR, LAR, LAR1:
        IF FOLLOWING-ELEMENT- OF PRESENT-ELEMENT- X-LNR
        IS ASSERTION OR FRAGMENT X-ASSERT
        THEN $REL-CLAUSE.
   $REL-CLAUSE =
        DO $FIND-ASSERT;
        EITHER ONE OF $IS-NMOD, $IS-RELATION
        [* Add $BUILD-REL-CONN to complete $BUILD-RELCLAUSE *]
        OR ALL OF $BUILD-RELCLAUSE, $BUILD-REL-CONN, $INDEX-REL-CONN.
   $IS-NMOD =
        X-PRE IS FRAGMENT WHERE ELEMENT- NSTG EXISTS;
        DO $IS-LONE-HOST;
        BOTH X-ASSERT HAS NODE ATTRIBUTE TFORM-ATT
        @AND PRESENT-ELEMENT- DOES NOT HAVE MEMBER TRNWH;
        REPLACE X-PRE BY ALL ELEMENTS OF X-NSTG;
        DELETE X-LNR;
        BOTH TRANSFORM X-ASSERT
        AND IF CONJUNCT OF X-ASSERT EXISTS @
        THEN TRANSFORM PRESENT-ELEMENT-.
   $IS-LONE-HOST =
        STORE IN X-NSTG;
        [* Make sure that this is not in a segment *]
        BOTH AT X-PRE EITHER GO LEFT
        OR GO RIGHT [ -- wrong test ! ]
        AND SUBJECT OF X-ASSERT IS NOT EMPTY;
        [* WARNING: This is not a sufficient condition ! *]
        [* For lack of a means to compare subtrees, this *]
        [* condition stays for the time being. *]
        [* The ideal condition is that host LNR and LNR *]
        [* of SUBJECT of X-ASSERT are exact copy of each *]
        [* other. *]
        BOTH AT VALUE OF LN OF LNR X-LNR OF X-NSTG,
        ITERATE PRESENT-ELEMENT IS EMPTY
        UNTIL GO RIGHT FAILS
        AND ELEMENT- RN OF X-LNR IS EMPTY.
   $IS-RELATION = EITHER $PN-RELATION OR $FIX-RELATION [- FIX XF??].
   $FIX-RELATION = X-ASSERT IS ASSERTION;
        CORE OF OBJECT IS PN X-PN;
        DO $PN-CONN-TEST;
        DO $BUILD-PCONN;
        DELETE X-ASSERT;
        DO $CHECK-FOR-NULL.
   $PN-RELATION = X-ASSERT IS FRAGMENT WHERE CORE IS PN X-PN;
        DO $PN-CONN-TEST;
        DO $BUILD-PCONN [GLOBAL IN T-SA-PNCONN];
        DELETE X-ASSERT;
        DO $CHECK-FOR-NULL.
   $CHECK-FOR-NULL = [TEMP - UNTIL XF IS FIXED ?]
        AT X-LNR ITERATE IF FOLLOWING-ELEMENT- IS NULL
        @THEN DELETE PRESENT-ELEMENT-
        UNTIL GO RIGHT FAILS.
   $FIND-ASSERT =
        ASCEND TO ASSERTION OR FRAGMENT PASSING THROUGH TYPE STRING;
        STORE IN X-PRE.
   $BUILD-RELCLAUSE =
        BEFORE X-PRE INSERT
        <PARSE-CONN> (<REL-CLAUSE> (<SA> (<NULL>)
        +<LCONNR> X-CONN
        +<SA> (<NULL>)));
        DO $BUILD-LCONNR [GLOBAL IN T-CONJ-IN-CENTER]. (GLOBAL)
   $INDEX-REL-CONN =
        BOTH EITHER CORE- X-CORE OF X-LNR HAS NODE ATTRIBUTE INDEX X-NDX
        OR X-CORE IS QN WHERE
        ELEMENT- N HAS NODE ATTRIBUTE INDEX X-NDX
        AND AT CORE- OF X-CONN ASSIGN NODE ATTRIBUTE INDEX
        WITH VALUE X-NDX.
   $BUILD-REL-CONN =
        IF X-ASSERT HAS NODE ATTRIBUTE TFORM-ATT
        WHERE PRESENT-ELEMENT- HAS MEMBER TRNWH
        THEN AT X-CONN REPLACE HEADCONN
        BY <HEADCONN> ( <GRAM-NODE> X-HDCONN = 'WH' ) [WHMOD]
        ELSE AT X-CONN REPLACE HEADCONN
        BY <HEADCONN> ( <GRAM-NODE> X-HDCONN = '[NMOD]');
        EITHER DO $REPLACE-WHMOD OR TRUE;
        AFTER X-PRE INSERT ALL ELEMENTS OF IMMEDIATE-NODE OF X-ASSERT;
        AT X-LNR ITERATET DELETE PRESENT-ELEMENT- UNTIL GO RIGHT FAILS;
        AT X-PRE DELETE FOLLOWING-ELEMENT-;
        AT X-PRE DO $TRANSFORM-TO-RIGHT [GLOBAL IN T-MOVE-S-UP].
   $REPLACE-WHMOD =
        VALUE X-WH OF X-ASSERT EXISTS;
        IF X-WH IS WH-PHRASE OR WHEN-PHRASE OR TM-PHRASE
        THEN AT VALUE, STORE IN X-WH;
        [X-WH IS 'WHERE' OR 'WHEN']
        [ OR 'WHICH' OR 'WHILE' OR 'WHOM' OR 'WHOSE' OR 'WHO']
        [ OR 'OU2' OR 'DONT' OR 'QUI' OR 'QUE';]
        DO $STORE-WORDPOS;
        ONE OF $WHERE, $WHEN, $WHICH, $WHILE, $WHO, $WHOM, $WHOSE,
   $OU2, $DONT, $QUI, $QUE, $OTHERS;
        DO $RESTORE-WORDPOS;
        DELETE X-WH.
   $STORE-WORDPOS =
        X-WH HAS NODE ATTRIBUTE WORD-POS X-WDPOS.
   $RESTORE-WORDPOS =
        AT X-WHN ASSIGN NODE ATTRIBUTE WORD-POS WITH VALUE X-WDPOS.
   $WHERE =
        BOTH X-WH IS 'WHERE'
        AND REPLACE X-HDCONN BY <N> X-WHN = 'WHERE'.
   $WHEN =
        BOTH X-WH IS 'WHEN'
        AND REPLACE X-HDCONN BY <N> X-WHN = 'WHEN'.
   $WHICH =
        BOTH X-WH IS 'WHICH'
        AND REPLACE X-HDCONN BY <N> X-WHN = 'WHICH'.
   $WHILE =
        BOTH X-WH IS 'WHILE'
        AND REPLACE X-HDCONN BY <N> X-WHN = 'WHILE'.
   $WHO =
        BOTH X-WH IS 'WHO'
        AND REPLACE X-HDCONN BY <N> X-WHN = 'WHO'.
   $WHOM =
        BOTH X-WH IS 'WHOM'
        AND REPLACE X-HDCONN BY <N> X-WHN = 'WHOM'.
   $WHOSE =
        BOTH X-WH IS 'WHOSE'
        AND REPLACE X-HDCONN BY <N> X-WHN = 'WHOSE'.
   $OU2 =
        BOTH X-WH IS 'OU2'
        AND REPLACE X-HDCONN BY <N> X-WHN = 'OU2'.
   $DONT =
        BOTH X-WH IS 'DONT'
        AND REPLACE X-HDCONN BY <N> X-WHN = 'DONT'.
   $QUI =
        BOTH X-WH IS 'QUI'
        AND REPLACE X-HDCONN BY <N> X-WHN = 'QUI'.
   $QUE =
        BOTH X-WH IS 'QUE'
        AND REPLACE X-HDCONN BY <N> X-WHN = 'QUE'.
   $OTHERS = TRUE
        [* cannot access the subsumed word *]
        [REPLACE X-HDCONN BY X-WH, X-NEWWH].
— T-CHECK-FRMT-TYPE
—       TRIMS FORMAT-ATT LIST DOWN TO ONE SINGLE FORMAT FOR
—       EACH KERNEL SENTENCE. IF THIS FAILS, ISSUE A WARNING.
— *** JUNE 12, 1997
—       THIS BEGINS TO ASSUME SOME OF THE WELL-FORMEDNESS CONDITIONS
T-CHECK-FRMT-TYPE = IN ASSERTION, FRAGMENT:
        IF PRESENT-ELEMENT- X-ASSERT HAS NODE ATTRIBUTE FORMAT-ATT
        X-TYPE-LIST
        THEN EITHER $FRMT5-ALG
        OR ALL OF $GET-ASSNSELS, $ADJUST-TYPE-LIST, $CHK-TYPE-LIST
        ELSE $CHK-NOFRMT.
   $GET-ASSNSELS =
        EITHER X-ASSERT HAS NODE ATTRIBUTE ASSN-SELATTS X-ASSNSELS
        OR X-ASSNSELS := NIL.
   $ADJUST-TYPE-LIST =
        IF BOTH X-TYPE-LIST HAS MEMBER FRMT5-PTFAM
        AND BOTH X-TYPE-LIST HAS MEMBER FRMT1-3
        AND X-TYPE-LIST HAS MEMBER FRMT4
        THEN BOTH X-FMTLIST := SYMBOL FRMT345
        AND BOTH X-TYPE-LIST := NIL
        AND PREFIX X-FMTLIST TO X-TYPE-LIST.
   $FRMT5-ALG =
        BOTH ONE OF $GET-SECTION-ALLERGIES, $GET-INTRO-ALLERGIES
        AND BOTH X-TYPE-LIST := LIST FRMT5-ALG-LIST
        AND DO $ASSIGN-FRMT.
   $GET-SECTION-ALLERGIES =
        IMMEDIATE-NODE OF X-ASSERT IS CENTER;
        DO L(SECTION);
        AT VALUE OF SECT-NAME,
        ITERATET GO RIGHT
        UNTIL PRESENT-ELEMENT- IS 'ALLERGIES' OR 'SENSITIVITIES'
        SUCCEEDS.
   $GET-INTRO-ALLERGIES =
        IMMEDIATE-NODE OF X-ASSERT IS CENTER;
        DO L(INTRODUCER);
        VALUE IS LNR
        WHERE CORE- IS 'ALLERGIES' OR 'SENSITIVITIES'.
   $CHK-TYPE-LIST =
        IF SUCCESSORS OF X-TYPE-LIST IS NOT NIL
        [* There is more than one format type, *]
        [* resolve ambiguity in format if possible.*]
        THEN $CHK-MORE
        ELSE IF BOTH X-TYPE-LIST HAS MEMBER FRMT3-5 OR FRMT345
        AND X-TYPE-LIST HAS MEMBER FRMT13-MED
        THEN DO $CHOSE-FRMT3-MED
        ELSE IF BOTH X-TYPE-LIST HAS MEMBER FRMT3-5 OR FRMT345
        AND X-ASSNSELS HAS MEMBER H-TTSURG
        THEN DO $CHOSE-FRMT3
        ELSE IF X-TYPE-LIST HAS MEMBER FRMT3-5
        THEN DO $CHOSE-FRMT5
        ELSE IF X-TYPE-LIST HAS MEMBER FRMT345 OR FRMT-UNIT
        THEN $CHK-NOFRMT.
   $CHK-MORE= IF NOT $OK-CONDITION THEN $PRINT-MESSG
        ELSE $ASSIGN-FRMT.
   $OK-CONDITION =
        ONE OF $REMOVE-FRMT0, [$REMOVE-FRMT2,] $REMOVE-FRMT6,
        [$REMOVE-FRMT1,] $CHK-FRMT5-EKG, $CHK-FRMT345,
   $INDIC-HISTORY, $CHK-FRMT3-5, $CHK-FRMT3-4,
   $REMOVE-FRMT-UNIT, $PE-CHK;
        DO $CHK-TYPE-LIST [* subsequent rounds of elimination *].
   $CHK-FRMT3-4 =
        BOTH X-TYPE-LIST HAS MEMBER FRMT1-3 OR FRMT13-MED
        AND X-TYPE-LIST HAS MEMBER FRMT4;
        [* if VERB is a VBE/BEREP or SHOW or change, *]
        [* use SUBJECT as the main cue (topical) to *]
        [* disambiguate the format. *]
        EITHER
        BOTH CORE-ATT X-VERB OF CORE- OF ELEMENT- VERB OF X-ASSERT HAS
        MEMBER VBE OR H-BECONN [* new 991027 *]
        OR BEREP OR H-SHOW OR H-CHANGE
        OR H-CHANGE-MORE OR H-CHANGE-LESS OR H-CHANGE-SAME
        AND CORE-ATT X-SUBJ OF CORE- X-SUBJ-CORE OF ELEMENT- SUBJECT
        OF X-ASSERT IS NOT NIL
        OR X-ASSERT IS FRAGMENT
        WHERE CORE-ATT X-SUBJ OF CORE- X-SUBJ-CORE OF
        ELEMENT- NSTG IS NOT NIL;
        IF BOTH X-SUBJ-CORE HAS NODE ATTRIBUTE COMPUTED-ATT
        AND X-SUBJ HAS MEMBER H-RESULT
        THEN CORE-SELATT X-SUBJ OF X-SUBJ-CORE IS NOT NIL;
        IF X-SUBJ HAS MEMBER H-TXVAR OR H-TXSPEC OR H-ORG
        OR H-PTSPEC OR H-TXRES
        [AND BOTH DO $FIND-SECTION]
        [ AND X-SECTION IS 'LAB' OR 'LABORATORY-DATA']
        [ OR 'HOSPITAL-COURSE']
        THEN DO $CHOSE-FRMT4
        ELSE IF X-SUBJ HAS MEMBER H-TTGEN OR H-TTCOMP OR H-TTSURG
        OR H-TTMED OR H-TTMODE
        THEN DO $CHOSE-FRMT3
        ELSE BOTH X-SUBJ DOES NOT HAVE MEMBER H-NULL OR H-PT OR
        H-FAMILY
        AND DO $CHOSE-FRMT5.
   $INDIC-HISTORY =
        X-TYPE-LIST HAS MEMBER FRMT345;
        [* if SUBJECT is a TXCLIN or TXPROC, *]
        [* VERB is comparable to VSHOW *]
        [* predicate is H-TTSURG or H-INDIC *]
        [* it is a structure of illness H-TXRES *]
        ALL OF $IMPLIED-HISTORY, $CHOSE-FRMT5, $ADD-TXRES.
   $IMPLIED-HISTORY =
        CORE-ATT X-SUBJ OF CORE- OF ELEMENT- SUBJECT OF X-ASSERT
        HAS MEMBER H-TXCLIN OR H-TXPROC;
        EITHER BOTH CORE-ATT X-VERB OF CORE- OF ELEMENT- VERB
        OF X-ASSERT HAS MEMBER H-SHOW
        AND CORE-ATT X-OBJ OF CORE- X-OBJCORE OF NSTGO OF
        ELEMENT- OBJECT OF X-ASSERT IS NOT NIL
        OR BOTH X-VERB HAS MEMBER VBE OR BEREP
        AND VALUE OF OBJBE OF OBJECTBE OF ELEMENT- OBJECT
        OF X-ASSERT IS PN
        WHERE CORE-ATT X-OBJ OF CORE- X-OBJCORE OF ELEMENT-
        NSTGO IS NOT NIL;
        X-OBJ HAS MEMBER H-TTSURG OR H-INDIC [OR H-DIAG].
   $ADD-TXRES = [* an H-TTSURG implies a past illness *]
        IF X-OBJ HAS MEMBER H-TTSURG
        THEN $INSERT-TXRES.
   $INSERT-TXRES =
        X-ADD := SYMBOL H-TXRES;
        PREFIX X-ADD TO X-OBJ;
        IF X-OBJCORE HAS NODE ATTRIBUTE COMPUTED-ATT
        THEN AT X-OBJCORE ASSIGN NODE ATTRIBUTE COMPUTED-ATT
        WITH VALUE X-OBJ
        ELSE AT X-OBJCORE ASSIGN NODE ATTRIBUTE SELECT-ATT
        WITH VALUE X-OBJ.
   $CHK-FRMT3-5 =
        [* Resolve ambiguity between FORMAT5 and FORMAT1-3 *]
        [* if fails, choose FORMAT5. *]
        X-TYPE-LIST HAS MEMBER FRMT3-5;
        EITHER BOTH X-TYPE-LIST HAS MEMBER FRMT5 OR FRMT5-PTFAM OR FRMT5F
        OR FRMT5-ALG
        AND X-TYPE-LIST DOES NOT HAVE MEMBER FRMT1-3 OR FRMT13-MED
        OR EITHER BOTH X-TYPE-LIST HAS MEMBER FRMT1-3 OR FRMT13-MED
        AND X-TYPE-LIST DOES NOT HAVE MEMBER FRMT5
        OR FRMT5-PTFAM OR FRMT5F OR FRMT5-ALG
        OR BOTH BOTH X-TYPE-LIST DOES NOT HAVE MEMBER FRMT5
        OR FRMT5-PTFAM OR FRMT5F OR FRMT5-ALG
        AND X-TYPE-LIST DOES NOT HAVE MEMBER FRMT1-3
        OR FRMT13-MED
        AND $CHOSE-FRMT5;
        DO $REMOVE-FRMT3-5.
   $REMOVE-FRMT3-5 =
        X-SUBLIST:= LIST FRMT3-5-LIST;
        COMPLEMENT X-TYPE-LIST OF X-TYPE-LIST EXISTS.
   $PE-CHK =
        X-TYPE-LIST HAS MEMBER FRMT5 OR FRMT5-PTFAM OR FRMT5F
        OR FRMT5-ALG;
        EITHER BOTH DO $FIND-INTRO
        AND X-INTRO IS 'PE' ['PE-10CC OF FLUID' IS FRMT5]
        OR BOTH DO $FIND-SECTION
        AND X-SECTION IS 'PHYSICAL-EXAM' OR 'PHYSICAL-EXAMINATION';
        DO $CHOSE-FRMT5.
   $REMOVE-FRMT0 =
        X-TYPE-LIST HAS MEMBER FRMT0;
        X-SUBLIST:= LIST FRMT0-LIST;
        COMPLEMENT X-TYPE-LIST OF X-TYPE-LIST EXISTS.
   $REMOVE-FRMT1 =
        X-TYPE-LIST HAS MEMBER FRMT1;
        X-TYPE-LIST HAS MEMBER FRMT1-3 OR FRMT13-MED OR FRMT4 OR
        FRMT5 OR FRMT5F OR FRMT5-ALG OR FRMT5-PTFAM;
        X-SUBLIST := LIST FRMT1-LIST;
        DO $REMOVE-IT.
   $REMOVE-IT = COMPLEMENT X-TYPE-LIST OF X-TYPE-LIST EXISTS.
   $REMOVE-FRMT2 =
        X-TYPE-LIST HAS MEMBER FRMT2;
        X-TYPE-LIST HAS MEMBER [FRMT3] FRMT1-3;
        X-SUBLIST:= LIST FRMT2-LIST;
        COMPLEMENT X-TYPE-LIST OF X-TYPE-LIST EXISTS.
   $REMOVE-FRMT6 = X-TYPE-LIST HAS MEMBER FRMT6;
        X-SUBLIST:= LIST FRMT6-LIST;
        COMPLEMENT X-TYPE-LIST OF X-TYPE-LIST EXISTS.
   $REMOVE-FRMT-UNIT =
        X-TYPE-LIST HAS MEMBER FRMT-UNIT;
        X-TYPE-LIST HAS MEMBER FRMT1-3 OR FRMT13-MED OR FRMT4 OR
        FRMT5-PTFAM OR FRMT5 OR FRMT5-ALG OR
        FRMT5F OR FRMT6;
        X-SUBLIST:= LIST FRMT-UNIT-LIST;
        COMPLEMENT X-TYPE-LIST OF X-TYPE-LIST EXISTS.
   $CHK-FRMT5-EKG =
        X-TYPE-LIST HAS MEMBER FRMT5-EKG;
        DO $CHOSE-FRMT5-EKG.
   $CHK-FRMT345 = [* this removes FRMT345 *]
        X-TYPE-LIST HAS MEMBER FRMT345;
        ONE OF $IS-A-FRMT4, $IS-A-FRMT35, $IS-A-FRMT5S,
   $IS-A-FRMT45, $IS-A-FRMT13;
        DO $REMOVE-FRMT345.
   $IS-A-FRMT4 = [* case FRMT4 and FRMT345 *]
        BOTH X-TYPE-LIST HAS MEMBER FRMT4
        AND X-TYPE-LIST DOES NOT HAVE MEMBER FRMT5 OR FRMT5F OR FRMT5-PTFAM
        OR FRMT5-ALG OR FRMT5-EKG OR FRMT5-MISC
        OR FRMT1-3 OR FRMT13-MED OR FRMT3-5.
   $IS-A-FRMT35 = [* case FRMT3-5 and FRMT345 *]
        BOTH X-TYPE-LIST HAS MEMBER FRMT3-5
        AND BOTH X-TYPE-LIST DOES NOT HAVE MEMBER FRMT4
        AND DO $CHK-FRMT3-5.
   $IS-A-FRMT5S = [* case FRMT5's and FRMT345 *]
        BOTH X-TYPE-LIST HAS MEMBER FRMT5 OR FRMT5F OR FRMT5-EKG
        OR FRMT5-PTFAM OR FRMT5-ALG
        OR FRMT5-MISC
        AND X-TYPE-LIST DOES NOT HAVE MEMBER FRMT1-3 OR FRMT4
        OR FRMT45 OR FRMT3-5.
   $IS-A-FRMT45 =
        BOTH X-TYPE-LIST HAS MEMBER FRMT5 OR FRMT5F
        OR FRMT5-PTFAM OR FRMT5-ALG
        AND X-TYPE-LIST HAS MEMBER FRMT4.
   $IS-A-FRMT13 =
        BOTH X-TYPE-LIST HAS MEMBER FRMT1-3 OR FRMT13-MED
        AND X-TYPE-LIST DOES NOT HAVE MEMBER FRMT5 OR FRMT5F
        OR FRMT5-PTFAM OR FRMT5-ALG OR FRMT5-EKG OR FRMT5-MISC
        OR FRMT4 OR FRMT45 OR FRMT3-5.
   $REMOVE-FRMT345 =
        X-SUBLIST:= LIST FRMT345-LIST;
        COMPLEMENT X-TYPE-LIST OF X-TYPE-LIST EXISTS.
   $ASSIGN-FRMT =
        AT X-ASSERT ASSIGN NODE ATTRIBUTE FORMAT-ATT
        WITH VALUE X-TYPE-LIST.
   $ASSIGN-NOFRMT = X-TYPE-LIST:= LIST NOFRMT-LIST;
        DO $ASSIGN-FRMT.
   $PRINT-MESSG =
        WRITE ON DIAG ' *** ERROR ';
        WRITE ON DIAG 'CONDITION:';
        WRITE ON DIAG ' More than 1 ';
        WRITE ON DIAG 'FORMAT type.';
        WRITE ON DIAG END OF LINE;
        AT X-TYPE-LIST WRITE ON DIAG LIST ELEMENT.
   $CHK-NOFRMT =
        ONE OF [$IS-H-CHANGE,] $CHK-INTRO, $CHOSE-FRMT5, $ASSIGN-NOFRMT.
   $CHK-INTRO =
        ONE OF $CHOSE-4-5, $CHOSE-UNIT, $CHOSE-MED, $CHOSE-PT.
   $CHOSE-PT =
        EITHER X-INTRO EXISTS OR $FIND-INTRO;
        BOTH X-INTRO IS H-PTPART OR H-PTFUNC
        AND DO $CHOSE-FRMT5.
   $CHOSE-MED =
        EITHER BOTH EITHER X-INTRO EXISTS OR $FIND-INTRO
        AND X-INTRO IS 'ME'
        OR BOTH EITHER X-SECTION EXISTS OR $FIND-SECTION
        AND X-SECTION IS 'MEDICATIONS';
        DO $CHOSE-FRMT3-MED.
   $CHOSE-4-5 =
        X-TYPE-LIST HAS MEMBER FRMT345;
        [BOTH DO $FIND-INTRO AND] DO $FIND-SECTION;
        IF [EITHER X-INTRO IS 'PE'--PHYSICAL-EXAM-- OR 'AS' --ASSESSMENT--
        OR 'IP'--IMPRESSION-- OR 'OB' --OBJECTIVE--,]

        [OR] X-SECTION IS 'PHYSICAL-EXAM' OR 'PHYSICAL-EXAMINATION'
        THEN DO $CHOSE-FRMT5
        ELSE IF DO $HAS-TTSURG
        THEN DO $CHOSE-FRMT3
        ELSE IF [EITHER X-INTRO IS 'HI'--HISTORY-- OR 'PL'--PLAN--,]
        [OR] X-SECTION IS 'LAB' OR 'LABORATORY-DATA'
        OR 'HOSPITAL-COURSE'
        THEN DO $CHOSE-FRMT4.
   $HAS-TTSURG =
        X-ASSNSELS HAS MEMBER H-TTSURG.
   $CHOSE-FRMT3 = X-TYPE-LIST:= LIST [FRMT3-LIST] FRMT1-3-LIST;
        DO $ASSIGN-FRMT
        [* Strange condition for FORMAT13-MED *]
        [IF ONE OF $OBJECT-EMPTY, $SUBJECT-EMPTY, $NSTG-CORE-EMPTY]
        [THEN $CHANGE-TO-MED].
   $CHOSE-FRMT5-EKG = X-TYPE-LIST:= LIST FRMT5-EKG-LIST;
        DO $ASSIGN-FRMT.
   $CHOSE-FRMT3-MED = X-TYPE-LIST:= LIST FRMT13-MED-LIST;
        DO $ASSIGN-FRMT.
   $OBJECT-EMPTY =
        EITHER VALUE XX-NSTG OF OBJECT IS NULLOBJ
        WHERE DO $BUILD-COND [BUILD NSTG]
        OR CORE OF OBJECT IS EMPTY WHERE IMMEDIATE LNR XX-LNR EXISTS.
   $SUBJECT-EMPTY = EITHER VALUE XX-NSTG OF SUBJECT IS NSTG
        WHERE CORE OF LNR XX-LNR IS EMPTY
        OR SUBJECT IS EMPTY WHERE DO $BUILD-SUBJ.
   $NSTG-CORE-EMPTY = CORE OF LNR XX-LNR OF NSTG IS EMPTY.
   $CHANGE-TO-MED = AT CORE OF XX-LNR [* ??? *]
        REPLACE PRESENT-ELEMENT- BY <GRAM-NODE> = '[MEDICATION]': (H-TTMED).
   $CHOSE-FRMT4 = X-TYPE-LIST := LIST FRMT4-LIST;
        DO $ASSIGN-FRMT.
   $CHOSE-FRMT5 =
        IF CORE-ATT X-SUBJ-ATT OF CORE- OF ELEMENT- SUBJECT OF X-ASSERT
        HAS MEMBER H-FAMILY
        THEN X-TYPE-LIST := LIST FRMT5F-LIST
        ELSE IF $FRMT5-ALG
        THEN X-TYPE-LIST := LIST FRMT5-ALG-LIST
        ELSE X-TYPE-LIST := LIST FRMT5-LIST;
        DO $ASSIGN-FRMT.
   $CHOSE-UNIT = X-TYPE-LIST HAS MEMBER FRMT-UNIT;
        IF BOTH $FIND-INTRO AND $FIND-SECTION
        THEN IF [EITHER X-INTRO IS 'ME' OR 'PL']
        [OR] X-SECTION IS 'MEDICATIONS'
        THEN $CHOSE-FRMT3-MED.
   $FIND-INTRO = IMMEDIATE-NODE OF X-ASSERT IS CENTER;
        DO L(INTRODUCER);
        ITERATET $NEXT-INTRO
        UNTIL PRESENT-ELEMENT- IS NOT EMPTY SUCCEEDS;
        CORE- X-INTRO OF VALUE EXISTS.
   $NEXT-INTRO = ASCEND TO MORESENT PASSING THROUGH STRING;
        DO L(ONESENT);
        ELEMENT- INTRODUCER EXISTS.
   $FIND-SECTION = IMMEDIATE-NODE OF X-ASSERT IS CENTER;
        DO L(SECTION);
        ITERATET $NEXT-SECTION
        UNTIL PRESENT-ELEMENT- IS NOT EMPTY SUCCEEDS;
        SECOND ELEMENT [CORE-] X-SECTION [OF VALUE] EXISTS.
   $NEXT-SECTION = ASCEND TO MORESENT PASSING THROUGH STRING;
        DO L(ONESENT);
        ELEMENT- SECTION EXISTS.
   $IS-H-CHANGE =
        ONE OF $CHANGE-VERB, $CHANGE-FRAG, $CHANGE-OBJ, $CHANGE-DOSE.
   $CHANGE-DOSE = NOT TRUE [* to be added *].
   $CHANGE-VERB =
        BOTH CORE-SELATT X-SEL OF CORE OF VERB X-VERB HAS MEMBER
        H-CHANGE OR H-CHANGE-MORE OR H-CHANGE-LESS OR
        H-CHANGE-SAME WHERE DO $NO-DOSE
        AND AT X-VERB IF DO L(SUBJECT)
        WHERE PRESENT-ELEMENT- X-SUBJ EXISTS
        THEN $ADD-COND-IN-SUBJ.
   $ADD-COND-IN-SUBJ = IF CORE X-C OF X-SUBJ IS EMPTY
        THEN AT X-SUBJ DO $CHANGE-TO-COND
        ELSE BOTH CORE-SELATT OF X-C HAS MEMBER H-PTPART
        OR H-PTAREA OR H-PT
        AND AT X-SUBJ DO $ADD-COND.
   $NO-DOSE = X-SEL DOES NOT HAVE MEMBER H-AMT.
   $CHANGE-TO-COND =
        IF SUBJECT IS EMPTY
        THEN $BUILD-SUBJ
        ELSE IF CORE X-CORE OF SUBJECT IS EMPTY
        THEN $BUILD-CORE.
   $BUILD-SUBJ = AT SUBJECT REPLACE PRESENT-ELEMENT- BY
        <SUBJECT> (<NSTG> XX-NSTG);
        DO $BUILD-COND.
   $BUILD-COND = AT XX-NSTG REPLACE PRESENT-ELEMENT- BY
        <NSTG> (<LNR>XX-LNR (<LN>X-LN
        +<NVAR> (<NULL>X-CORE)
        +<RN> (<NULL>)));
        DO $BUILD-LN;
        DO $BUILD-CORE.
   $ADD-COND =
        LNR XX-LNR OF NSTG OF X-SUBJ EXISTS;
        AT XX-LNR REPLACE PRESENT-ELEMENT- BY
        <LNR> (<LN> X-LN
        +<NVAR> (<NULL> X-CORE)
        +<RN> (<PN> (<P> = '[OF]' [DE]
        +<NSTGO> (<NSTG> (XX-LNR)))));
        DO $BUILD-LN;
        DO $BUILD-CORE.
   $BUILD-LN = AT X-LN REPLACE PRESENT-ELEMENT- BY
        <LN> (<TPOS> (<NULL>)
        +<QPOS> (<NULL>)
        +<APOS> (<NULL>)).
   $BUILD-CORE =
        AT X-CORE REPLACE PRESENT-ELEMENT- BY
        <N> = '[CONDITION]': (H-INDIC);
        TRANSFORM X-ASSERT.
   $CHANGE-FRAG = X-ASSERT IS FRAGMENT;
        CORE-SELATT OF CORE XX-CORE OF NSTG HAS MEMBER H-CHANGE
        OR H-CHANGE-MORE OR H-CHANGE-LESS OR H-CHANGE-SAME;
        DO $CHANGE-COND.
   $CHANGE-COND =
        IF XX-CORE IS OCCURRING IN LNR
        THEN $ADD-OF-COND
        ELSE BOTH SUBJECT X-SUBJ OF X-ASSERT EXISTS
        AND $ADD-COND-IN-SUBJ.
   $ADD-OF-COND =
        RIGHT-ADJUNCT-POS XX-RN OF XX-CORE EXISTS;
        REPLACE XX-RN BY
        <RN> (<PN> (<P> = '[DE]' [OF]
        +<NSTGO> (<NSTG> (<LNR> (<LN>X-LN
        +<NVAR> (<NULL>X-CORE)
        +XX-RN)))));
        DO $BUILD-LN;
        DO $BUILD-CORE.
   $CHANGE-OBJ = X-ASSERT IS ASSERTION;
        EITHER CORE-SELATT OF CORE XX-CORE OF OBJECT HAS MEMBER
        H-CHANGE OR H-CHANGE-MORE OR H-CHANGE-LESS OR
        H-CHANGE-SAME
        OR $CORE-IS-STRING;
        DO $CHANGE-COND.
   $CORE-IS-STRING = XX-CORE IS NPN OR NN OR PNN OR PN;
        NSTGO OF XX-CORE EXISTS;
        CORE-SELATT OF CORE XX-CORE HAS MEMBER H-CHANGE
        OR H-CHANGE-MORE OR H-CHANGE-LESS OR H-CHANGE-SAME.
— T-SUBJECT-CHK
—       OPERATES WHEN SUBJECT IS H-FAMILY AND NOT H-PT AND FORMAT-ATT IS
—       NOT FRMT00. T-SUBJECT-CHK ASSIGNS ASSERTION/FRAGMENT FORMAT-ATT
—       WITH THE VALUE FRMT0 WHICH IS USED FOR PATIENT DESCRIPTOR.
— -- OBSOLETE WITH FORMAT5F (FOR FAMILY MEMBER)
T-SUBJECT-CHK = IN ASSERTION, FRAGMENT:
        IF EITHER AT PRESENT-ELEMENT- X-ASSERT, SUBJECT EXISTS
        OR ELEMENT NSTG EXISTS
        @THEN AT CORE X1, DO $FAM-CHK.
   $FAM-CHK =
        EITHER $IS-FRMT00
        OR IF CORE-SELATT X-S OF X1 HAS MEMBER H-FAMILY
        THEN EITHER X-S HAS MEMBER H-PT
        OR EITHER [BOTH X1 IS PRO]
        [AND $REMOVE-FAMILY]
        AT X-ASSERT DO $CONFIRM-FRMT5F
        OR AT X-ASSERT DO $ASSIGN-FRMT0 [T-LXR-FORMAT-TYPE].
   $REMOVE-FAMILY =
        [* takes H-FAMILY out of a PRO -- temporary *]
        X-SUBLIST := LIST PT-FAM;
        COMPLEMENT X-S OF X-S IS NOT NIL.
   $CONFIRM-FRMT5F =
        EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-ATT
        WHERE PRESENT-ELEMENT- HAS MEMBER FRMT5F
        OR BOTH X-TYPE-LIST := LIST FRMT5F-LIST
        AND AT X-ASSERT ASSIGN NODE ATTRIBUTE FORMAT-ATT WITH
        VALUE X-TYPE-LIST.
   $IS-FRMT00 =
        BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-ATT
        @AND PRESENT-ELEMENT- HAS MEMBER FRMT00.
— T-REMOVE-INTRO
—       REMOVES INTRODUCER
— *** THIS RULE GOES WITH T-DISTRIBUTE-INTRO.
T-REMOVE-INTRO = IN CENTER:
        IF BOTH PREVIOUS-ELEMENT- IS INTRODUCER X-INTRO
        AND CORE- OF X-INTRO IS ':'
        THEN REPLACE X-INTRO BY <INTRODUCER> (<NULL>).
— T-PNCH-TREE - WRITES OUT RESULTANT TREE
— END-REGS