MLP Information Format Grammar Source
 
<CORE-NODE> ::= NULL.
<LXR-PHRASE> ::= NULL.
<ASOBJBE> ::= NULL.
<ADJN> ::= NULL.
<ANDORSTG> ::= NULL.
<ASTGP> ::= NULL.
<ASWELLASSTG> ::= NULL.
<MED-DEVICE> ::= NULL.
<DP1PN> ::= NULL.
<DP1P> ::= NULL.
<DP2PN> ::= NULL.
<DP3PN> ::= NULL.
<DP4PN> ::= NULL.
<DSTG> ::= NULL.
<DPSN> ::= NULL.
<FORTOVO> ::= NULL.
<NASOBJBE> ::= NULL.
<ND> ::= NULL.
<NINRN> ::= NULL.
<NN> ::= NULL.
<NGEV> ::= NULL.
<NPVINGO> ::= NULL.
<NPVINGSTG> ::= NULL.
<NSTGP> ::= NULL.
<NSVINGO> ::= NULL.
<NTOBE> ::= NULL.
<NTOVO> ::= NULL.
<NPSNWH> ::= NULL.
<NTHATS> ::= NULL.
<PSNWH> ::= NULL.
<PSVINGO> ::= NULL.
<SECTION> ::= NULL.
<SECT-NAME> ::= NULL.
<SOBJBE> ::= NULL.
<C1SHOULD> ::= NULL.
<NPSVINGO> ::= NULL.
<NSNWH> ::= NULL.
<PNHOWS> ::= NULL.
<PNSNWH> ::= NULL.
<PNTHATSVO> ::= NULL.
<PNVINGSTG> ::= NULL.
<PSTG> ::= NULL.
<TOBE> ::= NULL.
<VINGSTGPN> ::= NULL.
<PNN> ::= NULL.
<PNTHATS> ::= NULL.
<PVINGO> ::= NULL.
<PVINGSTG> ::= NULL.
<QUOTESTG> ::= NULL.
<SASOBJBE> ::= NULL.
<SNWH> ::= NULL.
<INFO-SOURCE> ::= NULL.
<SVEN> ::= NULL.
<SVO> ::= NULL.
<SVINGO> ::= NULL.
<VINGOFN> ::= NULL.
<VINGSTG> ::= NULL.
<WHETHS> ::= NULL.
<TANTSTG> ::= NULL.
<VSUBJ> ::= NULL.
<WITHSTG> ::= NULL.
— ATOMIC SYMBOLS NOT YET IN USE
<UNUSED> ::= <*CS0> / <*CS2> / <*CS3> / <*CS4> / <*CS5> / <*CS6> /
        <*CS7> / <*CS8> / <*CS9> / <*CS10> / <*NG> / <*DT> /
        <*DUMMY> / <*GRAM-NODE> /
        <*NULLPRO1> / <*NULLPRO2> / <*NULLC> / <*NULLN> .
<AINSIQUESTG> ::= NULL.
<AND-ORSTG> ::= NULL.
<AS-WELL-AS-STG> ::= NULL.
<ASSTG> ::= NULL.
<BEINGO> ::= NULL.
<BOTHSTG> ::= NULL.
<C1SHOULD> ::= NULL.
<COLONSTG> ::= NULL.
<CPDNUMBR> ::= NULL.
<CSSTG> ::= NULL.
<DASHSTG> ::= NULL.
<DAYYEAR> ::= NULL.
<DMQSTG> ::= NULL.
<DOSE-OF-N> ::= NULL.
<EGSTG> ::= NULL.
<EITHERSTG> ::= NULL.
<ENVINGO> ::= NULL.
<ESPECIALLY-STG> ::= NULL.
<ETCSTG> ::= NULL.
<FORTOVO-N> ::= NULL.
<FORMAT13-MED> ::= NULL.
<FORMAT5-MISC> ::= NULL.
<FRACTION> ::= NULL.
<FTIME> ::= NULL.
<GENDER> ::= NULL.
<HOWQASTG> ::= NULL.
<HOWQSTG> ::= NULL.
<IMPERATIVE> ::= NULL.
<INADDITIONTOSTG> ::= NULL.
<INTRO-PHRASE> ::= NULL.
<INTSTG> ::= NULL.
<LAR1> ::= NULL.
<LCDA> ::= NULL.
<LCDN> ::= NULL.
<LCDVA> ::= NULL.
<LCS> ::= NULL.
<LDATE> ::= NULL.
<LDATER> ::= NULL.
<LNAME> ::= NULL.
<LNAMER> ::= NULL.
<LNSR> ::= NULL.
<LPRO> ::= NULL.
<LQNR> ::= NULL.
<LTVR> ::= NULL.
<LVSA> ::= NULL.
<MEDDOSE> ::= NULL.
<MOREDATE> ::= NULL.
<NAMESTG> ::= NULL.
<NEG> ::= NULL.
<NEGV> ::= NULL.
<NEITHERSTG> ::= NULL.
<NINRN> ::= NULL.
<NISTG> ::= NULL.
<NORSTG> ::= NULL.
<NOTOPT> ::= NULL.
<NPDOSE> ::= NULL.
<NPSNWH> ::= NULL.
<NPSVINGO> ::= NULL.
<NPVO> ::= NULL.
<NPWHS> ::= NULL.
<NQ> ::= NULL.
<NSNWH> ::= NULL.
<NSPOS> ::= NULL.
<NTHATS> ::= NULL.
<NUMBRSTG> ::= NULL.
<NVINGO> ::= NULL.
<NVSA> ::= NULL.
<NWHSTG> ::= NULL.
<OBJBESA> ::= NULL.
<ORNOT> ::= NULL.
<PA> ::= NULL.
<PAREN-FRAG> ::= NULL.
<PAREN-RV> ::= NULL.
<PARENSTG> ::= NULL.
<PART> ::= NULL.
<PARTICULARLY-STG> ::= NULL.
<PNPVO> ::= NULL.
<PNSNWH> ::= NULL.
<PNTHATSVO> ::= NULL.
<PNVINGSTG> ::= NULL.
<PNVO> ::= NULL.
<PROPOS> ::= NULL.
<PROSENT> ::= NULL.
<PSNWH> ::= NULL.
<PSVINGO> ::= NULL.
<PTIME> ::= NULL.
<PUISSTG> ::= NULL.
<PVO-N> ::= NULL.
<PVO> ::= NULL.
<PWHNQ-PN> ::= NULL.
<PWHNQ> ::= NULL.
<PWHNS-PN> ::= NULL.
<PWHNS> ::= NULL.
<PWHQ-PN> ::= NULL.
<PWHQ> ::= NULL.
<PWHS-PN> ::= NULL.
<PWHS> ::= NULL.
<Q10S> ::= NULL.
<Q-ASSERT> ::= NULL.
<Q-INVERT> ::= NULL.
<Q-OF> ::= NULL.
<Q-PHRASE> ::= NULL.
<QN-TIME> ::= NULL.
<QNREP> ::= NULL.
<QNS> ::= NULL.
<QUAL> ::= NULL.
<QUECOMP> ::= NULL.
<QUISEG> ::= NULL.
<QUOTESTG> ::= NULL.
<RA1> ::= NULL.
<RDATE> ::= NULL.
<RNAME> ::= NULL.
<RNWH> ::= NULL.
<RSUBJ> ::= NULL.
<RXMODE> ::= NULL.
<S-N> ::= NULL.
<SAWH> ::= NULL.
<SAWHICHSTG> ::= NULL.
<SEGADJ> ::= NULL.
<SN> ::= NULL.
<SOBJBE> ::= NULL.
<SOBJBESA> ::= NULL.
<STOVO-N> ::= NULL.
<SUB10> ::= NULL.
<SUB11> ::= NULL.
<SUB12> ::= NULL.
<SUB13> ::= NULL.
<SUB2> ::= NULL.
<SUB3> ::= NULL.
<SUB4> ::= NULL.
<SUB5> ::= NULL.
<SUB6> ::= NULL.
<SUB7> ::= NULL.
<SUB9> ::= NULL.
<THANSTG> ::= NULL.
<THATS-N> ::= NULL.
<TITLE> ::= NULL.
<TOBE> ::= NULL.
<TOSTG> ::= NULL.
<TSUBJVO> ::= NULL.
<VERB1> ::= NULL.
<VERB2> ::= NULL.
<VERSUSSTG> ::= NULL.
<VINGSTG> ::= NULL.
<VINGSTGPN> ::= NULL.
<VOIRESTG> ::= NULL.
<WH-PHRASE> ::= NULL.
<TM-PHRASE> ::= NULL.
<WHATS-N> ::= NULL.
<WHERES> ::= NULL.
<WHETHS> ::= NULL.
<WHETHTOVO> ::= NULL.
<WHEVERS-N> ::= NULL.
<WHN> ::= NULL.
<WHNQ-N> ::= NULL.
<WHNS-N> ::= NULL.
<WHQ-N> ::= NULL.
<WHQ> ::= NULL.
<YESNOQ> ::= NULL.
— SNOPATH BNF
<PATH-I-F> ::= NULL.
<SPECIMEN> ::= NULL.
<FINDING> ::= NULL.
<SPEC> ::= NULL.
<SHOW-CONN> ::= NULL.
<PATHRES> ::= NULL.
— DEFINITION
— BNF

— 1. SENTENCE
<SENTENCE> ::= <TEXTLET> .
<TEXTLET> ::= <ONESENT> <MORESENT> .
<ONESENT> ::= <SECTION> <INTRODUCER> <CENTER> <ENDMARK> .
<SECTION> ::= <SECT-NAME> .
<MORESENT> ::= <*NULL> / <TEXTLET> .
<INTRODUCER> ::= (<*N> / <*ADJ>) ':' / <*NULL> .
<CENTER> ::= (<ASSERTION> / <SEGADJ> / <QUISEG> / <FRAGMENT>)
        <PAREN-FRAG> .
<PAREN-FRAG> ::= '(' <FRAGMENT> ')' / '(' <ASSERTION> ')' / <*NULL> .
<SEGADJ> ::= <NSTGT> / <PDATE> / <LDR> / <PN> .
<QUISEG> ::= WHO <VERB> <SA> <OBJECT> <SA> .
<ENDMARK> ::= '.' / ';' / '#' .
— 2. CENTER STRINGS
<ASSERTION> ::= <SA> <SUBJECT> <SA> <TENSE> <SA> <VERB> <SA>
        <OBJECT> <SA> .
<FRAGMENT> ::= <SA> (<TOVO> / <TVO> / <VO> / <BESHOW> /
        <NSTGF> / <ASTGF> / <PN> / <VENPASS>) <SA> .
<NSTGF> ::= <NSTG> .
<ASTGF> ::= <ASTG> .
<BESHOW> ::= <PROC> <BESUBJ> [':'] <BEDATE> <OBJBE> <SA> .
<PROC> ::= <NSTG> [':'] / <*NULL> .
<BESUBJ> ::= <NSTG> / <*NULL> .
<BEDATE> ::= <DATE> / <*NULL> .
<OBES> ::= <ASTG> <SA> <TENSE> <SA> <VERB> <SA> <SUBJECT>
        <SA> .
— 5. SUBJECT STRINGS
<SUBJECT> ::= THERE / <EKGSTG> / <NSTG> / <*NULLWH> / <*NULLC> / <WHATS-N> .
<EKGSTG> ::= <LWVR>.
<LWVR> ::= <LN> <WVVAR> <RWV>.
<WVVAR> ::= <*N>.
<RWV> ::= <RWVOPTS> <RWV> / <*NULL>.
<RWVOPTS> ::= <IN-LEADS> / <PN>.
<IN-LEADS> ::= (<*P> / - <*NULL>) <LLEADR>.
<LDATER> ::= <LDATE> <DATEVAR> <RDATE> .
<DATEVAR> ::= <*DT> '-' <*DT> / <*DT> / <T-DATE> .
<T-DATE> ::= THE <*Q>.
<LLEADR> ::= <LN> <LEADVAR> <RLEAD>.
<LEADVAR> ::= <*EKGLEAD> '-' <*EKGLEAD> /
        <*EKGLEAD> THROUGH <*EKGLEAD> /
        <*EKGLEAD> '-' <*Q> /
        <*EKGLEAD> THROUGH <*Q> / <*EKGLEAD> .
<RLEAD> ::= <*D> / <*NULL>.
<NSTG> ::= <LNR> .
<LNR> ::= <LN> <NVAR> <RN> .
<NVAR> ::= <*N> / <*PRO> / <*VING> / <*DS> / <QN>.
— 7. VERB AND VERBAL OBJECT STRINGS
<VERB> ::= <*NULLFRAG> / <*NULLC> / <LV> <VVAR> <RV> .
<VVAR> ::= <*TV> / <*V> .
<TENSE> ::= <LW> <*W> <RW> / <*NULL> .
<LVR> ::= <LV> <*V> <RV>.
<VENO> ::= <LVENR> <SA> <OBJECT> <SA> .
<LVENR> ::= <LV> <*VEN> <RV> .
<VENPASS> ::= <LVENR> <SA> <PASSOBJ> <SA> .
<VINGO> ::= <LVINGR> <SA> <OBJECT> <SA> .
<LVINGR> ::= <LV> <*VING> <RV> .
— 8. OBJECT STRINGS
<OBJECT> ::= <*NULLFRAG> / <*NULLC> / <NSTGO> / <DP1> /
        <NPDOSE> /
        <DP2> / <DP3> / <PN> / <NPN> / <VO> / <TOVO> /
        <ADVOBJ> / <THATS> / <VINGO> / <NTOVO> / <VENO> /
        <OBJECTBE> / <OBJBE> / <NA> / <VENPASS> / <NTHATS> /
        <ASSERTION> / <*NULLOBJ> .
<PASSOBJ> ::= <ASTG> / <PN> / <PDOSE> / <NSTGO> / <TOVO> /
        <*NULLOBJ> .
<OBJECTBE> ::= <VINGO> / <VENPASS> / <OBJBE> .
<OBJBE> ::= <ASTG> / <QUANT> / <NSTG> / <PN> / <PQUANT> /
        <PDATE> / <LDR> .
<QUANT> ::= <QN> / <QPERUNIT>.
<QPERUNIT> ::= <LQR> <PERUNIT> <REG-ADJ>.
<PERUNIT> ::= '/' <*N> / '%' / PER <*N> / <*NULL> .
<REG-ADJ> ::= <*ADJ> / <*NULL>.
<QN> ::= <LQR> <*N> <PERUNIT> <SCALESTG> .
<SCALESTG> ::= <*ADJ> / <IN-DIM> / <*NULL> .
<IN-DIM> ::= IN <*N> .
<PQUANT> ::= <*P> <QUANT>.
<ASTG> ::= <LAR> .
<NSTGO> ::= <NSTG> / <QUANT> / <*NULLC> / <*NULLWH> .
<ADVOBJ> ::= <LDR> .
<LDR> ::= <LD> <*D> <RD> .
<NTOVO> ::= <NSTGO> <TOVO> .
<TOVO> ::= TO <LVR> <SA> <OBJECT> <SA> .
<THATS> ::= THAT <ASSERTION> .
<NTHATS> ::= <NSTGO> <THATS> .
<TVO> ::= <TENSE> <SA> <VERB> <SA> <OBJECT> <SA> .
<VO> ::= <TENSE> <SA> <LVR> <SA> <OBJECT> <SA> .
— 8A. P STRINGS
<PD> ::= <*P> <LDR> .
<PN> ::= <LP> <*P> <NSTGO> .
<NPN> ::= <NSTGO> <PN> .
<NPDOSE> ::= <NSTGO> <*P> <*DS> [<*P> <*DS>] .
<PDOSE> ::= <*P> <*DS> [<*P> <*DS>] .
<P1> ::= <*P> .
— 8B. DP STRINGS
<DP1> ::= <*DP> .
<DP2> ::= <*DP> <NSTGO> .
<DP3> ::= <NSTGO> <*DP> .
<DP4> ::= NULL .
— 8D. NOMINALIZATION WITH ZEROED VERB BE
<NA> ::= <NSTG> <ASTG> .
— 9. SENTENCE ADJUNCT STRINGS
<SA> ::= <*NULL> / <SAOPTS> <SA> .
<SAOPTS> ::= <PDATE> / <*INT> / <LDR> / <PN> / <PD> /
        <VINGO> / <NSTGT> / <RNSUBJ> / <SUB1> /
        <SUB0> / <SUB2> / <SUB3> / <SUB8> /
        <TOVO> / -<VENPASS> .
<PDATE> ::= (<*P> / <*NULL>) <DATE> .
<DATE> ::= <DATEQ> / <DATEWD> .
<DATEQ> ::= <*Q> '/' <*Q> '/' <*Q> [':'] .
<DATEWD> ::= <*N> <*Q> [':'] .
<NSTGT> ::= <LTIME> <NSTG> .
<RNSUBJ> ::= <WHS-N> .
<SACONJ> ::= <SA> .
— 10. SUBORDINATE CONJUNCTION STRINGS
<SUB1> ::= <*CS1> <ASSERTION> .
<SUB0> ::= <*CS0> (<PN> / <*ADJ>) .
<SUB2> ::= <*CS2> <VENPASS> .
<SUB3> ::= <*CS3> <VINGO> .
<SUB8> ::= AS (WAS / WERE) <SUBJECT> .
— 11. RN RIGHT ADJUNCTS OF N
<RN> ::= <RNOPTS> <RN> / <*NULL> .
<RNOPTS> ::= <PAREN-RN> /<PDATE> / <BPART> / <VENPASS> / <ADJINRN>
        / <QUANT> / <LDR> / <PQUANT> / <PN> / <TOVO>
        / <VINGO> / <WHS-N> / <PWHS> / <THATS>
        / <TOVO-N> / <*DS> / <WHENS> / <WHOSES>
        / <PERUNIT> / <PAREN-NSTG> / - <APPOS>.
<PAREN-RN> ::= '(' <RNOPTS> <RN> ')' .
<PAREN-NSTG> ::= <NSTG> .
<ADJINRN> ::= <LAR> .
<BPART> ::= <LNR> .
<TOVO-N> ::= <TOVO> .
<APPOS> ::= [','] <LNR> .
— 12. LN LEFT ADJUNCTS OF N
<LN> ::= <TPOS> <QPOS> <APOS> <NPOS> .
<TPOS> ::= <LTR> / <*NULL> / <LNS>.
<LTR> ::= <LT> <*T> <RT> .
<LNS> ::= <TPOS> <*NS> .
<QPOS> ::= <LQR> / <*NULL> .
<LQR> ::= <LQ> <QVAR> <RQ> .
<QVAR> ::= <*Q> / <*Q> X <*Q> / <RATIO> / <QPER>
        / <*Q> '-' <*Q> / <*Q> TO <*Q>
        / <*Q> OVER <*Q> .
<QPER> ::= <*Q> '/' <*N> .
<RATIO> ::= <*Q> '/' <*Q> .
<APOS> ::= <ADJADJ> / <*NULL>.
<ADJADJ> ::= <LAR> / <QN> / <ADJADJ> (<LAR> / <QN>).
<LAR> ::= <LA> <AVAR> <RA> .
<AVAR> ::= <*ADJ> / <*VEN> /<*VING> .
<NPOS> ::= <NNN> / <*NULL> .
<NNN> ::= <*N> / <*DS> / <NNN> (<*N> / <*DS>).
— 13. RIGHT ADJUNCTS - OTHER THAN RN
<RT> ::= <*NULL> .
<RQ> ::= <*D> / <REG-ADJ> / <*NULL> .
<RA> ::= <PN> / <PQUANT> / <TOVO> / <*NULL> .
<RD> ::= <*NULL> .
<RV> ::= <PDATE> / <PN> / <PQUANT> / <LDR> / <THATS>
        / <TOVO> / <NSTGT> / <*NULL>.
<RW> ::= <LDR> / <*NULL> .
— 14. LEFT ADJUNCTS - OTHER THAN LN
<LT> ::= <*NULL> / <*Q> /<*D> .
<LA> ::= <*NULL> / <LDR> .
<LQ> ::= <*NULL> / <*D> / <*ADJ> .
<LV> ::= <LDR> / <*NULL>.
<LW> ::= <*D> / <*NULL> .
<LD> ::= <*NULL> / <*D> .
<LP> ::= <LDR> / <*NULL> .
<LTIME> ::= <*NULL> / <*D> .
— 15. WH-STRINGS
<WHS-N> ::= (WHO / WHICH / THAT) <ASSERTION>.
<PWHS> ::= <*P> WHICH <ASSERTION>.
<WHENS> ::= WHEN <ASSERTION> .
<WHOSES> ::= WHOSE <ASSERTION>.
— 16. CONJUNCTION STRINGS
<ANDSTG> ::= (AND / '&') <SACONJ> <Q-CONJ> (EACH / <*NULL>) .
<ORSTG> ::= OR <Q-CONJ> .
<NORSTG> ::= NOR <Q-CONJ> .
<INCLUDINGSTG> ::= INCLUDING <Q-CONJ> .
<BUTSTG> ::= BUT <Q-CONJ> .
<PLUSSTG> ::= PLUS <Q-CONJ> .
<COMMASTG> ::= ',' (<Q-CONJ> / <*NULL>) .
<Q-CONJ> ::= <*NULL> .
<LAUX> ::= NULL.
— TRANSFORMATIONAL DUMMIES
<AGENT> ::= NULL.
<PNX2> ::= (<PN> / <PVINGSTG>) <SA> (<PN> / <PVINGSTG>).
— DUMMY NODE FOR WRITING FORMAT
<STOP> ::= NULL.
— FORMAT NODES
<MODAL> ::= NULL.
<TM-PER> ::= NULL.
— REGULARIZATION MARKERS:
—       DUMMY BNF DEFINITIONS
<AREA-MOD> ::= NULL.
<CHANGE-OF-STATE> ::= NULL.
<EMBEDDED> ::= NULL.
<HEADCONN> ::= NULL.
<LCONN> ::= NULL.
<LCONNR> ::= NULL.
<LPR> ::= NULL.
<PARSE-CONN> ::= NULL.
<RCONN> ::= NULL.
<REL-CLAUSE> ::= NULL.
<RP> ::= NULL.
<SUB-CONJ> ::= NULL.
<TIME> ::= NULL.
— FORMATTING BNF MARKERS
<CONNECTIVE> ::= <CONN> <MODS> <TIME>.
<CONN> ::= <CONJOINED>/<RELATION>/<PREP-CONN>/
        <REL-CLAUSE>/<TIME-CONJ>/<SUB-CONJ>/<EMBEDDED>.
<FORMAT00> ::= <PARAGR><SENT-OP><PT-DEMOG><SUBJECT><OBJECT><VERB>.
<FORMAT0> ::= <PARAGR><PT-DEMOG><INST><PT><VERB>.
<FORMAT1> ::= <PARAGR><PT-DEMOG><INST><PT><VERB-MD><VERB>.
<FORMAT2> ::= <PARAGR><PT-DEMOG><INST><PT><VERB-TR><VERB>.
<FORMAT3> ::= <PARAGR><PT-DEMOG><INST><PT><MED-TR><VERB>.
<FORMAT4> ::= <PARAGR><PT-DEMOG><INST><PT><TEST-INFO><VERB><TEST-ENV>.
<FORMAT5> ::= <PARAGR><PT-DEMOG><METHOD><SUBJECT><VERB>
        <PSTATE-DATA><PSTATE-SUBJ><PRECISIONS><INST>.
<FORMAT5-EKG> ::= <PARAGR><PT-DEMOG><METHOD><SUBJECT><VERB>
        <EKG-SUBJ><EKG-DATA><IN-LEADS><PRECISIONS><INST>.
<EKG-SUBJ> ::= <WAVE> <INTERVAL> <AXIS> .
<EKG-DATA> ::= <QUANT> <EKG-MORPH> <NORMAL> .
<WAVE> ::= NULL.
<INTERVAL> ::= NULL.
<AXIS> ::= NULL.
<ALLIFE> ::= NULL.
<EKG-MORPH> ::= NULL.
<FORMAT5F> ::= <PARAGR><PT-DEMOG><METHOD><SUBJECT><VERB>
        <PSTATE-DATA><PSTATE-SUBJ><PRECISIONS>
        <INST>.
<FORMAT5-ALG> ::= <PARAGR><PT-DEMOG><AGENTS><SUBJECT><VERB>
        <PSTATE-DATA><PSTATE-SUBJ><PRECISIONS><INST>.
<FORMAT1-3> ::= <PARAGR><PT-DEMOG><TREATMENT><SUBJECT><VERB>
        <PSTATE-DATA><PSTATE-SUBJ><PRECISIONS>
        <INST>.
<FORMAT6> ::= <PARAGR><PT-DEMOG><PT><VERB><OBJECT>.
<AGENTS> ::= <TT-NEG><TT-MODAL><MED><ORGANISM><ALLIFE>.
<METHOD> ::= <PROCEDURE><EXAMTEST><MED-DEVICE>.
<TREATMENT> ::= <TT-NEG><TT-MODAL><GEN><SURG><MED><COMP><MED-DEVICE> .
<PT-DEMOG> ::= <AGE> <RACE> <GENDER><FAMILY>.
<AGE> ::= <AGE-MK><Q-N>.
<PSTATE-SUBJ> ::= <PTMEAS>/<PTFUNC>/<PTPART>/<PT>/
        <SUBJ-OTHER>.
<TEST-INFO> ::= <TXSPEC> <TXVAR> <SPEC-ACCESS> <PTPART> <RESULT>.
<RESULT> ::= <ORGANISM><DIAG><INDIC><TESTRES><QUALIFIERS><QUANT>.
<PSTATE-DATA> ::= <DIAG><INDIC><TXRES><QUALIFIERS><INFLUENCE>
        <QUANT><NORMAL>.
<MED-TR> ::= <MED><RXDATA><VERB-TR>.
<PRECISIONS> ::= <MORE-PREDS>.
<MORE-PREDS> ::= <REPT> / NULL . [<TIMEPER> /]
<RXDATA> ::= <RXDOSE><RXMODE>.
<RXMODE> ::= <RXMANNER><RXFREQUENCY>.
<GENDER> ::= NULL.
<QUANT> ::= <Q-N> [(<BETW> <Q-N2>) / <Q-N2>] .
<Q-N> ::= <NUM> <NON-NUM> <UNIT> <PERUNIT> [<NUM> <UNIT>].
<Q-N2> ::= <NUM> <UNIT> [<NUM> <UNIT>].
<MODS> ::= <NEG> <MODAL> . [<FACTUAL><MODS-OTHER>]
<TIME-ASP> ::= <CHANGE-MK> <BEG> <END>.
<BP-MOD> ::= <PTPART>.
<QUANTITY> ::= <NUM> <NON-NUM> <UNIT> <PERUNIT>.
<EVENT-TIME> ::= <TPREP1> <Q-N> <TPREP2> <REF-PT>.
— BOTTOM NODES OF THE FORMAT
, , , ,
, ARE NOT MENTIONED OR USED.

<ACTIVITY> ::= NULL.
<AGE-MK> ::= NULL.
<BEG> ::= NULL.
<BETW> ::= NULL.
<CHANGE> ::= NULL.
<CHANGE-MK> ::= NULL.
<SURG> ::= NULL.
<COMP> ::= NULL.
<CONJOINED> ::= NULL.
<DESCR> ::= NULL.
<DIAG> ::= NULL.
<DOUBLE-NEG> ::= NULL.
<END> ::= NULL.
<EXAM-FUNC> ::= NULL [TO BE REMOVED WHEN READY].
<EXAMTEST> ::= NULL.
<FACTUAL> ::= NULL.
<EXPAND-REFPT> ::= NULL.
<FAMILY> ::= NULL.
<GEN> ::= NULL.
<INFLUENCE> ::= NULL.
<INST> ::= NULL.
<MANY-TIMES> ::= NULL.
<MED> ::= NULL.
<MODS-OTHER> ::= NULL.
<NON-EMPTY> ::= NULL.
<NON-NUM> ::= NULL.
<NORMAL> ::= NULL.
<NUM> ::= NULL.
<ORGANISM> ::= NULL.
<PARAGR> ::= NULL.
<PREP> ::= NULL.
<PREP-CONN> ::= NULL.
<PROCEDURE> ::= NULL.
<PRT> ::= NULL.
<PT> ::= NULL.
<PTFUNC> ::= NULL.
<PTMEAS> ::= NULL.
<PTPART> ::= NULL.
<PTSTATE-OTHER> ::= NULL.
<QUALIFIERS> ::= NULL.
<RACE> ::= NULL.
<REF-PT> ::= NULL.
<REGX> ::= NULL.
<RELATION> ::= NULL.
<REPT> ::= NULL.
<RESPONSE> ::= NULL.
<RXFREQUENCY> ::= NULL.
<RXMANNER> ::= NULL.
<RXDOSE> ::= NULL.
<SENT-OP> ::= NULL.
<SPEC-ACCESS> ::= NULL.
<STATUS> ::= NULL.
<SUBJ-OTHER> ::= NULL.
<INDIC> ::= NULL.
<SUB-CONJ> ::= NULL.
<SUBUNIT> ::= NULL.
<TESTRES> ::= NULL.
<TEST-ENV> ::= NULL.
<TIME-CONJ> ::= NULL.
<TIME-UNIT> ::= NULL.
<TIMELOC> ::= NULL.
<TIMEPER> ::= NULL.
<TIME-QUAL> ::= NULL. [*GRI*]
<TM-PERIOD> ::= NULL. [*GRI*]
<TM-REPETITION> ::= NULL. [*GRI*]
<TM-UNIT0> ::= NULL.
<TPREP0> ::= NULL.
<TPREP1> ::= NULL.
<TPREP2> ::= NULL.
<TT-NEG> ::= NULL.
<TT-MODAL> ::= NULL.
<TTRES> ::= NULL.
<TXRES> ::= NULL.
<TXSPEC> ::= NULL.
<TXVAR> ::= NULL.
<VERB-TR> ::= NULL.
<VERB-MD> ::= NULL.
— CT STRUCTURE
<FORMAT-CT> ::= NULL.
<TIME-LOCS> ::= NULL.
<TIME-QUALS> ::= NULL.
<UNIT> ::= NULL.
<Y-OF> ::= NULL.
— ATTRIBUTE LISTS
—       1. BASE ATTRIBUTES USED IN DICTIONARY AND PARSING GRAMMAR.
—       MISSING DIDOMPN. UNUSED PT1.
—       2. SELECTION COMPONENT ADDS: PASS-SEL, LINKC, N-OMITSTG,
—       START-HGRAPH, STAY-HGRAPH, TRY-ATT.
—       3. TRANSFORMATION COMPONENT ADDS:
—       PREFX, DEL-ATT, INDEX, TENSE-ATT, TFORM-ATT,
—       [** ATTRIBUTES ASSIGNED TO TENSE-ATT **]
—       CONDITIONNEL, FUTURE, IMPARFAIT, IMPERTVE, PERF, PRESNT, PROG,
—       [** ATTRIBUTES ASSIGNED TO TFORM-ATT **]
—       TFORTOVO, TNPVINGO, TNPVO, TNSVINGO, TPVO, TRNFILLIN,
—       TRNWH, TSASOBJBE, TSOBJBE, TSVINGO, TTHATS, TWHATSN,
—       TWHETHS.
—       4. REGULARIZATION COMPONENT ADDS: FORMAT-ATT, EMBED-OBJ,
—       EMBED-SUBJ, REFPT-ATT, TYPE-ATT, PT2, SEM-CORE,
—       [** ATTRIBUTES ASSIGNED TO FORMAT-ATT **]
—       FRMT-UNIT, FRMT00, FRMT0, FRMT1, FRMT2, FRMT3, FRMT4,
—       FRMT1-3, FRMT13-MED, FRMT5-MISC, FRMT5-EKG,
—       FRMT4-5, FRMT5, FRMT5F, FRMT5-ALG, FRMT5-PTFAM, FRMT6, NOFRMT.
—       5. FORMAT COMPONENT ADDS:
—       FILLED-PT, FORMAT-PT, TRANSFORM-ATT, UNIT-ATT [NOT USED].
— WD-ATTRIBUTES USED IN DICTIONARY
ATTRIBUTE =
        [* ATTRIBUTES CURRENTLY USED *]
        AASP, ACCUSATIVE, ACT, AFORTO, APREQ, ASENT1,
        ASENT3, ATHAT,
        C, COLLECTIVE, COND,
        DATIVE, DEF, DEM, DEVAL, DLA, DLD, DLP, DLQ, DLTIME, DLV,
        DRA, DRD, DRQ, DRV, DSA,
        F, FUT,
        IMP, INDEF, INDEFINITE,
        INSTR,
        INV,
        LESS,
        M, MODAL-AFFIX, MORE, MORPH, H-POST,
        NCOUNT1, NEG-MEAN, NEG-PREFIX, NEGATIVE, NHUMAN,
        NMONTH, NO-REP, NOMINATIVE, NSCALE, NSENT1, NSENT4,
        NVN, PLACE-HOLDER [for non pronoun it],
        PAST, PERS1, PERS2, PERS3, PLURAL, POST, PRESNT, PREV, PVAL,
        QAGE, QALL, QDATE, QNUMBER, QROVING, QTENS, QTESTVAL,
        SAME, SCOPE, SINGULAR, SUBJONCTIF [French],
        TDEM, TIMETAG, TPOSS, TRANSITIVE,
        VBE, VETRE, VHAVE, VMIDDLE, VSE, VVERYVING,
        [* ATTRIBUTES CURRENTLY UNUSED *]
        ACOMPOUND, AGGREGATE, AINPA, AINRN, ARG, ARGPTR, ARGUMENT,
        ASCALE, ASENT2, ASHOULD, AWH,
        CATEGORIES, COMPARATIVE,
        CS0AS, CS1INNER,
        DLCOMP, DLCS, DLOC1, DLOC2, DLOC3, DLT, DLTPRO, DLW,
        DMANNER, DMIDDLE, DMOBILE, DPERM, DPRED, DRN,
        DRW, DSA1, DUNIV, DVERY,
        EACHEVRY,
        NAME, NCLASSIFIER1, NCLASSIFIER2, NCOUNT2, NCOUNT3,
        NCOUNT4, NEGADJ, NEO, NLETTER, NONHUMAN, NONTRANSITIVE,
        NPREQ, NSENT2, NSENT3, NSENTP, NTH, NTITLE,
        POS, PRE, PREFX, PROPOSS, PROSELF,
        QHALF, QMANY,
        REFLEXIVE,
        SUPERLATIVE,
        TQUAN,
        VASP, VCOLLECTIVE, VDO, VENDADJ, VEVENT, VEXP,
        VMANNER, VMOD, VMOTION, VRARE, VRECIP,
        VSENT1, VSENT2, VSENT3, VSENT4,
        W7WORD.
— GR-ATTRIBUTES USED IN GRAMMAR
ATTRIBUTE =
        [* ATTRIBUTES CURRENTLY USED *]
        ANYTHING [DVC1, DVC2],
        CONDITIONNEL,
        CONJ-LIKE,
        FRMT-UNIT, FRMT0, FRMT00, FRMT1, FRMT2, FRMT3, FRMT13-MED,
        FRMT5-MISC, FRMT5-EKG, FRMT4, FRMT4-5, FRMT5, FRMT5-ALG, FRMT5F,
        FRMT5-PTFAM, FRMT6,
        FUTURE, IMPARFAIT, IMPERTVE,
        NOFRMT,
        OBJECTPRO, OBJLIST,
        POBJLIST, PROG,
        PASS-SEL [CLASS FOR SELECTION LISTS- ALWAYS PASS],
        PATHIF [* snopath *],
        TFORTOVO, TNPVINGO, TNTOVO, TNSVINGO, TTOVO,
        TRNFILLIN, TRNWH, TSASOBJBE, TSOBJBE, TSVINGO,
        TTHATS, TWHATSN, TWHETHS,
        [* ATTRIBUTES CURRENTLY UNUSED *]
        BVAL,
        DECIMAL, DPVAL,
        NOTNOBJ, NOTNSUBJ, NPNPN,
        OVAL,
        P-ITIS, PERF, PNPN, POBJECT, PVAL1, PVAL2,
        SENTOBJ, SUB, SVAL,
        TOBJLIST.
— SUBLANGUAGE-ATTRBS
ATTRIBUTE = [FRENCH H-CHANGE SUBCLASSES] ME3ME, MOINS, PLUS.
ATTRIBUTE =
        [* LIST TYPE DECLARATIONS *]
        ADJUNCT-TYPE,
        BODYFUNC-PN, BODYLOC-PN, CONN-PN,
        CONN-TYPE,
        INSTR-TYPE,
        NULLNCLASS,
        QUANT-ADVERBIAL,
        TIME-ADVERBIAL,
        TIME-CLASS [USED TO MARK TIME CLASS LIST],
        VHAVE-TYPE,
        [* ATTRIBUTES CURRENTLY USED *]
        BEREP,
        EMPTY-SET,
        FAIL-SEL,
        FEM,
        GENERIC,
        H-AGE, H-ALLERGY, H-AMT,
        H-BECONN, H-BEH,
        H-CELLTYPE, H-CHANGEMK,
        H-CHANGE, H-CHANGE-MORE, H-CHANGE-LESS, H-CHANGE-SAME,
        H-CHEM [*S*], H-CONN,
        H-DESCR, H-DEVMED, H-DIAG,
        H-ETHNIC, H-EVID,
        H-FAMILY,
        H-GEOGR,
        H-INDIC, H-INST,
        H-MODAL,
        H-NEG, H-NORMAL, H-NOCLASS [*S*], H-NULL,
        H-OBSERVE, H-ORG,
        H-PT, H-PTAREA, H-PTDESCR, H-PTFUNC, H-PTLOC, H-PTMEAS,
        H-PTPALP, H-PTPART, H-PTSPEC, H-PTVERB,
        H-RECORD, H-DIET [formerly, H-REPAS], H-RESP, H-RESULT,
        H-SHOW,
        H-TMBEG, H-TMEND, H-TMLOC, H-TMDUR, H-TMPREP, H-TMREP,
        H-TRANSP, H-TRIGGER [* weak causative *],
        H-TTSURG, H-TTCOMP, H-TTFREQ, H-TTGEN, H-TTMED, H-TTMODE,
        H-TXCLIN, H-TXPROC, H-TXRES, H-TXSPEC, H-TXVAR,
        H-UNDEF [undefined word],
        MASC,
        NO-TYPE, NTIME1, NUNIT,
        PAST,
        TIME-PREFIX, TRANSP,
        [* ATTRIBUTES CURRENTLY UNUSED *]
        G-VRELFAC,
        H-ADJSPINE,
        H-DIMENSION, H-DOCTOR,
        H-ERROR, H-EVENT,
        H-GENERIC, H-GROW,
        H-HOSP,
        H-INGEST, H-INTOX,
        H-LABRES,
        H-MULT,
        H-NORM,
        H-OCCASION,
        H-PART, H-PSYCH,
        H-SET, H-SHAPE, H-STATUS,
        H-TESTVIEW, H-TIMEQUAL, H-TYPE,
        H-VRX, H-VTEST,
        H-VTENSE,
        NTIME2,
        V-HEAL.
— NODE-ATTRIBUTES
ATTRIBUTE = FRMT1-3 [NEW COMBINED F1+F2+F3+F5],
        FRMT345 [AMBIGUOUS FRMT1-3, FORMAT4 AND FRMT5/FRMT5x],
        FRMT3-5 [AMBIGUOUS FRMT1-3 AND FRMT5/FRMT5x],
        SEM-CORE [NEW NAME FOR HOST-ASP].
ATTRIBUTE =
        AMBIG [* ambiguous expansion *],
        ADVERBIAL-TYPE, ASSIGN-ATT,
        COMMA-NULLFRAG, COMPUTED-ATT,
        DEFERRED, DEL-ATT, DIDOMIT, DIDOMPN, DIRECT,
        EMBED-OBJ, EMBED-SUBJ,
        FILLED-PT, FORMAT-ATT, FORMAT-PT,
        HGRAPH-ATT,
        INDIRECT, INDEX,
        ANTECEDENT, ANALINK, [* anaphora lists *]
        LAST-NODE, LINKC, LN-TO-N-ATT,
        MATCHED, MED-ATT,
        N-OMITSTG, N-TO-LN-ATT, N-TO-RN-ATT,
        NO-RN-ATT, NOT-DISTR-LN-ATT, NOT-DISTR-RN-ATT, NOT-FREE,
        POSTCONJELEM, PRECONJELEM, PVAL-ATT, PT1, PT2,
        REFPT-ATT [identifies PN with REFPT in it], RN-TO-N-ATT,
        SE, SELECT-ATT, [SEM-CORE,] SHARED-CONNECTIVE,
        START-HGRAPH, STAY-HGRAPH,
        TENSE-ATT, TFORM-ATT, TRANSFORM-ATT, TRY-ATT, TYPE-ATT,
        WORD-POS, UNIT-ATT.
— PHRASE-ATTRIBUTES
ATTRIBUTE = PHRASE-ATT,
        AGE-PHRASE, DATE-PHRASE, DOSE-PHRASE, INFLUENCE-PHRASE,
        PTPART-PHRASE, QUANT-PHRASE, RADIATE-PHRASE, SOURCE-ATT,
        SOURCE-PHRASE, TIME-PHRASE, TIME-POST-PHRASE, TESTENV-PHRASE.
ATTRIBUTE = [* EKG ATTRIBUTES *]
        E-AX [axis], E-EKGPROC [EKG test], E-LEAD [EKG leads],
        E-INTVL [interval], E-WV [EKG wave].
ATTRIBUTE = ASSN-SELS [* all SELECT-ATTS of ASSN/FRAGMENT *].
ATTRIBUTE = SUPPORT-ATT [* SUPPORT-CLASS for major class *].
ATTRIBUTE =
        CONNSTK
        [* NODE ATTRIBUTE USED BY T-RECORD-CONJ TO THREAD *]
        [* CONJUNCTION NODE IN THE PROCESS OF LINKING *]
        [* CONJUNCTION WORDS TO ITS SECOND CONJUNCT *],
        CT-CONJ
        [* NODE ATTRIBUTE USE BY T-WRITE-CT. NODE ATTRIBUTE *]
        [* OF A SECOND CONJUNCT POINTING TO THE CONJUNCTION *]
        [* WORDS (REGULARIZED TREE HAS PREORDER PARSE-CONN *]
        [* STRUCTURE, THE EFFECT OF THIS IS TO TURN INTO AN *]
        [* INORDER STRUCTURE, REQUIRED BY CT). *],
        CT-WRITTEN [* Mark T-WRITE-CT nodes that have been written *].
ATTRIBUTE =
        CONJ-LINK
        [* MARKS LINK BETWEEN CONJUNCTION AND ITS ARGUMENTS VIA *]
        [* NODE ATTRIBUTE CONJ-LINK WITH THE SAME NUMERIC VALUE *].
ATTRIBUTE =
        C01, C02, C03, C04, C05, C06, C07, C08, C09, C10,
        C11, C12, C13, C14, C15, C16, C17, C18, C19, C20.
— WORD POSITION ATTRIBUTES
ATTRIBUTE = W001, W002, W003, W004, W005, W006, W007, W008, W009,
        W010, W011, W012, W013, W014, W015, W016, W017, W018, W019,
        W020, W021, W022, W023, W024, W025, W026, W027, W028, W029,
        W030, W031, W032, W033, W034, W035, W036, W037, W038, W039,
        W040, W041, W042, W043, W044, W045, W046, W047, W048, W049,
        W050, W051, W052, W053, W054, W055, W056, W057, W058, W059,
        W060, W061, W062, W063, W064, W065, W066, W067, W068, W069,
        W070, W071, W072, W073, W074, W075, W076, W077, W078, W079,
        W080, W081, W082, W083, W084, W085, W086, W087, W088, W089,
        W090, W091, W092, W093, W094, W095, W096, W097, W098, W099,
        W100, W101, W102, W103, W104, W105, W106, W107, W108, W109,
        W110, W111, W112, W113, W114, W115, W116, W117, W118, W119,
        W120, W121, W122, W123, W124, W125, W126, W127, W128, W129,
        W130, W131, W132, W133, W134, W135, W136, W137, W138, W139,
        W140, W141, W142, W143, W144, W145, W146, W147, W148, W149.
— GLOBAL LISTS
GLOBAL = $ASCNT [ROUTINE L(X)],
   $ASSIGN-PRE-AND-POST [PRE-POST-CONJELEM],
   $AT-LADJ [HOST-, HOST],
   $AT-RADJ [HOST-, HOST],
   $ATRNSUBJ [HOST-, HOST],
   $CORE-PATH [CORE-],
   $NHUMAN-CHK [CORE-ATT, CORE-SELATT],
   $PRECONJ [COEL1],
   $POSTCONJ [CORE, DOWN1, STACK-FOR-LEFT],
   $RIGHT-TO-HOST [FOLLOWING-ELEMENT, HOST-ELEMENT],
   $STACK-TEST [DOWN1],
   $TO-PRECONJUNCTION-Y [COEL1],
   $UP-CONJ [LEFT-ADJUNCT, RIGHT-ADJUNCT].
GLOBAL = $ASPECTUAL [DEEPEST-COVERB],
   $UP-THROUGH-Q [IMMEDIATE, PRESENT-STRING].
— FORMAT-GLOBALS
GLOBAL = $EMPTY [WRITE-WORDS, T-WRITE-FORMAT],
   $ERR-END [PUTIN-SLOT, T-FORMAT-SLOT, T-MOD],
   $ERR-SIGNAL [PUTIN-SLOT, T-FORMAT-SLOT, T-MOD],
   $SET-POINTERS [T-FORMAT-SLOT, T-MOD, T-TIMEUNIT, T-AGE,]
        [PUTIN-SLOT].
GLOBAL = $BUILD-BP-MOD [T-BUILD-FORMAT, T-FORMAT-SLOT],
   $BUILD-MODS [T-BUILD-FORMAT, T-MOD],
   $BUILD-Q-N [T-BUILD-FORMAT, T-AGE, T-QUANT],
   $BUILD-RXDOSE [T-BUILD-FORMAT, T-MEDDOSE],
   $BUILD-TENSE [T-BUILD-FORMAT, T-MOD],
   $BUILD-TIME-ASP [T-BUILD-FORMAT, T-MOD, T-TIMEUNIT,]
        [T-REFPT-PN, T-QN-TIME],
   $BUILD-TIME-QUAL [T-BUILD-FORMAT, T-TIME-QUAL] [*GRI*],
   $BUILD-EVENT-TIME [T-BUILD-FORMAT, T-MOD, T-TIMEUNIT,]
        [T-REFPT-PN, T-QN-TIME],
   $BUILD-QUANT [T-BUILD-FORMAT],
   $BUILD-UNIT [T-BUILD-FORMAT],
   $BUILD-Y-OF [T-BUILD-FORMAT],
   $BUILD-QUANTITY [T-BUILD-FORMAT, T-MOD],
   $CORE-FAIL-SEL [T-FORMAT-SLOT, T-MOD],
   $CORE-ADJUNCT-ATT [T-FORMAT-SLOT, T-MOD],
   $CHK-DOSE [T-MEDDOSE, T-FORMAT-SLOT],
   $CHK-FOR-PERUNIT [T-PERUNIT, T-QUANT, T-MEDDOSE],
   $FIND-FORMAT [T-FORMAT-SLOT, T-AGE, T-TIMEUNIT, T-REFPT-PN,]
        [T-REFPT-PDATE, T-QUANT, T-MEDDOSE, T-QN-TIME],
   $FIND-HOST-SLOT [T-MOD, T-TIMEUNIT, T-REFPT-PN,]
        [T-REFPT-PDATE, T-QN-TIME],
   $FIND-EVENT-TIME [T-MOD, T-TIMEUNIT, T-REFPT-PN,]
        [T-REFPT-DATE, T-NPOS-REFPT,T-QN-TIME],
   $FIND-TIME [T-MOD, T-TIMEUNIT, T-REFPT-PN, T-QN-TIME],
   $GET-SLOT [T-FORMAT-SLOT],
   $HAS-FAIL-SEL [T-FORMAT-SLOT],
   $HAS-ADJUNCT-ATT [T-FORMAT-SLOT],
   $IMM-LXR [T-FORMAT-SLOT, T-TIMEUNIT],
   $IS-LCONNR [T-FORMAT-SLOT, T-MOD],
   $IS-LQR-LQNR [T-FORMAT-SLOT, T-MOD],
   $IS-MINOR-CLASS [T-COMP-ATT, T-FORMAT-SLOT],
   $IS-NEG-MODAL [T-COMP-ATT, T-FORMAT-SLOT],
   $NEXT-SLOT-FOR-HOST [T-MOD, T-TIMEUNIT, T-REFPT-PN,]
        [T-REFPT-DATE, T-NPOS-REFPT, T-QN-TIME],
   $NO-SUBCLASS [T-FORMAT-SLOT, T-MOD],
   $NOT-FORMATED [T-AGE,T-TIMEUNIT,T-REFPT-PN,T-REFPT-PDATE,]
        [T-QUANT, T-MEDDOSE, T-QN-TIME],
   $PRE-TO-TIME-PTR [T-TIMEUNIT, T-REFPT-PN, T-REFPT-PDATE,]
        [T-QN-TIME],
   $PRE-TO-QUANT-PTR [T-QUANT, T-PERUNIT],
   $PUTIN-NUM [T-AGE, T-TIMEUNIT, T-REFPT-PN, T-QUANT],
   $PUTIN-Q-N [T-AGE, T-TIMEUNIT, T-REFPT-PN, T-QUANT],
   $PUTIN-UNIT [T-AGE, T-REFPT-PN],
   $QNREP-TEST [T-AGE, T-REFPT-PN, T-QUANT],
   $SET-FORMAT-REG [T-FORMAT-SLOT, T-MOD],
   $SET-PARSE-REG [T-FORMAT-SLOT, T-MOD],
   $SETUP-REFPT [T-REFPT-PN, T-REFPT-PDATE],
   $SUBCLASS-CHK [T-FORMAT-SLOT, T-PARAGR],
   $SYNTAX-CHK [T-FORMAT-SLOT, T-PARAGR],
   $WARNING-SIG [T-MOD, T-FORMAT-SLOT].
GLOBAL = $DESCENT-TYPE [TSEQ-STRING, TSEQ-ADJUNCT, TSEQ-OBJ],
   $LXR-TYPE [TSEQ-STRING, TSEQ-ADJUNCT],
   $STRING-TYPE [TSEQ-STRING, TSEQ-ADJUNCT].
— SUBLANGUAGE SELECTION LISTS
—       THE FOLLOWING LISTS ARE USED BY SUBLANGUAGE SELECTION AND
—       CONJUNCTION RESTRICTIONS

— SUBLANGUAGE-ATTS
—       LIST OF ALL ATTRIBUTES INVOLVED IN SELECTION; THIS INCLUDES ALL
—       SUBLANGUAGE CLASSES AND THOSE ENGLISH CLASSES WHICH PARTICIPATE
—       IN SELECTION (GIVEN AT BEGINNING OF THE LIST).
—       ANY CLASS ON THIS LIST WILL BE REQUIRED TO CONJOIN TO WORDS OF
—       THE SAME CLASS, UNLESS THE CLASS ALSO APPEARS ON THE LIST
—       EQUIV-CLASSES, WHICH DEFINES AN EQUIVALENCE CLASS FOR CONJUNCTION.
LIST SUBLANGUAGE-ATTS =
        [* ENGLISH CLASSES *]
        [ASENT1, ASENT2, AASP,]
        [BEREP,]
        [CONJ-LIKE, EMPTY-SET,] FEM,
        [INSTR,] MASC,
        [NSENT1, NSENT2, NSENT3, NSENTP,]
        NTIME1, NTIME2, [NULLNCLASS,] NUNIT,
        QNUMBER,
        VBE, VDO, VHAVE,
        [* SUBLANGUAGE CLASSES *]
        E-AX, E-EKGPROC, E-LEAD, E-INTVL, E-WV [EKGSTG],
        H-AGE, H-ALLERGY, H-AMT,
        H-BECONN, [H-BEH,]
        [H-CELLTYPE,] H-CHANGE, H-CHANGE-MORE, H-CHANGE-LESS, H-CHANGE-SAME,
        H-CONN, H-CHEM [*S*],
        H-DESCR, H-DEVMED, H-DIAG, [H-DIMENSION, H-DOCTOR,]
        H-ETHNIC, [H-EVENT,] H-EVID,
        H-FAMILY,
        H-GEOGR, [H-GROW, H-HOSP,]
        H-INDIC, H-INST, [H-INTOX,]
        [H-LABRES,]
        H-MODAL,
        H-NEG, [H-NOCLASS,] H-NORMAL, H-NULL,
        H-OBSERVE, [H-OCCASION,] H-ORG,
        H-PT, H-PTAREA, H-PTDESCR, H-PTFUNC, H-PTLOC, H-PTMEAS,
        [H-PTPALP,] H-PTPART, H-PTSPEC, H-PTVERB,
        H-RECORD, H-RESP, H-RESULT,
        H-SHOW, [H-STATUS,]
        H-TMBEG, H-TMEND, H-TMLOC, H-TMDUR, H-TMPREP, H-TMREP,
        H-TTSURG, H-TTCOMP, [H-TTFREQ,] H-TTGEN, H-TTMED, H-TTMODE,
        H-TXCLIN, H-TXPROC, H-TXRES, H-TXSPEC, H-TXVAR,
        H-TESTVIEW, H-TRANSP, [H-TRIGGER,]
        H-VTENSE, H-VTEST.
—       SPECIAL-LISTS NEEDED FOR CONJUNCTION AND SELECTION RETSTRICTIONS

— HUMAN-LIST
—       USED IN $NHUMAN-CHK; CONTAINS LIST OF HUMAN SUBCLASSES FOR
—       THE SUBLANGUAGE, ADDED ONTO WORDS WHICH ARE ONLY NHUMAN, AND
—       NOT OTHERWISE SUBCLASSIFIED (E.G., 'PERSON', OR 'SHE').
LIST HUMAN-LIST =
        H-FAMILY, [H-DOCTOR,] H-PT.
— NEG-LIST
—       CONTAINS NEGATIVE ATTRIBUTE H-NEG FOR COMPUTED-ATTRIBUTE.
LIST NEG-LIST = H-NEG.
— NO-REP-LIST
—       CONTAINS 'NO-REP' TO DETERMINE IF QNUMBER SHOULD CAUSE COMPUTED
—       ATTRIBUTE FOR CERTAIN WORDS.
LIST NO-REP-LIST = NO-REP.
LIST VSENT-LIST = VSENT1,VSENT2,VSENT3.
LIST NONHUMAN-LIST = NONHUMAN.
LIST NUNIT-LIST = NUNIT.
LIST QNUMBER-LIST = QNUMBER.
LIST H-AGE-LIST = H-AGE.
LIST DOCTOR-LIST = H-INST [H-DOCTOR].
LIST PT-GENDER = FEM, MASC.
LIST PT-FAM = H-PT, H-FAMILY.
LIST CHANGEMK-LIST = H-CHANGEMK.
LIST REPT-LIST =
        H-TTGEN, H-PTVERB, H-TTCOMP, H-TXPROC, H-TTSURG.
— INCLUSION OF EMIFSTBL_100.TXT AT THU APR 7 13:32:38 2005
— MAJOR-FMT-CLASS
—       INDICATES THE MAJOR SUBLANGUAGE CLASSES WHICH PARTICIPATE
—       IN CENTRAL SLOTS -- PSTATE-DATA, PSTATE-SUBJ, TREATMENT, METHOD
—       AND TEST-INFO OF FORMAT4 -- OF FORMATS.
LIST MAJOR-FMT-CLASS =
        H-NEG, H-MODAL,
        H-ALLERGY, H-CHEM, [H-CELLTYPE, H-NOCLASS,]
        H-DIAG, H-DEVMED, H-INDIC, H-RESP, H-DESCR, H-NORMAL,
        E-WV, E-EKGPROC, E-LEAD, E-AX, E-INTVL [EKG],
        H-TXPROC, H-TXCLIN, H-TXSPEC, H-TXRES, H-TXVAR,
        H-TTSURG, H-TTCOMP, H-TTGEN, H-TTMED, H-TTMODE,
        H-PT, H-PTAREA, H-PTLOC, H-PTMEAS, H-PTPART, H-PTFUNC,
        H-TMBEG, H-TMEND, H-TMLOC, H-TMDUR, H-TMPREP, H-TMREP, [*970917*]
        H-PTSPEC, H-ORG.
LIST FORMAT-EQUIV-CLASS =
        (H-INDIC, H-DIAG, H-ALLERGY, H-DESCR, H-RESULT),
        (H-PTFUNC, [H-GROW,] H-PTMEAS).
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,E-EKGPROC,
        [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 FORMAT-LIST
—       CONTAINS CORRESPONDENCE BETWEEN SUBCLASS AND FORMAT SLOT.
—       SOME FORMAT SLOTS ARE APPLICABLE ONLY IF FORMAT IS A CERTAIN
—       TYPE. THEREFORE AN ENTRY ON FORMAT-LIST COULD BE
—       H-INDIC:(INDIC:(FORMAT5)), MEANING THAT AN LXR WHOSE CORE-SELATT
—       IS H-INDIC CORRESPONDS TO NODE INDIC IN FORMAT5. WHEN THE FORMAT
—       TYPE IS MISSING -- AS IN H-INST:(INST) -- THE SUBCLASS IS
—       TO BE FORMATTED REGARDLESS OF THE FORMAT TYPE ASSIGNED.
LIST FORMAT-LIST =
        FEM:(GENDER [FEMALE]),
        H-AGE:(AGE-MK),
        H-AMT:(QUANT),
        H-ALLERGY:(INDIC:(FORMAT5-ALG)),
        H-CONN:(VERB:(FORMAT5F,FORMAT5-EKG,FORMAT5-ALG,FORMAT5)),
        H-CHANGE:(EKG-MORPH:(FORMAT5-EKG)),
        H-CHANGE:(QUANT),
        H-CHANGE-MORE:(QUANT),
        H-CHANGE-LESS:(QUANT),
        H-CHANGE-SAME:(QUANT),
        [H-CELLTYPE:(QUALIFIERS:(FORMAT4,FORMAT5F,FORMAT5-EKG,]
        [ FORMAT5,FORMAT5-ALG,FORMAT1-3)),]
        H-DESCR:(EKG-MORPH:(FORMAT5-EKG)),
        H-DESCR:(QUALIFIERS:(FORMAT4,FORMAT5F,FORMAT5,FORMAT5-EKG,
        FORMAT1-3,FORMAT5-ALG,FORMAT13-MED)),
        E-EKGPROC:(PROCEDURE:(FORMAT5F,FORMAT5-EKG,FORMAT5)),
        E-LEAD:(IN-LEADS:(FORMAT5-EKG)),
        E-WV:(WAVE:(FORMAT5-EKG)),
        E-INTVL:(INTERVAL:(FORMAT5-EKG)),
        E-AX:(AXIS:(FORMAT5-EKG)),
        H-DEVMED:(PROCEDURE:(FORMAT5F,FORMAT5)),
        H-DEVMED:(MED-DEVICE:(FORMAT13-MED,FORMAT1-3)),
        H-DIAG:(DIAG:(FORMAT5F,FORMAT5-EKG,FORMAT5,FORMAT13-MED,FORMAT1-3,
        FORMAT4,FORMAT5-ALG)),
        H-FAMILY:(FAMILY:(FORMAT5F), SUBJECT:(FORMAT5F)),
        H-GEOGR:(INST),
        H-INDIC:(INDIC:(FORMAT5F,FORMAT5,FORMAT13-MED,FORMAT1-3,FORMAT4,
        FORMAT5-EKG,FORMAT5-ALG)),
        H-INST:(INST),
        H-NORMAL:(NORMAL),
        H-OBSERVE:(EXAMTEST:(FORMAT5F,FORMAT5-ALG,FORMAT5-EKG,FORMAT5),
        TESTRES:(FORMAT4)),
        H-ORG:(ORGANISM:(FORMAT4,FORMAT5-ALG)),
        H-PT:(SUBJECT:(FORMAT5F,FORMAT5-EKG,FORMAT5,FORMAT5-ALG,
        FORMAT13-MED,FORMAT1-3)),
        H-PT:(PT:(FORMAT4,FORMAT0,FORMAT6)),
        H-PTDESCR:(PRECISIONS),
        H-PTFUNC:(PTFUNC:(FORMAT5F,FORMAT5-ALG,FORMAT5-EKG,FORMAT5,
        FORMAT13-MED,FORMAT1-3)),
        H-PTFUNC:(PTPART:(FORMAT4 [*GRI*])),
        H-PTLOC:(PTPART),
        H-PTMEAS:(PTMEAS:(FORMAT5F,FORMAT5-ALG,FORMAT5-EKG,FORMAT5)),
        H-PTPART:(PTPART:(FORMAT5F,FORMAT5-ALG,FORMAT5-EKG,FORMAT5,
        FORMAT13-MED,FORMAT1-3,FORMAT4)),
        H-PTSPEC:(PTPART:(FORMAT4 [*GRI*])),
        H-PTAREA:(PTPART:(FORMAT5F,FORMAT5-ALG,FORMAT5-EKG,FORMAT5,
        FORMAT13-MED,FORMAT1-3,FORMAT4)),
        H-ETHNIC:(RACE),
        H-DIET:(INFLUENCE:(FORMAT5F,FORMAT5-ALG,FORMAT5-EKG,FORMAT5,
        FORMAT13-MED,FORMAT1-3)),
        H-RECORD:(PARAGR [* Consultation Note *]),
        H-RESP:(TXRES:(FORMAT5F,FORMAT5-ALG,FORMAT5-EKG,FORMAT5)),
        H-RESP:(TTRES:(FORMAT13-MED,FORMAT1-3)),
        H-SHOW:(VERB:(FORMAT5F,FORMAT5-ALG,FORMAT5-EKG,FORMAT5)),
        [H-TMREP:(PRECISIONS:(FORMAT5F,FORMAT5,FORMAT13-MED,FORMAT1-3)),]
        [H-TMDUR:(PRECISIONS:(FORMAT5F,FORMAT5,FORMAT13-MED,FORMAT1-3)),]
        H-TMDUR:(TM-PERIOD), [7.28.92]
        H-TMREP:(TM-REPETITION), [7.28.92]
        H-TTSURG:(SURG:(FORMAT1-3)),
        H-TTSURG:(SPEC-ACCESS:(FORMAT4)),
        H-TTSURG:(PROCEDURE:(FORMAT5)),
        H-TTCOMP:(COMP:(FORMAT13-MED,FORMAT1-3)),
        H-TTGEN:(VERB:(FORMAT4 [* check his thyroid function *])),
        H-TTGEN:(GEN:(FORMAT13-MED,FORMAT1-3,FORMAT5,FORMAT5F,
        FORMAT5-EKG,FORMAT5-ALG)),
        H-TTMED:(MED:(FORMAT13-MED,FORMAT1-3,FORMAT5-ALG)),
        H-TTMODE:(MED:(FORMAT13-MED,FORMAT1-3)),
        H-TXCLIN:(EXAMTEST:(FORMAT5F,FORMAT5-EKG,FORMAT5)),
        H-TXPROC:(PROCEDURE:(FORMAT5F,FORMAT5-EKG,FORMAT5)),
        H-TXRES:(TESTRES:(FORMAT4)),
        H-TXRES:(EKG-MORPH:(FORMAT5-EKG)),
        H-TXRES:(TXRES:(FORMAT5F,FORMAT5)),
        H-TXSPEC:(TXSPEC:(FORMAT4)),
        H-TXVAR:(TXVAR:(FORMAT4)),
        MASC:(GENDER [MALE]), [*GRI*]
        'A2':(VERB:(FORMAT1-3)),
        'FOR':(VERB:(FORMAT5F,FORMAT5-ALG,FORMAT5-EKG,FORMAT5,
        FORMAT13-MED,FORMAT1-3)),
        'POUR':(VERB:(FORMAT5F,FORMAT5-EKG,FORMAT5,
        FORMAT13-MED,FORMAT1-3)).
— SLOT-LIST: NODES IN FORMAT THAT ARE CHILDREN OF MAIN NODE-
—       PSTATE-DATA HAS INDIC,QUANT,DESCR,... UNDER IT.
LIST SLOT-LIST =
        MED-TR:(MED,RXDOSE,RXMANNER,RXFREQUENCY,VERB-TR),
        AGENTS:(MED,ORGANISM,ALLIFE),
        METHOD:(PROCEDURE,EXAMTEST),
        TREATMENT:(GEN,SURG,MED,COMP,MED-DEVICE),
        EKG-SUBJ:(WAVE,INTERVAL,AXIS),
        EKG-DATA:(QUANT,EKG-MORPH,DIAG,INDIC,NORMAL),
        PSTATE-SUBJ:(PT,FAMILY,PTPART,PTFUNC,PTMEAS[,SUBJ-OTHER]),
        PSTATE-DATA:(DIAG,INDIC,NORMAL,[DESCR,STATUS,]TTRES,TXRES,
        INFLUENCE,QUALIFIERS,QUANT [,PTSTATE-OTHER]),
        RESULT:(DIAG,INDIC,TESTRES,ORGANISM,NORMAL,QUANT),
        PRECISIONS:(MORE-PREDS),
        [GENDER:(MALE,FEMALE)]
        TIME-QUALS:(TM-PERIOD,TM-REPETITION) [7.28.92].
— MODIFIER-LIST
—       LIST OF FORMAT MODIFIER, SUBCLASS CORRESPONDING TO THAT
—       MODIFIER, AND CORRESPONDING FORMAT SLOT IN MODIFIER.
—       AN LXR WHOSE CORE-SELATT IS H-TMBEG IS A TIME-ASP MODIFIER,
—       AND SHOULD BE ASSIGNED TO FORMAT SLOT BEG IN TIME-ASP.
LIST MODIFIER-LIST =
        TIME-QUAL: (H-TMDUR:(TM-PERIOD),H-TMREP:(TM-REPETITION)),
        EVENT-TIME: (H-TMLOC:(TPREP2), NTIME2:(TPREP2),
        H-RECORD:(TPREP2)),
        MODS:(H-MODAL:(MODAL),
        H-NEG:(NEG)),
        TENSE:(H-VTENSE:(TENSE)),
        TIME-ASP:(H-TMBEG:(BEG),
        H-TMEND:(END)),
        Y-OF:(H-TRANSP:(Y-OF)).
— HOST-OF-MODIFIERS
—       FOR EACH MODIFIER, LISTS FORMAT SLOTS WHICH CAN
—       HAVE THAT PARTICULAR MODIFIER.
LIST HOST-OF-MODIFIERS =
        TIME-QUAL:(SENT-OP,VERB,VERB-MD,VERB-TR,EXAM-FUNC,PSTATE-DATA,
        EXAMTEST,TXRES,TTRES,TESTRES [?],STATUS,RESPONSE,
        BEG,INFLUENCE,CHANGE-MK,END,EKG-DATA,
        TEST-INFO,RESULT,MED,MODS,OBJECT), [*GRI*]
        EVENT-TIME:(SENT-OP,VERB,VERB-MD,VERB-TR,EXAM-FUNC,PSTATE-DATA,
        EXAMTEST,TXRES,TTRES,TESTRES [?],STATUS,RESPONSE,
        BEG,INFLUENCE,CHANGE-MK,END,INST,PRECISIONS,EKG-DATA,
        PROCEDURE,TEST-INFO,RESULT,MED,SURG,MODS,OBJECT),
        TIME-ASP:(SENT-OP,VERB,VERB-MD,VERB-TR,EXAMTEST,PSTATE-DATA,
        PTFUNC,PTMEAS,PTPART,TXRES,TTRES,TESTRES [?],
        BEG,INFLUENCE,CHANGE-MK,END,EKG-DATA,
        RESPONSE,STATUS,
        TEST-INFO,RESULT,MED,MODS,OBJECT),
        TENSE:(VERB,VERB-TR,VERB-MD [,SURG,MED,GEN,COMP]),
        MODS:(SENT-OP,VERB,VERB-MD,VERB-TR,EXAMTEST,PSTATE-DATA,
        STATUS,RESPONSE,EKG-DATA,
        TEST-INFO,RESULT,TIME-ASP,MODS,OBJECT,TXRES,TTRES,
        TESTRES [?]),
        BP-MOD:(MED,PROCEDURE,TXRES,TTRES,TESTRES,DIAG,INDIC,INTERVAL,BP-MOD).
— MOD-CLASS
—       LIST OF MODIFIER SUBCLASSES - WORDS WITH THESE SUBCLASSES MAP
—       INTO MODIFIER FIELDS IN THE FORMATS.
LIST MOD-CLASS =
        H-AMT, H-TMBEG, H-TMEND, H-MODAL, H-EVID, H-NEG, H-TMREP,
        H-TMDUR, H-CHANGE, H-CHANGE-MORE, H-CHANGE-LESS, H-CHANGE-SAME,
        H-TRANSP, NUNIT, H-PTAREA, H-PTPART, H-PTLOC,
        H-CHANGEMK, QNUMBER, NTIME1, NTIME2, H-VTENSE, H-TMLOC.
— TIME-MOD-CLASSES
—       LIST OF SUBCLASSES WHICH FORMAT INTO TIME OR MODIFIER SLOTS.

LIST TIME-MOD-CLASSES =
        H-TMBEG, H-CHANGE, H-CHANGE-MORE, H-CHANGE-LESS, H-CHANGE-SAME,
        H-TMEND, H-EVID, H-MODAL,
        H-NEG, H-OBSERVE, H-TMDUR, H-TRANSP,
        H-TMLOC, NTIME1.
LIST TIME-MODS-LIST =
        NTIME1, NTIME2, H-TMBEG, H-TMEND, H-TMLOC, H-TMDUR, H-TMREP.
LIST PTPART-SLOT =
        H-PTPART, H-PTAREA, H-PTLOC.
LIST PTPART-F4-SLOT =
        H-PTPART, H-PTAREA, H-PTLOC, H-PTSPEC, H-PTFUNC.
— INCLUSION OF EMREGTBL_100.TXT AT THU APR 7 13:32:38 2005
— 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 HOSTS-OF-QUANT =
        NUNIT, H-TXVAR, H-INDIC, H-RESP, H-PTPART, H-PTMEAS,
        H-PTFUNC [2/1/89], H-NORMAL [has cleared considerably],
        H-TXRES, H-TTMED, H-DIAG [* GRI *].
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 OPERATOR-LIST = NSENT1,NSENT2,NSENT3,ASENT1,ASENT3,VSENT1,
        VSENT2,VSENT3,VSENT4.
LIST TRANSP-LIST =
        H-AMT, H-TMBEG, H-CHANGE, H-CHANGE-MORE, H-CHANGE-LESS,
        H-CHANGE-SAME, H-TMEND, H-EVID,
        H-MODAL, H-NEG, H-OBSERVE, H-TMDUR, H-TMREP, H-TRANSP.
LIST TIME-ADVERB-LIST = TIME-ADVERBIAL.
— MULTI-ENTRY
—       LIST OF FORMAT SLOTS WHICH CAN CORRESPOND TO MORE THAN
—       ONE PARSE TREE NODE - I.E. MORE THAN ONE NON-EMPTY ELEMENT
—       EACH ONE POINTING TO A DIFFERENT PARSE TREE NODE.
LIST MULTI-ENTRY =
        INST, REPT, REF-PT, NON-NUM, RXFREQUENCY,
        TIME-QUALS, TIMEPER, TENSE, VERB, VERB-MD,
        [* New Additions *]
        EXAMTEST, TXRES, TXSPEC, DIAG, INDIC, NORMAL, PROCEDURE,
        GEN, SURG, MED-DEVICE, PTFUNC, PTPART, QUANT, SUBJECT,
        COMP, MED, TXVAR [Level 5], SPEC-ACCESS, ORGANISM, INFO-SOURCE,
        ALLIFE,
        IN-LEADS [EKG], EVENT-TIME [for TIME-PHRASE's].
— MOD-LIST: LIST OF SLOTS IN MOD MODIFIER.
LIST MOD-LIST = NEG, MODAL, FACTUAL, MODS-OTHER.
— FORMAT-TYPES: THE NAMES OF THE DIFFERENT FORMATS, INCLUDING CONNECTIVE.
LIST FORMAT-TYPES =
        PATH-I-F, FORMAT00, FORMAT0, FORMAT1, FORMAT2, FORMAT3,
        FORMAT13-MED, FORMAT5-MISC, FORMAT5-EKG,
        FORMAT1-3, FORMAT4, FORMAT5, FORMAT5F, FORMAT5-ALG, FORMAT6, CONNECTIVE.
— ONE-ELEMENT: THESE NODES HAVE SEVERAL ELEMENTS BUT ONLY ONE OF THESE
—       ELEMENTS CAN BE 'FILLED' (CAN CORRESPOND TO A PARSE TREE NODE)
—       FOR EX. PSTATE-DATA HAS INDIC + DIAG + NORMAL +... BUT ONLY ONE OF
—       THOSE NODES CAN CORRESPOND TO A PARSE TREE NODE.
LIST ONE-ELEMENT = [PSTATE-DATA, PSTATE-SUBJ,] SUBJECT, OBJECT.
— CONJ-NUMBERS
—       USED TO LINK CONJUNCTION WITH ITS ARGUMENT VIA CONJ-LINK.
LIST CONJ-NUMBERS =
        C01, C02, C03, C04, C05, C06, C07, C08, C09, C10,
        C11, C12, C13, C14, C15, C16, C17, C18, C19, C20.
— MODAL-LIST
—       CONTAINS MODAL ATTRIBUTE H-MODAL FOR CONSTRUCTION OF SELECT-ATT.
LIST MODAL-LIST = H-MODAL.
— END OF LISTS USED BY SUBLANGUAGE SELECTION RESTRICTIONS

— TYPE LISTS

TYPE ADJSET =
        LA, LCDA, LCDN, LCDVA, LCS, LDATE, LN, LNAME, LP, LPRO, LQ,
        LT, LV, LVSA, LW, LAUX,
        RA, RA1, RD, RDATE, RN, RNAME, RQ, RV, RW,
        SA,
        [** CONN GRAMMAR NODES **]
        LCONN, LD, LTIME, RCONN, RP, QUAL.
TYPE ADJSET1 =
        AND-ORSTG, ANDSTG, ASSTG, [AS-WELL-AS-STG,] BOTHSTG, BUTSTG,
        COLONSTG, COMMASTG, DASHSTG, EGSTG, EITHERSTG, ESPECIALLY-STG,
        LA, LCDA, LCDN, LCDVA, LCS, LD, LDATE, LN, LNAME, LP, LPRO, LQ,
        LT, LV, LVSA, LW, LAUX,
        NEITHERSTG, NORSTG, ORSTG, PARENSTG, PARTICULARLY-STG,
        QNREP, QUOTESTG,
        RA, RA1, RD, RDATE, RN, RNAME, RQ, RV, RW, RWV,
        SA,
        THANSTG, TOSTG, VERSUSSTG,
        [** CONN GRAMMAR NODES **]
        LCONN, RCONN, RP.
        [* TYPE RNOPTSET IS REMOVED *]
TYPE CONJ-NODE = ANDSTG, ANDORSTG, ASWELLASSTG, BUTSTG, COMMASTG,
        INADDITIONTOSTG, INCLUDINGSTG, ORSTG, NORSTG,
        PARTICULARLY-STG, PLUSSTG, WITHSTG, THANSTG,
        [FRENCH] DMQSTG, NISTG, PUISSTG, AINSIQUESTG.
TYPE SCOPE-NODE = BOTHSTG, EITHERSTG, NEITHERSTG, NISTG.
TYPE SP-NODE = ANDSTG, ANDORSTG, ASWELLASSTG, BUTSTG, COMMASTG,
        INADDITIONTOSTG, INCLUDINGSTG, ORSTG, NORSTG,
        PARTICULARLY-STG, PLUSSTG, WITHSTG, THANSTG,
        [FRENCH] DMQSTG, NISTG, PUISSTG, INTSTG, AINSIQUESTG.
TYPE LADJSET =
        LA, LCDA, LCDN, LCDVA, LCS, LDATE, LN, LNAME, LP, LPRO, LQ,
        LT, LV, LVSA, LW, LAUX,
        [** CONN GRAMMAR NODES **]
        LCONN, LD, LTIME.
TYPE LXR =
        LAR, LAR1, LDATER, LDR, LNAMER, LNR, LNSR, LQR, LQNR, LTR,
        LTVR, LVENR, LVINGR, LVR, TENSE, VERB, LLEADR [ekg], LWVR [ekg],
        [** CONN GRAMMAR NODES **]
        LCONNR, LPR.
TYPE MINLIST = PN, D, SUB1, NSTGT, INT, PDATE, TOVO, PVO.
— MODIFIERS: NAME OF FORMAT SLOT MODIFIERS.
TYPE MODIFIERS = TIME-ASP, MODS, BP-MOD, QUANTITY, EVENT-TIME,
        TENSE, Y-OF, TIME-QUAL [*GRI*].
TYPE N-OBJ-IN-STR = [N OR PN OBJECTS OF TYPE STRING]
        ADJN, DP2, DP3, DP4, DP1PN, DP2PN, DP3PN, DP4PN, NA, NASOBJBE,
        ND, NN, NPDOSE, NPN, NPSNWH, NPSVINGO, NPVINGO, NPVINGSTG,
        NSNWH, NTHATS, PN, PNN, PNSNWH, PNTHATS, PNTHATSVO, PNVINGSTG,
        VINGSTGPN, PNX2.
TYPE PSTRING =
        PD, PN, PQUANT, PVINGSTG, PSVINGO, PSNWH, PVINGO.
— MED TYPES.
TYPE ADJAUX = RNWH, NSTGT, CSSTG, RSUBJ, RNSUBJ, SAWH, SN, SNWH.
TYPE N-OMITTING-WH-STRING =
        FORTOVO-N, SAWHICHSTG, S-N, THATS-N, TOVO-N, WHATS-N, WHEVERS-N,
        WHNQ-N, WHNS-N, WHQ-N, WHS-N.
— MED UPDATE
TYPE PDPOBJECT =
        DP1, DP2, DP3, DP4, DPSN,
        DP1PN, DP2PN, DP3PN, DP4PN, DP1P,
        NPN, NPSNWH, NPSVINGO, NPVINGO, NPVINGSTG,
        P1, PN, PNN, PNX2, PNTHATS, PNTHATSVO, PNSNWH, PNVINGSTG,
        PSNWH, PSVINGO, PVINGO, PVINGSTG,
        VINGSTGPN.
TYPE PN-OMITTING-WH-STG =
        PWHNQ-PN, PWHNS-PN, PWHQ-PN, PWHS-PN.
TYPE RADJSET=
        RA, RA1, RD, RDATE, RN, RNAME, RNOPTS, RQ, RT, RV, RW,
        RWV [ekg], RWVOPTS [ekg], RLEAD [ekg],
        [** CONN GRAMMAR NODES **]
        RCONN, RP.
TYPE RECURSIVE = TPOS, ADJADJ, NNN, RN, SA, LDR.
TYPE REPETITIVE = RN, RV.
TYPE STGSEG = ASSERTION, TOVO, VINGO, QN, PVO, SVO.
— MED UPDATE IN LAST 6 DEFINITIONS
TYPE STRING =
        ADJINRN, ADJN, APPOS, ASOBJBE, ASSERTION,
        BEINGO, BPART, C1SHOULD, CPDNUMBR,
        DP1, DP2, DP3, DP4, DP1P, DP1PN, DP2PN, DP3PN, DP4PN, DPSN,
        [ETCSTG,] FORTOVO, FORTOVO-N,
        HOWQASTG, HOWQSTG,
        IMPERATIVE,
        LN,
        NA, NASOBJBE, ND, NN, NPN, NPSNWH, NPSVINGO, NPVINGO, NPVINGSTG,
        NQ, NSNWH, NSTGT, NSVINGO, NTHATS, NTOBE, NUMBRSTG, NVSA, NTOVO,
        OBES, OBJBESA, PTIME [* 09/13/2001 *],
        P1, PA, PD, PDATE, PN, PNN, PNSNWH, PNTHATS, PNTHATSVO, PNVINGSTG,
        PROSENT, PQUANT, PSNWH, PSVINGO, PVINGO, PVINGSTG, PWHNQ,
        PWHNQ-PN, PWHNS, PWHNS-PN, PWHQ, PWHQ-PN, PWHS-PN, PARENSTG,
        Q-ASSERT, Q-CONJ, Q-INVERT, Q-PHRASE, QN, QNS, Q-OF, QPERUNIT,
        S-N, SASOBJBE, SAWHICHSTG, SENTENCE, SOBJBE, SOBJBESA, STOVO-N,
        SUB0, SUB1, SUB2, SUB3, SUB4, SUB5, SUB6, SUB7, SUB8, SUB9, SUB11,
        SUB12, SUB13, SVEN, SVINGO, SVO,
        THATS, THATS-N, TOBE, TOVO, TOVO-N, TSUBJVO,
        VENO, VENPASS, VINGO, VINGOFN, VINGSTGPN, VO,
        WHATS-N, WHENS, WHERES, WHETHS, WHETHTOVO, WHEVERS-N, WHNQ-N,
        WHNS-N, WHQ, WHQ-N, WHS-N,
        YESNOQ,
        [*** FRAGMENT GRAMMAR NODES ***]
        ASTGF, ASTGP, NSTGP, [* snopath *]
        BESHOW, FRAGMENT, MEDDOSE, NSTGF, NPDOSE, ONESENT, PDOSE,
        TVO, NPVO, PVO,
        PWHS, WHOSES, PNX2
        [*** FRENCH ***]
        [ENVINGO, FTIME, NPWHS, NVINGO, PNPVO, PNVO, PVO-N, SUB10].
TYPE TRANSMITTING-OBJ-STG =
        ASSERTION, C1SHOULD, DP2, FORTOVO-N, NA, ND, NN, NPN, NPSNWH,
        NPSVINGO, NPVINGO, NPVINGSTG, NTHATS, PN, PNTHATSVO,
        PSVINGO, PVINGO, PVINGSTG, TOVO, SASOBJBE, SOBJBE, SVEN, SVO,
        THATS, VENO, VENPASS, VINGO, WHETHS,
        PVO.
TYPE VERBAL = LVR, LVENR, LVINGR, VERB.
— CT-DB-FIELDS CONTAINS NODES THAT CORRESPOND TO
—       INGRES/INFORMIX FIELD NAMES.
TYPE CT-DB-FIELDS =
        PT-DEMOG, AGE, GENDER, [MALE, FEMALE,]
        CONN, CONJOINED, RELATION, PREP-CONN,
        REL-CLAUSE, TIME-CONJ, SUB-CONJ, EMBEDDED,
        CHANGE, CHANGE-MK, BEG, END, TM-PERIOD, TM-REPETITION,
        TPREP1, TPREP2, REF-PT, Q-N, NUM, NON-NUM, UNIT, PERUNIT,
        RXDOSE, RXMODE, RXMANNER, RXFREQUENCY, MED-DEVICE,
        PROCEDURE, EXAMTEST, GEN, SURG, MED, COMP, SUBJECT,
        VERB, NEG, MODAL, DIAG, INDIC, TXRES, QUANT, NORMAL,
        PTPART, PTFUNC, PTMEAS, PRECISIONS [MORE-PREDS], TIME-QUALS,
        TIME-LOCS, TESTRES, TTRES, TXVAR, TXSPEC, ORGANISM, INFLUENCE,
        ALLIFE,
        TREATMENT, METHOD, PSTATE-DATA, PSTATE-SUBJ, TEST-INFO, TEST-ENV,
        EKG-DATA, EKG-SUBJ, WAVE, INTERVAL, AXIS, EKG-MORPH, IN-LEADS,
        SPEC-ACCESS,INFO-SOURCE, EVENT-TIME, QUALIFIERS.
TYPE CONN-DB-FIELDS =
        CONN, CONJOINED, RELATION, PREP-CONN,
        REL-CLAUSE, TIME-CONJ, SUB-CONJ, EMBEDDED.
TYPE MAJOR-DB-FIELDS =
        SUBJECT, VERB, PRECISIONS, TIME-QUALS, TIME-LOCS,
        PT-DEMOG, GENDER, INFO-SOURCE, EKG-DATA, EKG-SUBJ, IN-LEADS,
        TREATMENT, METHOD, PSTATE-DATA, PSTATE-SUBJ, TEST-INFO.
TYPE MOD-DB-FIELDS =
        CHANGE, CHANGE-MK, BEG, END, TM-PERIOD, TM-REPETITION,
        NEG, MODAL,
        TPREP1, TPREP2, REF-PT, Q-N, NUM, NON-NUM, UNIT, PERUNIT,
        RXDOSE, RXMODE, RXMANNER, RXFREQUENCY.
TYPE MAJOR-MODIFIERS =
        TIME-QUAL, EVENT-TIME, TIME-ASP, TENSE, MODS, BP-MOD.
— TRANFORMATION TYPES.
TYPE EXPAND-STR =
        TOBE, PVO, TOVO, VENO, VENPASS, VINGO, VO.
TYPE STRING-TO-ASSERT =
        ASSERTION, FORTOVO, FRAGMENT, IMPERATIVE, NSVINGO,
        NPVO, SASOBJBE, SOBJBE, SVINGO, NTOBE, NTOVO.
TYPE STATEMENT-EQV-NODES =
        [* Nodes which are equivalent to a format statement *]
        NPWHS, PVO, PVO-N, PWHS, QUANT, VINGO, WHENS, WHS-N.
— ********** **************************************** **********
—       *
—       ROUTINES *
—       *
— ********** **************************************** **********

ROUTINE COEL1-(X) =
        [* GIVEN THAT X AND Y ARE ELEMENTS OF SOME STRING. COEL1- ]
        [* STARTS AT Y AND GOES LEFT OR RIGHT TO X. HOWEVER IF X ]
        [* IS IN A STRING SEGMENT COEL1- WILL NOT GO TO X (COELEMENT ]
        [* ROUTINE DOES IT).IN A SITUATION X1Y1 CONJ X2Y2, COEL1 ]
        [* STARTING AT Y2 WILL GO TO X2. AND IN A SITUATION XY1 CONJ ]
        [* Y2 COEL1- STARTING AT Y2 WILL GO TO X.]
        EITHER $LEFT-OR-RIGHT
        OR ITERATE $TO-PRECONJUNCTION-Y UNTIL $LEFT-OR-RIGHT SUCCEEDS.
   $LEFT-OR-RIGHT =
        EITHER DO L (X) OR DO R (X).
   $TO-PRECONJUNCTION-Y =
        EITHER $PRECONJ OR $ASSIGN-PRECONJELEM. (GLOBAL)
   $PRECONJ =
        THE PRESENT-ELEMENT- HAS NODE ATTRIBUTE PRECONJELEM. (GLOBAL)
   $ASSIGN-PRECONJELEM =
        VERIFY $LOCATE-CONJNODE;
        VERIFY $ASSIGN-PRE-AND-POST [PRE-POST-CONJELEM];
        DO $PRECONJ.
   $LOCATE-CONJNODE =
        ASCEND TO Q-CONJ; GO UP; STORE IN X100.
ROUTINE COEL1(X) =
        [* COEL1(X) IS THE STACKING COUNTERPART OF COEL1-. IN A ]
        [* SITUATION (X1 CONJ X2)Y , STARTING AT Y COEL1 GOES TO ]
        [* X1 AND STACKS X2. IN A SITUATION X1Y1 CONJ X2Y2, COEL1 ]
        [* STARTING AT Y1 WILL GO TO X1 AND WILL NOT STACK X2. IF ]
        [* THE PARSE TREE IS X(Y1 CONJ Y2), STARTING AT EITHER Y1 ]
        [* OR Y2 COEL1 GOES TO X.]
        STORE IN X200;
        EITHER $LEFT-OR-RIGHT
        OR ITERATE $TO-PRECONJUNCTION-Y UNTIL $LEFT-OR-RIGHT SUCCEEDS.
   $LEFT-OR-RIGHT =
        EITHER $LEFT-TO-X OR $RIGHT-TO-X.
   $LEFT-TO-X =
        DO L (X); DO STACK-FOR-LEFT.
   $RIGHT-TO-X =
        DO R (X); DO STACK-FOR-RIGHT.
ROUTINE COELEMENT-(X) =
        [* GIVEN THAT X AND Y ARE ELEMENTS OF SOME STRING COELEMENT- ]
        [* STARTS AT Y AND GOES TO X. IF X IS IN A STRING SEGMENT ]
        [* COELEMENT- WILL GO ONE LEVEL BELOW THE STRING SEGMENT TO ]
        [* FIND X.]
        EITHER DO COEL1-(X) OR $STRING-SEGMENT.
   $STRING-SEGMENT = DO COEL1-(STGSEG); DO ELEMENT-(X).
ROUTINE COELEMENT(X) =
        [* THE STACKING COUNTERPART OF COELEMENT-. IF X IS IN A ]
        [* STRING SEGMENT SEG,COELEMENT WILL FIRST GO TO SEG AND ]
        [* STACK THE CONJUNCTS OF SEG IF THERE ARE ANY. COELEMENT ]
        [* WILL THEN GO TO X ONE LEVEL BELOW SEG. IF X HAS ANY ]
        [* CONJUNCTS THEY WILL BE STACKED. IF X IS NOT IN A STRING ]
        [* SEGMENT THEN COELEMENT IS THE SAME AS COEL1.]
        EITHER DO COEL1(X) OR $STRING-SEGMENT.
   $STRING-SEGMENT = DO COEL1(STGSEG); DO ELEMENT(X).
ROUTINE CORE- =
        [* LOOKS FOR AN ATOMIC NODE OR STRING NODE WHICH IS EITHER ]
        [* THE NODE CURRENTLY BEING 'LOOKED AT' OR ONE THAT LIES ]
        [* BELOW THIS NODE. THE DESCENT DOES NOT PASS THROUGH NODES ]
        [* ON THE LIST ADJSET1.]
        DO $CORE-PATH. (GLOBAL)
   $CORE-PATH =
        ONE OF $AT-ATOM,
   $DESCEND-TO-ATOM,
   $DESCEND-TO-STRING IS TRUE.
   $AT-ATOM = TEST FOR ATOM.
   $DESCEND-TO-ATOM =
        IF PRESENT-ELEMENT- IS APOS OR NPOS
        THEN GO DOWN;
        DESCEND TO ATOM NOT PASSING THROUGH ADJSET1.
   $DESCEND-TO-STRING =
        DESCEND TO STRING NOT PASSING THROUGH ADJSET1;
        IF TEST FOR LN
        THEN $RIGHT-TO-CORE
        [IF TEST FOR QN]
        [THEN $QN-CORE].
   $RIGHT-TO-CORE =
        ITERATE GO RIGHT UNTIL TEST FOR CONJ-NODE FAILS;
        DO CORE- .
   $QN-CORE =
        GO DOWN;
        ITERATE GO RIGHT UNTIL TEST FOR N SUCCEEDS.
ROUTINE CORE =
        [* THE CORE ROUTINE IS THE STACKING COUNTERPART OF CORE-. ]
        [* THE CORE MAY HAVE SEVERAL VALUES BECAUSE OF CONJUNCTION. ]
        [* IF AN ELEMENT X1 OF AN LXR TYPE STRING HAS CONJUNCTS X2, ]
        [* X3, THEN THE CORE OF X2, X3, ETC. IS STACKED.]
        DO $CORE-PATH;
        VERIFY $TO-X-POS-IN-LXR.
   $TO-X-POS-IN-LXR =
        EITHER $ASCNT OR TRUE;
        DO $STACK-CORE-TEST.
   $ASCNT = GO UP;
        TEST FOR AVAR OR NVAR OR QVAR OR VVAR OR WVVAR OR
        LEADVAR OR DATEVAR OR HEADCONN OR LNAMER OR NQ;
        IF PRESENT-ELEMENT- IS LNAMER OR NQ
        THEN IMMEDIATE-NODE OF IMMEDIATE-NODE IS NVAR.
   $STACK-CORE-TEST = IF $POSTCONJ THEN $STACK-CONJUNCTS.
   $POSTCONJ = THE PRESENT-ELEMENT- HAS NODE ATTRIBUTE POSTCONJELEM.
   $STACK-CONJUNCTS = VERIFY ITERATE $STACK-CORES.
   $STACK-CORES = DO $POSTCONJ;
        STORE IN XX-CORE;
        DO $CORE-PATH;
        STACK;
        GO TO XX-CORE.
ROUTINE DOWN1-(X) =
        [* TESTS WHETHER X IS AN ELEMENT WHICH IS ONE LEVEL BELOW THE ]
        [* NODE THE PROGRAM IS CURRENTLY 'LOOKING AT'.]
        GO DOWN;
        ITERATET GO RIGHT UNTIL TEST FOR X SUCCEEDS.
ROUTINE DOWN1(X) =
        [* DOWN1 IS THE STACKING COUNTERPART OF DOWN1-. IF X HAS ]
        [* CONJUNCTS THEY ARE PLACED ON A RE-EXECUTION STACK.]
        DO DOWN1-(X); DO $STACK-TEST.
   $STACK-TEST = IF $POSTCONJ THEN $STACK-CONJUNCTS.
   $STACK-CONJUNCTS = VERIFY ITERATE $STACK-X.
   $STACK-X = DO $POSTCONJ; STACK.
ROUTINE ELEMENT-(X) =
        [* TESTS WHETHER X IS AN ELEMENT ONE LEVEL BELOW THE NODE THE ]
        [* PROGRAM IS CURRENTLY 'LOOKING AT'. IF NOT, AND A STRING ]
        [* SEGMENT IS ONE LEVEL BELOW THE CURRENT NODE THE SEARCH ]
        [* CONTINUES ONE LEVEL BELOW THE STRING SEGMENT NODE.]
        EITHER DO DOWN1-(X) OR $STRING-SEGMENT.
   $STRING-SEGMENT = DO DOWN1-(STGSEG); DO DOWN1-(X).
ROUTINE ELEMENT(X) =
        [* ELEMENT(X) IS THE STACKING COUNTERPART OF ELEMENT-(X). IF ]
        [* ELEMENT X GOES TO X1 AND X1 HAS CONJUNCTS X2,X3,ETC THEN X2, ]
        [* X3, ETC ARE PLACED ON THE RE-EXECUTION STACK.IF X1 IS ]
        [* IN A STRING SEGMENT S AND S HAS CONJUNCTS THEN THEY ]
        [* ARE PLACED IN THE RE-EXECUTION STACK.]
        EITHER DO DOWN1(X) OR $STRING-SEGMENT.
   $STRING-SEGMENT = DO DOWN1(STGSEG); DO DOWN1(X).
ROUTINE FOLLOWING-ELEMENT- =
        [* GOES RIGHT TO THE FIRST NODE WHICH IS NOT SP-NODE.]
        DO $RIGHT-TO-HOST [HOST-ELEMENT].
ROUTINE FOLLOWING-ELEMENT =
        [* FOLLOWING-ELEMENT IS THE STACKING COUNTERPART OF ]
        [* FOLLOWING-ELEMENT-. IT GOES TO THE ]
        [* FOLLOWING-ELEMENT- AND STACKS IT'S CONJUNCTS.]
        STORE IN X200;
        DO $RIGHT-TO-HOST [HOST-ELEMENT];
        DO STACK-FOR-RIGHT.
ROUTINE HOST- =
        [* GOES TO THE CORE OF HOST-ELEMENT ]
        CORE- OF HOST-ELEMENT EXISTS.
ROUTINE HOST =
        EITHER TEST FOR ADJSET OR ASCEND TO ADJSET;
        ONE OF $IN-LADJSET, $IN-RADJSET, $IN-RNSUBJ;
        DO $CORE-PATH .
   $IN-LADJSET =
        DO $AT-LADJ [HOST-ELEMENT];
        DO STACK-FOR-RIGHT.
   $IN-RADJSET =
        DO $AT-RADJ [HOST-ELEMENT];
        DO STACK-FOR-LEFT.
   $IN-RNSUBJ =
        DO $ATRNSUBJ[HOST-ELEMENT];
        DO $STACK-TEST [STARTAT].
ROUTINE HOST-ELEMENT =
        [* STARTS AT OR ASCENDS TO LADJSET OR RADJSET OR RNSUBJ Y. ]
        [* IF Y IS OF TYPE RADJSET OR LADJSET IT GOES TO THE CORE ]
        [* ELEMENT X (TO X IN AN LXR TYPE NODE). IF Y IS RNSUBJ IT ]
        [* ASCENDS TO SA AND THEN GOES TO COELEMENT SUBJECT. ]
        [* ** FRENCH CHANGE IN $AT-RADJ ** *]
        EITHER TEST FOR ADJSET OR ASCEND TO ADJSET PASSING THROUGH ADJINRN;
        ONE OF $AT-LADJ, $AT-RADJ, $ATRNSUBJ IS TRUE.
   $AT-LADJ =
        TEST FOR LADJSET;
        STORE IN X200;
        DO $RIGHT-TO-HOST .
   $RIGHT-TO-HOST =
        EITHER $GO-RIGHT-PAST-C
        OR ITERATE $TO-PRECONJUNCTION-Y [COEL1-]
        UNTIL $GO-RIGHT-PAST-C SUCCEEDS.
   $GO-RIGHT-PAST-C = ITERATE GO RIGHT UNTIL TEST FOR SP-NODE FAILS.
   $AT-RADJ =
        EITHER $IN-RN OR $IN-OTHERS;
        STORE IN X200;
        EITHER $RV-TEST OR $LEFT-TO-HOST.
   $IN-RN =
        TEST FOR RN;
        STORE IN X100;
        GO LEFT;
        IF PRESENT-ELEMENT- IS RNOPTS THEN DO $1;
        GO TO X100.
   $1 = GO UP; DO $IN-RN.
   $IN-OTHERS = TEST FOR RADJSET.
   $RV-TEST =
        TEST FOR RV;
        STORE IN X100;
        ONE OF $L-VVAR, $L-V, $L-VING, $L-VEN.
   $L-VVAR = DO L(VVAR).
   $L-V = DO L(V).
   $L-VING = DO L(VING).
   $L-VEN = DO L(VEN).
   $LEFT-TO-HOST =
        EITHER $LEFT-PAST-C
        OR ITERATE $TO-PRECONJUNCTION-Y [COEL1]
        UNTIL $LEFT-PAST-C SUCCEEDS.
   $LEFT-PAST-C = ITERATE GO LEFT UNTIL TEST FOR SP-NODE FAILS.
   $ATRNSUBJ =
        BOTH VALUE OF SA IS RNSUBJ
        AND PRESENT-ELEMENT- HAS COELEMENT- SUBJECT OR BESUBJ.
— IMMEDIATE(X) ASCENDS TO X. NODES ON THE STRING LIST ARE NOT
—       PASSED THROUGH.IF THIS ROUTINE STARTS AT Q-CONJ IT WILL GO
—       TO THE HOST NODE(UP TWICE FROM TOP OF Q NEST).
ROUTINE IMMEDIATE (X) =
        DO $UP-THROUGH-Q;
        ASCEND TO X PASSING THROUGH Q-CONJ.
   $UP-THROUGH-Q = ITERATET $GO-UP-TWICE UNTIL
        TEST FOR Q-CONJ FAILS. (GLOBAL)
   $GO-UP-TWICE = GO UP; GO UP.
ROUTINE IMMEDIATE-NODE- = GO UP.
ROUTINE IMMEDIATE-NODE =
        EITHER ITERATE $UP-CONJ [IN LEFT-ADJUNCT ROUTINE] OR TRUE ;
        GO UP.
ROUTINE IMMEDIATE-STRING = ASCEND TO STRING ;
        IF PRESENT-ELEMENT- IS Q-CONJ THEN DO IMMEDIATE-STRING.
ROUTINE INITIALRT =
        [* TESTS THAT THERE IS NO NODE TO THE LEFT OF THE ]
        [* NODE THE PROGRAM IS CURRENTLY 'LOOKING AT'.]
        VERIFY NOT DO PREVIOUS-ELEMENT-.
ROUTINE L (X) = ITERATE GO LEFT UNTIL TEST FOR X SUCCEEDS.
ROUTINE LAST-COELEMENT = EITHER ITERATE GO RIGHT OR TRUE.
ROUTINE LAST-ELEMENT- =
        [* GOES TO LEVEL BELOW THE NODE THE PROGRAM IS CURRENTLY ]
        [* 'LOOKING AT' AND GOES TO THE RIGHTMOST NODE ON THAT LEVEL. ]
        GO DOWN;
        EITHER ITERATE GO RIGHT OR TRUE.
ROUTINE LAST-ELEMENT =
        [* LAST-ELEMENT IS THE STACKING COUNTERPART OF LAST-ELEMENT-. ]
        [* IT GOES TO THE LAST-ELEMENT- AND STACKS IT'S CONJUNCTS.]
        DO LAST-ELEMENT-;
        DO $STACK-TEST [STARTAT].
ROUTINE LEFT-ADJUNCT =
        EITHER $ASCNT [IN CORE] OR TRUE;
        EITHER $LEFT-TO-LADJ OR $UP-AND-LEFT.
   $LEFT-TO-LADJ =
        DO L (LADJSET); EITHER TEST FOR LN OR DO CORE.
   $UP-AND-LEFT =
        ITERATET $UP-CONJ UNTIL $LEFT-TO-LADJ SUCCEEDS
        [GO UP TO CONJUNCTION AND TRY TO GO LEFT].
   $UP-CONJ =
        IMMEDIATE-NODE- IS Q-CONJ; GO UP [WILL BE AT CONJ-NODE].
ROUTINE LEFT-ADJUNCT-POS =
        [* STARTS AT A CORE NODE Y WHERE Y IS AN ELEMENT OF AN LXR ]
        [* TYPE NODE OR FROM THE CORE ASCENDS TO Y IF Y = AVAR, QVAR ]
        [* OR NVAR. IT THEN GOES LEFT UNTIL IT FINDS A NODE WHICH IS ]
        [* ON THE LADJSET LIST. IF IT FINDS LNAME IN NVAR, IT WILL GO ]
        [* FROM LNAME TO LN.]
        EITHER $ASCNT [CORE] OR TRUE;
        STORE IN X200;
        EITHER DO L(LADJSET) OR ITERATE $TO-PRECONJUNCTION-Y [COEL1-]
        UNTIL DO L(LADJSET) SUCCEEDS.
ROUTINE LOOKAHEAD(X) =
        GO TO THE CURRENT WORD;
        ITERATET GO TO THE NEXT WORD UNTIL DO X SUCCEEDS.
ROUTINE NELEMRT =
        [* CALLED AFTER AN OPERATOR HAS GONE TO THE NTH ELEMENT OF ]
        [* A STRING (IGNORING SPECIAL PROCESS NODES). IT STACKS THE ]
        [* CONJUNCTS OF THAT ELEMENT.]
        DO $STACK-TEST [STARTAT].
ROUTINE NONSEG-IMMSTG =
        DO IMMEDIATE-STRING;
        EITHER $UP-THRU-SEG OR TRUE.
   $UP-THRU-SEG = TEST FOR STGSEG; DO IMMEDIATE-NODE; TEST FOR STRING.
ROUTINE PRESENT-ELEMENT =
        ITERATET $HOST-OF-CONJ UNTIL TEST FOR Q-CONJ FAILS.
   $HOST-OF-CONJ =
        GO UP [TO CONJ-NODE];
        GO UP [TO HOST OF CONJ-NODE].
ROUTINE PRESENT-ELEMENT- = TRUE.
ROUTINE PREVIOUS-ELEMENT- =
        [* PREVIOUS-ELEMENT- SIMPLIFIED THE PREVIOUS-ELEMENT- IN MDPAR6]
        GO LEFT.
ROUTINE R (X) = ITERATE GO RIGHT UNTIL TEST FOR X SUCCEEDS.
ROUTINE RIGHT-ADJUNCT =
        EITHER $ASCNT OR TRUE;
        EITHER $RIGHT-TO-RADJ OR $UP-AND-RIGHT.
   $RIGHT-TO-RADJ=
        DO R(RADJSET); DO CORE.
   $UP-AND-RIGHT =
        ITERATE $UP-CONJ [IN LEFT-ADJUNCT ] UNTIL $RIGHT-TO-RADJ SUCCEEDS.
ROUTINE RIGHT-ADJUNCT-POS =
        EITHER $ASCNT [CORE] OR TRUE;
        STORE IN X200;
        EITHER DO R(RADJSET)
        OR ITERATE $TO-PRECONJUNCTION-Y [ COEL1- ]
        UNTIL DO R(RADJSET) SUCCEEDS;
        IF PRESENT-ELEMENT- IS RNAME
        THEN AT IMMEDIATE NVAR DO RIGHT-ADJUNCT-POS.
ROUTINE STACK-FOR-LEFT =
        [* STACK-FOR-LEFT ROUTINES WHICH GO FROM ONE ELEMENT OF A ]
        [* STRING TO ANOTHER ELEMENT OF THE STRING BY GOING LEFT CALL ]
        [* STACK-FOR-LEFT TO HANDLE STACKING. GIVEN THAT X AND Y ARE ]
        [* ELEMENTS OF A STRING, STACK-FOR-LEFT IS ASSUMED TO START AT ]
        [* X AFTER THE ROUTINE WHICH CALLED IT GOES FROM Y TO X. ]
        [* IN STRUCTURE (X1 CONJ X2) Y, STACK-FOR-LEFT WILL STACK X2. ]
        [* IN STRUCTURE X1 Y1 CONJ X2 Y2, STACK-FOR-LEFT WILL NOT STACK X2.]
        IF $POSTCONJ THEN VERIFY $STACK-IF-NO-Y-RGHT.
   $STACK-IF-NO-Y-RGHT =
        IF $POSTCONJ
        @THEN EITHER ALL OF $NO-Y-TO-RIGHT,
   $DO-STACK,
   $STACK-IF-NO-Y-RGHT
        OR TRUE.
   $NO-Y-TO-RIGHT =
        NOT ITERATE GO RIGHT UNTIL TEST FOR X200 SUCCEEDS.
   $DO-STACK = STACK.
ROUTINE STACK-FOR-RIGHT =
        [* STACK-FOR-RIGHT ROUTINES WHICH GO FROM ONE ELEMENT OF A ]
        [* STRING TO ANOTHER ELEMENT OF THE STRING BY GOING RIGHT ]
        [* CALL STACK-FOR-RIGHT TO HANDLE STACKING. GIVEN THAT X AND ]
        [* Y ARE ELEMENTS OF A STRING, STACK-FOR-RIGHT IS ASSUMED TO ]
        [* START AT Y AFTER THE ROUTINE WHICH CALLED IT GOES FROM X ]
        [* TO Y. IN A SITUATION X1 Y1 CONJ Y2, STACK-FOR-RIGHT ]
        [* STARTING AT Y1 WILL STACK Y2. IN A SITUATION X1 Y1 CONJ X2 ]
        [* Y2, STACK-FOR-RIGHT STARTING AT Y1 WILL NOT STACK Y2.]
        IF $POSTCONJ THEN VERIFY $STACK-IF-NO-Y-LEFT.
   $STACK-IF-NO-Y-LEFT =
        IF $POSTCONJ
        @THEN EITHER ALL OF $NO-Y-TO-LEFT,
   $DO-STACK,
   $STACK-IF-NO-Y-LEFT
        OR TRUE.
   $NO-Y-TO-LEFT =
        NOT ITERATE GO LEFT UNTIL TEST FOR X200 SUCCEEDS.
   $DO-STACK = STACK.
ROUTINE STARTAT (X) = EITHER TEST FOR X OR DO DOWN1-(X).
ROUTINE SUBSUMERT(X) =
        [* SEARCHES FOR A WORD OF GIVEN CLASS (AND SUBCLASS) WHICH ]
        [* IS MATCHED TO ANY ATOMIC NODE ON THE SUBTREE BELOW THE ]
        [* NODE THAT THE PROGRAM IS CURRENTLY 'LOOKING AT', I. E. ]
        [* WHICH IS SUBSUMED BY THE CURRENT NODE.]
        VERIFY $2;
        GO TO THE WORD STARTING THE PRESENT NODE;
        NOT TEST FOR X150;
        ITERATET $1 UNTIL DO X SUCCEEDS.
   $1 = GO TO THE NEXT WORD; NOT TEST FOR X150.
   $2 = GO TO THE WORD FOLLOWING THE PRESENT NODE; STORE IN X150.
— ********** **************************************** **********
—       *
—       EXTENDED SCOPE ROUTINES *
—       *
— ********** **************************************** **********

ROUTINE EXTENDED-CORE- =
        [* goes to the core. If the core is NULLWH, this routine ]
        [* goes up to the RN and from there to the host noun. ]
        [* Simplify the same routine in the MDPAR6]
        DO CORE-;
        IF BOTH PRESENT-ELEMENT- IS NULLWH
        AND $PATH1 [WWH1; X5=WHS-N]
        THEN AT X5 DO HOST-.
   $PATH1 = EITHER NONSEG-IMMSTG X5 IS WHS-N
        OR $NESTED. (GLOBAL)
   $NESTED = NONSEG-IMMSTG IS THATS OR TOVO OR PVO OR ASSERTION
        OR VENO OR VENPASS; DO $PATH1.
ROUTINE EXTENDED-CORE =
        DO CORE;
        IF BOTH PRESENT-ELEMENT- IS NULLWH
        AND PRESENT-ELEMENT- HAS NODE ATTRIBUTE N-OMITSTG
        [* go to WH-stg *]
        @THEN IF PRESENT-ELEMENT- IS WHNS-N OR WHNQ-N
        THEN CORE OF WHN EXISTS
        ELSE IF PRESENT-ELEMENT- IS WHQ-N
        THEN FIRST ELEMENT EXISTS
        ELSE HOST EXISTS
        ELSE IF PRESENT-ELEMENT- IS NULLC
        THEN IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE LINKC @
        THEN EXTENDED-CORE EXISTS.
— ROUTINE NONSEGWH IS A VERSION OF NONSEG-IMMEDSTG USED IN WH
— RESTRICTIONS.

ROUTINE NONSEGWH = ASCEND TO STRING; EITHER $1 OR TRUE .
   $1 = TEST FOR STGSEG;
        GO UP;
        TEST FOR STRING;
        EITHER $1 OR TRUE.
— PRESENT-STRING -SAME AS PRESENT-ELEMENT

ROUTINE PRESENT-STRING = DO $UP-THROUGH-Q [IMMEDIATE(X)] .
— DEEPEST-COVERB
—       STARTS AT ANY ELEMENT EXCEPT THE VERB OF A
—       VERB-CONTAINING STRING (USUALLY AT THE SUBJECT) AND GOES FIRST
—       TO THE VERB IN THE STRING;IF THAT VERB HAS A VERB-CONTAINING
—       OBJECT (OR A PREDICATE CONSISTING OF AN AASP+TOVO) THEN IT
—       GOES TO THE VERB IN THAT OBJECT (OR TOVO), WHERE IT REPEATS
—       THE TEST FOR A VERB-CONTAINING OBJECT. THE ITERATION ENDS ON THE
—       VERB WHICH DOESN'T HAVE A VERB-CONTAINING OBJECT (OR PREDICATE).
—       NOTE RE SN IN $VERBAL: THIS TEST MAKES 'IS' NOT 'SUFFER' THE
—       DEEPEST-COVERB IN 'TO LIVE IS TO SUFFER' AND 'HIS AIM IS NOT TO
—       SUFFER'(1 OF 2 READINGS).
—       USER BEWARE: SHIFT OF SUBJECT-OBJECT RELATION IN THE KERNEL DUE
—       TO PASSIVE MUST BE HANDLED BY THE RESTRICTION USING THE ROUTINE.
ROUTINE DEEPEST-COVERB- = ITERATE $NEXT-VERB- UNTIL $OBJ-HAS-VERB FAILS.
   $NEXT-VERB- = DO $1; DO $2 . (GLOBAL)
   $1 = THE PRESENT-ELEMENT- HAS COELEMENT- VERB OR LVINGR OR LVENR OR
        LVR OR VERB1 X7 .
   $2 = IF X7 IS VERB1 WHERE VALUE IS NOT LTVR THEN PRESENT-ELEMENT-
        HAS COELEMENT- VERB2 X7 .
   $OBJ-HAS-VERB =
        BOTH $VERBAL-
        @ AND PRESENT-STRING HAS ELEMENT- OBJECT OR PASSOBJ .
   $VERBAL- =
        IF PRESENT-ELEMENT- HAS COELEMENT- OBJECT OR PASSOBJ@
        THEN EITHER CORE- XX-COVERB IS VO OR VINGO OR TOVO OR TOBE
        OR VENO OR VENPASS OR PVO
        WHERE XX-COVERB IS NOT OCCURRING IN SN,
        OR $ASPECTUAL IS TRUE.
   $ASPECTUAL = BOTH XX-COVERB IS ADJ:AASP
        AND RIGHT-ADJUNCT OF XX-COVERB IS TOVO OR PVO. (GLOBAL)
ROUTINE DEEPEST-COVERB = ITERATE $NEXT-VERB UNTIL $OBJ-HAS-VERB FAILS.
   $NEXT-VERB = DO $1; DO $2. (GLOBAL)
   $1 = PRESENT-ELEMENT- HAS COELEMENT VERB OR LVINGR OR LVENR OR LVR
        OR VERB1 X7.
   $2 = IF X7 IS VERB1 WHERE VALUE IS NOT LTVR
        THEN PRESENT-ELEMENT- HAS COELEMENT VERB2 X7.
   $OBJ-HAS-VERB =
        BOTH $VERBAL
        @ AND PRESENT-STRING HAS ELEMENT OBJECT OR PASSOBJ.
   $VERBAL =
        IF PRESENT-ELEMENT HAS COELEMENT OBJECT OR PASSOBJ@
        THEN EITHER CORE- XX-COVERB IS VO OR VINGO OR VENO OR TOVO
        OR TOBE OR VENPASS OR PVO
        WHERE XX-COVERB IS NOT OCCURRING IN SN,
        OR $ASPECTUAL [DEEPEST-COVERB-] IS TRUE.
ROUTINE ULTIMATE-HOST = ITERATE $HOSTJUMP UNTIL $PNADJ FAILS.
   $HOSTJUMP = DO HOST; STORE IN X3 .
   $PNADJ = X3 IS OCCURRING IN PN WHERE PN IS OCCURRING AS RN. (GLOBAL)
ROUTINE ULTIMATE-OBJECT =
        EITHER ITERATE $ASCEND OR TEST FOR OBJECT
        OR PASSOBJ; EITHER $ADJUNCT OR TRUE .
   $ASCEND = ASCEND TO OBJECT OR PASSOBJ PASSING THROUGH
        TRANSMITTING-OBJ-STG NOT PASSING THROUGH ADJSET .
   $ADJUNCT = ONE OF $ASP, $SNRA, $SNRN, $SN-IN-RV IS TRUE;
        DO $UPAGAIN.
   $SN-IN-RV = BOTH X6 IS OCCURRING AS SN @ AND SN IS OCCURRING AS
        RV WHERE PREVIOUS-ELEMENT- IS OBJECT OR PASSOBJ X40.
   $ASP= EITHER NONSEGWH X6 IS TOVO WHERE TOVO IS OCCURRING AS RA X40
        OR NONSEGWH X6 IS PVO WHERE PVO IS OCCURRING AS RA X40 .
   $SNRA = X6 IS OCCURRING AS SN X8 WHERE X8 IS OCCURRING AS RA X40.
   $SNRN =
        BOTH X6 IS OCCURRING AS SN X8 WHERE X8 IS OCCURRING AS RN X40
        AND IF X40 IS OCCURRING IN PN @ THEN PN IS OCCURRING AS RN OR
        OBJBE X40.
   $UPAGAIN = GO TO X40; DO ULTIMATE-OBJECT .
ROUTINE ULTIMATE-SUBJECT =
        [* ITERATIVELY ASCENDS TO OBJECT OR PASSOBJ PASSING THROUGH ]
        [* VERB-CONTAINING OBJECT STRINGS UNTIL IT FINDS AN OBJECT ]
        [* THAT HAS A COELEMENT SUBJECT. IT ALSO ASCENDS THROUGH ]
        [* PREDICATE NOUNS AND ADJECTIVES AND THEIR ADJUNCTS AS LONG ]
        [* AS THE ADJUNCTS DO NOT CONTAIN THE NODE SUBJECT. THUS THE ]
        [* ULTIMATE SUBJECT OF X ASCENDS TO THE FIRST NODE SUBJECT ON ]
        [* ANY LEVEL ABOVE X IN THE PARSE TREE. NOTE THAT THE DEEPEST- ]
        [* COVERB DESCENDS MORE NARROWLY, PASSING THROUGH VERB-CONTAINING ]
        [* OBJECT STRINGS AND TOVO AS ADJUNCT OF AASP, BUT NOT THROUGH ]
        [* OTHER PREDICATES OR ADJUNCTS. USE DEEPEST-COVERB (NOT ]
        [* ULTIMATE-SUBJECT) IN SELECTIONAL RESTRICTIONS BECAUSE ]
        [* 'IT' IS THE ULTIMATE SUBJECT OF 'SWIM' IN BOTH ]
        [* 'IT LIKES TO SWIM' AND 'IT IS FUN TO SWIM' ]
        [* USE ULTIMATE SUBJECT FOR 'IT' PERMUTATIONS.]
        ITERATET $UP-TO-OBJ UNTIL $COELSUBJ SUCCEEDS.
   $UP-TO-OBJ =
        EITHER ASCEND TO OBJECT OR PASSOBJ PASSING THROUGH VENO OR
        VENPASS OR VINGO OR TOVO OR PVO OR VO OR Q-CONJ,
        OR ASCEND TO OBJBE PASSING THROUGH VENO OR VENPASS OR TOVO OR
        PVO OR VINGO OR VO OR Q-CONJ.
   $COELSUBJ = PRESENT-ELEMENT HAS COELEMENT SUBJECT OR BESUBJ OR TPOS.
ROUTINE VERB-COELEMENT- = DO $NEXT-VERB- .
   $NEXT-VERB- = DO $1. (GLOBAL)
   $1 = THE PRESENT-ELEMENT- HAS COELEMENT- VERB OR LVINGR OR
        LVENR OR LVR.
ROUTINE VERB-COELEMENT = DO $NEXT-VERB.
   $NEXT-VERB = DO $1. (GLOBAL)
   $1 = THE PRESENT-ELEMENT- HAS COELEMENT VERB OR LVINGR OR
        LVENR OR LVR.
— FIRST-FILLED-ATOM
—       AT THE PRESENT LOCATION, LOOK DOWN THE SUBSTREE TO FIND THE
—       FIRST ATOM THAT IS LEXICALLY FILLED.
ROUTINE FIRST-FILLED-ATOM =
        ITERATET $GO-TO-NEXT-NODE
        UNTIL BOTH PRESENT-ELEMENT- IS OF TYPE ATOM
        AND PRESENT-ELEMENT- IS NOT EMPTY SUCCEEDS.
   $GO-TO-NEXT-NODE =
        EITHER GO DOWN
        OR ITERATET GO UP
        UNTIL GO RIGHT SUCCEEDS.
— LAST-FILLED-ATOM
—       AT THE PRESENT LOCATION, LOOK DOWN THE SUBTREE TO FIND THE
—       LAST ATOM THAT IS LEXICALLY FILLED.
ROUTINE LAST-FILLED-ATOM =
        ITERATET $GO-TO-NEXT-NODE
        UNTIL BOTH PRESENT-ELEMENT- IS OF TYPE ATOM
        AND PRESENT-ELEMENT- IS NOT EMPTY SUCCEEDS.
   $GO-TO-NEXT-NODE =
        EITHER DO $LAST-NODE
        OR ITERATET GO UP
        UNTIL GO LEFT SUCCEEDS.
   $LAST-NODE =
        GO DOWN;
        EITHER ITERATE GO RIGHT OR TRUE.
— ********** **************************************** **********
—       *
—       CONJUNCTION ROUTINES *
—       *
— ********** **************************************** **********

ROUTINE CO-CONJ(X)=
        STORE IN X200;
        EITHER $COELEMENT OR $STRING-SEGMENT.
   $COELEMENT = DO COEL1-(X); DO $NOT-XY-CONJ-XY.
   $NOT-XY-CONJ-XY =
        ITERATE BOTH PRESENT-STRING- HAS NODE ATTRIBUTE POSTCONJELEM
        @AND NEITHER $Y-TO-RIGHT NOR $Y-TO-LEFT.
   $Y-TO-RIGHT= ITERATE GO RIGHT UNTIL TEST FOR X200 SUCCEEDS.
   $Y-TO-LEFT= ITERATE GO LEFT UNTIL TEST FOR X200 SUCCEEDS.
   $STRING-SEGMENT =
        BOTH $GO-THRU-SEG-TO-X
        @AND EITHER PRESENT-ELEMENT HAS NODE ATTRIBUTE POSTCONJELEM
        OR AT X300 $NOT-XY-CONJ-XY IS TRUE.
   $GO-THRU-SEG-TO-X =
        DO COEL1-(STGSEG);
        STORE IN X300;
        DO ELEMENT-(X).
ROUTINE CONJELEM- =
        [* SIMILAR TO CONJELEM EXCEPT STARTING NODE MUST BE DIRECTLY ]
        [* BELOW Q-CONJ.]
        STORE IN X200;
        ITERATE $UP-2-IF-CONJ UNTIL $FIND-X200 SUCCEEDS.
   $UP-2-IF-CONJ = IMMEDIATE-NODE- IS Q-CONJ; GO UP.
   $FIND-X200 = ITERATE GO LEFT UNTIL TEST FOR X200 SUCCEEDS.
ROUTINE CONJELEM =
        [* CONJELEM: INVERSE OF CORE-CONJUNCT.]
        [* STARTS AT THE CONJUNCT OF X AND GOES TO X. IN A SITUATION ]
        [* X1Y1 CONJ X2Y2, STARTING AT X2 CONJELEM WILL GO TO X1. ]
        [* GIVEN THAT Z2 IS SEVERAL LEVELS BELOW X2,STARTING AT Z2 ]
        [* CONJELEM WILL GO TO Z1,SEVERAL LEVELS BELOW X1. ]
        EITHER $ATQ OR $UPQ;
        DO $TO-PRECONJUNCTION-Y [COEL1-];
        EITHER TEST FOR X600 OR DESCEND TO X600.
   $ATQ =
        TEST FOR Q-CONJ;
        GO DOWN;
        STORE IN X600;
        STORE IN X200.
   $UPQ =
        STORE IN X600;
        STORE IN X200;
        GO UP;
        ITERATET $UPQ1 UNTIL TEST FOR Q-CONJ SUCCEEDS;
        GO TO X200.
   $UPQ1 =
        STORE IN X200;
        NOT TEST FOR STRING;
        GO UP.
ROUTINE CORE-CONJUNCT =
        [* STARTING AT THE GIVEN NODE, CORE-CONJUNCT DESCENDS TO ]
        [* THE CORE AND THEN GOES TO ITS CONJUNCT.]
        DO $CORE-PATH [CORE-];
        EITHER $ASCNT [CORE] OR TRUE;
        DO $POSTCONJ [STARTAT];
        DO $CORE-PATH.
— GOVERNING-CONJ
—       STARTS IN A Q STRING AND FINDS HEAD CONJUNCTION OF C-Q
—       COMPLEX.

ROUTINE GOVERNING-CONJ =
        EITHER TEST FOR Q-CONJ OR ASCEND TO Q-CONJ;
        GO UP [TO CONJ-NODE]; GO DOWN.
ROUTINE PRE-POST-CONJELEM =
        [* GIVEN THAT STRING Q-CONJ HAS ELEMENTS F1 F2 ... FN ]
        [* WHICH ARE CONJUNCTS OF E1 E2 ... EN, I.E. THE NODES TO ]
        [* THE LEFT OF THE SPECIAL PROCESS NODE ONE LEVEL ABOVE ]
        [* Q-CONJ, THEN TO EACH FI THIS ROUTINE ASSIGNS THE NODE ]
        [* ATTRIBUTE PRECONJELEM WITH VALUE EI AND TO EACH EI ]
        [* THE NODE ATTRIBUTE POSTCONJELEM WITH VALUE FI.]
        STORE IN X100;
        DO ELEMENT- (Q-CONJ); DO LAST-ELEMENT-;
        ITERATE VERIFY $ASSIGN-TEST UNTIL GO LEFT FAILS.
$ASSIGN-TEST =
        EITHER TEST FOR SP-NODE
        OR EITHER $PRECONJ OR
   $ASSIGN-PRE-AND-POST. (GLOBAL)
   $ASSIGN-PRE-AND-POST =
        STORE IN X500; STORE IN X0; GO TO X100;
        ITERATE $GO-LEFT UNTIL TEST FOR X500 SUCCEEDS;
        EITHER ITERATE $POSTCONJ OR TRUE;
        DO $ASSIGN-POSTCONJELEM; STORE IN X0; GO TO X500;
        DO $ASSIGN-PRECONJELEM. (GLOBAL)
   $GO-LEFT =
        ITERATET $UPCONJ UNTIL GO LEFT SUCCEEDS;
        STORE IN X100.
   $UPCONJ = GO UP; TEST FOR Q-CONJ; GO UP.
   $ASSIGN-POSTCONJELEM =
        ASSIGN THE PRESENT ELEMENT NODE ATTRIBUTE POSTCONJELEM.
   $ASSIGN-PRECONJELEM =
        ASSIGN THE PRESENT ELEMENT NODE ATTRIBUTE PRECONJELEM.
— ********** **************************************** **********
—       *
—       ROUTINES FOR SELECTION *
—       *
— ********** **************************************** **********

ROUTINE COMPLEMENT =
        [* TAKES THE COMPLEMENT OF LIST STORED IN REGISTER X-SUBLIST. ]
        [* THE COMPLETE LIST IS ASSUMED TO BE PRESENT LOCATION. ]
        [* COMPLEMENT CREATES A LIST STORED IN X-COMPLEMENT WHICH ]
        [* CONSISTS OF ALL THOSE ELEMENTS ON CURRENT LIST THAT ARE ]
        [* NOT ON X-SUBLIST. ]
        X-CURRENTLIST:= PRESENT-ELEMENT-;
        X-COMPLEMENT:= NIL;
        ITERATE BOTH X-HEAD2:= HEAD OF X-CURRENTLIST
        AND IF X-SUBLIST DOES NOT HAVE MEMBER X-HEAD2
        THEN $ADD-TO-COMP
        UNTIL X-CURRENTLIST:= SUCCESSORS OF X-CURRENTLIST WHERE
        X-CURRENTLIST IS NIL SUCCEEDS;
        GO TO X-COMPLEMENT.
   $ADD-TO-COMP =
        IF X-ATTL := ATTRIBUTE-LIST OF X-CURRENTLIST
        THEN PREFIX X-HEAD2:X-ATTL TO X-COMPLEMENT
        ELSE PREFIX X-HEAD2 TO X-COMPLEMENT.
ROUTINE CORE-ATT =
        [* RETURNS AN ATTRIBUTE LIST FOR ITS PRESENT LOCATION, ]
        [* LOOKING FOR AN ATTRIBUTE LIST IN THE FOLLOWING ORDER ]
        [* 1. COMPUTED ATTRIBUTE LIST, STORED AS VALUE OF NODE ]
        [* ATTRIBUTE 'COMPUTED-ATT'; ]
        [* 2. SELECTIONAL ATTRIBUTE LIST, STORED AS VALUE OF ]
        [* NODE ATTRIBUTE 'SELECT-ATT'; ]
        [* 3. ATTRIBUTE LIST OF WORD, PRUNED TO CONTAIN ONLY ]
        [* SELECTIONALLY RELEVANT CLASSES, AS DEFINED BY THE ]
        [* LIST SUBLANGUAGE-ATTS (USES INTERSECT, TO OBTAIN ]
        [* INTERSECTION OF SUBLANGUAGE-ATTS AND ATTRIBUTE LIST). ]
        [* 4. IF INTERSECTION IS NIL AND WORD HAS ATTRIBUTE NHUMAN ]
        [* OR NAME, LIST HUMAN-LIST IS RETURNED. ]
        EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE COMPUTED-ATT
        OR EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE SELECT-ATT
        OR EITHER ATTRIBUTE-LIST X-NEWLIST EXISTS
        WHERE BOTH X-SUBLANGUAGE-ATTS := LIST SUBLANGUAGE-ATTS
        AND INTERSECT OF X-SUBLANGUAGE-ATTS IS NOT NIL
        OR $NHUMAN-CHK.
   $NHUMAN-CHK =
        BOTH PRESENT-ELEMENT- HAS ATTRIBUTE NHUMAN OR NAME
        AND X-INTERSECT := LIST HUMAN-LIST.
ROUTINE CORE-SELATT =
        [* RETURNS AN ATTRIBUTE LIST FOR ITS PRESENT LOCATION, LOOKING ]
        [* FOR AN ATTRIBUTE LIST IN THE FOLLOWING ORDER ]
        [* 1. SELECT ATTRIBUTE LIST, STORE AS VALUE OF NODE ATTRIBUTE ]
        [* 'SELECT-ATT'. ]
        [* 2. ATTRIBUTE LIST OF WORD, PRUNED TO CONTAIN ONLY ]
        [* SELECTIONALLY RELEVANT CLASSES, AS DEFINED BY THE LIST ]
        [* SUBLANGUAGE-ATTS (USES ROUTINE INTERSECT TO OBTAIN) ]
        [* INTERSECTION OF SUBLANGUAGE-ATTS AND ATTRIBUTE LIST. ]
        [* 3. IF WORD HAS NO ATTRIBUTES ON SUBLANGUAGE-ATTS, AND ]
        [* HAS CLASS NHUMAN, THEN LIST HUMAN-LIST IS RETURN AS VALUE ]
        [* OF CORE-SELATT. ]
        EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE SELECT-ATT
        OR EITHER ATTRIBUTE-LIST X-NEWLIST EXISTS WHERE
        BOTH X-SUBLANGUAGE-ATTS:= LIST SUBLANGUAGE-ATTS
        AND INTERSECT OF X-SUBLANGUAGE-ATTS IS NOT NIL
        OR $NHUMAN-CHK [CORE-ATT]. (GLOBAL)
ROUTINE INTERSECT =
        [* TAKES INTERSECTION OF LIST IN CURRENT LOCATION WITH LIST ]
        [* STORED IN REGISTER X-NEWLIST, AND CREATES THE LIST REPRE-]
        [* SENTING THE INTERSECTION (INCLUDING ATTRIBUTE LISTS OF THE ]
        [* INTERSECTING ELEMENTS). THE NEW LIST REPRESENTING THE ]
        [* INTERSECTION IS STORED IN REGISTER X-INTERSECTION; THE ]
        [* ROUTINE FINISHES LOCATED AT THIS LIST (X-INTERSECTION). ]
        [* ** NOTE THAT IT IS THE LIST STORED IN X-NEWLIST WHOSE ]
        [* ** MEMBERS (AND POSSIBLE ATTRIBUTE LISTS) ARE COPIED. ]
        [* ]
        [*** WARNING ]
        [* IF REGISTER X-NEWLIST DOES NOT POINT TO A LIST, THE ]
        [* ROUTINE WILL FAIL; IF THE ROUTINE DOES NOT START AT ]
        [* AN ATOM OR A LIST, THE INTERSECTION WILL BE EMPTY. ]
        X-CURRENTLIST:= PRESENT-ELEMENT-;
        X-INTERSECTION:= NIL ;
        X-2NDLIST:= X-NEWLIST;
        ITERATE IF X-2NDLIST HAS MEMBER X-CURRENTLIST X-2NDLIST
        THEN $ADD
        ELSE X-2NDLIST:= NIL [END INTERSECTION]
        UNTIL EITHER X-2NDLIST IS NIL
        OR X-2NDLIST:= SUCCESSORS OF X-2NDLIST
        WHERE X-2NDLIST IS NIL SUCCEEDS;
        GO TO X-INTERSECTION.
   $ADD =
        X-HEAD2:= HEAD OF X-2NDLIST;
        IF X-ATTL:= ATTRIBUTE-LIST OF X-2NDLIST
        THEN PREFIX X-HEAD2:X-ATTL TO X-INTERSECTION
        ELSE PREFIX X-HEAD2 TO X-INTERSECTION.
ROUTINE UNION =
        [* COMPUTES THE SET-THEORETIC UNION OF TWO SETS; ONE SET ]
        [* IS PASSED IN STORED IN THE REGISTER X-UNION; THE ROUTINE ]
        [* MUST BEGIN FROM THE SECOND LIST (SET); IT CHECKS THAT EACH ]
        [* ELEMENT FROM THE PCURRENT LIST (STORED IN X-ADD-TO-UNION) ]
        [* IS EITHER ALREADY ON LIST X-UNION OR IF NOT, IT IS PREFIXED ]
        [* TO X-UNION. THE UNION IS RETURNED IN REGISTER X-UNION, ]
        [* WHICH IS ALSO WHERE THE ROUTINE LEAVES YOU. IF THE INITIAL ]
        [* LIST IS NIL (EMPTY), UNION WILL RETURN WHATEVER LIST IS ]
        [* STORED IN X-UNION. ]
        IF PRESENT-ELEMENT- IS NOT NIL
        THEN $ADD-TO-UNION
        ELSE GO TO X-UNION.
   $ADD-TO-UNION =
        X-ADD-TO-UNION := PRESENT-ELEMENT-;
        ITERATE BOTH X-ADD-EL-TO-UNION := HEAD OF X-ADD-TO-UNION
        AND IF X-UNION DOES NOT HAVE MEMBER X-ADD-EL-TO-UNION
        THEN IF ATTRIBUTE-LIST X-ATTRB-UNION
        OF X-ADD-TO-UNION EXISTS
        THEN PREFIX X-ADD-EL-TO-UNION: X-ATTRB-UNION
        TO X-UNION
        ELSE PREFIX X-ADD-EL-TO-UNION TO X-UNION
        UNTIL SUCCESSORS X-ADD-TO-UNION OF X-ADD-TO-UNION IS NIL SUCCEEDS;
        GO TO X-UNION.
— FIND-SLOT(X): LOCATES X IN FORMAT TREE.
—       1. FIND-SLOT FIRST TRIES TO DESCEND TO X FROM PRESENT LOCATION.
—       2. IF THAT FAILS, IT TRIES TO DESCEND TO X FROM X-FORMAT.

ROUTINE FIND-SLOT(X) =
        IF X-SIGNAL IS NOT NIL
        THEN $FIND-XSLOT
        ELSE EITHER TEST FOR X
        OR EITHER DESCEND TO X
        OR AT X-FORMAT DESCEND TO X;
        VERIFY X-SIGNAL:= NIL.
   $FIND-XSLOT =
        EITHER TEST FOR X-SLOT
        OR EITHER DESCEND TO X-SLOT
        OR AT X-FORMAT DESCEND TO X-SLOT.
— FILLED-SLOT(X): LOCATES X IN FORMAT TREE AND FROM X TRIES TO
—       DESCEND TO NODE NON-EMPTY. IF IT CAN, THAT MEANS
—       FORMAT SLOT X HAS BEEN FILLED.
ROUTINE FILLED-SLOT(X) = DO FIND-SLOT(X);
        DESCEND TO NON-EMPTY.
— PUTIN-SLOT(X): LOCATES X IN FORMAT TREE AND ASSIGNS CONTENTS OF X-PUTIN
—       TO THAT FORMAT SLOT. A FORMAT SLOT IS 'FILLED' OR ASSIGNED TO
—       A NODE IN THE PARSE TREE AS FOLLOWS:
—       IF FORMAT SLOT FS IS EMPTY ITS VALUE IS REPLACED BY A NODE
—       CALLED NON-EMPTY WHICH IS ASSIGNED A NODE ATTRIBUTE FILLED-PT
—       WITH VALUE SAME AS X-PUTIN (LOCATION IN PARSE TREE). THE NODE
—       IN X-PUTIN IS ASSIGNED A NODE ATTRIBUTE FORMAT-PT WITH VALUE
—       POINTING TO NON-EMPTY. THEREFORE THE CORRESPONDENCE BETWEEN
—       FORMAT NODES AND PARSE TREE NODES IS MADE VIA VALUE OF NODE
—       ATTRIBUTE FILLED-PT AND THE CORRESPONDENCE BETWEEN PARSE TREE
—       NODES AND FORMAT NODES IS MADE VIA VALUE OF NODE ATTRIBUTE
—       FORMAT-PT. IF FORMAT SLOT FS ALREADY HAS A VALUE NON-EMPTY,
—       THEN IT MAY HAVE ANOTHER NON-EMPTY ELEMENT ( AND THEREFORE
—       CORRESPOND TO MORE THAN ONE PARSE TREE NODE) IF IT IS ON LIST
—       MULTI-ENTRY.
—       IT IS ASSUMED THAT REG X-PUTIN POINTS TO LOCATION IN PARSE
—       TREE WHICH FORMAT SLOT X IS TO CORRESPOND TO.
—       1. IF X DOES NOT HAVE VALUE EMPTY, IT CHECKS IF X IS ON LIST
—       MULTI-ENTRY. IF IT IS NOT- IT FAILS WITH ERROR MESSAGE.
—       IF IT IS, IT ADDS A SISTER NODE NON-EMPTY TO
—       THE OTHER NON-EMPTY. THE NEW NODE IS IN X-FRMT-SLOT.
—       2. IF X DOES HAVE VALUE EMPTY[OR VALUE DOES NOT EXIST], THEN IT
—       REPLACES EMPTY BY NON-EMPTY AND STORES IT IN X-FRMT-SLOT.
—       3. SET POINTERS TO AND FROM PARSE TREE AND FORMAT TREE.
—       A. SET NODE ATTRIBUTE FORMAT-PT FROM NODE IN X-PUTIN IN PARSE
—       TREE TO X-FRMT-SLOT IN FORMAT TREE. FORMAT-PT IS CHAINED
—       SINCE NODES I N PARSE TREE MAY CORRESPOND TO MORE THAN ONE NODE
—       IN FORMAT. THEREFOR IF X-PUTIN ALREADY HAS NODE ATTRIBUTE
—       FORMAT-PT, GO TO VALUE AND ASSIGN IT NODE ATTRIBUTE
—       FORMAT-PT WITH VALUE X-FRMT-SLOT.
—       B. SET POINTER FILLED-PT FROM X-FRMT-SLOT TO X-PUTIN.

ROUTINE PUTIN-SLOT(X)=
        IF DO FIND-SLOT(X) @THEN $TEST-AND-SETUP
        ELSE $ERR-MESS3.
   $ERR-SIGNAL =
        WRITE ON DIAG '* <<<<< FATAL ERROR';
        WRITE ON DIAG ' >>>>>';
        WRITE ON DIAG END OF LINE. (GLOBAL)
   $TEST-AND-SETUP =
        STORE IN X-SLOT;
        IF AT X-SLOT DESCEND TO NON-EMPTY
        THEN $TEST-MULTI-ENTRY
        ELSE $IMMED-CHK.
   $IMMED-CHK =
        EITHER AT X-SLOT BOTH TEST FOR MODIFIERS
        AND $BUILD-XSLOT
        OR $ONE-ELEM-CHK.
   $ONE-ELEM-CHK = [CHECK IF THIS ELEMENT HAS BEEN FILLED ALREADY]
        IF AT IMMEDIATE-NODE- OF X-SLOT TEST FOR ONE-ELEMENT
        @THEN EITHER BOTH NOT DESCEND TO NON-EMPTY [NOT FILLED]
        AND AT VALUE DO $BUILD-XSLOT
        OR ONE OF $CHK-FOR-EQ, $ERR-MESS4
        [DO NOT BUILD; BUT DO NOT FAIL]
        ELSE $BUILD-XSLOT.
   $BUILD-XSLOT =
        REPLACE X-SLOT BY X-SLOT (<NON-EMPTY> X-FRMT-SLOT);
        DO $SET-POINTERS.
   $TEST-MULTI-ENTRY =
        IF X-SLOT IS OF TYPE MULTI-ENTRY
        THEN EITHER $IN-LADJSET
        OR BOTH AFTER LAST-ELEMENT OF X-SLOT
        INSERT <NON-EMPTY> X-FRMT-SLOT
        AND $SET-POINTERS
        ELSE ONE OF $CHK-FOR-PT, $CHK-FOR-EQUIV, $ERR-MESS2.
   $IN-LADJSET =
        [* If node to be formatted is in LADJSET *]
        [* and host has been formatted at the *]
        [* same slot *]
        [* then put the formatted slot in front *]
        [* of formatted slot of host *]
        [* TO PRESERVE LINEAR ORDERING. *]
        AT X-PRE ASCEND TO LADJSET;
        IMMEDIATE-NODE- IS OF TYPE LXR
        WHERE PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT
        X-LXR-FMT;
        IMMEDIATE-NODE- IS IDENTICAL TO X-SLOT;
        BOTH BEFORE X-LXR-FMT INSERT <NON-EMPTY> X-FRMT-SLOT
        AND $SET-POINTERS.
   $CHK-FOR-PT = X-SLOT IS PT;
        DO $ERR-MESS2.
   $CHK-FOR-EQ = DESCEND TO NON-EMPTY;
        DO $CHK-FOR-EQUIV.
   $CHK-FOR-EQUIV =
        [CHECK IF IN LEFT OR RIGHT ADJUNCT IN SAME FORMAT SLOT]
        DO $GET-TREE-POS;
        DO $FRMT-EQUIV-CHK.
   $SET-POINTERS =
        AT X-FRMT-SLOT, ASSIGN NODE ATTRIBUTE FILLED-PT WITH VALUE
        X-PUTIN;
        AT X-PUTIN EITHER ITERATE PRESENT-ELEMENT- HAS NODE ATTRIBUTE
        FORMAT-PT
        OR TRUE;
        ASSIGN NODE ATTRIBUTE FORMAT-PT WITH VALUE X-FRMT-SLOT. (GLOBAL)
   $GET-TREE-POS =
        PRESENT-ELEMENT- HAS NODE ATTRIBUTE FILLED-PT
        [* point to parse tree *];
        EITHER TEST FOR LXR
        OR ASCEND TO LXR PASSING THROUGH STRING;
        STORE IN X-TTT [* find LXR that contains it *].
   $FRMT-EQUIV-CHK =
        [* If putting LEFT or RIGHT ADJUNCT in same format *]
        [* slot as the one already formated. Do not fail *]
        [* if slot is already filled. *]
        EITHER $IN-LADJS OR $IN-RADJS;
        ASCEND TO LXR PASSING THROUGH STRING;
        STORE IN X-TT;
        X-TT IS IDENTICAL TO X-TTT;
        AT X-PUTIN ASSIGN NODE ATTRIBUTE TRANSFORM-ATT
        [* Do not try to format it again *].
   $IN-LADJS = AT X-PUTIN ASCEND TO LADJSET PASSING THROUGH STRING
        NOT PASSING THROUGH LXR.
   $IN-RADJS = AT X-PUTIN ASCEND TO RADJSET PASSING THROUGH STRING
        NOT PASSING THROUGH LXR.
   $ERR-MESS1 =
        DO $ERR-SIGNAL;
        WRITE ON DIAG '* More than 1 ';
        WRITE ON DIAG 'alternative under ';
        AT IMMEDIATE-NODE OF X-SLOT WRITE ON DIAG NODE NAME;
        WRITE ON DIAG ' : ';
        AT X-TEMP WRITE ON DIAG NODE NAME;
        AT X-SLOT WRITE ON DIAG NODE NAME;
        DO $ERR-END.
   $ERR-END = WRITE ON DIAG END OF LINE;
        NOT TRUE. (GLOBAL)
   $ERR-MESS2 =
        DO $WARNING-SIG;
        WRITE ON DIAG '* More than 1 ';
        WRITE ON DIAG 'element in slot ';
        AT X-SLOT WRITE ON DIAG NODE NAME;
        WRITE ON DIAG ' = ';
        AT X-SLOT VALUE HAS NODE ATTRIBUTE FILLED-PT;
        WRITE ON DIAG WORDS SUBSUMED;
        WRITE ON DIAG '. It is not';
        WRITE ON DIAG ' MULTI-ENTRY.';
        WRITE ON DIAG END OF LINE.
   $ERR-MESS3 = DO $ERR-SIGNAL;
        WRITE ON DIAG '* Cannot ';
        WRITE ON DIAG 'find FORMAT NODE = ';
        IF X-SIGNAL IS NIL THEN WRITE ON DIAG ' X '
        ELSE AT X-SLOT WRITE ON DIAG LIST ELEMENT;
        X-SIGNAL:= NIL;
        DO $ERR-END.
   $ERR-MESS4 = DO $WARNING-SIG;
        WRITE ON DIAG '* ';
        AT IMMEDIATE-NODE- OF X-SLOT WRITE ON DIAG NODE NAME;
        WRITE ON DIAG ' = ';
        AT IMMEDIATE-NODE OF X-SLOT DESCEND TO NON-EMPTY
        WHERE PRESENT-ELEMENT- HAS NODE ATTRIBUTE FILLED-PT;
        WRITE ON DIAG WORDS SUBSUMED;
        WRITE ON DIAG '. It can have ';
        WRITE ON DIAG 'one slot fileed.';
        WRITE ON DIAG END OF LINE.
— ROUTINE WRITE-WORDS
—       WRITES WORDS UNDER A GIVEN NODE, EXCEPT FOR NON-CONJUNCTION
—       COMMA; IT THEN RETURNS TO ITS ORIGINAL POSITION (USED IN
—       PLACE OF 'WRITE WORDS SUBSUMED' COMMAND).
ROUTINE WRITE-WORDS =
        BOTH ONE OF $EMPTY, $COMMA, [$DASH,] $EMPTY-BRACKETS, $OTHER
        AND TRUE [Return to start - VERIFY is not working correctly].
   $EMPTY-BRACKETS =
        PRESENT-ELEMENT- IS '[]'.
   $DASH =
        BOTH PRESENT-ELEMENT- IS '-' OR '--'
        AND WRITE ON INFO WORDS SUBSUMED.
   $EMPTY =
        EITHER PRESENT-ELEMENT- IS NULL OR NULLC OR NULLN OR
        NULLWH OR NULLOBJ,
        OR PRESENT-ELEMENT- IS 'NULLN' [WHERE DO $WRITE-BRKT].
   $WRITE-BRKT = WRITE ON INFO '[ ]'.
   $COMMA = BOTH PRESENT-ELEMENT- IS COMMASTG
        AND IMMEDIATE-NODE- IS NOT CONJOINED.
   $OTHER =
        BOTH IF PRESENT-ELEMENT- X-WRITE-NODE IS OF TYPE ATOM
        THEN ASSIGN NODE ATTRIBUTE CT-WRITTEN
        ELSE $MARK-CT-WRITTEN
        AND DO $WRITE-WORDS-COMPLEX.
   $WRITE-WORDS-COMPLEX =
        WRITE ON INFO '<';
        IF X-WRITE-NODE IS OF TYPE ATOM
        THEN AT X-WRITE-NODE,
        BOTH WRITE ON INFO NODE NAME
        AND ALL OF $WRITE-NUMBERS, $WRITE-ATTRBS
        ELSE AT CORE- OF X-WRITE-NODE DO $WRITE-ATTRBS;
        WRITE ON INFO '>';
        AT X-WRITE-NODE WRITE ON INFO WORDS SUBSUMED;
        WRITE ON INFO '</';
        IF X-WRITE-NODE IS OF TYPE ATOM
        THEN AT X-WRITE-NODE,
        BOTH DO $WRITE-CLOSE-ATTRBS
        AND BOTH WRITE ON INFO NODE NAME
        AND DO $WRITE-NUMBERS
        ELSE AT CORE- OF X-WRITE-NODE DO $WRITE-ATTRBS;
        WRITE ON INFO '>'.
   $WRITE-NUMBERS =
        IF PRESENT-ELEMENT- X-FATOM IS N
        THEN IF X-FATOM IS SINGULAR
        THEN WRITE ON INFO ':SI'
        ELSE IF X-FATOM IS PLURAL
        THEN WRITE ON INFO ':PL'
        ELSE TRUE
        ELSE TRUE.
   $WRITE-ATTRBS =
        IF PRESENT-ELEMENT- X-FATOM HAS NODE ATTRIBUTE WORD-POS X-WPOS
        THEN BOTH WRITE ON INFO ' WordNo='
        AND AT X-WPOS, WRITE ON INFO LIST;
        [* reassign VBE to its original attribute *]
        IF BOTH X-FATOM IS 'AM' OR 'BE' OR 'IS' OR 'ARE'
        OR 'WAS' OR 'WERE' OR 'BEEN'
        AND X-FATOM IS VBE
        THEN DO $ASSIGN-VBE;
        IF X-FATOM HAS NODE ATTRIBUTE COMPUTED-ATT X-ATT
        THEN DO $WRITE-NORMAL-ATT
        ELSE IF X-FATOM HAS NODE ATTRIBUTE SELECT-ATT X-ATT
        THEN IF X-FATOM HAS NODE ATTRIBUTE SUPPORT-ATT X-NEWLIST
        THEN IF INTERSECT OF X-ATT IS NIL
        THEN DO $WRITE-NORMAL-ATT
        ELSE DO $WRITE-SUPPORT-ATT
        ELSE DO $WRITE-NORMAL-ATT
        ELSE IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE FAIL-SEL
        THEN WRITE ON INFO ':(FAIL-SEL)'
        [ELSE WRITE ON INFO ':()'].
   $ASSIGN-VBE =
        X-NEWLIST := ATTRIBUTE-LIST OF X-FATOM;
        X-SUBLANG := LIST SUBLANGUAGE-ATTS;
        X-VBE := INTERSECT OF X-SUBLANG;
        AT X-FATOM, ASSIGN NODE ATTRIBUTE SELECT-ATT WITH VALUE X-VBE.
   $WRITE-NORMAL-ATT =
        AT X-ATT,
        [IF PRESENT-ELEMENT- IS NIL]
        [THEN WRITE ON INFO ':()']
        IF PRESENT-ELEMENT- IS NOT NIL THEN
        [ELSE]BOTH WRITE ON INFO '><'
        AND WRITE ON INFO LIST [ELEMENT].
   $WRITE-SUPPORT-ATT =
        X-MAINATT := HEAD OF X-NEWLIST;
        X-SUPATT := ATTRIBUTE-LIST OF X-NEWLIST;
        WRITE ON INFO '><(';
        AT X-MAINATT, WRITE ON INFO LIST [ELEMENT];
        WRITE ON INFO ':';
        AT X-SUPATT, WRITE ON INFO LIST [ELEMENT];
        WRITE ON INFO ')'.
   $WRITE-CLOSE-ATTRBS =
        IF PRESENT-ELEMENT- X-FATOM HAS NODE ATTRIBUTE COMPUTED-ATT X-ATT
        THEN DO $WRITE-CLOSE-NORMAL-ATT
        ELSE IF X-FATOM HAS NODE ATTRIBUTE SELECT-ATT X-ATT
        THEN IF X-FATOM HAS NODE ATTRIBUTE SUPPORT-ATT X-NEWLIST
        THEN IF INTERSECT OF X-ATT IS NIL
        THEN DO $WRITE-CLOSE-NORMAL-ATT
        ELSE DO $WRITE-CLOSE-SUPPORT-ATT
        ELSE DO $WRITE-CLOSE-NORMAL-ATT
        ELSE IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE FAIL-SEL
        THEN WRITE ON INFO ':(FAIL-SEL)'
        [ELSE WRITE ON INFO ':()'].
   $WRITE-CLOSE-NORMAL-ATT =
        AT X-ATT,
        [IF PRESENT-ELEMENT- IS NIL]
        [THEN WRITE ON INFO ':()']
        IF PRESENT-ELEMENT- IS NOT NIL THEN
        BOTH WRITE ON INFO LIST [ELEMENT]
        [ELSE]AND WRITE ON INFO '></'.
   $WRITE-CLOSE-SUPPORT-ATT =
        X-MAINATT := HEAD OF X-NEWLIST;
        X-SUPATT := ATTRIBUTE-LIST OF X-NEWLIST;
        WRITE ON INFO '(';
        AT X-MAINATT, WRITE ON INFO LIST [ELEMENT];
        WRITE ON INFO ':';
        AT X-SUPATT, WRITE ON INFO LIST [ELEMENT];
        WRITE ON INFO ')></'.
   $WRITE-NODE-DESC =
        AT X-WORD, WRITE ON INFO NODE NAME;
        WRITE ON INFO ':';
        AT X-ATT, WRITE ON INFO LIST [ELEMENT].
   $MARK-CT-WRITTEN =
        AT PRESENT-ELEMENT- X-WR-START,
        ITERATE VERIFY $PROCESS-NODE
        UNTIL $GO-TO-NEXT-NODE FAILS.
   $PROCESS-NODE =
        IF PRESENT-ELEMENT- IS OF TYPE ATOM
        WHERE NOT $EMPTY
        THEN BOTH ASSIGN NODE ATTRIBUTE CT-WRITTEN
        AND BOTH WRITE ON INFO '<'
        AND BOTH WRITE ON INFO WORDS SUBSUMED
        AND BOTH WRITE ON INFO ' '
        AND DO $WRITE-ATTRBS.
   $GO-TO-NEXT-NODE =
        EITHER $GO-DOWN-TREE
        OR ITERATET $GO-UP-TREE
        UNTIL GO RIGHT SUCCEEDS.
   $GO-DOWN-TREE = PRESENT-ELEMENT- IS NOT EMPTY; GO DOWN.
   $GO-UP-TREE =
        GO UP;
        PRESENT-ELEMENT- IS NOT IDENTICAL TO X-WR-START
        [* stop at starting position *].
— ROUTINE HAS-MODIFIER(X)
—       TESTS WHETHER CURRENT FORMAT SLOT HAS MODIFIER X TO ITS RIGHT.
—       IF IT REACHES A NON-MODIFIER SLOT BEFORE IT FINDS X, IT FAILS.
ROUTINE HAS-MODIFIER(X) =
        ITERATE $MOVE-RIGHT
        UNTIL TEST FOR X SUCCEEDS.
   $MOVE-RIGHT = GO RIGHT; TEST FOR MODIFIERS.
— T-WRITE7
T-WRITE7 = IN SENTENCE:
        [WRITE ON TAPE7;]
        WRITE ON INFO END OF LINE;
        WRITE ON INFO '********************';
        WRITE ON INFO '********************';
        WRITE ON INFO END OF LINE;
        WRITE ON INFO '********************';
        WRITE ON INFO '********************';
        WRITE ON INFO END OF LINE;
        WRITE ON INFO '*SID='; WRITE ON INFO IDENTIFICATION;
        WRITE ON INFO END OF LINE;
        WRITE ON INFO SENTEXT [SOURCE];
        WRITE ON INFO END OF LINE;
        WRITE ON INFO END OF LINE.
— T-SIMPLIFY-CENTER
—       STRUNG OUT A RECURSIVE CENTERS -- I.E. CENTER THAT
—       CONTAINS CENTER.
—       THIS IS AN ERRONEOUS STRUCTURE...
T-SIMPLIFY-CENTER = IN SENTENCE:
        BOTH BOTH ITERATE GO DOWN
        UNTIL EITHER PRESENT-ELEMENT- IS INTRODUCER
        OR PRESENT-ELEMENT- IS SECTION SUCCEEDS
        @AND COELEMENT- CENTER X-CENTER EXISTS
        AND ITERATET REPLACE X-C BY ALL ELEMENTS OF X-C
        UNTIL ELEMENT- CENTER X-C OF X-CENTER EXISTS FAILS.
— ***** ****************************************************************


—       FORMATTING TRANSFORMATIONS


— **** ******************************************************************
— T-RECORD-CONJ
—       PUTS CONNECTIVE ON THE SECOND CONJUNCT BY MARKING THE
—       SECOND CONJUNCT WITH NODE ATTRIBUTE CT-CONJ WITH VALUE
—       POINTING TO THE CONNECTIVE.
— **** THE PARSE TREE CONNECTIVES ARE ARRANGED IN POLISH NOTATION.
—       THIS ATTEMPTS TO RESTORE INFIX NOTATION FOR CONNECTIVES: BY
—       ASSOCIATING THE SECOND CONJUNCT WITH ITS SCOPE CONNECTIVE.
T-RECORD-CONJ = IN CENTER:
        BOTH X-CONJ-NUM := LIST CONJ-NUMBERS
        AND AT VALUE OF IMMEDIATE-NODE-
        ITERATET $WHAT-TO-MARK UNTIL $GO-NEXT FAILS.
   $GO-NEXT =
        ITERATE GO RIGHT
        UNTIL TEST FOR CENTER SUCCEEDS.
   $WHAT-TO-MARK =
        [AT CENTER, GO TO FIRST PARSE-CONN AND CONNECT]
        [PARSE-CONN TO ITS SECOND CONJUNCT.]
        AT VALUE ITERATE IF PRESENT-ELEMENT IS PARSE-CONN
        THEN BOTH BOTH $SET-CONN-STACK
        AND DO $SET-NEW-LINK
        AND DO $CONJ-CONFIG
        UNTIL GO RIGHT FAILS.
   $SET-CONN-STACK =
        LCONNR X-PRE OF VALUE OF PRESENT-ELEMENT- EXISTS;
        X-START := X-PRE;
        X-LAST := X-PRE.
   $CONJ-CONFIG =
        BOTH DO $STACK-NODE [PUT PARSE-CONN ON STACK]
        AND GO RIGHT [GO TO FIRST CONJUNCT];
        IF PRESENT-ELEMENT- X-FIRST-ARG IS PARSE-CONN
        THEN BOTH DO $SET-NEW-LINK AND DO $CONJ-CONFIG
        ELSE DO $SET-ARG-LINK;
        DO $NEXT-ARG.
   $NEXT-ARG =
        GO RIGHT [TO SECOND CONJUNCT];
        IF PRESENT-ELEMENT- X-LAST-ARG IS PARSE-CONN
        THEN BOTH BOTH DO $SET-NEW-LINK
        AND DO $CONJ-CONFIG
        AND AT X-FIRST-ARG, BOTH $SET-CONN AND $RESTORE-ARG
        ELSE BOTH $SET-2ND-ARG-LINK AND $SET-CONN.
   $SET-NEW-LINK =
        BOTH BOTH X-CNUM := HEAD OF X-CONJ-NUM
        AND X-CONJ-NUM := SUCCESSORS OF X-CONJ-NUM
        AND AT LCONNR OF VALUE OF PRESENT-ELEMENT-, DO $SET-ARG-LINK.
   $SET-ARG-LINK =
        ASSIGN PRESENT ELEMENT NODE ATTRIBUTE CONJ-LINK WITH VALUE X-CNUM.
   $SET-2ND-ARG-LINK =
        BOTH X-PRE HAS NODE ATTRIBUTE CONJ-LINK X-CLINK
        AND ASSIGN PRESENT ELEMENT NODE ATTRIBUTE CONJ-LINK
        WITH VALUE X-CLINK.
   $STACK-NODE =
        BOTH X-LAST := X-PRE
        AND BOTH LCONNR X-PRE OF VALUE OF PRESENT-ELEMENT- EXISTS
        AND AT X-PRE ASSIGN NODE ATTRIBUTE CONNSTK WITH VALUE X-LAST.
   $SET-CONN =
        AT PRESENT-ELEMENT- X-NODE
        ASSIGN NODE ATTRIBUTE CT-CONJ WITH VALUE X-PRE;
        AT X-PRE ERASE NODE ATTRIBUTE CONNSTK;
        X-PRE := X-LAST;
        EITHER X-PRE HAS NODE ATTRIBUTE CONNSTK X-LAST
        OR X-LAST := NIL;
        GO TO X-NODE.
   $RESTORE-ARG =
        [* RECOVER THE FIRST ARGUMENT OF CONNECTIVE *]
        X-FIRST-ARG HAS NODE ATTRIBUTE CT-CONJ;
        ASCEND TO PARSE-CONN;
        GO RIGHT;
        STORE IN X-FIRST-ARG;
        GO TO X-LAST-ARG [* BACK TO THE LAST NODE ANALYZED *].
— T-BUILD-FORMAT BUILDS FORMAT NODES, TO THE RIGHT OF THE HIGHEST
—       ASSERT OR FRAG OR IMPERATIVE .
—       TARGET STRUCTURE:
—       ASSERT __ FORMAT [__ CONNECT __ ASSERT __ FORMAT]*
—       DIFFERENT FORMATS ARE BUILT DEPENDING ON THE VALUE OF FORMAT-ATT
—       WHICH HAS BEEN ASSIGNED TO FRAGMENT/ASSERTION IN REGULARIZATION
—       COMPONENT. FOR EX. FORMAT1 IS BUILT FOR AN ASSERTION WHOSE
—       FORMAT-ATT HAS A VALUE OF FRMT1.
T-BUILD-FORMAT = IN ASSERTION, FRAGMENT:
        IF PRESENT-ELEMENT- X-PRE DOES NOT HAVE NODE ATTRIBUTE
        PHRASE-ATT [* special phrases, e.g. INFO-SOURCE *]
        THEN BOTH X-PRE HAS NODE ATTRIBUTE FORMAT-ATT X-FMT
        AND ONE OF $IS-F00, $IS-F0, $IS-F13-MED, $IS-F1-3,
        [* $IS-F2, $IS-F3, *] $IS-F4, $IS-F5-EKG,
   $IS-F5, $IS-F5F, $IS-F5-ALG, $IS-F5-MISC,
   $IS-F6, $IS-NOFRMT.
   $IS-F00 = X-FMT HAS MEMBER FRMT00;
        AFTER X-PRE INSERT
        <FORMAT00>X-FORMAT
        ( <PARAGR>
        + <SENT-OP>
        + <PT-DEMOG>
        + <SUBJECT>
        + <OBJECT>
        + <VERB>
        + <INFO-SOURCE>
        + <PRECISIONS> (<MORE-PREDS>)
        + <TIME-QUALS> (<TM-PERIOD>+<TM-REPETITION>)).
   $IS-F0 = X-FMT HAS MEMBER FRMT0;
        AFTER X-PRE INSERT
        <FORMAT0>X-FORMAT
        ( <PARAGR>
        + <PT-DEMOG>
        + <INST>
        + <PT>
        + <VERB>
        + <INFO-SOURCE>
        + <PRECISIONS> (<MORE-PREDS>)
        + <TIME-QUALS> (<TM-PERIOD>+<TM-REPETITION>));
        DO $BUILD-VERB;
        DO $BUILD-PT-DEMOG.
   $IS-F1 = X-FMT HAS MEMBER FRMT1;
        AFTER X-PRE INSERT
        <FORMAT1>X-FORMAT
        ( <PARAGR>
        + <PT-DEMOG>
        + <INST>
        + <PT>
        + <VERB-MD>
        + <VERB>
        + <INFO-SOURCE>
        + <PRECISIONS> (<MORE-PREDS>)
        + <TIME-QUALS> (<TM-PERIOD>+<TM-REPETITION>));
        DO $BUILD-VERB;
        DO $BUILD-PT-DEMOG.
   $IS-F2 = X-FMT HAS MEMBER FRMT2;
        AFTER X-PRE INSERT
        <FORMAT2>X-FORMAT (<PARAGR>
        +<PT-DEMOG>
        +<INST>
        +<PT>
        +<VERB-TR>
        +<VERB>
        +<INFO-SOURCE>
        +<PRECISIONS> (<MORE-PREDS>)
        +<TIME-QUALS> (<TM-PERIOD>+<TM-REPETITION>));
        DO $BUILD-PT-DEMOG;
        DO $BUILD-VERB.
   $IS-F3 = X-FMT HAS MEMBER FRMT3;
        AFTER X-PRE INSERT
        <FORMAT3> X-FORMAT (<PARAGR>
        +<PT-DEMOG>
        +<INST>
        +<PT>
        +<MED-TR>
        +<VERB>
        +<INFO-SOURCE>
        +<PRECISIONS> (<MORE-PREDS>)
        +<TIME-QUALS>
        (<TM-PERIOD>+<TM-REPETITION>));
        DO $BUILD-PT-DEMOG;
        DO $BUILD-MED-TR;
        DO $BUILD-RXDATA;
        DO $BUILD-VERB.
   $IS-F4 =
        X-FMT HAS MEMBER FRMT4;
        AFTER X-PRE INSERT
        <FORMAT4>X-FORMAT (<PARAGR>
        +<PT-DEMOG>
        +<INST>
        +<PT>
        +<TEST-INFO>
        +<VERB>
        + <INFO-SOURCE>
        +<PRECISIONS> (<MORE-PREDS>)
        +<TIME-QUALS> (<TM-PERIOD>+<TM-REPETITION>));
        DO $BUILD-PT-DEMOG;
        DO $BUILD-TEST-INFO;
        DO $BUILD-VERB.
   $IS-F1-3 = X-FMT HAS MEMBER FRMT1-3;
        AFTER X-PRE INSERT
        <FORMAT1-3>X-FORMAT ( <PARAGR>
        + <PT-DEMOG>
        + <TREATMENT> ( <TT-NEG>
        + <TT-MODAL>
        + <GEN>
        + <SURG>
        + <MED>
        + <COMP>
        + <MED-DEVICE> )
        + <SUBJECT>
        + <VERB>
        + <PSTATE-DATA>
        + <PSTATE-SUBJ>
        + <INFO-SOURCE>
        + <PRECISIONS> ( <MORE-PREDS> )
        + <INST>
        + <TIME-QUALS> (<TM-PERIOD>
        +<TM-REPETITION>));
        DO $BUILD-PT-DEMOG;
        DO $BUILD-PSTATE-SUBJ;
        DO $BUILD-PSTATE-DATA;
        AT ELEMENT- TXRES OF PSTATE-DATA OF X-FORMAT
        REPLACE PRESENT-ELEMENT- BY <TTRES>;
        DO $BUILD-VERB.
   $IS-F13-MED = X-FMT HAS MEMBER FRMT13-MED;
        AFTER X-PRE INSERT
        <FORMAT13-MED>X-FORMAT ( <PARAGR>
        + <PT-DEMOG>
        + <TREATMENT> ( <TT-NEG>
        + <TT-MODAL>
        + <GEN>
        + <SURG>
        + <MED>
        + <COMP>
        + <MED-DEVICE> )
        + <SUBJECT>
        + <VERB>
        + <PSTATE-DATA>
        + <PSTATE-SUBJ>
        + <INFO-SOURCE>
        + <PRECISIONS> ( <MORE-PREDS> )
        + <INST>
        + <TIME-QUALS> (<TM-PERIOD>
        +<TM-REPETITION>));
        DO $BUILD-PT-DEMOG;
        DO $BUILD-PSTATE-SUBJ;
        DO $BUILD-PSTATE-DATA;
        AT ELEMENT- TXRES OF PSTATE-DATA OF X-FORMAT
        REPLACE PRESENT-ELEMENT- BY <TTRES>;
        DO $BUILD-VERB.
   $IS-F5 = X-FMT HAS MEMBER FRMT5 OR FRMT5-PTFAM [* temporary *];
        IF X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PHR-ATT
        WHERE X-PHR-ATT HAS MEMBER SOURCE-PHRASE
        THEN TRUE
        ELSE DO $IS-A-FORMAT5.
   $IS-A-FORMAT5 =
        [* 1/22/97 add TREATMENT:GEN into FORMAT5 *]
        AFTER X-PRE INSERT
        <FORMAT5>X-FORMAT ( <PARAGR>
        + <PT-DEMOG>
        + <METHOD> ( <PROCEDURE>
        + <EXAMTEST> )
        + <TREATMENT> ( <TT-NEG>
        + <TT-MODAL>
        + <GEN>
        + <SURG>
        + <MED>
        + <COMP>
        + <MED-DEVICE> )
        + <SUBJECT>
        + <VERB>
        + <PSTATE-DATA>
        + <PSTATE-SUBJ>
        + <INFO-SOURCE>
        + <PRECISIONS> ( <MORE-PREDS> )
        + <INST>
        + <TIME-QUALS> (<TM-PERIOD>
        +<TM-REPETITION>));
        DO $BUILD-PT-DEMOG;
        DO $BUILD-PSTATE-SUBJ;
        DO $BUILD-PSTATE-DATA;
        DO $BUILD-VERB.
   $IS-F5-EKG = X-FMT HAS MEMBER FRMT5-EKG;
        [* 1/22/97 add TREATMENT:GEN into FORMAT5 *]
        AFTER X-PRE INSERT
        <FORMAT5-EKG> X-FORMAT ( <PARAGR>
        + <PT-DEMOG>
        + <METHOD> ( <PROCEDURE>
        + <EXAMTEST> )
        + <TREATMENT> ( <TT-NEG>
        + <TT-MODAL>
        + <GEN>
        + <SURG>
        + <MED>
        + <COMP>
        + <MED-DEVICE> )
        + <SUBJECT>
        + <VERB>
        + <EKG-SUBJ> ( <WAVE>
        + <INTERVAL>
        + <AXIS> )
        + <EKG-DATA> ( <QUANT>
        + <EKG-MORPH>
        + <DIAG>
        + <INDIC>
        + <NORMAL> )
        + <IN-LEADS>
        + <INFO-SOURCE>
        + <PRECISIONS> ( <MORE-PREDS> )
        + <INST>
        + <TIME-QUALS> (<TM-PERIOD>
        +<TM-REPETITION>));
        DO $BUILD-PT-DEMOG;
        DO $BUILD-VERB.
   $IS-F5-MISC = X-FMT HAS MEMBER FRMT5-MISC;
        [* 1/22/97 add TREATMENT:GEN into FORMAT5 *]
        AFTER X-PRE INSERT
        <FORMAT5-MISC>X-FORMAT ( <PARAGR>
        + <PT-DEMOG>
        + <METHOD> ( <PROCEDURE>
        + <EXAMTEST> )
        + <TREATMENT> ( <TT-NEG>
        + <TT-MODAL>
        + <GEN>
        + <SURG>
        + <MED>
        + <COMP>
        + <MED-DEVICE> )
        + <SUBJECT>
        + <VERB>
        + <PSTATE-DATA>
        + <PSTATE-SUBJ>
        + <INFO-SOURCE>
        + <PRECISIONS> ( <MORE-PREDS> )
        + <INST>
        + <TIME-QUALS> (<TM-PERIOD>
        +<TM-REPETITION>));
        DO $BUILD-PT-DEMOG;
        DO $BUILD-PSTATE-SUBJ;
        DO $BUILD-PSTATE-DATA;
        DO $BUILD-VERB.
   $IS-F5-ALG = X-FMT HAS MEMBER FRMT5-ALG;
        AFTER X-PRE INSERT
        <FORMAT5-ALG>X-FORMAT ( <PARAGR>
        + <PT-DEMOG>
        + <AGENTS> ( <TT-NEG>
        + <TT-MODAL>
        + <MED>
        + <ORGANISM>
        + <ALLIFE> )
        + <SUBJECT>
        + <VERB>
        + <PSTATE-DATA>
        + <PSTATE-SUBJ> ( <PT>
        + <PTPART>
        + <PTFUNC>
        + <PTMEAS> )
        + <INFO-SOURCE>
        + <PRECISIONS> ( <MORE-PREDS> )
        + <INST>
        + <TIME-QUALS> (<TM-PERIOD>
        +<TM-REPETITION>));
        DO $BUILD-PT-DEMOG;
        DELETE ELEMENT- FAMILY OF ELEMENT- PT-DEMOG OF X-FORMAT;
        DO $BUILD-PSTATE-DATA;
        DO $BUILD-VERB.
   $IS-F5F = X-FMT HAS MEMBER FRMT5F;
        AFTER X-PRE INSERT
        <FORMAT5F>X-FORMAT ( <PARAGR>
        + <PT-DEMOG>
        + <METHOD> ( <PROCEDURE>
        + <EXAMTEST> )
        + <TREATMENT> ( <TT-NEG>
        + <TT-MODAL>
        + <GEN>
        + <SURG>
        + <MED>
        + <COMP>
        + <MED-DEVICE> )
        + <SUBJECT>
        + <VERB>
        + <PSTATE-DATA>
        + <PSTATE-SUBJ> ( <FAMILY>
        + <PTPART>
        + <PTFUNC>
        + <PTMEAS> )
        + <INFO-SOURCE>
        + <PRECISIONS> ( <MORE-PREDS> )
        + <INST>
        + <TIME-QUALS> (<TM-PERIOD>
        +<TM-REPETITION>));
        DO $BUILD-PT-DEMOG;
        DELETE ELEMENT- FAMILY OF ELEMENT- PT-DEMOG OF X-FORMAT;
        DO $BUILD-PSTATE-DATA;
        DO $BUILD-VERB.
   $IS-F6 = X-FMT HAS MEMBER FRMT6;
        AFTER X-PRE INSERT
        <FORMAT6> X-FORMAT (<PARAGR> +<PT-DEMOG> + <PT> + <VERB>
        +<OBJECT>
        +<INFO-SOURCE>
        +<PRECISIONS> (<MORE-PREDS>)
        +<TIME-QUALS> (<TM-PERIOD>
        +<TM-REPETITION>));
        DO $BUILD-PT-DEMOG.
   $IS-NOFRMT = X-FMT HAS MEMBER NOFRMT.
   $BUILD-PT-DEMOG =
        REPLACE PT-DEMOG OF X-FORMAT BY
        <PT-DEMOG> ( <AGE>X-QN
        + <RACE>
        + <GENDER>
        + <FAMILY>)
        [REPLACE X-QN BY]
        [ <Q-N>X-QUANT ( <NUM>]
        [ + <NON-NUM>]
        [ + <UNIT>]
        [ + <PERUNIT>)]
        [DO $BUILD-AGE].
   $BUILD-AGE = REPLACE X-AGE BY
        <AGE> (<AGE-MK>).
   $BUILD-VERB = TRUE.
   $BUILD-SUBJECT =
        REPLACE SUBJECT OF X-FORMAT BY
        <SUBJECT> (<PT> + <INST> + <FAMILY> + <SUBJ-OTHER>).
   $BUILD-MED-TR = REPLACE MED-TR OF X-FORMAT BY
        <MED-TR>(<MED> + <RXDATA>X-RXDATA + <VERB-TR>).
   $BUILD-RXDATA = REPLACE X-RXDATA BY
        <RXDATA> (<RXDOSE> (<NULL>) +<RXMODE> (<RXMANNER>
        +<RXFREQUENCY>)).
   $BUILD-TEST-INFO =
        REPLACE TEST-INFO OF X-FORMAT BY
        <TEST-INFO> ( <TXSPEC>
        + <TXVAR>
        + <SPEC-ACCESS>
        + <PTPART>
        + <RESULT> X-RESULT
        + <TEST-ENV>);
        REPLACE X-RESULT BY
        <RESULT> ( <ORGANISM> [* also DIAG *]
        + <DIAG>
        + <INDIC>
        + <TESTRES>
        + <QUALIFIERS>
        + <QUANT> (<NULL>)
        + <NORMAL>).
   $BUILD-PSTATE-SUBJ =
        REPLACE PSTATE-SUBJ OF X-FORMAT BY
        <PSTATE-SUBJ> ( <PT> + <PTPART> + <PTFUNC> + <PTMEAS> ).
   $BUILD-PSTATE-DATA = REPLACE PSTATE-DATA OF X-FORMAT BY
        <PSTATE-DATA> ( <DIAG>
        + <INDIC>
        + <TXRES>
        + <QUALIFIERS>
        + <INFLUENCE>
        + <QUANT> (<NULL>)
        + <NORMAL>
        [+ <PTSTATE-OTHER>] ).
        [* THE FOLLOWING SUBSTATEMENTS ARE NOT CALLED UNTIL NEEDED, *]
        [* BUT ARE GLOBAL AND ARE INSERTED HERE FOR COMPLETENESS. *]
   $BUILD-BP-MOD = AFTER PRESENT-ELEMENT- INSERT
        <BP-MOD>X-MOD-SLOT (<PTPART> (<NULL>)). (GLOBAL)
   $BUILD-MODS = AFTER PRESENT-ELEMENT-
        INSERT <MODS> X-MOD-SLOT
        (<NEG>+<MODAL> [+<FACTUAL>+<MODS-OTHER>]).
   $BUILD-TIME-ASP =
        AFTER PRESENT-ELEMENT- INSERT
        <TIME-ASP>X-TIME-SLOT
        ([ <CHANGE> + <CHANGE-MK> +]
        <BEG>
        +<END>
        [+<TIMELOC>]
        [+<TIMEPER>]
        [+<REPT>]). (GLOBAL)
   $BUILD-TIME-QUAL =
        AFTER PRESENT-ELEMENT- INSERT
        <TIME-QUAL>X-TMQUAL-SLOT (<TM-PERIOD> (<NULL>)
        +<TM-REPETITION> (<NULL>)). (GLOBAL)
   $BUILD-EVENT-TIME =
        AFTER PRESENT-ELEMENT- INSERT
        <EVENT-TIME>X-EVENT-SLOT (<TPREP1>X-QUANT (<NULL>)
        +<TPREP2> (<NULL>)
        +<REF-PT> (<NULL>));
        AT X-QUANT DO $BUILD-Q-N. (GLOBAL)
   $BUILD-Q-N =
        AFTER PRESENT-ELEMENT- INSERT
        <Q-N>X-QUANT ( <NUM>
        + <NON-NUM>
        + <UNIT>
        + <PERUNIT>). (GLOBAL)
   $BUILD-RXDOSE =
        AT X-RXDOSE REPLACE PRESENT-ELEMENT- BY
        <RXDOSE>X-RXDOSE (<RXMODE> (<RXMANNER> (<NULL>)
        +<RXFREQUENCY> (<NULL>)));
        VALUE OF X-RXDOSE EXISTS;
        DO $BUILD-Q-N. (GLOBAL)
   $BUILD-TENSE =
        AFTER PRESENT-ELEMENT- INSERT <TENSE>X-TIME-SLOT. (GLOBAL)
   $BUILD-QUANTITY =
        AFTER PRESENT-ELEMENT- INSERT
        <QUANTITY> (<Q-N>X-QUANT ( <NUM>
        + <NON-NUM>
        + <UNIT>
        + <PERUNIT>)). (GLOBAL)
   $BUILD-Y-OF = AFTER PRESENT-ELEMENT-
        INSERT <Y-OF> X-Y-OF. (GLOBAL)
— T-BUILD-CONNECTIVE
—       BUILDS CORRESPONDING FORMAT CONNECTIVE FOR PARSE PARSE-CONN
—       NODE.
T-BUILD-CONNECTIVE = IN PARSE-CONN:
        PRESENT-ELEMENT- X-PRE EXISTS;
        AFTER PRESENT-ELEMENT- INSERT
        <CONNECTIVE> ( VALUE OF X-PRE
        ( <CONN> ( <NON-EMPTY> X-FRMT-SLOT)));
        ELEMENT LCONNR X-PUTIN OF VALUE OF X-PRE EXISTS;
        DO $SET-POINTERS [PUTIN-SLOT(X)].
— T-SPECIAL-PHRASES
—       PUTS ASSERTION OR PN SOURCE-PHRASE
—       INTO SOURCE.
T-SPECIAL-PHRASES = IN SA, LV:
        AT VALUE ITERATE ALL OF $FORMAT-SOURCE, $FORMAT-TIME,
   $FORMAT-INFLUENCE
        UNTIL GO RIGHT FAILS.
   $FORMAT-SOURCE =
        IF BOTH EITHER PRESENT-ELEMENT- X-PRE IS ASSERTION OR FRAGMENT OR PN
        OR BOTH PRESENT-ELEMENT- IS LCS
        AND FOLLOWING-ELEMENT- IS CSSTG
        WHERE ELEMENT- SUB1 X-PRE EXISTS
        AND X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PHR-ATT
        WHERE X-PHR-ATT HAS MEMBER SOURCE-PHRASE
        THEN IF ALL OF $NOT-FORMATED, $FIND-FORMAT [T-FORMAT-SLOT]
        THEN BOTH X-PUTIN := X-PRE
        AND AT X-FORMAT DO PUTIN-SLOT(INFO-SOURCE).
   $FORMAT-TIME =
        IF BOTH EITHER PRESENT-ELEMENT- IS ASSERTION OR PN X-PRE
        OR PRESENT-ELEMENT- IS LCS WHERE
        VALUE X-PRE OF COELEMENT- CSSTG EXISTS
        AND X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PHR-ATT
        WHERE X-PHR-ATT HAS MEMBER TIME-PHRASE
        THEN IF ALL OF $NOT-FORMATED, $FIND-FORMAT [T-FORMAT-SLOT],
   $MAKE-EVENT-TIME
        THEN BOTH X-PUTIN := X-PRE
        AND AT X-FORMAT DO PUTIN-SLOT(EVENT-TIME).
   $MAKE-EVENT-TIME =
        IF X-FORMAT DOES NOT HAVE ELEMENT- EVENT-TIME
        THEN AFTER ELEMENT- VERB OF X-FORMAT
        INSERT <EVENT-TIME>.
   $FORMAT-INFLUENCE =
        IF BOTH EITHER PRESENT-ELEMENT- IS ASSERTION OR PN X-PRE
        OR EITHER PRESENT-ELEMENT- IS SUB0 X-PRE
        OR PRESENT-ELEMENT- IS LCS WHERE
        VALUE X-PRE OF COELEMENT- CSSTG EXISTS
        AND X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PHR-ATT
        WHERE X-PHR-ATT HAS MEMBER INFLUENCE-PHRASE
        THEN IF ALL OF $NOT-FORMATED, $FIND-FORMAT [T-FORMAT-SLOT]
        THEN BOTH X-PUTIN := X-PRE
        AND AT X-FORMAT DO PUTIN-SLOT(INFLUENCE).
— T-PARAGR
—       PUTS CONTENTS OF INTRODUCER UNDER FIRST PARAGR OF
—       FIRST FORMAT IN ONESENT. IF VALUE IS LNR OR LAR IT
—       TRANSFORMS IT.
T-PARAGR = IN ASSERTION, FRAGMENT:
        IF BOTH PRESENT-ELEMENT- X-ASSERT EXISTS
        AND AT ELEMENT- INTRODUCER X-PUTIN OF IMMEDIATE
        ONESENT OF IMMEDIATE CENTER,
        PRESENT-ELEMENT- IS NOT EMPTY
        [AND $FIRST-ONE] [IT IS FIRST ASSERTION IN ONESENT]
        THEN [BOTH $PUTIN-PARAGR AND] $TRANSFORM-CHK.
   $FIRST-ONE = STORE IN X-ASSERT;
        NEITHER ITERATE GO LEFT UNTIL TEST FOR ASSERTION OR FRAGMENT
        SUCCEEDS
        NOR AT IMMEDIATE-NODE- ITERATE GO LEFT UNTIL TEST FOR CENTER
        SUCCEEDS;
        AT X-ASSERT DO R(FORMAT-TYPES) [GO TO FIRST FORMAT];
        STORE IN X-FORMAT.
   $PUTIN-PARAGR = X-PRE:= X-PUTIN;
        AT X-FORMAT DO PUTIN-SLOT(PARAGR).
   $TRANSFORM-CHK =
        IF VALUE OF X-PUTIN IS LNR OR LAR
        @THEN [TRANSFORM PRESENT-ELEMENT-]
        BOTH DO $SET-PARSE-REG [T-FORMAT-SLOT]
        AND IF $CORRECT-FORMAT
        THEN BOTH $SUBCLASS-CHK
        AND $SYNTAX-CHK [T-FORMAT-SLOT]
        ELSE TRUE
        ELSE ALL OF $CORRECT-FORMAT, $PUTIN-PARAGR.
   $CORRECT-FORMAT =
        AT X-ASSERT DO R(FORMAT-TYPES);
        STORE IN X-FORMAT.
— ******************* ******************** ******************** ********
—       *
—       SPECIAL TRANSFORMATIONS *
—       PN AND QN TRANSFORMATIONS *
—       *
— ******************* ********************* ********************* ******

— T-AGE HANDLES ALL AGE EXPRESSIONS THAT ARE NOT ALSO TIME EXPRESSIONS
—       (PHRASES BEGINNING WITH 'AT' ARE HANDLED BY T-TIMEUNIT + T-REFPT
—       -E.G. AT AGE 2 MONTHS; AT THE AGE OF 2 MONTHS; AT 2 MONTHS OF AGE )
— CO-OCCURRENCE RESTRICTIONS:
—       THE HEAD NOUN (OR SUBJECT) MUST BE N:NHUMAN OR POSSIBLY NULLN;
— CASES:
—       1) PN
—       FOR PN: P = 'OF'; HEAD NOUN = 'AGE' OR NTIME1
—       A) HEAD NOUN = 'AGE'; RN = QN: 'OF AGE 2 MONTHS'
—       B) HEAD NOUN : NTIME1 'OF 3 YEARS'
—       2) QUANT-QN
—       FOR QN: N = NTIME1
—       A) IN ASTG: 'THE CHILD IS 4 YEARS (OLD/ OF AGE)'
—       B) IN RN = QN: 'THE CHILD 2 YEARS (OLD/ OF AGE)'
—       C) IN APOS : 'THE 4 MO OLD CHILD'
—       3) LQR : 'THE CHILD IS 4'.
—       FOR LQR: HOST IS NULLN; SUBJECT IS NHUMAN (EG. 'THE CHILD IS 4')
— TRANSFORMATION:
—       1. THE AGE NODE IS CONSTRUCTED BY $BUILD-AGE;
—       2. THE VALUES FOR NUM (X31), TIME-UNIT (X32), AND AGE-MK (X33)
—       ARE LOCATED FOR EACH OF THE 3 MAJOR CONSTRUCTIONS;
—       3. FIRST LQR (IN X31) IS MOVED TO NUM AND REPLACED BY NULL; ($Q)
—       4. NEXT IF IN A QN WITH SCALESTG, THE SCALESTG IS MOVED TO AGE-MK
—       AND REPLACED BY NULL, LEAVING JUST N= NUNIT IN QN; ($MK1)
—       5. N= NUNIT IS MOVED INTO TIME-UNIT AND REPLACED BY NULL IN THE
—       ORIGINAL (THIS REMOVES QN IN RN OF 'OF AGE 30 YRS'); ($UNIT)
—       6. FINALLY IF X33 STILL HAS AGE-MK (CASE 1A), IT IS MOVED INTO
—       FORMAT; ($MK2)
T-AGE = IN PN, QN, LQR:
        IF ALL OF $NOT-FORMATED, $CHECK-HOST, $SET-PARSE-REG,
   $FIND-FORMAT [T-FORMAT-SLOT]
        THEN IF $INSERT-AGE THEN $PRE-TO-AGE-PTR.
   $PRE-TO-AGE-PTR =
        IF X-PRE IS NOT LNR THEN $SET-PN-QN-PTR.
   $SET-PN-QN-PTR =
        X-PUTIN:= X-PRE;
        X-FRMT-SLOT:= X-AGE;
        DO $SET-POINTERS [PUTIN-SLOT(X)].
   $NOT-FORMATED = NOT $IS-FORMATED. (GLOBAL)
   $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
   $CHECK-HOST =
        EITHER $HOST-CHK OR $IS-PRED;
        IF X-HOST IS NOT EMPTY
        THEN AT CORE-SELATT X-S OF X-HOST DO $PT-FAM-CHK.
   $HOST-CHK = HOST- X-HOST EXISTS;
        IF PRESENT-ELEMENT- IS EMPTY
        THEN IF PRESENT-ELEMENT- IS OCCURRING IN PN
        @THEN $CHECK-HOST ['PATIENT OF 3'].
   $IS-PRED = EITHER IMMEDIATE OBJECT EXISTS
        OR IMMEDIATE OBJECT OF IMMEDIATE LN EXISTS;
        CORE- X-HOST OF COELEMENT- SUBJECT EXISTS.
   $PT-FAM-CHK =
        PRESENT-ELEMENT- HAS MEMBER H-PT OR H-FAMILY OR MASC OR FEM.
   $INSERT-AGE =
        IF X-PRE IS PN OR QN THEN $PN-QN-AGE
        ELSE IF PRESENT-ELEMENT- IS QN THEN $QN-AGE
        ELSE $LQR-CASE.
   $PN-QN-AGE =
        IF X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PHRASE-ATT
        WHERE X-PHRASE-ATT HAS MEMBER AGE-PHRASE
        THEN DO FIND-SLOT(AGE)
        WHERE REPLACE PRESENT-ELEMENT- BY
        <AGE> (<NON-EMPTY> X-AGE)
        ELSE BOTH P IS 'DE' OR 'OF' OR 'IN'
        AND ONE OF $CASE-1A , $CASE-1B, $CASE-1C.
   $CASE-1A = ['OF AGE 2 MONTHS']
        CORE-SELATT X-S OF CORE- X-CORE OF ELEMENT- LNR X-AGE-MK
        OF NSTG OF NSTGO OF X-PRE HAS MEMBER H-AGE;
        AT X-AGE-MK ELEMENT- RN HAS ELEMENT- QUANT [QN]
        WHERE DO $QN-AGE.
   $CASE-1B = ['OF 3 YEARS']
        X-S HAS MEMBER NTIME1;
        X-UNIT:= X-AGE-MK;
        DO $GET-LQR;
        STORE IN X-LQR;
        [DO $SETUP-AGE;]
        [DO $PUTIN-Q-N.]
        DO $PUTIN-AGE.
   $PUTIN-AGE =
        EITHER DO FIND-SLOT(AGE) OR DO FIND-SLOT(AGE);
        STORE IN X-AGE;
        X-PUTIN := X-AGE-MK;
        DO PUTIN-SLOT(AGE).
   $GET-LQR = AT ELEMENT- QPOS OF ELEMENT- LN OF X-AGE-MK,
        DESCEND TO LQR.
   $CASE-1C = ['OF 3']
        X-CORE IS EMPTY;
        DO $GET-LQR;
        STORE IN X-LQR;
        [DO $SETUP-AGE;]
        [DO $PUTIN-NUM.]
        DO $PUTIN-AGE.
   $SETUP-AGE = EITHER DO FIND-SLOT(AGE)
        OR DO FIND-SLOT(AGE);
        VERIFY IMMEDIATE-NODE- X-AGE EXISTS;
        STORE IN X-AGE;
        DO $BUILD-Q-N;
        IF ELEMENT- Q-N X-QUANT DOES NOT HAVE ELEMENT- SCALESTG
        THEN AFTER LAST-ELEMENT- OF X-QUANT INSERT <SCALESTG>.
   $PUTIN-Q-N = DO $PUTIN-UNIT;
        DO $PUTIN-NUM. (GLOBAL)
   $PUTIN-UNIT = X-PUTIN:= X-UNIT;
        AT X-QUANT DO PUTIN-SLOT(UNIT).
   $PUTIN-NUM = X-PUTIN:= X-LQR;
        AT X-QUANT DO PUTIN-SLOT(NUM). (GLOBAL)
   $QN-AGE = ['3 MONTHS OLD/OF AGE']
        EITHER X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PHRASE-ATT
        WHERE BOTH X-PHRASE-ATT HAS MEMBER AGE-PHRASE
        AND BOTH X-PUTIN := X-PRE AND DO PUTIN-SLOT(AGE)
        OR $OTHER-QN-AGE.
   $OTHER-QN-AGE =
        ELEMENT- QN EXISTS;
        ELEMENT- LQR X-LQR EXISTS;
        IF COELEMENT- SCALESTG IS NOT EMPTY
        @THEN VALUE X-AGE-MK EXISTS;
        CORE-SELATT OF COELEMENT- N X-UNIT OF X-LQR HAS MEMBER NTIME1;
        DO $SETUP-AGE;
        DO $PUTIN-Q-N;
        IF X-AGE-MK EXISTS WHERE X-PUTIN:= X-AGE-MK
        THEN DO PUTIN-SLOT(SCALESTG);
        DO $QNREP-TEST.
   $QNREP-TEST =
        IF COELEMENT- QNREP X-QN OF X-LQR EXISTS
        THEN $QNREP. (GLOBAL)
   $QNREP = ['2 YEARS 3 MONTHS']
        AT X-QUANT DO FIND-SLOT(UNIT);
        AFTER PRESENT-ELEMENT- INSERT <NUM>X-NUM-SLOT
        +<UNIT>X-UNIT-SLOT;
        X-PUTIN:= ELEMENT- LQR OF VALUE OF X-QN;
        AT X-NUM-SLOT DO PUTIN-SLOT(NUM);
        X-PUTIN:= ELEMENT- N OF VALUE OF X-QN;
        AT X-UNIT-SLOT DO PUTIN-SLOT(UNIT). (GLOBAL)
   $LQR-CASE = ['CHILD IS 3']
        X-PRE IS LQR X-LQR;
        DO $SETUP-AGE;
        DO $PUTIN-NUM.
— T-TESTENV-PHRASE
—       TEST ENVIRONMENT FOR SENTENCES SUCH AS
—       E.G. BLOOD GASES WERE H+ 32 BREATHING AIR ON ADMISSION
—       GASES ON AIR ON ADMISSION WERE H+ 36
—       THESE PHRASES (PN: ON AIR, VINGO: BREATHING AIR) ARE
—       TO BE FORMATTED TO TEST-INFO.
T-TESTENV-PHRASE = IN PN, VINGO:
        IF BOTH PRESENT-ELEMENT- X-PRE HAS NODE ATTRIBUTE PHRASE-ATT
        WHERE PRESENT-ELEMENT- HAS MEMBER TESTENV-PHRASE
        AND ALL OF $NOT-FORMATED, $FIND-FORMAT [T-FORMAT-SLOT],
   $A-FORMAT4
        THEN ALL OF $MARK-TEST-INFO, $SET-POINTERS.
   $A-FORMAT4 =
        X-FORMAT IS FORMAT4.
   $MARK-TEST-INFO =
        X-PUTIN := X-PRE;
        AT X-FORMAT, DESCEND TO TEST-ENV;
        IF DESCEND TO NON-EMPTY
        THEN AFTER LAST-ELEMENT- INSERT <NON-EMPTY> X-FRMT-SLOT
        ELSE REPLACE PRESENT-ELEMENT-
        BY <TEST-ENV> (<NON-EMPTY> X-FRMT-SLOT).
— T-P-WITH-NVN
—       DEALS WITH P THAT HAS PVAL-ATT THAT HAS INCORRECT
—       POINTER -- RESETS POINTER AND PUTS THE STRUCTURE
—       IN TRANSFORM STACK..
T-P-WITH-NVN = IN PN: DO $P-WITH-NVN-CHK.
   $P-WITH-NVN-CHK =
        IF BOTH ELEMENT- P X-PUTIN OF PRESENT-ELEMENT- X-PRE HAS NODE
        ATTRIBUTE PVAL-ATT X-PVAL
        [* pointing to NVN which P should be *]
        [* formatted as a sister to *]
        AND AT X-PVAL DO $CORRECT-PTR
        THEN AT X-PVAL DO $PUT-WITH-NVN.
   $CORRECT-PTR =
        [* rule out VBE + OBJBE:PN -- 2000-10-06 *]
        BOTH BOTH CORE-ATT OF X-PVAL DOES NOT HAVE MEMBER VBE
        AND IMMEDIATE-NODE- OF X-PRE IS NOT OBJBE
        AND DO $UP-TO-ASSERT WHERE
        STORE IN X-P [* ASSERTION where PVAL-ATT ptr is in *];
        AT X-PRE DO $UP-TO-ASSERT [* ASSERTION of this structure *]
        WHERE STORE IN X-ASSERT;
        IF X-P IS NOT IDENTICAL TO X-ASSERT
        [* Pointer is incorrect because of effect of EXPAND *]
        [* routine in transformation component of PVAL-ATT *]
        [* pointer. Pointer points to conjunct instead of *]
        [* original. To correct, erase PVAL-ATT. Previous *]
        [* PVAL-ATT pointer will become current. If that is *]
        [* in the same ASSERTION, it is the correct one. *]
        THEN BOTH AT ELEMENT- P OF X-PRE ERASE NODE ATTRIBUTE PVAL-ATT
        AND DO $CORRECT-PVAL [* new *]
        [AND AT X-PRE DO $P-WITH-NVN-CHK].
   $CORRECT-PVAL =
        CORE- X-PVAL OF ELEMENT- VERBAL OF X-ASSERT EXISTS
        WHERE PRESENT-ELEMENT- HAS ATTRIBUTE OBJLIST:PN:PVAL;
        AT ELEMENT- P OF X-PRE ASSIGN NODE ATTRIBUTE PVAL-ATT
        WITH VALUE X-PVAL.
   $UP-TO-ASSERT =
        ASCEND TO ASSERTION OR FRAGMENT PASSING THROUGH STRING.
   $PUT-WITH-NVN =
        IF $CHK-IF-FRMTED
        @THEN BOTH AFTER PRESENT-ELEMENT- INSERT <NON-EMPTY>X-FRMT-SLOT
        AND $SET-POINTERS [ROUTINE PUTIN-SLOT]
        ELSE $TRANSFORM-IT-FRST.
   $CHK-IF-FRMTED = EITHER $IS-FORMATED
        OR EITHER AT IMMEDIATE LXR DO $IS-FORMATED
        OR AT IMMEDIATE NNN DO $IS-FORMATED.
   $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
   $TRANSFORM-IT-FRST =
        EITHER IMMEDIATE LXR EXISTS
        OR EITHER IMMEDIATE NNN EXISTS
        OR TRUE;
        EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE TRANSFORM-ATT
        OR BOTH ASSIGN NODE ATTRIBUTE TRANSFORM-ATT
        AND $DO-BOTH.
   $DO-BOTH = VERIFY TRANSFORM X-PRE;
        TRANSFORM PRESENT-ELEMENT- [* transform NVN first, then PN *].
— T-INFLUENCE-PN
T-INFLUENCE-PN = IN PN, VENPASS:
        PRESENT-ELEMENT- X-PRE EXISTS;
        EITHER $IS-FORMATED
        OR IF BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE PHRASE-ATT
        @AND PRESENT-ELEMENT- HAS MEMBER INFLUENCE-PHRASE
        THEN ALL OF $FIND-FORMAT, $PUTIN-INFLUENCE, $FURTHER-XFS.
   $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
   $PUTIN-INFLUENCE =
        X-PUTIN := X-PRE;
        AT X-FORMAT DO FIND-SLOT(INFLUENCE);
        DO PUTIN-SLOT(INFLUENCE).
   $FURTHER-XFS = [* Transform right adjunct if not empty *]
        IF RN OF LNR X-LNR OF NSTG OF NSTGO OF X-PRE IS NOT EMPTY
        THEN TRANSFORM X-LNR.
— T-BODYFUNC-PN
—       PUTS LNR INTO ACTIVITY OF EXAM-FUNC IF OCCURRING
—       IN PN WHICH HAS NODE ATTRIBUTE ADVERBIAL-TYPE WITH MEMBER
—       BODYFUNC-PN ( 'ON FLEXION').
— -- ADJUSTED TO BRING THE PN AND PVINGO INTO INFLUENCE 981022.
—       ADD PVINGO INTO THE HOUSING, AND CHANGE PRECISIONS TO INFLUENCE.
T-BODYFUNC-PN = IN PN, PVINGO:
        PRESENT-ELEMENT- X-PRE EXISTS;
        EITHER $IS-FORMATED
        OR IF BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE ADVERBIAL-TYPE
        @AND PRESENT-ELEMENT- HAS MEMBER BODYFUNC-PN
        THEN ALL OF $FIND-FORMAT, $PUTIN-FUNC, [$MARK-LNR,]
   $FURTHER-XFS.
   $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
   $PUTIN-FUNC =
        X-PUTIN := X-PRE;
        AT X-FORMAT DO FIND-SLOT(INFLUENCE) [ACTIVITY] [EXAM-FUNC];
        DO PUTIN-SLOT(INFLUENCE) [PRECISIONS] [ACTIVITY].
   $MARK-LNR =
        EITHER X-PUTIN := LNR OF NSTG OF NSTGO OF X-PRE
        OR X-PUTIN := LVINGR OF VINGO OF X-PRE;
        DO $SET-POINTERS [ROUTINE PUTIN-SLOT].
   $FURTHER-XFS = [* Transform right adjunct if not empty *]
        IF EITHER RN OF LNR X-LNR OF NSTG OF NSTGO OF X-PRE IS NOT EMPTY
        OR RV OF LVINGR X-LNR OF VINGO OF X-PRE IS NOT EMPTY
        THEN TRANSFORM X-LNR.
— T-ADJUST-SEM-CORE
—       VERIFIES THAT PRESENT PN IS:
—       . NOT FORMATTED,
—       . HAS CORE NTIME1 AND HAS NODE ATTRIBUTE ADVERBIAL-TYPE
—       WITH VALUE TIME-ADVERBIAL
—       . IS OCCURRING IN ASSERTION/FRAGMENT/PARSE-CONN/INTRODUCER
—       WHICH HAS A FORMAT FRAME BUILT.
—       . FORMAT FRAME IS A FORMAT5
—       . FIND HOST SLOT.
—       . HOST FORMAT SLOT IS NOT IN PSTATE-DATA
—       THEN:
—       . LOOK FOR A FILLED FORMAT SLOT IN PSTATE-DATA
—       . GO TO NON-EMPTY GET FILLED-PT VALUE
—       . ASSIGN PN NODE ATTRIBUTE SEM-CORE WITH VALUE
—       CORE OF FILLED-PT.
T-ADJUST-SEM-CORE = IN PN: TRUE.
   $CHECK-TIME =
        AT PRESENT-ELEMENT- X-PRE
        BOTH ELEMENT- LNR X-LNR OF NSTG OF NSTGO EXISTS
        AND ELEMENT- P IS NOT 'PAR' OR 'PER' OR 'PRO';
        CORE-SELATT OF CORE- OF X-LNR HAS MEMBER NTIME1;
        BOTH X-PRE HAS NODE ATTRIBUTE ADVERBIAL-TYPE
        @AND PRESENT-ELEMENT- HAS MEMBER TIME-ADVERBIAL.
   $IS-FORMAT5 =
        X-FORMAT IS FORMAT5 OR FORMAT13-MED OR FORMAT1-3
        OR FORMAT5-EKG OR FORMAT5-MISC OR FORMAT5F.
   $NOT-IN-PSTATE-DATA =
        IMMEDIATE-NODE- OF X-HOST-SLOT IS NOT PSTATE-DATA.
   $LOCATE-PSTATE-DATA =
        BOTH ELEMENT- PSTATE-DATA X-PT OF X-FORMAT EXISTS
        AND AT VALUE OF X-PT,
        ITERATET GO RIGHT
        UNTIL ELEMENT- NON-EMPTY X-HS EXISTS SUCCEEDS.
   $ADJUST-SEM-CORE =
        BOTH X-HS HAS NODE ATTRIBUTE FILLED-PT
        WHERE CORE- X-HA EXISTS
        AND AT X-PRE ASSIGN NODE ATTRIBUTE SEM-CORE WITH VALUE X-HA.
— ********* **********************************************************
—       *
—       T I M E E X P R E S S I O N S *
—       *
— ********* **********************************************************
— *** TREATMENT OF TIME EXPRESSIONS ARE DIVIDED INTO TWO PARTS:
—       1. A REFERENCE POINT: E.G. AN EVENT, DATE OR NTIME2 TO WHICH A
—       FIXED TIME POINT CAN BE ASSIGNED;
—       2. A TIME PERIOD RELATIVE TO THIS FIXED POINT: E.G.
—       ONE DAY [TIME PERIOD] BEFORE ADMISSION [REFERENCE POINT].
—       REFERENCE POINT EXPRESSIONS ARE HANDLED BY T-REFPT-PN AND
—       T-REFPT-DATE (FOR DATES); T-TIMEUNIT HANDLES TIME-PERIODS.
— *** STRATEGY FOR TIME EXPRESSIONS *****
—       A. DETERMINE IF WE HAVE REF-PT OR UNIT:
—       1. IN PN OR NSTGT CORE IS NTIME1 (TIME PERIOD) OR NTIME2 (REFPT)
—       2. IF HAVE TIME PREP AND NOT NTIME1 THEN HAVE EVENT = REF. PT;
—       3. OR CORE IS AN EVENT: A NOMINALIZED VERB OF CERTAIN CLASSES
—       OR A TIME-RELATED NOUN: H-CHANGE OR
—       H-ASP (REFERENCE POINT)
—       4. PDATE IS A REF PT.
—       B. FIND THE HOST OF THE TIME EXPRESSIONS; DONE BY $FIND-HOST.
—       MUST FIND HOST IN ORDER TO PUT TIME EXPRESSION INTO APPROPRIATE
—       TIME SLOT IN FORMAT.
—       1. IF RV IS ON A VERB, THEN VERB IS HOST.
—       2. IF IN SA THEN FIND VERB; IF NO VERB, THEN TRY FIRST OBJECT,
—       THEN SUBJECT, AND DO $CHECK-HOST.
—       3. IF IN RN-- DO $CHECK-HOST.
—       C. CHECK THE HOST ($CHECK-HOST)
—       1. ASSUME IF HOST IS VERB THEN DON'T HAVE TO CHECK HOST AT ALL,
—       SINCE ANY VERB CAN SUPPORT A TIME MODIFIER.
—       2. NTIME1 OK AS HOST
—       3. OTHER ALLOWABLE HOSTS: H-TTGEN,H-TXVAR AND NODES IN FINDING
—       D. TRANSFER TIME INFORMATION TO EVENT SLOTS
—       DONE BY $SETUP-REFPT FOR REF-PT, AND $SETUP-TIME FOR TIME PER.
—       E. WRONG HOST: (IF CANNOT FIND A HOST THAT SUPPORTS TIME ADJUNCT)
—       . IF HOST IS IN PN, FIND ITS HOST, AND DO $CHECK-HOST ON IT;
—       (ASSUME THAT NESTED PNS WERE PARSED WRONG, ATTACHED TOO LOW)
—       . OTHERWISE ASCEND UNTIL FIND A VERBAL ELEMENT AS HOST.
— NTN 1/16/97 ADD LDR FOR 'AS PREVIOUSLY MENTIONED'
T-TIMEUNIT = IN LNR, LDR, VERB, PN:
        AT PRESENT-ELEMENT- X-PRE,
        IF ALL OF $NOT-LCONN, $NOT-FORMATED [T-AGE], $CHECK-TIME,
   $FIND-FORMAT [T-FORMAT-SLOT]
        THEN IF DO $FIND-HOST-SLOT [T-MOD]
        THEN AT X-PRE
        EITHER ONE OF $IN-PN-TIME, $PN-TIME
        OR ITERATE ALL OF $FIND-EVENT-TIME [T-MOD],
   $PUT-IN-TIME [$PRE-TO-TIME-PTR]
        UNTIL $NEXT-SLOT-FOR-HOST [T-MOD] FAILS
        ELSE IF DO $SEM-CORE
        THEN TRUE [* pass to get it later *]
        ELSE IF $NOT-TRANSFORM-ATT
        THEN BOTH $FIND-VERB
        AND ONE OF $PN-TIME, $VERB-TIME.
   $SEM-CORE =
        [* since $CHECK-TIME finds that the core of LXR is time *]
        [* this function complements FIND-HOST-SLOT which is up *]
        [* high in PN. *]
        X-CORE HAS NODE ATTRIBUTE SEM-CORE
        WHERE PRESENT-ELEMENT- IS NOT NIL.
   $NOT-TRANSFORM-ATT = [* Check for assignment of TRANSFORM-ATT *]
        IF X-HOST-LXR EXISTS
        THEN X-HOST-LXR DOES NOT HAVE NODE ATTRIBUTE TRANSFORM-ATT.
   $NOT-LCONN = [* LDR in LCONN does not need to be formatted *]
        IF X-PRE IS LDR
        THEN IMMEDIATE-NODE- IS NOT LCONN.
   $IN-PN-TIME =
        X-PRE IS LNR;
        X-PRE IS OCCURRING IN PN;
        DO $IS-FORMATED.
   $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
   $PN-TIME =
        EITHER X-PRE HAS NODE ATTRIBUTE ADVERBIAL-TYPE X-PHRASE-ATT
        WHERE X-PHRASE-ATT HAS MEMBER TIME-ADVERBIAL
        OR X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PHRASE-ATT
        WHERE X-PHRASE-ATT HAS MEMBER TIME-PHRASE;
        [EITHER AT X-SLOT DO HAS-MODIFIER(EVENT-TIME)]
        [ WHERE STORE IN X-FRMT-SLOT ]
        [OR] AFTER X-SLOT INSERT <EVENT-TIME> (<NON-EMPTY> X-FRMT-SLOT);
        X-PUTIN := X-PRE;
        [DO PUTIN-SLOT(EVENT-TIME)]
        DO $SET-POINTERS [PUTIN-SLOT].
   $VERB-TIME =
        AFTER X-SLOT INSERT <EVENT-TIME> (<NON-EMPTY> X-FRMT-SLOT);
        X-PUTIN := X-PRE;
        DO $SET-POINTERS [PUTIN-SLOT].
   $FIND-VERB = [* if there's no host, go to verb *]
        ELEMENT- VERB X-SLOT OF X-FORMAT EXISTS.
   $PRE-TO-TIME-PTR =
        IF X-PRE IS NOT LNR THEN $SET-PN-PTR.
   $SET-PN-PTR =
        X-PUTIN:= X-PRE;
        X-FRMT-SLOT:= X-EVENT-SLOT;
        DO $SET-POINTERS [PUTIN-SLOT(X)]. (GLOBAL)
   $CHECK-TIME =
        EITHER X-PRE HAS NODE ATTRIBUTE ADVERBIAL-TYPE X-PHRASE-ATT
        WHERE X-PHRASE-ATT HAS MEMBER TIME-ADVERBIAL
        OR EITHER X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PHRASE-ATT
        WHERE X-PHRASE-ATT HAS MEMBER TIME-PHRASE
        OR $CHECK-TIME-CONTEXT.
   $CHECK-TIME-CONTEXT =
        IF X-PRE IS PN
        THEN BOTH ELEMENT- LNR X-LNR OF NSTG OF NSTGO EXISTS
        AND ELEMENT- P IS NOT 'PAR' OR 'PER' OR 'PRO'
        ELSE X-PRE IS LNR OR VERB OR LDR X-LNR;
        EITHER CORE-SELATT X-S OF CORE- X-CORE OF X-LNR HAS MEMBER
        NTIME1 OR H-TMLOC
        OR BOTH X-S HAS MEMBER H-TRANSP
        AND BOTH X-CORE HAS NODE ATTRIBUTE COMPUTED-ATT X-S
        AND X-S HAS MEMBER NTIME1 OR H-TMLOC;
        AT X-CORE, DO $NOT-FORMATED;
        X-TYPE-SLOT:= SYMBOL EVENT-TIME.
   $PUT-IN-TIME =
        EITHER $HAS-EVENT-SUBUNIT OR $NO-EVENT-SUBUNIT.
   $HAS-EVENT-SUBJUNIT =
        AT X-EVENT-SLOT IF DO FILLED-SLOT(Q-N)
        THEN $FORM-SUBUNIT
        ELSE EITHER X-QUANT EXISTS
        OR AT X-EVENT-SLOT DO FIND-SLOT(Q-N)
        WHERE PRESENT-ELEMENT- X-QUANT EXISTS;
        ALL OF $P, $N, $Q, $RN-TIMELOC.
   $NO-EVENT-SUBUNIT =
        AT X-SLOT DO HAS-MODIFIER(EVENT-TIME)
        WHERE AFTER LAST-ELEMENT- INSERT <NON-EMPTY> X-FRMT-SLOT;
        X-PUTIN := X-PRE;
        DO $SET-POINTERS [PUTIN-SLOT].
   $P = IF X-PRE IS PN WHERE P X-PUTIN EXISTS
        THEN AT X-EVENT-SLOT DO PUTIN-SLOT(TPREP1).
   $N = X-LNR IS NOT EMPTY WHERE X-UNIT:= X-LNR.
   $Q = IF ONE OF $LQR, $ADJ, $PLU
        THEN $PUTIN-Q-N [T-AGE]
        ELSE $PUTIN-UNIT [T-AGE].
   $RN-TIMELOC =
        IF CORE-SELATT OF CORE- X-RN OF RN OF X-LNR
        HAS MEMBER H-TMLOC
        THEN $PUTIN-TPREP2.
   $PUTIN-TPREP2 =
        AT X-RN EITHER $UP-RN
        OR DO $IMM-LXR [T-FORMAT-SLOT];
        X-PUTIN:= PRESENT-ELEMENT- [DSTG OR LXR = H-TMLOC];
        AT X-EVENT-SLOT DO PUTIN-SLOT(TPREP2).
   $UP-RN = [for RN:D]
        BOTH IMMEDIATE-NODE- IS RN
        AND PRESENT-ELEMENT- EXISTS.
   $LQR = LQR X-LQR OF QPOS OF LN X-LN OF X-LNR IS NOT EMPTY.
   $PLU = CORE- OF X-LNR HAS COELEMENT- N X-LQR WHERE PRESENT-ELEMENT-
        IS 'PLURAL'.
   $ADJ =
        EITHER CORE-SELATT OF CORE- X-CORE OF APOS OF LN OF X-LNR
        HAS MEMBER H-AMT [OR H-TMREP]
        OR X-CORE IS 'FIRST' OR '1ST' OR
        [* French *] '3E' OR '3E2ME' OR '4E2ME' OR '4E';
        IMMEDIATE LAR [LAR1 FOR NON-MDCG] X-LQR OF X-CORE EXISTS.
   $FORM-SUBUNIT =
        BEFORE FIRST ELEMENT OF X-EVENT-SLOT INSERT
        <SUBUNIT>(<TPREP0>(ALL ELEMENTS OF TPREP1 OF X-EVENT-SLOT)
        +<TM-UNIT0>(ALL ELEMENTS OF Q-N OF X-EVENT-SLOT));
        AT X-EVENT-SLOT DO FIND-SLOT(TPREP1);
        REPLACE PRESENT-ELEMENT- BY <TPREP1>;
        AT X-EVENT-SLOT DO FIND-SLOT(UNIT);
        REPLACE PRESENT-ELEMENT- BY <UNIT>;
        AT X-EVENT-SLOT DO FIND-SLOT(NUM);
        REPLACE PRESENT-ELEMENT- BY <NUM>;
        AT X-EVENT-SLOT DO FIND-SLOT(Q-N);
        STORE IN X-QUANT.
— T-TIME-QUAL
—       REGISTERING TIME QUALITY
T-TIME-QUAL = IN LXR:
        AT PRESENT-ELEMENT- X-PRE
        IF ALL OF $NOT-FORMATED [T-AGE],
   $IS-TIME-QUAL,
   $FIND-FORMAT [T-FORMAT-SLOT]
        THEN IF $FIND-HOST-SLOT [T-MOD]
        THEN AT X-PRE ITERATE ALL OF $FIND-TIME-QUAL,
   $PUT-IN-TIME
        UNTIL $NEXT-SLOT-FOR-HOST [T-MOD] FAILS.
   $IS-TIME-QUAL =
        CORE-ATT X-SEL-CORE OF CORE- OF X-PRE HAS MEMBER H-TMDUR
        OR H-TMREP.
   $FIND-TIME-QUAL =
        AT X-SLOT EITHER DO HAS-MODIFIER(TIME-QUAL)
        WHERE STORE IN X-TMQUAL-SLOT
        OR $BUILD-TIME-QUAL [T-BUILD-FORMAT].
   $PUT-IN-TIME =
        AT X-PRE, STORE IN X-PUTIN;
        IF CORE-ATT X-SEL-CORE OF CORE- OF X-PRE HAS MEMBER H-TMDUR
        THEN DO $PUT-IN-PERIOD
        ELSE IF X-SEL-CORE HAS MEMBER H-TMREP
        THEN DO $PUT-IN-REPETITION.
   $PUT-IN-PERIOD =
        AT X-TMQUAL-SLOT
        IF DO FILLED-SLOT(TM-PERIOD)
        THEN AFTER LAST-ELEMENT- OF X-TMQUAL-SLOT
        INSERT <TM-PERIOD> X-SLOT [X-PUTIN]
        ELSE BOTH AT X-TMQUAL-SLOT DO FIND-SLOT(TM-PERIOD)
        @AND STORE IN X-SLOT [X-PUTIN];
        AT X-TMQUAL-SLOT DO PUTIN-SLOT(TM-PERIOD).
   $PUT-IN-REPETITION =
        AT X-TMQUAL-SLOT
        IF DO FILLED-SLOT(TM-REPETITION)
        THEN AFTER LAST-ELEMENT- OF X-TMQUAL-SLOT
        INSERT <TM-REPETITION>X-SLOT [X-PUTIN]
        ELSE BOTH AT X-TMQUAL-SLOT DO FIND-SLOT(TM-REPETITION)
        @AND STORE IN X-SLOT [X-PUTIN];
        AT X-TMQUAL-SLOT DO PUTIN-SLOT(TM-REPETITION).
— T-REFPT-PN
—       FORMATS INTO EVENT-TIME OR REF-PT
—       FOR PN AND SUB2 THAT ARE TIME-ADVERBIAL.
T-REFPT-PN = IN PN, SUB2 [92.08.03]:
        IF BOTH ALL OF $NOT-FORMATED [T-AGE], $CHECK-REFPT,
   $FIND-FORMAT [T-FORMAT-SLOT],
        AND ONE OF $TIME-PHRASE-HOST, $FIND-HOST-SLOT [T-MOD],
   $LXR-HOST
        THEN AT X-PRE
        ITERATE IF ALL OF $FIND-EVENT-TIME [T-MOD], $NOT-TIMEUNIT,
   $SETUP-REFPT
        THEN EITHER ALL OF $PUT-IN-REFPT,
   $PRE-TO-TIME-PTR [T-TIMEUNIT]
        OR DO $PRE-TO-TIME-PTR [T-TIMEUNIT]
        ELSE DO $PRE-TO-TIME-PTR [T-TIMEUNIT]
        UNTIL $NEXT-SLOT-FOR-HOST [T-MOD] FAILS.
   $LXR-HOST =
        HOST- EXISTS;
        ASCEND TO LXR; STORE IN X-HOST-SLOT;
        PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT X-SLOT.
   $NOT-TIMEUNIT =
        [* Eliminate ambiguous NUNIT NTIME1 *]
        NOT $FORMATTED-TIMEUNIT.
   $FORMATTED-TIMEUNIT =
        EITHER ELEMENT- P OF X-PRE HAS NODE ATTRIBUTE FORMAT-PT
        OR EITHER ELEMENT- LNR OF ELEMENT- NSTG OF ELEMENT- NSTGO OF
        X-PRE HAS NODE ATTRIBUTE FORMAT-PT
        OR ELEMENT- QUANT OF ELEMENT- NSTGO OF
        X-PRE HAS NODE ATTRIBUTE FORMAT-PT;
        IMMEDIATE EVENT-TIME EXISTS
        WHERE PRESENT-ELEMENT- IS IDENTICAL TO X-EVENT-SLOT.
   $CHECK-REFPT =
        [PRESENT-ELEMENT- X-PRE HAS NODE ATTRIBUTE REFPT-ATT;]
        EITHER
        PRESENT-ELEMENT- X-PRE HAS NODE ATTRIBUTE ADVERBIAL-TYPE
        WHERE PRESENT-ELEMENT- HAS MEMBER TIME-ADVERBIAL
        OR PRESENT-ELEMENT- X-PRE HAS NODE ATTRIBUTE PHRASE-ATT
        WHERE PRESENT-ELEMENT- HAS MEMBER TIME-PHRASE;
        X-TYPE-SLOT := SYMBOL EVENT-TIME.
   $TIME-PHRASE-HOST =
        BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE PHRASE-ATT
        AND IMMEDIATE-NODE IS SA X-SA;
        COELEMENT- VERBAL X-VERB OF X-SA EXISTS;
        X-HOST-SLOT := CORE- OF X-VERB;
        AT X-FORMAT DO FIND-SLOT(VERB)
        WHERE STORE IN X-SLOT.
   $SETUP-REFPT = AT X-EVENT-SLOT
        IF DO FILLED-SLOT(EVENT-TIME)
        THEN BOTH NOT DO FILLED-SLOT(REF-PT)
        AND IF DO FIND-SLOT(TPREP2) WHERE VALUE IS NON-EMPTY
        @THEN REPLACE PRESENT-ELEMENT- BY <NULL>
        [* take out TPREP2 for TPREP2 that goes with REFPT *]. [GLOBAL]
   $PUT-IN-REFPT = ALL OF $P, $N.
   $P = ELEMENT- P X-PUTIN OF X-PRE EXISTS;
        IF P IS NOT '[P]'
        THEN AT X-EVENT-SLOT DO PUTIN-SLOT(TPREP2).
   $N = AT X-PRE,
        EITHER ELEMENT- LNR X-LNR OF NSTG OF NSTGO EXISTS
        OR ELEMENT- QN X-LNR OF QUANT OF NSTGO EXISTS;
        X-PUTIN:= X-LNR;
        IF CORE- X-CORE HAS NODE ATTRIBUTE N-TO-LN-ATT
        @THEN PRESENT-ELEMENT- X-PUTIN EXISTS
        ELSE IF X-CORE HAS NODE ATTRIBUTE N-TO-RN-ATT
        @THEN PRESENT-ELEMENT- X-PUTIN EXISTS
        [* if CORE has COMPUTED-ATT, REF-PT *]
        [* should be LXR which causes COMPUTED-ATT *];
        AT X-EVENT-SLOT DO PUTIN-SLOT(REF-PT);
        IF X-PUTIN IS NOT IDENTICAL TO X-LNR [WAS THERE A COMPUTED-ATT]
        THEN BOTH X-PUTIN:= X-LNR AND $SET-POINTERS
        [* mark LNR of NSTGO of PN as having been formated *];
        IF CORE- OF X-LNR IS 'A3GE' OR 'AGE'
        THEN $AGE-REFPT.
   $AGE-REFPT =
        IF EITHER RN OF X-LNR HAS ELEMENT- QUANT
        WHERE ELEMENT- QN X-QN EXISTS ['AGE 3 YEARS']
        OR LP OF X-PRE HAS ELEMENT- QN X-QN ['3 YEARS OF AGE']
        THEN $QN
        ELSE IF AT ELEMENT- PN X-PN OF RN OF X-LNR
        BOTH P IS 'DE' OR 'OF'
        AND EITHER CORE-SELATT OF CORE- X-S OF LNR OF NSTG
        OF NSTGO HAS MEMBER NTIME1
        ['AT THE AGE OF 3 YEARS']
        OR CORE-ATT OF X-S HAS MEMBER NUNIT
        ['AT THE AGE OF 3']
        THEN $PN-IN-PN.
   $QN =
        AT X-QN ELEMENT- LQR X-LQR EXISTS;
        AT X-QN ELEMENT- N X-UNIT EXISTS;
        DO $PUTIN-Q-N [T-AGE];
        DO $QNREP-TEST.
   $PN-IN-PN =
        LQR X-LQR OF QPOS OF LEFT-ADJUNCT OF X-S IS NOT EMPTY;
        AT X-EVENT-SLOT DO $PUTIN-NUM [T-AGE];
        IF CORE-SELATT OF X-S HAS MEMBER NTIME1
        THEN IMMEDIATE LNR X-UNIT OF X-S EXISTS;
        DO $PUTIN-UNIT [T-AGE];
        DO $SET-PN-IN-PN-PTR;
        DO $SWITCH-PREPS.
   $SET-PN-IN-PN-PTR =
        X-PUTIN:= X-PN;
        X-FRMT-SLOT:= X-EVENT-SLOT;
        DO $SET-POINTERS [PUTIN-SLOT(X)].
   $SWITCH-PREPS = AT X-EVENT-SLOT DO FIND-SLOT(TPREP2);
        STORE IN X2;
        AT X-EVENT-SLOT DO FIND-SLOT(TPREP1);
        REPLACE PRESENT-ELEMENT- BY <TPREP1>(ALL ELEMENTS OF X2);
        AT X2 REPLACE PRESENT-ELEMENT- BY <TPREP2>(<NULL>);
        ELEMENT P X-PUTIN OF X-PN EXISTS;
        DO PUTIN-SLOT(TPREP2).
— T-REFPT-DATE
T-REFPT-DATE = IN PDATE, PD:
        AT PRESENT-ELEMENT- X-PRE
        IF ALL OF $NOT-FORMATED [T-MOD],
   $FIND-FORMAT [T-FORMAT-SLOT],
   $SET-TYPE-REG
        THEN EITHER IF $FIND-HOST-SLOT [T-MOD]
        THEN AT X-PRE
        ITERATE IF ALL OF $FIND-EVENT-TIME [T-MOD],
   $SETUP-REFPT [T-REFPT-PN]
        THEN $PUT-IN-REFPT
        UNTIL $NEXT-SLOT-FOR-HOST [T-MOD] FAILS
        OR $HOSTLESS-TIME.
   $HOSTLESS-TIME =
        EITHER X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PATT
        WHERE X-PATT HAS MEMBER TIME-PHRASE
        OR X-PRE HAS NODE ATTRIBUTE ADVERBIAL-TYPE X-PATT
        WHERE X-PATT HAS MEMBER TIME-ADVERBIAL;
        ELEMENT- VERB X-SLOT OF X-FORMAT EXISTS;
        AFTER X-SLOT INSERT <EVENT-TIME> (<NON-EMPTY> X-FRMT-SLOT);
        X-PUTIN := X-PRE;
        DO $SET-POINTERS [PUTIN-SLOT].
   $SET-TYPE-REG = X-TYPE-SLOT:= SYMBOL EVENT-TIME.
   $PUT-IN-REFPT =
        ALL OF $P, $N, $PRE-TO-TIME-PTR [T-TIMEUNIT].
   $N = ONE OF $DATE, $LQR, $LDR;
        AT X-EVENT-SLOT DO PUTIN-SLOT(REF-PT).
   $DATE =
        IF ELEMENT- DATE OF X-PRE EXISTS
        THEN X-PUTIN := DATE OF X-PRE
        ELSE IF ELEMENT- LDATER OF X-PRE EXISTS
        THEN X-PUTIN := LDATER OF X-PRE
        [;IF MOREDATE OF X-PRE HAS VALUE LDATER X-PUTIN]
        [ THEN AT X-EVENT-SLOT DO PUTIN-SLOT(REF-PT)].
   $LQR = X-PUTIN := LQR OF X-PRE.
   $LDR = X-PUTIN := LDR OF X-PRE.
   $P = IF VALUE X-PUTIN IS NOT NULL
        THEN AT X-EVENT-SLOT DO PUTIN-SLOT(TPREP2).
— T-NPOS-REFPT
—       PUTS NVN WORDS WHICH ARE ALSO H-TTGEN OR H-TTMED AND
—       WHICH ARE IN NPOS INTO REFPT. IF N IN NPOS IS NTIME1,
—       IT PUTS IT INTO UNIT IN EVENT-SLOT OF HOST.
T-NPOS-REFPT = IN NNN:
        IF $IS-NPOS-REFPT THEN $PUT-IN-REFPT
        ELSE $CHECK-TIME.
   $IS-NPOS-REFPT =
        BOTH CORE- X-CORE OF PRESENT-ELEMENT- X-PRE IS NVN
        AND EITHER X-S HAS MEMBER H-TTGEN
        OR X-S HAS MEMBER H-TTCOMP OR H-TTMED
        WHERE CORE-SELATT OF HOST- X-HOST DOES NOT HAVE
        MEMBER H-TTCOMP.
   $PUT-IN-REFPT = IF $SETUP THEN $REFPT;
        ITERATET IF ALL OF $FIND-EVENT-TIME [T-MOD],
   $SETUP-REFPT [T-REFPT-PN]
        THEN $REFPT
        UNTIL $NEXT-SLOT-FOR-HOST [T-MOD] FAILS.
   $SETUP =
        ALL OF $NOT-FORMATED [T-AGE], $FIND-FORMAT [T-FORMAT-SLOT],
   $SET-AND-FIND-H, $FIND-EVENT-TIME [T-MOD],
   $SETUP-REFPT [T-REFPT-PN].
   $REFPT = [* GRI - eliminate NPOS-TIME *]
        X-PUTIN := X-PRE;
        AT X-EVENT-SLOT DO PUTIN-SLOT(REF-PT).
   $CHECK-TIME =
        IF BOTH X-S HAS MEMBER NTIME1
        AND $SETUP
        THEN BOTH ALL OF $SET-QUANT, $N, $P
        AND ITERATET IF ALL OF $FIND-EVENT-TIME, $SETUP-REFPT
        THEN ALL OF $N, $P
        UNTIL $NEXT-SLOT-FOR-HOST [T-MOD] FAILS.
   $SET-QUANT = AT X-EVENT-SLOT
        DO FIND-SLOT(Q-N);
        STORE IN X-QUANT.
   $N = X-UNIT:= X-PRE;
        AT X-EVENT-SLOT DO $PUTIN-UNIT [T-AGE].
   $Q= AT X-QUANT DO FIND-SLOT(NUM);
        REPLACE PRESENT-ELEMENT- BY
        <NUM> (<NON-EMPTY> X-FRMT-SLOT (<LQR> X-PUTIN
        (<LQ> (<NULL>)
        +<QVAR> (<Q>='[1]')
        +<RQ> (<NULL>))));
        DO $SET-POINTERS [PUTIN-SLOT].
   $P = TRUE. [* GRI - eliminate NPOS-TIME *]
   $SET-AND-FIND-H =
        X-TYPE-SLOT:= SYMBOL EVENT-TIME;
        AT X-PRE DO $FIND-HOST-SLOT [T-MOD].
— ********* **********************************************************
—       *
—       Q U A N T I T Y E X P R E S S I O N S *
—       *
— ********* **********************************************************
— T-QUANT
—       THIS TRANSFORMATION HANDLES EXPRESSIONS OF QUANTITATIVE RESULTS,
—       PLACING THEM IN FORMAT NODE QUANT. (TIME AND AGE EXPR ARE EXCLUDED)
—       *CASES
—       1. LQR IN QPOS, WITH NULLN, NUNIT OR H-TXVAR AS CORE OF IMMED LNR;
—       [HCT WAS 24; TEST SHOWED 10 POLYS]
—       2. LQNR, WHERE N OF QN/NQ = NUNIT.
—       A. LQNR IN APOS [A 10 LB. CHILD]
—       B. LQNR IN ASTG OF OBJECT [WEIGHT WAS 2 LBS];
—       C. LQNR IN RN
—       EACH QN CAN HAVE A QNREP, CONTAINING A SECOND NUM + UNIT:
—       EG. 'WEIGHT 2 LBS 10 OZ';
—       EITHER CASE CAN BE CONJOINED [HCT 24 TO 37] INDICATING A
—       RANGE; IN THIS CASE QUANT WILL CONTAIN A RANGE MARKER 'BETW'
—       (CONTAINING THE CONJUNCTION), Q-N (FOR THE 1ST VALUE) AND
—       Q-N2 (FOR THE SECOND VALUE).
—       *STEPS
—       1. CHECK COOC: NO TIME OR AGE EXPRESSIONS ALLOWED;
—       ONLY FIRST CONJUNCTION OPERATED ON IF THERE IS CONJUNCTION.
—       2. BUILD APPROPRIATE QUANT WITH Q-N -AND Q-N2 IF IN A CONJUNCTION
—       3. LOCATE LQR (STORED IN X31) AND UNIT EXPRESSION (X32);
—       NOTE THAT QNREP IS INSERTED INTO FORMAT AND ERASED IN QN FIRST
—       4. MOVE LQR AND UNIT INTO FORMAT:
—       LQR MOVED INTO NUM AND ORIGINAL ERASED;
—       ENTIRE QN OR LNR (MINUS LQR AND/OR QNREP) IS INSERTED INTO
—       UNIT-WD.
—       *POINTERS
—       IF LQR IN QPOS MODIFIES NULLN OR AN ALREADY FORMATTED
—       H-TXVAR WORD
—       THEN POINTER SET FROM QPOS TO NUM (FOR FIRST CONJUNCT ONLY)
—       OTHERWISE POINTER SET FROM NODE ABOVE LNR OR QN/NQ TO UNIT-WD.
—       *LEFT AND RIGHT ADJUNCTS OF Q, QN, NQ ARE IGNORED.
T-QUANT = IN LXR, QPERUNIT, DSTG, NNN, NQ, QN [, PQUANT]:
        [* LXR = LQR, LAR, LAR1, LNR, LDR, LTR *]
        AT PRESENT-ELEMENT- X-PRE
        IF $CHECK-COOC
        THEN IF $QUANT-IN-PTPART
        THEN TRUE
        ELSE IF $QUANT-IN-H-PALP
        THEN DO PUTIN-SLOT(TXRES)
        ELSE IF ONE OF $DS-NODE, $LAR-NODE
        THEN DO PUTIN-SLOT(QUANT)
        ELSE ALL OF [$SET-UP-PQUANT,] $SET-UP-QN, $INSERT,
   $CHK-FOR-PERUNIT [T-PERUNIT],
   $CHK-FOR-SCALESTG,
   $CHK-FOR-PREP.
   $QUANT-IN-PTPART =
        BOTH X-PRE IS LQR
        WHERE ASCEND TO LNR PASSING THROUGH LN
        @AND CORE-ATT OF CORE- HAS MEMBER H-PTPART.
   $DS-NODE =
        EITHER X-PRE IS LNR
        WHERE EITHER CORE- X-PUTIN IS DS
        OR VALUE OF ELEMENT- RN IS DS X-PUTIN
        OR X-PRE IS NNN WHERE CORE- X-PUTIN IS DS.
   $LAR-NODE = [* a small non-Q-wave anterior myocardial infarction *]
        X-PRE IS LAR
        WHERE CORE- X-PUTIN IS ADJ.
   $QUANT-IN-H-PALP =
        [ Example: Foie a2 3 cm du RC ]
        X-FORMAT IS FORMAT5;
        EITHER BOTH X-PRE IS LNR X-PUTIN
        WHERE CORE-ATT OF CORE- HAS MEMBER NUNIT
        AND X-PRE IS OCCURRING IN PN
        OR X-PRE IS PQUANT X-PUTIN;
        HOST- IS H-PTPALP.
   $SET-UP-PQUANT =
        IF X-PRE IS PQUANT
        THEN VALUE OF ELEMENT- QUANT EXISTS WHERE STORE IN X-PRE.
   $CHK-FOR-SCALESTG =
        IF ONE OF $QN-SCALE, $PTMEAS
        THEN BOTH IF X-TEMP DOES NOT HAVE ELEMENT- SCALESTG
        THEN AFTER LAST-ELEMENT- OF X-QUANT [Q-N]
        INSERT <SCALESTG>
        AND AT X-QUANT, DO PUTIN-SLOT(SCALESTG).
   $QN-SCALE =
        BOTH X-PRE IS QN
        AND ELEMENT- SCALESTG X-PUTIN OF X-PRE IS NOT EMPTY.
   $PTMEAS =
        [* PUT H-PTMEAS OF PN UNIT STRUCTURE INTO SCALESTG *]
        BOTH X-PRE IS LNR
        WHERE CORE- X-UNIT IS NUNIT
        AND BOTH ELEMENT- RN OF X-PRE IS NOT EMPTY
        WHERE BOTH ELEMENT- PN X-PN EXISTS
        AND VALUE OF X-PN IS 'DE' OR 'DES' OR 'OF'
        AND LNR X-PUTIN OF NSTG OF NSTGO OF X-PN EXISTS
        WHERE CORE- IS H-PTMEAS.
   $CHK-FOR-PREP =
        IF EITHER X-PRE IS PQUANT WHERE ELEMENT- P X-PREP EXISTS
        OR EITHER X-PRE IS LNR
        WHERE BOTH ASCEND TO PN
        @AND ELEMENT- P X-PREP EXISTS
        OR EITHER X-PRE IS QN
        WHERE BOTH IMMEDIATE-NODE- IS QUANT
        @AND COELEMENT- P X-PREP EXISTS
        OR X-PRE IS QPERUNIT
        WHERE BOTH IMMEDIATE-NODE- IS QUANT
        @AND BOTH IMMEDIATE-NODE- IS NSTGO
        @AND COELEMENT- P X-PREP EXISTS
        THEN BOTH X-PUTIN := X-PREP
        AND BOTH IF X-TEMP DOES NOT HAVE ELEMENT- PREP
        THEN BEFORE VALUE OF X-QUANT INSERT <PREP>
        AND AT X-QUANT, DO PUTIN-SLOT(PREP).
   $CONJ-TEST =
        DO R(CONJ-NODE);
        EITHER Q-CONJ EXISTS OR $CONJ-TEST [IGNORE ',' PUNCT.];
        GO DOWN.
   $CHECK-COOC =
        ALL OF $NOT-FORMATED [T-AGE], $NO-CONJ, $QUANT-TYPE,
   $FIND-FORMAT [T-FORMAT-SLOT], $IS-FORMAT4OR5.
   $IS-FORMAT4OR5 =
        X-FORMAT IS FORMAT1-3 OR FORMAT13-MED OR FORMAT4 OR
        FORMAT5 OR FORMAT5-EKG OR FORMAT5-MISC OR FORMAT5F.
   $PRE-TO-QUANT-PTR =
        IF X-PRE IS NOT LQR OR LNR THEN $SET-QN-NQ-PTR.
   $SET-QN-NQ-PTR =
        X-QUANT := X-FRMT-SLOT;
        X-PUTIN:= X-PRE;
        DO $SET-POINTERS [PUTIN-SLOT(X)].
   $NO-CONJ =
        IF BOTH PRESENT-ELEMENT- X-PRE IS LQR
        AND ASCEND TO LNR PASSING THROUGH LN WHERE STORE IN X-LNR
        @THEN IMMEDIATE-NODE- IS NOT Q-CONJ
        ELSE IMMEDIATE-NODE- IS NOT Q-CONJ.
   $QUANT-TYPE =
        [* Checks for types of QUANT expressions: *]
        [* LQR, PQUANT, QN, NQ, QPERUNIT, LNR, DS, or *]
        [* H-AMT in LAR, LAR1, NNN, DSTG, LDR or LTR *]
        IF PRESENT-ELEMENT- IS LQR
        THEN ONE OF $Q-IN-QPOS, $Q-IN-RN, $Q-IN-QUANT
        ELSE IF X-PRE IS PQUANT
        [THEN AT ELEMENT- LQR OF QUANT, DO $NOT-FORMATED]
        THEN DO $QN-STRUCT
        ELSE IF PRESENT-ELEMENT- IS QN OR NQ
        THEN DO $QN-STRUCT
        ELSE IF X-PRE IS QPERUNIT
        [WHERE ELEMENT- PERUNIT X-UNIT EXISTS]
        THEN TRUE
        ELSE IF X-PRE IS LNR
        WHERE CORE- X-UNIT IS NUNIT OR H-AMT
        THEN BOTH X-UNIT IS NOT NTIME1 OR
        H-PTPART OR H-PTAREA OR H-TTMED
        OR H-INST
        AND $NOT-TPOSS-UNIT
        ELSE EITHER $DS-NODE
        OR BOTH X-PRE IS LAR OR LAR1 OR NNN
        OR DSTG OR LDR OR LTR
        WHERE CORE- X-UNIT IS H-AMT
        AND $HOST-OK.
   $NOT-TPOSS-UNIT =
        [* 'our unit' is H-INST, not QUANT *]
        BOTH X-UNIT IS H-INST
        AND AT TPOS OF LEFT-ADJUNCT OF X-UNIT,
        BOTH VALUE X-LQR IS NOT EMPTY
        AND CORE- OF X-LQR IS NOT T:TPOSS.
   $QN-STRUCT =
        IF CORE-SELATT X-QNATT OF ELEMENT- N EXISTS
        THEN BOTH X-QNATT DOES NOT HAVE MEMBER NTIME1
        AND BOTH AT ELEMENT- LQR, DO $NOT-FORMATED
        AND AT ELEMENT- N, DO $NOT-FORMATED.
   $Q-IN-QUANT = IMMEDIATE-NODE- IS QUANT.
   $Q-IN-RN =
        PRESENT-ELEMENT- IS OCCURRING IN RADJSET
        WHERE HOST- X-HOST EXISTS;
        CORE-SELATT DOES NOT HAVE MEMBER NTIME1 OR H-AGE.
   $Q-IN-QPOS = ALL OF $OK-CORE, $HOST-OK, $TXRES-QUANT, $OK-P.
   $TXRES-QUANT =
        [* LQR: '3' should not be formatted in case of *]
        [* 'foie a2 3 cm du RC', where 'a2 3 cm du RC' *]
        [* has been formatted as TXRES of PTPART 'foie' *]
        IF BOTH X-ATT HAS MEMBER NUNIT
        [AND BOTH X-FORMAT IS FORMAT5]
        AND EITHER IMMEDIATE PN OF IMMEDIATE LNR OF X-HOST EXISTS
        OR IMMEDIATE PQUANT EXISTS
        @THEN HOST- IS NOT H-PTPALP.
   $OK-CORE =
        AT CORE- EITHER PRESENT-ELEMENT- IS Q [QNUMBER OR H-AMT]
        OR PRESENT-ELEMENT- IS CPDNUMBR.
   $HOST-OK =
        EITHER EITHER HOST- X-HOST IS NULLN
        OR EITHER $LDR-IN-LTR
        OR BOTH PRESENT-ELEMENT- IS OCCURRING IN OBJECT X-OBJ
        AND CORE- X-HOST OF COELEMENT- SUBJECT
        OF X-OBJ EXISTS
        OR BOTH CORE-SELATT X-ATT OF X-HOST HAS MEMBER
        NUNIT OR H-TXVAR
        OR H-INDIC OR H-RESP OR H-PTPART OR H-PTMEAS OR
        H-PTFUNC [2/1/89] OR H-NORMAL [has cleared considerably]
        OR H-TXRES OR H-TTMED OR H-DIAG [* GRI *]
        AND X-ATT DOES NOT HAVE MEMBER NTIME2 OR H-AGE OR H-TXPROC;
        IF X-UNIT EXISTS
        @THEN IF PRESENT-ELEMENT- IS NOT H-AMT
        THEN $CHK-NOREP
        ELSE $CHK-NOREP.
   $LDR-IN-LTR =
        IMMEDIATE-NODE- OF X-PRE IS LT
        WHERE IMMEDIATE-NODE- IS LTR X-LTR;
        CORE-ATT OF CORE- OF X-PRE HAS MEMBER H-AMT;
        HOST- X-HOST OF X-LTR EXISTS.
   $CHK-NOREP =
        IF X-ATT HAS MEMBER H-TXVAR
        THEN X-HOST IS H-TXVAR:NO-REP
        [IT IS RESULT OF TEST AND NOT NUMBER OF TESTS].
   $OK-P =
        IF AT X-HOST
        EITHER PRESENT-ELEMENT- IS NULLN
        OR CORE-ATT HAS MEMBER NUNIT
        THEN IF EITHER IMMEDIATE PN EXISTS
        OR IMMEDIATE PQUANT EXISTS
        @THEN P IS 'A2' OR 'DE' OR 'PRESQUE' OR 'SOUS'
        [English] OR 'AT' OR 'OF' OR 'ON' OR 'IN' OR
        'TO' OR 'OVER' OR 'FROM' OR 'UNDER'.
   $CONJOINED-TEST = IF $CONJOINED @THEN $CONJ.
   $Q-N-TO-Q-N2 = AT X-QUANT REPLACE PRESENT-ELEMENT- BY
        <Q-N2>(ALL ELEMENTS OF X-QUANT);
        STORE IN X-QUANT.
   $CONJOINED =
        EITHER $LNR-CONJ OR $QN-NQ-CONJ.
   $LNR-CONJ =
        IF PRESENT-ELEMENT- IS LQR WHERE X-LNR EXISTS
        @THEN COELEMENT- CONJ-NODE X12 EXISTS;
        AT ELEMENT- Q-CONJ DESCEND TO LN;
        DESCEND TO X-PRE;
        STORE IN X-PRE.
   $QN-NQ-CONJ = COELEMENT- CONJ-NODE X12 EXISTS;
        AT ELEMENT- Q-CONJ DESCEND TO QN OR NQ;
        STORE IN X-PRE.
   $CONJ =
        ALL OF $SET-UP-QN2, $INSERT [IN Q-N2], $Q-N-TO-Q-N2.
   $SET-UP-QN2 =
        AT X-QUANT DO $BUILD-Q-N;
        BEFORE X-QUANT INSERT <BETW>X-SLOT(<NULL>);
        VALUE X-PUTIN OF X12 EXISTS;
        AT X-SLOT DO PUTIN-SLOT(BETW).
   $SET-UP-QN =
        AT X-FORMAT, DO FIND-SLOT(QUANT) WHERE STORE IN X-TEMP;
        EITHER AT VALUE OF X-TEMP DO $BUILD-Q-N
        [* treadmill exercise stress testing demonstrating *]
        [* about 2 mm of inferior ST segment depression *]
        OR DO $BUILD-Q-N [T-BUILD-FORMAT].
   $INSERT = ALL OF $NONNUM-OR-NUM, $QNREP-TEST [T-AGE].
   $NONNUM-OR-NUM =
        IF X-UNIT [CORE OF X-PRE] IS H-AMT
        THEN $PUTIN-NONNUM
        ELSE BOTH $LQR AND $N.
   $PUTIN-NONNUM = AT X-QUANT REPLACE PRESENT-ELEMENT- BY
        <Q-N>X-QUANT (<NON-NUM>);
        X-PUTIN:= X-PRE;
        AT X-QUANT DO PUTIN-SLOT(NON-NUM).
   $PLU =
        IF 4TH ELEMENT OF ELEMENT- QN OF X-UNIT [UNIT-WD]
        IS N X-LQR WHERE VERIFY PRESENT-ELEMENT- IS 'PLURAL'
        THEN AT X-QUANT IF DO FILLED-SLOT(NUM)
        THEN TRUE
        ELSE $PUTIN-NUM [T-AGE].
   $LQR = EITHER PRESENT-ELEMENT- IS LQR X-LQR
        OR EITHER ELEMENT- LQR X-LQR EXISTS
        OR EITHER ELEMENT- Q X-LQR EXISTS
        OR EITHER X-PRE IS QPERUNIT
        WHERE ELEMENT- LQR X-LQR EXISTS
        OR $QUANT-LNR.
   $QUANT-LNR =
        BOTH X-PRE IS LNR WHERE CORE X-CORE EXISTS
        AND EITHER BOTH ELEMENT- LN OF X-PRE IS EMPTY
        AND X-CORE IS NUNIT [*new*]
        OR EITHER AT QPOS OF LEFT-ADJUNCT OF X-CORE,
        VALUE X-LQR IS NOT EMPTY
        [OR EITHER X-CORE HAS NODE ATTRIBUTE COMPUTED-ATT]
        [WHERE PRESENT-ELEMENT- HAS MEMBER H-TTMED]
        OR EITHER X-CORE IS PLURAL
        OR AT TPOS OF LEFT-ADJUNCT OF X-CORE,
        BOTH VALUE X-LQR IS NOT EMPTY
        AND CORE- OF X-LQR IS 'A' OR 'AN' OR
        [French] 'UN' OR 'UNE' OR
        'L''' OR 'LE' OR 'LA' OR 'LES'.
   $N = IF ONE OF $LQR-N-NOTFRMT,
   $Q-CONJ-N,
   $NQ-OR-QN,
   $LNR-CHK [, $QPERUNIT]
        THEN IF X-PRE IS LNR [* core is NUNIT *]
        WHERE ELEMENT- LN IS EMPTY
        THEN $PUTIN-UNIT [T-AGE]
        ELSE $PUTIN-Q-N [T-AGE]
        ELSE $PUTIN-NUM [T-AGE].
   $QPERUNIT =
        X-PRE IS QPERUNIT;
        ELEMENT- N OF X-UNIT IS NUNIT.
   $LQR-N-NOTFRMT = X-PRE IS LQR;
        AT X-LNR BOTH $NOT-FORMATED [T-MOD]
        AND CORE- IS NOT 'POUR-CENT' OR 'PERCENT';
        X-UNIT:= X-LNR.
   $Q-CONJ-N =
        PRESENT-ELEMENT- IS Q-CONJ WHERE ELEMENT- N X-UNIT EXISTS.
   $NQ-OR-QN =
        X-PRE IS QN OR NQ WHERE ELEMENT- N X-UNIT IS NOT
        'POUR-CENT' OR 'PERCENT'.
   $LNR-CHK =
        X-PRE IS LNR WHERE X-CORE IS NOT 'POUR-CENT' OR 'PERCENT';
        X-UNIT:= X-PRE.
— T-PERUNIT
—       PLACES PER + UNIT (OR 'PERCENT') AFTER UNIT IN QUANT.
T-PERUNIT = IN PN:
        AT PRESENT-ELEMENT- X-PRE,
        DO $CHK-FOR-PERUNIT.
   $CHK-FOR-PERUNIT =
        IF ALL OF $HAVE-PERUNIT, $NOT-FORMATED [T-MOD],
        [$NOT-PERUNIT,] $FIND-FORMAT
        THEN $PUTIN-PERUNIT.
   $HAVE-PERUNIT =
        IF PRESENT-ELEMENT- IS PN X-PUTIN
        THEN BOTH P IS 'PAR' OR 'PER' OR 'PRO'
        AND BOTH LP IS EMPTY
        AND CORE- OF NSTG OF NSTGO IS NUNIT
        ELSE EITHER $PERUNIT-NOT-NULL
        OR ELEMENT- N X-PUTIN EXISTS
        WHERE PRESENT-ELEMENT- IS 'POUR-CENT' OR 'PERCENT'.
   $PERUNIT-NOT-NULL =
        EITHER PERUNIT IS NOT EMPTY
        OR AT PERUNIT DO R(PERUNIT)
        WHERE PRESENT-ELEMENT- IS NOT EMPTY [CHECK BOTH PERUNITS];
        STORE IN X-PUTIN.
   $PUTIN-PERUNIT =
        DO $QUANT-FULL [*GRI*];
        [AFTER UNIT OF X-QUANT INSERT <PERUNIT>;]
        AT X-QUANT DO PUTIN-SLOT(PERUNIT).
   $NOT-PERUNIT =
        ONE OF $HAVE-Q-N, $QUANT-FULL,
   $RXDOSE-FULL [Find Q-N this PERUNIT pertains to];
        PRESENT-ELEMENT- DOES NOT HAVE ELEMENT- PERUNIT.
   $HAVE-Q-N = X-QUANT EXISTS [Filling X-QUANT].
   $RXDOSE-FULL = DO FIND-SLOT(RXDOSE);
        STORE IN X-QUANT;
        PRESENT-ELEMENT- HAS ELEMENT- Q-N [* it is filled *].
   $QUANT-FULL = DO FIND-SLOT(QUANT);
        STORE IN X-QUANT;
        EITHER PRESENT-ELEMENT- HAS ELEMENT Q-N
        OR DO $BUILD-Q-N [* T-BUILD-FORMAT *].
— T-MEDDOSE
—       FORMATS DOSAGE INFORMATION. THERE ARE 2 CASES:
—       1- PDOSE/MEDDOSE IN RN
—       - PLACE LQR OF QN IN RXNUM
—       - EVERYTHING ELSE IN QN INTO RXUNIT
—       RECURSIVELY LOOK FOR X-TIMES, H-TTMODE AND H-TTFREQ WORDS AND
—       PUT THEM IN RXFREQUENCY, RXMANNER AND RXPERIOD RESPECTIVELY.
—       2- LQNR IN APOS (MUST CHECK THAT N IS NOT NTIME1)
—       - DO THE SAME IN THE QN AS IN MEDDOSE
T-MEDDOSE = IN PDOSE, PN [, LQNR, MEDDOSE]: [* add PDOSE & PN 5/24/96 *]
        AT PRESENT-ELEMENT- X-PRE IF $CHECK-COOC THEN $MEDDOSE.
   $CHECK-COOC =
        [EITHER] BOTH X-PRE IS PDOSE OR PN
        WHERE DO $IN-PDOSE-QUANT
        AND ALL OF $NOT-FORMATED, $HOST-CHK, $FIND-FORMAT,
   $IS-FORMAT345
        [OR ALL OF $NOT-FORMATED] [T-AGE][, $HOST-CHK,]
        [ $FIND-FORMAT] [T-FORMAT-SLOT][, $IS-FORMAT3].
   $IS-FORMAT3 = X-FORMAT IS FORMAT1-3 OR FORMAT13-MED.
   $IS-FORMAT345 =
        X-FORMAT IS FORMAT1-3 OR FORMAT13-MED OR FORMAT4 OR FORMAT5
        OR FORMAT5-MISC [OR FORMAT5F].
   $HOST-CHK = IF X-PRE IS LQNR THEN HOST IS H-TTMED.
   $IN-PDOSE-QUANT =
        PRESENT-ELEMENT- HAS NODE ATTRIBUTE PHRASE-ATT X-DATT;
        X-DATT HAS MEMBER DOSE-PHRASE.
   $MEDDOSE =
        [EITHER] BOTH X-PRE IS PDOSE OR PN X-PUTIN
        WHERE DO $IN-PDOSE-QUANT
        AND DO PUTIN-SLOT(QUANT)
        [OR ALL OF $CHK-DOSE, $GET-DOSE, $RXMODE, $SET-DOSE-PTR].
   $CHK-DOSE =
        DO FIND-SLOT(RXDOSE);
        STORE IN X-RXDOSE;
        EITHER BOTH DO FILLED-SLOT(RXDOSE)
        @AND DO FIND-SLOT(Q-N) WHERE STORE IN X-QUANT
        OR $BUILD-RXDOSE [T-BUILD-FORMAT]. (GLOBAL)
   $GET-DOSE = ONE OF $QN, $LQR-NULLN, $NULL-DOSE.
   $LQR-NULLN = CORE IS NULLN X-UNIT;
        COELEMENT- LQR X-LQR EXISTS;
        DO $PUTIN-Q-N.
   $NULL-DOSE = ELEMENT NULL EXISTS.
   $QN = EITHER CORE OF X-PRE IS QN
        OR ELEMENT- QN EXISTS;
        STORE IN X-QN;
        LQR X-LQR EXISTS WHERE COELEMENT- N X-UNIT EXISTS;
        DO $PUTIN-Q-N [T-AGE];
        AT X-QN BOTH $CHK-FOR-PERUNIT AND $QNREP-TEST [T-AGE].
   $SET-DOSE-PTR =
        X-PUTIN:= X-PRE;
        X-FRMT-SLOT:= X-RXDOSE;
        DO $SET-POINTERS [PUTIN-SLOT(X)].
   $RXMODE = ITERATET $LOOK UNTIL ELEMENT- RXMODE IS NOT EMPTY FAILS.
   $LOOK =
        AT VALUE VERIFY $FREQ-MANNER.
   $FREQ-MANNER =
        IF PRESENT-ELEMENT- IS EMPTY @THEN GO RIGHT;
        IF EITHER PRESENT-ELEMENT- X-PUTIN IS MANY-TIMES
        OR CORE-SELATT X-S HAS MEMBER H-TTFREQ
        THEN DO PUTIN-SLOT(RXFREQUENCY)
        ELSE IF X-S HAS MEMBER H-TTMODE
        THEN DO PUTIN-SLOT(RXMANNER).
— T-STATUS-TIME
—       PUTS 'STATUS [5 ANS APRE2S] X' IN EVENT-TIME.
T-STATUS-TIME = IN QN-TIME:
        PRESENT-ELEMENT- X-PRE EXISTS;
        IF ALL OF $NOT-FORMATED [T-AGE],
        [$CHECK-COOC,]
   $FIND-FORMAT [T-FORMAT-SLOT],
   $FIND-HOST-SLOT [T-MOD]
        THEN DO $PUT-IN-PREP1.
   $PUT-IN-PREP1 =
        DO $FIND-EVENT-TIME [T-MOD];
        AT X-PRE, STORE IN X-PUTIN;
        AT X-EVENT-SLOT, DO PUTIN-SLOT(TPREP1).
— T-QN-TIME
—       PUTS TIME EXPRESSION IN QN OR APOS (E.G. 4 HOUR TRANSFUSION)
—       INTO EVENT-TIME SLOT.
— -- 960528 -- TAKE OUT QN THAT HAS TIME-ADVERBIAL
T-QN-TIME = IN QN, NQ [QN-TIME]:
        PRESENT-ELEMENT- X-PRE EXISTS;
        IF BOTH BOTH CORE-SELATT OF ELEMENT- N X-UNIT
        OF PRESENT-ELEMENT- X-QN HAS MEMBER NTIME1
        OR H-TMLOC OR H-AGE [* Mar 22 1999 *]
        AND $QN-IN-PQUANT [* Mar 10 1999 *]
        AND AT X-PRE,
        ALL OF [$NOT-FORMATED in T-AGE,]
   $CHECK-COOC,
   $FIND-FORMAT [T-FORMAT-SLOT],
   $FIND-HOST-SLOT [T-MOD]
        THEN IF EITHER X-PRE HAS NODE ATTRIBUTE PHRASE-ATT X-PATT
        WHERE X-PATT HAS MEMBER TIME-PHRASE
        OR X-PRE HAS NODE ATTRIBUTE ADVERBIAL-TYPE X-ADVB
        WHERE X-ADVB DOES NOT HAVE MEMBER TIME-ADVERBIAL
        THEN DO $FIND-TIME-LOCS
        ELSE ITERATE BOTH $PUT-IN AND $PRE-TO-TIME-PTR
        UNTIL $NEXT-SLOT-FOR-HOST [T-MOD] FAILS.
   $QN-IN-PQUANT =
        DO $NOT-FORMATED [T-AGE];
        IF IMMEDIATE PQUANT OF X-PRE EXISTS
        WHERE DO $NOT-FORMATED
        @THEN STORE IN X-PRE.
   $FIND-TIME-LOCS =
        X-PUTIN := X-PRE;
        AFTER X-SLOT INSERT <EVENT-TIME> (<NON-EMPTY> X-FRMT-SLOT);
        [DO PUTIN-SLOT(TIME-LOCS)]
        DO $SET-POINTERS [PUTIN-SLOT].
   $PUT-IN =
        BOTH $FIND-EVENT-TIME [T-MOD]
        AND $SETUP-REFPT [T-REFPT-PN];
        AT X-PRE, STORE IN X-QUANT;
        ALL OF $PUTIN-UNIT [T-AGE], $SCALE, $P, $Q.
   $SCALE =
        IF BOTH VALUE X-PUTIN OF SCALESTG OF X-QN IS ADJ
        @AND CORE-SELATT HAS MEMBER H-TMDUR
        THEN AT X-EVENT-SLOT IF NOT DO FILLED-SLOT(TIMEPER)
        @THEN DO PUTIN-SLOT(TIMEPER).
   $P = TRUE.
   $Q = IF ELEMENT- LQR X-LQR OF X-QN IS NOT EMPTY
        THEN $PUTIN-NUM [T-AGE].
   $CHECK-COOC = BOTH $1 AND $2.
   $1 = IF HOST- IS N OR ADJ [* premature at 26 weeks *]
        @THEN CORE-SELATT DOES NOT HAVE MEMBER H-PT OR H-FAMILY OR
        H-INST [H-DOCTOR].
   $2 = IF EITHER ASCEND TO OBJECT OR ASCEND TO OBJBE
        @THEN NOT CORE- OF COELEMENT- SUBJECT IS N:NHUMAN;
        X-TYPE-SLOT:= SYMBOL EVENT-TIME.
— T-TPOSS
—       REMOVES SELECT-ATT OF POSSESSIVE ARTICLES.
—       AND INSERTS ADJUNCT-TYPE TO HOST.
T-TPOSS = IN LTR:
        IF BOTH CORE- X-CORE OF PRESENT-ELEMENT- IS T:TPOSS
        AND X-CORE DOES NOT HAVE NODE ATTRIBUTE COMPUTED-ATT
        THEN DO $INSERT-ADJUNCT-TYPE.
   $INSERT-ADJUNCT-TYPE =
        X-ADJ-TYPE := NIL;
        X-ADJ := SYMBOL ADJUNCT-TYPE;
        PREFIX X-ADJ TO X-ADJ-TYPE;
        AT X-CORE, ASSIGN NODE ATTRIBUTE ADVERBIAL-TYPE
        WITH VALUE X-ADJ-TYPE.
— T-NO
—       TURNS LTR:'NO' OF HOST H-TXVAR:NO-REP
—       OF A FRAGMENT:NSTG INTO QUANT='[0]'.
T-NO = IN LTR:
        IF BOTH CORE- OF PRESENT-ELEMENT- X-PRE IS T:H-NEG
        ['AUCUN' OR 'AUCUNE' OR 'NON' OR 'NO']
        AND AT IMMEDIATE LNR X-LNR OF HOST X-HOST
        DO $IS-FORMATED
        THEN $CHK-TEST-LABRES.
   $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
   $CHK-TEST-LABRES =
        IF BOTH X-S HAS MEMBER H-TXVAR
        WHERE AT X-HOST, PRESENT-ELEMENT- IS H-TXVAR:NO-REP
        AND $IN-NSTG-FRAG
        THEN $SETUP-ZERO.
   $IN-NSTG-FRAG = AT X-PRE ASCEND TO NSTG PASSING THROUGH LN
        WHERE IMMEDIATE-NODE- IS FRAGMENT.
   $SETUP-ZERO = DO $FIND-FORMAT [T-FORMAT-SLOT];
        DO FIND-SLOT(QUANT);
        AT VALUE DO $BUILD-Q-N [T-BUILD-FORMAT];
        REPLACE VALUE OF NUM OF X-QUANT BY
        <NON-EMPTY>X-FRMT-SLOT (<LQR>X-PUTIN (<LQ>(<NULL>)
        +<QVAR> (<Q>='[0]')));
        DO $SET-POINTERS;
        IF COELEMENT- N X-N OF X-HOST IS 'PLURAL'
        THEN BOTH X-TEMP:= NIL
        AND AT X-N ASSIGN NODE ATTRIBUTE FORMAT-PT WITH VALUE
        X-TEMP [ASSIGN FORMAT-PT TO NOTHING SO THAT]
        [PLURAL IS NOT FORMATED];
        AT X-PRE ASSIGN NODE ATTRIBUTE FORMAT-PT WITH VALUE X-FRMT-SLOT.
— T-FORMAT-EKG-LEADS
T-FORMAT-EKG-LEADS = IN LLEADR:
        AT IMMEDIATE IN-LEADS X-PRE,
        IF ALL OF $FIND-FORMAT, $NOT-FORMATED
        THEN BOTH BOTH X-PUTIN := X-PRE
        AND AT X-FORMAT, DO PUTIN-SLOT(IN-LEADS)
        AND IF BOTH X-PRE HAS ELEMENT- LLEADR X-PUTIN
        AND AT X-PUTIN, DO $NOT-FORMATED
        THEN AT X-FORMAT, DO PUTIN-SLOT(IN-LEADS).
— T-FORMAT-SLOT
—       --- 2001 01 09 ADD FORMAT GENDER, I.E. NODE GRAM-NODE
—       TO THE RIGHT OF CORE.
T-FORMAT-SLOT = IN LXR, NNN, DSTG, LD:
        BOTH DO $FORMAT-GENDER
        AND DO $FORMAT-SLOTS.
   $FORMAT-GENDER =
        IF BOTH PRESENT-ELEMENT- X-PRE IS OF TYPE LXR
        AND COELEMENT- GRAM-NODE X-PUTIN OF CORE-
        IS '[MALE]' OR '[FEMALE]'
        WHERE CORE-ATT X-S OF X-PUTIN EXISTS
        THEN IF ALL OF $FIND-FORMAT, $NOT-FORMATED
        THEN AT X-FORMAT, DO PUTIN-SLOT(GENDER).
   $FORMAT-SLOTS =
        VERIFY $SET-PARSE-REG;
        EITHER $EXCEPTION
        OR IF $FIND-FORMAT
        THEN IF ONE OF $HAS-FAIL-SEL, $HAS-ADJUNCT-ATT,
   $CORE-FAIL-SEL, $CORE-ADJUNCT-ATT, $F00-CHK
        THEN $SYNTAX-CHK
        ELSE BOTH $SUBCLASS-CHK AND $SYNTAX-CHK
        ELSE TRUE.
   $SET-PARSE-REG = [GLOBAL]
        CORE- X-CORE OF PRESENT-ELEMENT- X-PRE EXISTS;
        EITHER BOTH X-CORE HAS NODE ATTRIBUTE COMPUTED-ATT X-S
        AND X-CORE HAS NODE ATTRIBUTE SELECT-ATT X-NEWLIST
        WHERE DO $IS-MINOR-CLASS
        OR EITHER CORE-SELATT X-S OF X-CORE EXISTS
        OR X-S:= NIL.
   $EXCEPTION = ONE OF $IS-TM-SIGN, $IS-INTRO, [$IS-FORMATED,]
   $IS-TM-OF-LXR,
   $IN-SS-FORMATTED-LNR,
   $Y-OF-FORMATED, $NNN-IN-NNN,
   $IS-LQR-LQNR, $IS-LCONNR, $IS-MOD-VERB,
   $IS-LD, $IS-NEG-MODAL.
   $IN-SS-FORMATTED-LNR =
        [* do not format words in an LNR which had been formatted *]
        AT X-PRE,
        ITERATE EITHER PRESENT-ELEMENT- IS OCCURRING IN PN
        WHERE ASCEND TO LNR PASSING THROUGH ADJSET1
        OR ASCEND TO LNR PASSING THROUGH ADJSET1
        UNTIL BOTH EITHER CORE- OF PRESENT-ELEMENT- X-FPRE HAS NODE
        ATTRIBUTE FORMAT-PT
        WHERE IMMEDIATE-NODE- X-FRMT-HEAD IS DIAG OR INDIC
        [OR TXRES OR TTRES OR TESTRES OR PTFUNC]
        OR PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT
        WHERE IMMEDIATE-NODE- X-FRMT-HEAD IS DIAG OR INDIC
        [OR TXRES OR TTRES OR TESTRES OR PTFUNC]
        AND BOTH $MATCH-FRMT-HEAD
        AND GO TO X-FPRE
        SUCCEEDS.
   $MATCH-FRMT-HEAD =
        EITHER BOTH X-S HAS MEMBER H-DIAG
        AND X-FRMT-HEAD IS DIAG
        OR [EITHER] BOTH X-S HAS MEMBER H-INDIC
        AND X-FRMT-HEAD IS INDIC
        [OR BOTH X-S HAS MEMBER H-TXRES OR H-RESP]
        [AND X-FRMT-HEAD IS TXRES OR TTRES OR TESTRES]
        [OR BOTH X-S HAS MEMBER H-PTFUNC]
        [AND X-FRMT-HEAD IS PTFUNC].
   $NNN-IN-NNN =
        BOTH X-PRE IS NNN
        AND IMMEDIATE-NODE- OF X-PRE IS NNN
        WHERE DO $IS-FORMATED.
   $IS-TM-OF-LXR =
        BOTH X-PRE IS OF TYPE LXR
        AND EITHER BOTH X-S HAS MEMBER H-TMDUR [7.30.92]
        AND HOST- EXISTS
        WHERE PRESENT-ELEMENT IS OCCURRING IN LXR
        OR BOTH X-PRE IS OF TYPE VERBAL [6.12.97]
        AND X-S HAS MEMBER H-TMBEG OR H-TMEND.
   $IS-TM-SIGN = [7.28.92]
        ALL OF $TM-SEM-CORE, $SIGN-SYMPTOM, $ERASE-SEM-CORE.
   $TM-SEM-CORE = [7.28.92]
        BOTH BOTH X-CORE HAS NODE ATTRIBUTE SELECT-ATT X-NEWLIST
        AND X-NEWLIST HAS MEMBER H-TMDUR
        AND X-S EXISTS WHERE PRESENT-ELEMENT- IS NOT NIL.
   $SIGN-SYMPTOM = [7.28.92]
        BOTH BOTH X-CORE HAS NODE ATTRIBUTE SEM-CORE X-SH
        @AND CORE-ATT X-SH-ATT OF CORE- EXISTS
        AND X-SH-ATT HAS MEMBER H-INDIC OR H-DIAG.
   $ERASE-SEM-CORE = [7.28.92]
        BOTH AT X-CORE, ERASE NODE ATTRIBUTE SEM-CORE
        AND FALSE.
   $IS-INTRO =
        [* LXR in INTRODUCER can be repeatedly formatted *]
        [* SPECIAL CASE: 'Heart: s1 s2, no murmur' *]
        BOTH $IS-FORMATED
        AND IMMEDIATE-NODE- IS NOT INTRODUCER.
   $IS-LD =
        [* SPECIAL CASE: D of LD needs to be formatted. *]
        BOTH X-PRE IS LD
        AND VALUE OF X-PRE IS NOT D.
   $IS-MOD-VERB =
        [* EXCLUDE H-MODAL/H-NEG VERB FROM FORMATTING INTO VERB *]
        BOTH X-CORE IS V OR TV OR VEN OR VING
        AND X-S HAS MEMBER H-MODAL OR H-NEG.
   $Y-OF-FORMATED =
        [* If this is a Y-OF structure then check if *]
        [* phrase had been formatted: if it did, exit. *]
        BOTH $IN-PN
        AND BOTH ONE OF $HAS-TRANSFORM-ATT, $IS-SEM-CORE-OF, $IS-X-FROM-N
        AND IMMEDIATE LNR OF X-HST HAS NODE ATTRIBUTE FORMAT-PT.
   $IN-PN =
        IF X-PRE IS OCCURRING IN PN
        @THEN HOST- X-HST EXISTS
        ELSE HOST- X-HST EXISTS.
   $HAS-TRANSFORM-ATT =
        X-PRE HAS NODE ATTRIBUTE TRANSFORM-ATT.
   $IS-SEM-CORE-OF =
        BOTH X-HST HAS NODE ATTRIBUTE SEM-CORE X-CMP
        AND CORE- OF X-PRE IS IDENTICAL TO X-CMP.
   $IS-X-FROM-N =
        BOTH EITHER X-HST HAS NODE ATTRIBUTE N-TO-RN-ATT X-CMP
        OR X-HST HAS NODE ATTRIBUTE N-TO-LN-ATT X-CMP
        AND X-PRE IS IDENTICAL TO X-CMP.
   $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
   $CORE-FAIL-SEL = AT X-CORE DO $HAS-FAIL-SEL. (GLOBAL)
   $CORE-ADJUNCT-ATT = AT X-CORE DO $HAS-ADJUNCT-ATT. (GLOBAL)
   $HAS-FAIL-SEL =
        PRESENT-ELEMENT- HAS NODE ATTRIBUTE FAIL-SEL.
   $HAS-ADJUNCT-ATT =
        BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE ADVERBIAL-TYPE
        @AND PRESENT-ELEMENT- HAS MEMBER ADJUNCT-TYPE.
   $IS-LCONNR = EITHER X-PRE IS LCONNR
        OR X-PRE IS OCCURRING IN LCONNR.
   $F00-CHK = X-FORMAT IS FORMAT00.
   $FIND-SLOT = VERIFY X-NEWLIST:= LIST FORMAT-LIST;
        IF INTERSECT OF X-S IS NOT NIL
        THEN EITHER $PUT-IN-FORMAT OR TRUE.
   $PUT-IN-FORMAT =
        VERIFY X-PUTIN := X-PRE;
        VERIFY X-SIGNAL:= X-PRE [GET ARG FROM X-SLOT SIGNAL];
        VERIFY $CHK-FORMAT-TYPE.
   $CHK-FORMAT-TYPE =
        EITHER ITERATET SUCCESSORS X-INTERSECTION OF
        X-INTERSECTION IS NOT NIL
        UNTIL $CHK-TYPE SUCCEEDS
        OR TRUE.
   $CHK-TYPE =
        EITHER BOTH DO $IS-CHANGE-X
        AND AT X-FORMAT DO FIND-SLOT(QUANT)
        WHERE STORE IN X-SLOT
        OR [BOTH IF $IS-PT-GENDER THEN DO $IS-GENDER]
        [AND] ATTRIBUTE-LIST X-SLOT OF X-INTERSECTION EXISTS;
        IF ATTRIBUTE-LIST X-F OF X-SLOT EXISTS
        THEN AT X-FORMAT BOTH TEST FOR X-F AND $PUT-IN
        ELSE AT X-FORMAT DO $PUT-IN.
   $IS-PT-GENDER =
        [BOTH X-INTERSECTION HAS MEMBER H-PT OR H-FAMILY]
        [AND] X-INTERSECTION HAS MEMBER FEM OR MASC.
   $IS-GENDER =
        BOTH X-HEAD := HEAD OF X-INTERSECTION
        AND BOTH X-GENDER := LIST PT-GENDER
        AND X-GENDER HAS MEMBER X-HEAD.
   $PUT-IN =
        [* NOTE: To separate H-CHANGE:(MORE) from *]
        [* H-CHANGE:(LESS) -- to do *]
        EITHER BOTH DO $IS-CHANGE-X
        AND BOTH VERIFY X-SIGNAL := NIL
        AND DO PUTIN-SLOT(QUANT)
        OR BOTH VERIFY X-SIGNAL := X-PRE [get arg from X-SLOT signal]
        AND DO PUTIN-SLOT(REGX);
        EITHER $TEST-FOR-GENDER
        OR IF SUCCESSORS OF X-INTERSECTION IS NOT NIL
        THEN $WARN-MESS1.
   $IS-CHANGE-X =
        X-S HAS MEMBER H-CHANGE OR H-CHANGE-MORE OR H-CHANGE-LESS
        OR H-CHANGE-SAME.
   $TEST-FOR-GENDER =
        EITHER AT X-INTERSECTION DO $GENDER-TEST
        WHERE DO $PUTIN-OTHER [PUT IN SLOT OTHER THAN GENDER]
        OR BOTH SUCCESSORS X-INTERSECTION OF
        X-INTERSECTION IS NOT NIL
        @AND DO $GENDER-TEST
        WHERE AT X-INTERSECTION DO $PUTIN-GENDER.
   $PUTIN-OTHER =
        IF SUCCESSORS X-INTERSECTION OF X-INTERSECTION IS NOT NIL
        WHERE ATTRIBUTE-LIST X-SLOT EXISTS
        THEN $PUT-IN-FORMAT.
   $PUTIN-GENDER =
        ATTRIBUTE-LIST X-SLOT EXISTS [PUT IN GENDER SLOT];
        X-SIGNAL:= X-PRE;
        DO PUTIN-SLOT(REGX);
        IF $MORE-CHK
        [* more than 1 subclass on list excluding FEM/MASC *]
        THEN $WARN-MESS1 [HOMONYMN MESSAGE].
   $MORE-CHK =
        X-TEMP:= X-INTERSECTION;
        IF AT X-TEMP DO $GENDER-TEST
        THEN $HAS-2
        ELSE IF $HAS-SUCCESSOR
        THEN AT X-TEMP NOT $GENDER-TEST.
   $GENDER-TEST = ATTRIBUTE-LIST HAS MEMBER GENDER.
   $HAS-SUCCESSOR = SUCCESSORS X-TEMP OF X-TEMP EXISTS.
   $HAS-2 = DO $HAS-SUCCESSOR;
        DO $HAS-SUCCESSOR.
   $SPECIAL-CHK = IF X-SLOT IS RXMANNER
        THEN $CHK-DOSE
        [IN T-MEDDOSE-BUILD MEDDOSE IF ]
        [IT IS NOT THERE FOR RXMANNER SLOT].
   $WARN-MESS1 = DO $WARNING-SIG [T-MOD];
        WRITE ON DIAG '* Only first ';
        WRITE ON DIAG 'subclass formatted ';
        WRITE ON DIAG 'for homonyms.';
        WRITE ON DIAG END OF LINE;
        AT X-CORE WRITE ON DIAG NODE NAME;
        WRITE ON DIAG ' = ';
        AT X-CORE WRITE ON DIAG WORDS SUBSUMED;
        WRITE ON DIAG ' = ';
        AT X-INTERSECTION WRITE ON DIAG LIST ELEMENT;
        WRITE ON DIAG END OF LINE.
   $FIND-FORMAT =
        X-SIGNAL:= NIL;
        AT X-PRE, ASCEND TO ASSERTION OR PARSE-CONN OR FRAGMENT
        OR INTRODUCER PASSING THROUGH STRING;
        STORE IN X-ASSERT;
        IF PRESENT-ELEMENT- IS INTRODUCER
        THEN BOTH DO R(CENTER) [GET FIRST CENTER]
        @AND AT VALUE ITERATET GO RIGHT
        UNTIL TEST FOR ASSERTION OR FRAGMENT
        SUCCEEDS [go to first ASSERTION/FRAGMENT]
        WHERE STORE IN X-ASSERT;
        AT X-ASSERT DO R(FORMAT-TYPES);
        STORE IN X-FORMAT. (GLOBAL)
   $NO-SUBCLASS =
        X-S IS NIL.
   $SUBCLASS-CHK = EITHER $NO-SUBCLASS OR $FIND-SLOT.
   $SYNTAX-CHK =
        AT X-PRE, IF $SYNTAX-TEST
        THEN ONE OF $IN-VERB, $IN-FRMT5-SUBJ, $IN-FRMT00,
   $IN-FRMT6-OBJ, $TRUE.
   $TRUE = TRUE.
   $SYNTAX-TEST =
        DO $NOT-EMPTY;
        NOT [IF] $IS-FORMATED [THEN X-CORE IS OCCURRING IN VERB];
        X-PUTIN:=X-PRE.
   $NOT-EMPTY = PRESENT-ELEMENT- IS NOT EMPTY.
   $IN-VERB =
        [* Except for FORMAT1-3, also fill VERB in other formats *]
        AT X-CORE ASCEND TO VERB NOT PASSING THROUGH ADJSET1;
        IF EITHER NOT $IS-FORMATED
        OR X-FORMAT IS NOT [FORMAT1 OR] FORMAT1-3 [OR FORMAT13-MED]
        THEN DO $FILL-VERB.
   $FILL-VERB =
        X-SIGNAL := NIL;
        AT X-FORMAT DO PUTIN-SLOT(VERB);
        IF X-FORMAT IS FORMAT00
        THEN $SENTOP-CHK.
   $IN-FRMT5-SUBJ =
        X-CORE IS OCCURRING IN SUBJECT;
        X-FORMAT IS FORMAT5 OR FORMAT5-EKG OR FORMAT5-MISC OR FORMAT1-3
        OR FORMAT13-MED OR FORMAT5F;
        DO $IS-SUBJ-OTHER.
   $IS-SUBJ-OTHER =
        EITHER X-S HAS MEMBER H-INST
        OR X-S IS NIL;
        X-CORE IS N OR PRO;
        BOTH X-SIGNAL := NIL
        AND AT X-FORMAT DO PUTIN-SLOT(SUBJECT).
   $IN-FRMT00 =
        X-FORMAT IS FORMAT00;
        IF X-CORE IS OCCURRING IN SUBJECT
        THEN $PUTIN-SUBJ
        ELSE IF X-CORE IS OCCURRING IN OBJECT
        THEN $PUTIN-OBJ;
        DO $SENTOP-CHK.
   $IN-FRMT6-OBJ =
        X-FORMAT IS FORMAT6;
        IF X-CORE IS OCCURRING IN OBJECT THEN $PUTIN-OBJ.
   $SENTOP-CHK =
        IF X-S HAS MEMBER OPERATOR-LIST
        THEN AT X-FORMAT DO PUTIN-SLOT(SENT-OP).
   $PUTIN-SUBJ = AT X-FORMAT DO PUTIN-SLOT(SUBJECT).
   $PUTIN-OBJ = AT X-FORMAT DO PUTIN-SLOT(OBJECT).
   $IS-LQR-LQNR = X-PRE IS LQNR.
— T-COMP-ATT
T-COMP-ATT = IN LXR, DSTG, NNN:
        IF ONE OF $HAS-SEM-CORE, $HAS-N-TO-RN-ATT,
   $HAS-N-TO-LN-ATT
        @THEN ONE OF $IS-FORMATED,
   $HAS-FAIL-SEL, $HAS-ADJUNCT-ATT,
   $CANNOT-BE-FRMTD, $ASSIGN-AND-TRANS.
   $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
   $CANNOT-BE-FRMTD =
        PRESENT-ELEMENT- HAS NODE ATTRIBUTE TRANSFORM-ATT.
   $ASSIGN-AND-TRANS =
        BOTH ASSIGN NODE ATTRIBUTE TRANSFORM-ATT
        AND TRANSFORM PRESENT-ELEMENT-.
   $HAS-SEM-CORE =
        CORE- X-CORE OF PRESENT-ELEMENT- HAS NODE ATTRIBUTE SEM-CORE
        WHERE BOTH PRESENT-ELEMENT- IS NOT EMPTY
        AND EITHER PRESENT-ELEMENT- IS OCCURRING IN DSTG
        OR NNN,
        OR PRESENT-ELEMENT- IS OCCURRING IN LXR;
        IF $IS-NEG-MODAL
        THEN BOTH AT X-CORE, ERASE NODE ATTRIBUTE COMPUTED-ATT
        AND FALSE
        ELSE IF AT X-CORE, NOT $UNFORMATTABLE
        THEN BOTH AT X-CORE, ERASE NODE ATTRIBUTE SEM-CORE
        AND FALSE.
   $HAS-N-TO-RN-ATT =
        [* NTN 04/12/89 *]
        [* CONDITIONS FOR USE OF COMPUTED ATTRIBUTE: *]
        [* ONLY IF BOTH NODES BELONG TO MAJOR FORMAT *]
        [* SUBLANGUAGE CLASS. *]
        BOTH X-CORE HAS NODE ATTRIBUTE N-TO-RN-ATT X-ATT
        AND IF NOT $UNFORMATTABLE
        THEN BOTH AT X-CORE ERASE NODE ATTRIBUTE N-TO-RN-ATT
        AND FALSE.
   $HAS-N-TO-LN-ATT =
        BOTH X-CORE HAS NODE ATTRIBUTE N-TO-LN-ATT X-ATT
        AND IF NOT $UNFORMATTABLE
        THEN BOTH AT X-CORE ERASE NODE ATTRIBUTE N-TO-LN-ATT
        AND FALSE.
   $UNFORMATTABLE =
        IF BOTH X-CORE HAS NODE ATTRIBUTE COMPUTED-ATT X-COMP-ATT
        AND X-COMP-ATT DOES NOT HAVE MEMBER
        H-TMDUR OR H-TMLOC OR H-TMREP OR H-TMPREP
        THEN BOTH X-CORE HAS NODE ATTRIBUTE SELECT-ATT X-NEWLIST
        WHERE DO $IS-MINOR-CLASS
        AND CORE-SELATT X-NEWLIST OF CORE- OF X-ATT EXISTS
        WHERE DO $IS-MINOR-CLASS.
   $IS-MINOR-CLASS = [GLOBAL]
        BOTH X-MAJOR-ATTS := LIST MAJOR-FMT-CLASS
        AND INTERSECT OF X-MAJOR-ATTS IS NIL.
   $IS-NEG-MODAL = [GLOBAL]
        BOTH X-CORE HAS NODE ATTRIBUTE COMPUTED-ATT
        AND BOTH X-CORE HAS NODE ATTRIBUTE SELECT-ATT
        @AND PRESENT-ELEMENT- HAS MEMBER H-NEG OR H-MODAL.
— T-PTPART
T-PTPART = IN LXR, DSTG, NNN:
        IF BOTH $NOT-FORMATED [T-FORMAT-SLOT]
        AND CORE-ATT [CORE-SELATT] X-S OF CORE- X-CORE OF
        PRESENT-ELEMENT- X-PRE HAS MEMBER
        H-PTPART OR H-PTAREA OR H-PTLOC OR H-PTSPEC
        THEN ALL OF $FIND-FORMAT [T-BUILD-FORMAT], $PLACE-BP.
   $PLACE-BP =
        BOTH ONE OF $COMP-ATT, $GET-HOST, $IN-PN,
   $IN-INTRO, $IN-SUBJ, $IN-OBJ, $IN-VERBAL
        @AND $FRMT-CHK.
   $COMP-ATT = X-CORE HAS NODE ATTRIBUTE SEM-CORE
        [from COMPUTED-ATT construction].
   $GET-HOST = HOST- OF X-PRE EXISTS.
   $IN-PN = X-PRE IS OCCURRING IN PN;
        EITHER HOST- EXISTS
        OR EITHER $IN-NPN OR $IN-OBJ [SUBJECT or VERB is HOST].
   $IN-NPN =
        BOTH PRESENT-ELEMENT- IS OCCURRING IN NPN OR PNN X-NPN
        AND EITHER COELEMENT NSTGO EXISTS WHERE CORE- IS NOT NHUMAN
        OR H-PT
        OR AT X-NPN DO $IN-OBJ.
   $IN-INTRO =
        X-PRE IS OCCURRING IN INTRODUCER
        WHERE AT VALUE OF COELEMENT- CENTER
        ITERATET GO RIGHT
        UNTIL TEST FOR ASSERTION OR FRAGMENT SUCCEEDS;
        EITHER $IN-FRAG OR $IN-ASSRT.
   $IN-FRAG = PRESENT-ELEMENT- IS FRAGMENT WHERE CORE- EXISTS.
   $IN-ASSRT = PRESENT-ELEMENT- IS ASSERTION;
        EITHER CORE-SELATT OF CORE X-CORE OF SUBJECT HAS MEMBER
        H-PTPART OR H-PTAREA OR H-PTLOC OR H-PTSPEC,
        OR $CHK-OBJ;
        X-CORE EXISTS.
   $CHK-OBJ = EITHER X-CORE IS NULL
        OR X-CORE IS 'IT' OR 'IL';
        DO $IN-SUBJ.
   $IN-SUBJ = PRESENT-ELEMENT- IS OCCURRING IN SUBJECT;
        EITHER $HOST-IS-OBJ OR $HOST-IS-VERB.
   $HOST-IS-OBJ = COELEMENT- OBJECT EXISTS;
        PRESENT-ELEMENT- IS NOT EMPTY;
        EITHER DESCEND TO LAR OR LNR, [ TEMP - XF?]
        OR TRUE;
        CORE- X-CORE EXISTS;
        IF PRESENT-ELEMENT- IS PN
        @THEN CORE- X-CORE OF LNR OF NSTG OF NSTGO EXISTS;
        PRESENT-ELEMENT- IS NOT EMPTY;
        IF CORE-SELATT EXISTS
        @THEN PRESENT-ELEMENT- DOES NOT HAVE MEMBER H-PT;
        X-CORE EXISTS.
   $IN-OBJ =
        PRESENT-ELEMENT- IS OCCURRING IN OBJECT
        WHERE EITHER $HOST-IS-SUBJ
        OR CORE- OF COELEMENT VERBAL IS NOT EMPTY.
   $IN-VERBAL =
        PRESENT-ELEMENT- IS VERB
        WHERE DO $HOST-IS-SUBJ.
   $HOST-IS-SUBJ =
        CORE- OF COELEMENT SUBJECT IS NOT EMPTY;
        IF EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE N-TO-RN-ATT
        OR PRESENT-ELEMENT- HAS NODE ATTRIBUTE N-TO-LN-ATT
        @THEN CORE- EXISTS [IF SUBJ IS 'INCREASE IN PAIN',]
        [HOST IS 'PAIN' AND NOT 'INCREASE'].
   $HOST-IS-VERB = CORE- X-CORE OF COELEMENT VERB EXISTS.
   $FRMT-CHK =
        EITHER $IMM-LXR OR TRUE;
        IF $IS-FORMATED
        @THEN ONE OF $IN-LADJSET, $IN-FORMAT-EKG, $FIND-SLOT-FOR-BP
        ELSE IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE TRANSFORM-ATT
        [* HOST could not be transformed *]
        THEN NOT TRUE
        ELSE $ASSIGN-TRANS-ATT.
   $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT X-PTFRMT.
   $IN-LADJSET =
        [* If host has been formatted at PTPART *]
        [* then do not format this node -- *]
        [* THE EFFECT is that this node will be *]
        [* formatted as left adjunct of host *]
        [* thus PRESERVING THE INPUT TEXT ORDER.*]
        BOTH IMMEDIATE-NODE- X-TEMP OF X-PTFRMT IS PTPART
        AND AT X-PRE, ASCEND TO LADJSET.
   $IMM-LXR = EITHER IMMEDIATE LXR EXISTS
        OR PRESENT-ELEMENT- IS OCCURRING IN DSTG OR NNN.
   $ASSIGN-TRANS-ATT =
        BOTH ASSIGN NODE ATTRIBUTE TRANSFORM-ATT
        AND BOTH TRANSFORM X-PRE
        AND TRANSFORM PRESENT-ELEMENT-
        [* wait until HOST is transformed *].
   $IN-FORMAT-EKG = [* new FORMAT5-EKG *]
        BOTH X-FORMAT IS FORMAT5-EKG
        AND IMMEDIATE-NODE X-TEMP OF X-PTFRMT EXISTS;
        [* about 2mm of inferior ST segment depression *]
        PRESENT-ELEMENT- IS INTERVAL OR DIAG OR INDIC OR
        NORMAL OR IN-LEADS;
        DO $BUILD-BP-MOD;
        X-SIGNAL:=NIL;
        DO $PUTIN-BP-SLOT.
   $FIND-SLOT-FOR-BP =
        IMMEDIATE-NODE- X-TEMP EXISTS;
        ONE OF $MED-INST-BP, $STAT-RESP, $BP-BP, $OTHER-BP;
        X-SIGNAL:=NIL;
        DO $PUTIN-BP-SLOT.
   $PUTIN-BP-SLOT = X-PUTIN:= X-PRE;
        AT X-MOD-SLOT DO PUTIN-SLOT(PTPART).
   $MED-INST-BP =
        PRESENT-ELEMENT- IS MED OR INST OR PROCEDURE;
        DO $MODIFIER-BP.
   $BP-BP = PRESENT-ELEMENT- IS PTPART;
        DO $MODIFIER-BP.
   $STAT-RESP = PRESENT-ELEMENT- IS STATUS [OR RESPONSE];
        AT X-FORMAT DO FIND-SLOT(PSTATE-SUBJ);
        DO $PSTATE-SUBJ-BP.
   $PSTATE-SUBJ-BP = PRESENT-ELEMENT- IS PSTATE-SUBJ;
        IF DO FILLED-SLOT(PSTATE-SUBJ)
        @THEN AT IMMEDIATE-NODE- DO $MOD-OF-BP
        ELSE DO FIND-SLOT(PTPART) WHERE STORE IN X-MOD-SLOT.
   $OTHER-BP = IMMEDIATE-NODE- OF X-TEMP EXISTS;
        ONE OF $PSTATE-BP, $BP-MOD-BP, $PSTATE-SUBJ-BP, $TEST-INFO-BP,
   $IN-PSTATE-SUBJ, $ERR-BP.
   $PSTATE-BP = PRESENT-ELEMENT- IS PSTATE-DATA [OR EXAM-FUNC];
        AT X-FORMAT DO FIND-SLOT(PSTATE-SUBJ);
        DO $PSTATE-SUBJ-BP.
   $IN-PSTATE-SUBJ =
        IF AT X-FORMAT EITHER DO FILLED-SLOT(PSTATE-DATA)
        OR DO FILLED-SLOT(PSTATE-SUBJ)
        THEN AT X-FORMAT BOTH DO FIND-SLOT(PSTATE-SUBJ)
        @AND $PSTATE-SUBJ-BP.
   $TEST-INFO-BP = PRESENT-ELEMENT- IS TEST-INFO OR RESULT;
        AT X-FORMAT DO FIND-SLOT(PTPART) WHERE STORE IN
        X-MOD-SLOT.
   $ERR-BP = NOT TRUE.
   $MODIFIER-BP =
        IF PRESENT-ELEMENT- IS PTPART
        THEN IF VALUE IS NON-EMPTY [SLOT IS FILLED]
        THEN $MOD-OF-BP
        ELSE STORE IN X-MOD-SLOT [PUT IN EMPTY PTPART]
        ELSE $MOD-OF-BP.
   $MOD-OF-BP = EITHER DO R(BP-MOD) WHERE DO $LOWEST-BP-NEST
        OR $BUILD-BP-MOD [GLOBAL IN T-BUILD-FORMAT].
   $BP-MOD-BP = PRESENT-ELEMENT- IS BP-MOD;
        ONE OF $BP-OF-LN, $BP-OF-RN, $BP-OF-OTHER.
   $BP-OF-LN = BOTH X-PRE IS OCCURRING IN LN
        AND AT VALUE [OF BP-MOD] DO $BUILD-BP-MOD.
   $BP-OF-RN = BOTH AT X-PRE ASCEND TO RN PASSING THROUGH PN
        AND $LOWEST-BP-NEST.
   $LOWEST-BP-NEST =
        EITHER ITERATE DESCEND TO BP-MOD
        OR TRUE;
        AT VALUE [of lowest BP-MOD in nest] DO $BUILD-BP-MOD.
   $BP-OF-OTHER = DO $LOWEST-BP-NEST.
— T-NEG
—       PUTS PREVERBAL NEG INTO MODIFIER LIST OF THE VERB.
—       -- 2/3/97, PUTS RV:PN:P NEG INTO MODIFIER LIST OF THE VERB
—       -- 10/3/2000, PUTS RN/RA:PN:P NEG INTO MODIFIER LIST OF ITS OBJECT
—       E.G. NECK : SUPPLE WITHOUT LYMPHADENOPATHY.
T-NEG = IN NEG, PN:
        IF BOTH PRESENT-ELEMENT- X-PRE IS NOT EMPTY
        AND ALL OF $FIND-VERB, $FIND-CORE
        THEN DO $MAKE-HOST-AND-TYPE.
   $FIND-VERB =
        EITHER COELEMENT- VERBAL EXISTS
        WHERE CORE- X-HOST EXISTS
        OR HOST- X-HOST EXISTS [* from RV:PN *].
   $FIND-CORE =
        EITHER CORE- X-CORE OF X-PRE IS NG:H-NEG
        OR BOTH CORE-ATT OF ELEMENT- P X-CORE OF X-PRE
        HAS MEMBER H-NEG
        AND EITHER IMMEDIATE-NODE- IS RV
        OR $NEGATED-OBJ-OF-PN.
   $NEGATED-OBJ-OF-PN =
        IMMEDIATE-NODE- IS RN OR RA;
        ELEMENT- LNR X-HOST OF NSTG OF NSTGO OF X-PRE EXISTS.
   $MAKE-HOST-AND-TYPE =
        X-TYPE := SYMBOL MODS; [* should be done in REG component *]
        AT X-CORE
        BOTH ASSIGN NODE ATTRIBUTE TYPE-ATT WITH VALUE X-TYPE
        AND ASSIGN NODE ATTRIBUTE SEM-CORE WITH VALUE X-HOST.
— T-LONE-PN
—       FORMATS FRAGMENT:PN WHERE P IS H-NEG OR H-MODAL.
—       THIS PREPOSITION PHRASE DOES NOT HAVE A HOST.
— -- 12/31/2000
T-LONE-PN = IN PN:
        IF ALL OF $LONE-PN, $FIND-FORMAT
        THEN DO $MAIN-MODIFIERS.
   $LONE-PN =
        BOTH IMMEDIATE-NODE- OF PRESENT-ELEMENT- X-PRE IS FRAGMENT
        WHERE IMMEDIATE CENTER EXISTS
        AND CORE- X-PUTIN IS P;
        CORE-ATT OF X-PUTIN HAS MEMBER H-NEG OR H-MODAL;
        X-PUTIN DOES NOT HAVE NODE ATTRIBUTE FORMAT-PT.
   $MAIN-MODIFIERS =
        ELEMENT- VERB X-SLOT OF X-FORMAT EXISTS;
        AFTER X-SLOT INSERT <NEG>+<MODAL>;
        EITHER BOTH CORE-ATT OF X-PUTIN HAS MEMBER H-NEG
        AND DO PUTIN-SLOT(NEG)
        OR BOTH CORE-ATT OF X-PUTIN HAS MEMBER H-MODAL
        AND DO PUTIN-SLOT(MODAL).
— T-NEG-PREP
—       FORMATS NEG PREPOSITION OF VERB.
— -- 11/30/1998 ADD VBE+OBJECT:PN
T-NEG-PREP = IN PN:
        IF BOTH [ONE OF] $PN-IN-RV [, $PN-IN-OBJBE]
        AND $FIND-FORMAT
        THEN DO $MAIN-NEG.
   $PN-IN-RV =
        BOTH IMMEDIATE-NODE- OF PRESENT-ELEMENT- X-PRE IS RV
        AND CORE- X-PUTIN IS P;
        X-PUTIN HAS NODE ATTRIBUTE SEM-CORE;
        X-PUTIN HAS NODE ATTRIBUTE TYPE-ATT;
        CORE-ATT OF X-PUTIN HAS MEMBER H-NEG;
        X-PUTIN DOES NOT HAVE NODE ATTRIBUTE FORMAT-PT.
   $PN-IN-OBJBE =
        BOTH IMMEDIATE-NODE- OF PRESENT-ELEMENT- X-PRE IS OBJBE
        WHERE BOTH IMMEDIATE OBJECT EXISTS
        @AND CORE- X-VCORE OF COELEMENT- VERB IS VBE
        AND CORE- X-PUTIN IS P;
        EITHER X-PUTIN HAS NODE ATTRIBUTE SEM-CORE
        OR AT X-PUTIN, ASSIGN NODE ATTRIBUTE SEM-CORE WITH VALUE X-VCORE;
        EITHER X-PUTIN HAS NODE ATTRIBUTE TYPE-ATT
        OR BOTH X-TYPE := SYMBOL MODS
        AND AT X-PUTIN, ASSIGN NODE ATTRIBUTE TYPE-ATT WITH
        VALUE X-TYPE;
        CORE-ATT OF X-PUTIN HAS MEMBER H-NEG;
        X-PUTIN DOES NOT HAVE NODE ATTRIBUTE FORMAT-PT.
   $MAIN-NEG =
        ELEMENT- VERB X-SLOT OF X-FORMAT EXISTS;
        DO $CONSTRUCT-MODS;
        DO $SET-POINTERS [in PUTIN-SLOT].
   $CONSTRUCT-MODS =
        IF COELEMENT- MODS X-NOHOST-MOD OF X-SLOT EXISTS
        THEN TRUE
        ELSE AFTER X-SLOT
        INSERT <MODS> X-NOHOST-MOD (<NEG>+<MODAL>);
        IF AT ELEMENT- NEG X-NEG-MOD OF X-NOHOST-MOD
        DESCEND TO NON-EMPTY
        THEN AFTER LAST-ELEMENT- OF X-NEG-MOD
        INSERT <NON-EMPTY> X-FRMT-SLOT
        ELSE REPLACE X-NEG-MOD BY <NEG> (<NON-EMPTY> X-FRMT-SLOT).
— T-MOD
T-MOD = IN LXR, VERB, NEG, DSTG, NNN, LAUX:
        VERIFY BOTH $SET-PARSE-REG [T-FORMAT-SLOT]
        AND $COMPLEX-NPOS;
        ONE OF $INFO-SOURCE-PHRASE, $EXCEPTION, $IS-ASP.
   $COMPLEX-NPOS =
        IF X-PRE IS NNN
        WHERE BOTH IMMEDIATE-NODE IS NPOS
        AND LAST-ELEMENT- IS LAR X-LAR
        THEN AT X-LAR,
        BOTH CORE-ATT X-S OF CORE- X-CORE OF X-LAR EXISTS
        AND STORE IN X-PRE.
   $INFO-SOURCE-PHRASE =
        AT X-PRE, ASCEND TO ASSERTION OR PARSE-CONN OR FRAGMENT
        OR INTRODUCER PASSING THROUGH STRING;
        PRESENT-ELEMENT- HAS NODE ATTRIBUTE PHRASE-ATT
        WHERE PRESENT-ELEMENT- HAS MEMBER SOURCE-PHRASE.
   $MOD-NOT-FRMTD =
        NOT ITERATE $IS-FORMATED
        UNTIL EITHER $IN-MODIFIER
        OR $IN-VERB SUCCEEDS.
   $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
   $IN-VERB = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FILLED-PT
        WHERE PRESENT-ELEMENT- IS OF TYPE VERBAL.
   $EXCEPTION =
        ONE OF [$NO-SUBCLASS,] [T-FORMAT-SLOT]
   $IS-LQR-LQNR [T-FORMAT-SLOT],
   $IS-LCONNR,
   $IS-ZERO-NO,
   $IS-QUANT,
   $IS-TIME-PN,
   $IS-TM-COMP-ATT [* GRI *],
   $HAS-FAIL-SEL [T-FORMAT-SLOT],
   $HAS-ADJUNCT-ATT [T-FORMAT-SLOT],
   $CORE-FAIL-SEL [T-FORMAT-SLOT],
   $CORE-ADJUNCT-ATT [T-FORMAT-SLOT].
   $IS-TIME-PN =
        AT X-PRE, ASCEND TO PN
        WHERE ALL OF [$IS-TIME-CORE,] $IS-TIME-PHRASE, $IS-FORMATED.
   $IS-TIME-PHRASE =
        EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE PHRASE-ATT
        WHERE PRESENT-ELEMENT- HAS MEMBER TIME-PHRASE
        OR PRESENT-ELEMENT- HAS NODE ATTRIBUTE ADVERBIAL-TYPE
        WHERE PRESENT-ELEMENT- HAS MEMBER TIME-ADVERBIAL.
   $IS-TM-COMP-ATT =
        [* clear COMPUTED-ATT H-INDIC or H-DIAG *]
        [* of a node with SELECT-ATT H-TMDUR *]
        BOTH BOTH X-CORE HAS NODE ATTRIBUTE SELECT-ATT
        @AND PRESENT-ELEMENT- HAS MEMBER H-TMDUR
        AND BOTH BOTH X-CORE HAS NODE ATTRIBUTE COMPUTED-ATT
        @AND PRESENT-ELEMENT- HAS MEMBER H-INDIC OR H-DIAG
        AND AT X-CORE,
        BOTH ERASE NODE ATTRIBUTE COMPUTED-ATT
        AND IF PRESENT-ELEMENT HAS NODE ATTRIBUTE SEM-CORE
        THEN ERASE NODE ATTRIBUTE SEM-CORE.
   $IS-QUANT =
        BOTH X-PRE IS LNR OR LQR OR LAR OR LAR1
        WHERE DO $IS-FORMATED
        @AND IMMEDIATE QUANT EXISTS [* in QUANT not Q modifier *].
   $IS-ZERO-NO =
        X-PRE IS LTR
        WHERE EITHER X-CORE IS T:H-NEG [aucun, aucune, no, non, etc]
        OR AT COELEMENT- LT OF X-CORE [pas de]
        BOTH CORE- IS D:H-NEG
        AND CORE-SELATT X-S OF CORE- X-CORE EXISTS;
        AT X-PRE DO $IS-FORMATED;
        VALUE IS LQR WHERE CORE- IS '[0]'.
   $IS-ASP =
        EITHER $TIME-QUALS-VERB
        OR BOTH $MODIFIER-CHK AND $COEL-N-OF-CORE.
   $TIME-QUALS-VERB =
        [* TIME-QUALS verb H-TMBEG and H-TMEND has no host *]
        BOTH CORE- X-CORE OF X-PRE IS TV OR V OR VEN OR VING
        WHERE CORE-SELATT X-S HAS MEMBER H-TMBEG OR H-TMEND
        AND EITHER $IS-FORMATED
        OR ALL OF $FIND-FORMAT, $PUTIN-TIME-QUALS.
   $PUTIN-TIME-QUALS =
        [* since this type of verb is not a TIME-ASP *]
        [* by nature, it should be put in TIME-QUALS *]
        X-PUTIN := X-PRE;
        DO PUTIN-SLOT(TIME-QUALS).
   $COEL-N-OF-CORE =
        AT X-CORE ITERATET $MORE-MODIFIER UNTIL GO RIGHT FAILS.
   $MORE-MODIFIER =
        IF EITHER PRESENT-ELEMENT- X-PRE IS N OR GRAM-NODE
        WHERE CORE-SELATT X-S OF PRESENT-ELEMENT- X-CORE HAS
        MEMBER H-TMREP OR H-TMLOC OR H-TMDUR [* 960530 *]
        OR H-NEG OR H-MODAL OR H-VTENSE OR QNUMBER
        OR PRESENT-ELEMENT- X-PRE IS TV OR V OR VEN OR VING
        WHERE BOTH IMMEDIATE-NODE IS LAUX
        AND CORE-SELATT X-S OF PRESENT-ELEMENT- X-CORE
        HAS MEMBER H-NEG OR [H-TMREP OR] H-MODAL OR
        H-VTENSE OR QNUMBER
        THEN AT X-PRE VERIFY $MODIFIER-CHK.
   $IN-MODIFIER = ASCEND TO MODIFIERS.
   $MODIFIER-CHK =
        IF BOTH $IS-MODIFIER AND $MOD-NOT-FRMTD
        THEN ALL OF $FIND-FORMAT, $BUILD-SLOTS.
   $IS-MODIFIER =
        X-TYPE-SLOT:= LIST MODIFIER-LIST;
        ITERATET SUCCESSORS X-TYPE-SLOT OF X-TYPE-SLOT IS NOT NIL
        UNTIL $IDENTIFY-MODIFIER SUCCEEDS.
   $IDENTIFY-MODIFIER =
        X-NEWLIST:= ATTRIBUTE-LIST
        [LIST OF SUBCLASSES AND THEIR CORRESPONDING FORMAT SLOTS];
        INTERSECT OF X-S IS NOT NIL;
        X-TYPE:= NIL;
        X-HEAD := HEAD OF X-TYPE-SLOT;
        PREFIX X-HEAD TO X-TYPE; [set up list consisting of TYPE only]
        X-SAVE-ASPLIST:= X-INTERSECTION;
        X-ASP-LIST:= X-INTERSECTION.
   $BUILD-SLOTS =
        AT X-PRE IF DO $FIND-HOST-SLOT [Global]
        [* Find slot in FORMAT for semantic host *]
        WHERE X-HOST-SLOT:= X-SLOT [* Save host slot *]
        THEN ITERATE $BUILD-MODIFIER
        UNTIL SUCCESSORS X-ASP-LIST OF X-ASP-LIST
        IS NIL SUCCEEDS
        ELSE EITHER $HOSTLESS-NEG-MODAL
        OR TRUE;
        DO $NEXT-SLOT.
   $HOSTLESS-NEG-MODAL =
        BOTH X-S HAS MEMBER H-MODAL OR H-NEG
        AND ELEMENT- VERB X-SLOT OF X-FORMAT EXISTS;
        DO $CONSTRUCT-MODS;
        X-PUTIN := X-PRE [X-CORE];
        DO $SET-POINTERS [in PUTIN-SLOT].
   $CONSTRUCT-MODS =
        IF COELEMENT- MODS X-NOHOST-MOD OF X-SLOT EXISTS
        THEN TRUE
        ELSE AFTER X-SLOT
        INSERT <MODS> X-NOHOST-MOD (<NEG>+<MODAL>);
        IF X-S HAS MEMBER H-MODAL
        THEN IF AT ELEMENT- MODAL X-MODAL-MOD OF X-NOHOST-MOD
        DESCEND TO NON-EMPTY
        THEN AFTER LAST-ELEMENT- OF X-MODAL-MOD
        INSERT <NON-EMPTY> X-FRMT-SLOT
        ELSE REPLACE X-MODAL-MOD
        BY <MODAL> (<NON-EMPTY> X-FRMT-SLOT)
        ELSE IF AT ELEMENT- NEG X-NEG-MOD OF X-NOHOST-MOD
        DESCEND TO NON-EMPTY
        THEN AFTER LAST-ELEMENT- OF X-NEG-MOD
        INSERT <NON-EMPTY> X-FRMT-SLOT
        ELSE REPLACE X-NEG-MOD BY <NEG> (<NON-EMPTY> X-FRMT-SLOT).
   $NEXT-SLOT =
        ITERATET $BUILD-MODFRS
        UNTIL $NEXT-SLOT-FOR-HOST FAILS.
   $BUILD-MODFRS =
        X-ASP-LIST:= X-SAVE-ASPLIST;
        ITERATE $BUILD-MODIFIER
        UNTIL SUCCESSORS X-ASP-LIST OF X-ASP-LIST IS NIL SUCCEEDS.
   $NEXT-SLOT-FOR-HOST =
        X-NEXT-SLOT IS NOT NIL;
        [* Pre-empt the looping non-empty *]
        X-NEXT-SLOT IS NOT NON-EMPTY;
        AT X-NEXT-SLOT DO $IS-FORMATED;
        DO $HOST-OF-SLOT. [GLOBAL]
   $HOST-OF-SLOT =
        STORE IN X-NEXT-SLOT;
        IMMEDIATE-NODE- X-SLOT EXISTS [use node above NON-EMPTY];
        X-HOST-SLOT := X-SLOT.
   $FIND-HOST-SLOT = [GLOBAL]
        BOTH VERIFY X-NEXT-SLOT := NIL
        AND IF $FIND-SEM-CORE
        @THEN $FIND-SLOT
        ELSE BOTH $ERR-MESS3 AND FALSE.
   $FIND-SEM-CORE =
        [* Go to semantic host of the modifier *]
        EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE SEM-CORE
        OR EITHER CORE- HAS NODE ATTRIBUTE SEM-CORE
        OR EITHER PRESENT-ELEMENT- IS OCCURRING IN PN
        WHERE PRESENT-ELEMENT- HAS NODE ATTRIBUTE SEM-CORE
        OR EITHER PRESENT-ELEMENT- IS LAUX
        WHERE CORE- OF IMMEDIATE-NODE EXISTS
        OR EITHER BOTH IMMEDIATE-NODE- OF X-CORE IS LT
        AND HOST- OF X-PRE EXISTS [pas de]
        OR EITHER PRESENT-ELEMENT- IS QN-TIME OR PQUANT
        WHERE HOST- EXISTS
        OR CORE- IS N OR W WHERE HOST- EXISTS;
        STORE IN X-SEM-CORE.
   $FIND-SLOT = EITHER $SLOT-FOR-RESULT OR $GET-SLOT.
   $SLOT-FOR-RESULT =
        [* If H-RESULT put ASPECTUAL as MODIFIER of PSTATE-DATA *]
        [* If PSTATE-DATA is NON-EMPTY; otherwise put on VERB *]
        CORE-ATT HAS MEMBER H-RESULT OR H-INDIC;
        AT X-FORMAT DO FIND-SLOT(PSTATE-DATA);
        IF DO FILLED-SLOT(PSTATE-DATA) WHERE STORE IN X-NEXT-SLOT
        @ THEN IMMEDIATE-NODE EXISTS
        ELSE DO FIND-SLOT(VERB);
        STORE IN X-SLOT.
   $GET-SLOT =
        EITHER IMMEDIATE LXR X-HOST-LXR EXISTS
        OR EITHER PRESENT-ELEMENT- IS OCCURRING IN DSTG OR NNN
        OR TRUE;
        IF $IS-FORMATED
        @THEN $HOST-OF-SLOT
        ELSE IF PRESENT-ELEMENT- HAS NODE ATTRIBUTE TRANSFORM-ATT
        [* HOST was transformed but could not be formatted *]
        THEN BOTH $ERR-MESS4 [Use V-TEST for HOST, write message]
        AND FALSE
        ELSE EITHER $IS-IN-LCONNR
        OR ALL OF $ASSIGN-TRANS, $T-HOST-XPRE, $NOT-TRUE.
   $IS-IN-LCONNR =
        [* If it is in LCONNR, slot CONN of *]
        [* CONNECTIVE is the slot for HOST. *]
        EITHER PRESENT-ELEMENT- IS LCONNR
        OR PRESENT-ELEMENT- IS OCCURRING IN LCONNR;
        DO FIND-SLOT(CONN);
        STORE IN X-SLOT.
   $ASSIGN-TRANS = ASSIGN NODE ATTRIBUTE TRANSFORM-ATT.
   $T-HOST-XPRE = BOTH TRANSFORM X-PRE
        AND TRANSFORM PRESENT-ELEMENT-.
   $NOT-TRUE = NOT TRUE [WAIT UNTIL HOST IS TRANSFORMED].
   $CHK-HOST-IS-OK =
        IF X-PRE IS 'NEG-MEAN'
        THEN X-HOST-SLOT IS CHANGE
        ELSE EITHER X-TYPE IS TENSE OR QUANTITY OR Y-OF,
        OR $CHECK-HOST.
   $CHECK-HOST =
        X-NEWLIST:= LIST HOST-OF-MODIFIERS;
        X-NEWLIST HAS MEMBER X-TYPE
        [* Find type of MODIFIER on list HOST-OF-MODIFIERS *];
        X-HOST-LIST:= ATTRIBUTE-LIST
        [* Its ATTRIBUTE-LIST is a list of *]
        [* allowable hosts for this type of modifier];
        X-HOST-LIST EXISTS;
        DO $CHECK-HOST-OK.
   $CHECK-HOST-OK =
        AT X-HOST-SLOT
        ONE OF $SLOT-ON-LIST, $ASCEND-TO-SLOT, $IN-MODFR-SLOT,
   $ERR-MESS5 [COULD NOT FIND HOST SLOT- USE V-ZEROED].
   $SLOT-ON-LIST = TEST FOR X-HOST-LIST.
   $ASCEND-TO-SLOT = ASCEND TO X-HOST-LIST.
   $IN-MODFR-SLOT =
        X-HOST-SLOT EXISTS;
        ASCEND TO MODIFIERS;
        ITERATE GO LEFT UNTIL TEST FOR MODIFIERS FAILS
        [go to slot that MODIFIER is on];
        STORE IN X-HOST-SLOT;
        STORE IN X-SLOT;
        DO $CHECK-HOST-OK.
   $BUILD-MODIFIER =
        IF $CHK-HOST-IS-OK
        THEN $BUILD-IT.
   $BUILD-IT =
        X-SLOT:= X-HOST-SLOT [Restore host slot for testing];
        X-ASP-SLOT:= ATTRIBUTE-LIST OF X-ASP-LIST;
        X-SIGNAL:= NIL;
        ONE OF $MOD-SLOT, $TIME-ASP-SLOT, $BP-MOD-SLOT,
   $TENSE-SLOT, $TIME-QUAL-SLOT, $EVENT-TIME-SLOT,
   $QUANTFR-SLOT, $Y-OF-SLOT.
   $MOD-SLOT =
        X-TYPE IS MODS;
        AT X-SLOT IF $MODS-THERE
        THEN EITHER $NEG-CHK [IS DOUBLE-NEG NEEDED]
        OR AT X-MOD-SLOT DO $PUTIN-ASP-SLOT [NO NEG]
        ELSE BOTH $BUILD-MODS [T-BUILD-FORMAT]
        AND AT X-MOD-SLOT DO $PUTIN-ASP-SLOT.
   $MODS-THERE =
        DO HAS-MODIFIER(MODS);
        STORE IN X-MOD-SLOT.
   $NEG-CHK =
        X-ASP-SLOT IS NEG [IF NEG IS BEING FORMATED AND NEG IS]
        [ALREADY FILLED THEN CREATE DOUBLE-NEG];
        AT X-MOD-SLOT DO FILLED-SLOT(NEG);
        STORE IN X-TEMP;
        AT X-MOD-SLOT IF DESCEND TO DOUBLE-NEG THEN $ERR-MESS6
        ELSE $BUILD-DOUBLE.
   $BUILD-DOUBLE =
        AT X-TEMP, REPLACE PRESENT-ELEMENT- BY
        <DOUBLE-NEG> ( X-TEMP
        + <NEG> X-MOD-SLOT (<NULL>));
        AT X-MOD-SLOT DO $PUTIN-ASP-SLOT.
   $PUTIN-ASP-SLOT =
        VERIFY X-PUTIN:= X-PRE;
        VERIFY X-SIGNAL:= X-PRE;
        VERIFY X-SLOT := X-ASP-SLOT;
        DO PUTIN-SLOT(REGX).
   $FIND-TIME-ASP =
        AT X-SLOT EITHER DO HAS-MODIFIER(TIME-ASP)
        WHERE STORE IN X-TIME-SLOT
        OR $BUILD-TIME-ASP [T-BUILD-FORMAT]. (GLOBAL)
   $TIME-ASP-SLOT =
        X-TYPE IS TIME-ASP;
        DO $FIND-TIME-ASP;
        AT X-TIME-SLOT DO $PUTIN-ASP-SLOT.
   $TIME-QUAL-SLOT =
        X-TYPE IS TIME-QUAL;
        DO $FIND-TIME-QUAL;
        AT X-TMQUAL-SLOT DO $PUTIN-ASP-SLOT.
   $FIND-TIME-QUAL =
        AT X-SLOT EITHER DO HAS-MODIFIER(TIME-QUAL)
        WHERE STORE IN X-TMQUAL-SLOT
        OR $BUILD-TIME-QUAL [T-BUILD-FORMAT].
   $EVENT-TIME-SLOT =
        X-TYPE IS EVENT-TIME;
        DO $FIND-EVENT-TIME;
        AT X-EVENT-SLOT DO $PUTIN-ASP-SLOT.
   $FIND-EVENT-TIME =
        AT X-SLOT EITHER DO HAS-MODIFIER(EVENT-TIME)
        WHERE BOTH STORE IN X-EVENT-SLOT
        AND DO $FIND-ASP-SLOT
        OR $BUILD-EVENT-TIME [T-BUILD-FORMAT].
   $FIND-ASP-SLOT = [* build EVENT-TIME if cannot find TPREP2 *]
        VERIFY X-PUTIN:= X-PRE;
        VERIFY X-SIGNAL:= X-PRE;
        VERIFY X-SLOT := X-ASP-SLOT;
        DO FIND-SLOT(REGX).
   $BP-MOD-SLOT = NOT TRUE [TO BE ADDED].
   $QUANTFR-SLOT =
        X-TYPE IS QUANTITY;
        AT X-SLOT EITHER DO HAS-MODIFIER(QUANTITY)
        WHERE STORE IN X-QUANT
        OR $BUILD-QUANTITY [T-BUILD-FORMAT];
        AT X-QUANT DO $PUTIN-ASP-SLOT.
   $Y-OF-SLOT =
        X-TYPE IS Y-OF;
        X-CORE HAS NODE ATTRIBUTE N-TO-RN-ATT X-HST-SLT;
        X-HST-SLT HAS NODE ATTRIBUTE FORMAT-PT X-Y-SLOT;
        AT X-HST-SLT ERASE NODE ATTRIBUTE FORMAT-PT;
        BOTH AT X-PRE ASSIGN NODE ATTRIBUTE FORMAT-PT
        WITH VALUE X-Y-SLOT
        AND AT X-Y-SLOT ASSIGN NODE ATTRIBUTE FILLED-PT
        WITH VALUE X-PRE.
   $TENSE-SLOT = X-TYPE IS TENSE;
        AT X-SLOT EITHER EITHER BOTH X-PRE IS TENSE
        AND DO HAS-MODIFIER(TENSE)
        WHERE STORE IN X-TIME-SLOT
        OR DO HAS-MODIFIER(TENSE)
        WHERE STORE IN X-TIME-SLOT
        OR $BUILD-TENSE;
        AT X-TIME-SLOT DO $PUTIN-ASP-SLOT.
   $ERR-MESS3 =
        [USE VERB IF THERE IS NO HOST- WRITE WARNING MESS.]
        DO $WARNING-SIG;
        WRITE ON DIAG '* No HOST found for ';
        AT X-PRE DO $WRITE-NODE-INFO;
        WRITE ON DIAG END OF LINE.
   $WRITE-NODE-INFO =
        PRESENT-ELEMENT- X-NODE EXISTS;
        WRITE ON DIAG NODE NAME;
        WRITE ON DIAG ' subsuming - ';
        AT X-NODE WRITE ON DIAG WORDS SUBSUMED;
        WRITE ON DIAG ' - '.
   $ERR-MESS4 = [HOST OF TIME OR MOD COULD NOT BE FORMATED]
        VERIFY $MESS4.
   $MESS4 = DO $WARNING-SIG;
        WRITE ON DIAG '* Could not format ';
        WRITE ON DIAG 'HOST ';
        AT X-SEM-CORE DO $WRITE-NODE-INFO;
        WRITE ON DIAG '. MODIFIER = ';
        AT X-PRE DO $WRITE-NODE-INFO;
        WRITE ON DIAG '. It will not be ';
        WRITE ON DIAG 'formatted.';
        WRITE ON DIAG END OF LINE.
   $PUTIN-VERB =
        WRITE ON DIAG '* Slot VERB ';
        WRITE ON DIAG 'will be used.';
        WRITE ON DIAG END OF LINE;
        DO FIND-SLOT(VERB);
        STORE IN X-SLOT.
   $ERR-MESS5 = [ FORMAT SLOT CAN NOT HAVE TIME OR MODS ON IT]
        VERIFY $MESS5.
   $MESS5 = DO $WARNING-SIG;
        WRITE ON DIAG '* FORMAT SLOT = ';
        AT X-HOST-SLOT WRITE ON DIAG NODE NAME;
        WRITE ON DIAG '. It cannot have a ';
        WRITE ON DIAG 'modifier ';
        AT X-TYPE WRITE ON DIAG LIST ELEMENT;
        WRITE ON DIAG END OF LINE.
   $ERR-MESS6 = [There is already a double NEG]
        DO $WARNING-SIG;
        WRITE ON DIAG '* There is a double ';
        WRITE ON DIAG 'NEG in MOD slot of ';
        AT X-SLOT WRITE ON DIAG NODE NAME;
        WRITE ON DIAG '. Cannot format ';
        AT X-PRE WRITE ON DIAG NODE NAME;
        WRITE ON DIAG ' = ';
        AT X-PRE WRITE ON DIAG WORDS SUBSUMED.
   $WARNING-SIG =
        WRITE ON DIAG '* <<<< WARNING ';
        WRITE ON DIAG 'CONDITION >>>>';
        WRITE ON DIAG END OF LINE. (GLOBAL)
— ***** *************************************************************

—       SEQUENCING TRANSFORMATIONS

— ***** *************************************************************
TSEQ-STRING = IN STRING, CENTER:
        EITHER $EXCEPTION
        OR BOTH IF DO DOWN1(INTRODUCER) WHERE PRESENT-ELEMENT- IS NOT EMPTY
        @THEN TRANSFORM PRESENT-ELEMENT-
        AND DO $TRANSFORM-ELEMENTS.
   $TRANSFORM-ELEMENTS =
        AT VALUE EITHER ITERATE GO RIGHT OR TRUE;
        IF PRESENT-ELEMENT- IS EMPTY
        THEN IF $LEFT-NOT-MTY
        @THEN ITERATE VERIFY $WHAT-TO-DO
        UNTIL $LEFT-NOT-MTY FAILS
        ELSE TRUE
        ELSE ITERATE VERIFY $WHAT-TO-DO
        UNTIL $LEFT-NOT-MTY FAILS.
   $LEFT-NOT-MTY =
        ITERATE GO LEFT
        UNTIL BOTH PRESENT-ELEMENT- IS NOT INTRODUCER
        AND PRESENT-ELEMENT- IS NOT EMPTY SUCCEEDS.
   $WHAT-TO-DO =
        IF ONE OF $ATOM-TYPE, $IS-TEXTLET
        THEN TRUE
        ELSE IF $VERBAL-TYPE
        THEN BOTH $TRANSFORM-NEG
        AND TRANSFORM PRESENT-ELEMENT-
        ELSE IF $TRANSFORM-TYPE
        @THEN TRANSFORM PRESENT-ELEMENT-.
   $TRANSFORM-NEG =
        IF COELEMENT- NEG X-NEG IS NOT EMPTY
        THEN TRANSFORM X-NEG.
   $EXCEPTION =
        ONE OF $IS-EMPTY, $HAS-Q-CONJ, $IS-LN, $FORMATED-CHK,
   $HAS-FAIL-SEL [T-FIXUP-ATOMS],
   $HAS-ADJUNCT-ATT [T-FIXUP-ATOMS],
   $IS-NOFRMT.
   $FORMATED-CHK =
        BOTH $IS-FORMATED AND NOT $TIME-IN-TIME.
   $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
   $TIME-IN-TIME = VERIFY $TIME-TEST;
        AT RIGHT-ADJUNCT OF CORE OF NSTGO DO $TIME-TEST.
   $TIME-TEST = PRESENT-ELEMENT- IS PN;
        EITHER PRESENT-ELEMENT- HAS NODE ATTRIBUTE ADVERBIAL-TYPE
        WHERE PRESENT-ELEMENT- HAS MEMBER TIME-ADVERBIAL
        OR PRESENT-ELEMENT- HAS NODE ATTRIBUTE PHRASE-ATT
        WHERE PRESENT-ELEMENT- HAS MEMBER TIME-PHRASE.
   $IS-EMPTY = PRESENT-ELEMENT- IS EMPTY.
   $IS-NOFRMT = PRESENT-ELEMENT- IS ASSERTION OR FRAGMENT;
        BOTH PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-ATT
        @AND PRESENT-ELEMENT- HAS MEMBER NOFRMT OR FRMT6.
   $HAS-Q-CONJ = PRESENT-ELEMENT- HAS ELEMENT- Q-CONJ.
   $IS-LN = PRESENT-ELEMENT- IS LN [transformed by TSEQ-LXR].
   $TRANSFORM-TYPE =
        ONE OF $STRING-TYPE, $LXR-TYPE, $ADJSET-TYPE,
   $CONJ-TYPE, $OBJ-TYPE, $IS-CENTER, $DESCENT-TYPE.
   $IS-CENTER = PRESENT-ELEMENT- IS CENTER OR PARSE-CONN.
   $IS-TEXTLET =
        PRESENT-ELEMENT- IS TEXTLET;
        ITERATE $TRANS-TEXT
        UNTIL VALUE OF COELEMENT MORESENT OF X-TEMP IS TEXTLET
        FAILS.
   $TRANS-TEXT = AT ONESENT X-TEMP TRANSFORM ELEMENT CENTER.
   $VERBAL-TYPE = PRESENT-ELEMENT- IS OF TYPE VERBAL.
   $ATOM-TYPE = PRESENT-ELEMENT- IS OF TYPE ATOM.
   $STRING-TYPE = PRESENT-ELEMENT- IS OF TYPE STRING.
   $ADJSET-TYPE = PRESENT-ELEMENT- IS OF TYPE ADJSET.
   $LXR-TYPE = EITHER PRESENT-ELEMENT- IS OF TYPE LXR
        OR PRESENT-ELEMENT- IS DSTG.
   $CONJ-TYPE = PRESENT-ELEMENT- HAS ELEMENT- Q-CONJ X1;
        IF COELEMENT SACONJ IS NOT EMPTY
        @THEN TRANSFORM VALUE;
        X1 EXISTS.
   $OBJ-TYPE = PRESENT-ELEMENT- IS OBJECT OR OBJBE OR PASSOBJ
        WHERE PRESENT-ELEMENT- IS NOT EMPTY.
   $DESCENT-TYPE =
        EITHER DESCEND TO QPERUNIT NOT PASSING THROUGH LXR
        OR EITHER DESCEND TO LXR
        OR EITHER DESCEND TO STRING NOT PASSING THROUGH LXR
        OR DESCEND TO DSTG NOT PASSING THROUGH LXR;
        IF PRESENT-ELEMENT- IS OF TYPE STRING
        THEN VERIFY NONE OF $HAS-FAIL-SEL, $HAS-ADJUNCT-ATT
        ELSE VERIFY AT CORE NONE OF $HAS-FAIL-SEL, $HAS-ADJUNCT-ATT.
— TSEQ-OBJ
—       PUTS DESCENT-TYPE LXR, STRING, DSTG OF OBJECT, OBJBE AND
—       PASSOBJ IN TRANSFORM STACK.
TSEQ-OBJ = IN OBJECT, OBJBE, PASSOBJ:
        IF PRESENT-ELEMENT- IS NOT EMPTY
        THEN EITHER PRESENT-ELEMENT- IS OBJBE
        WHERE PRESENT-ELEMENT- IS OCCURRING IN OBJECT
        [* been transformed already *]
        OR IF $DESCENT-TYPE [Global in TSEQ-STRING]
        @THEN TRANSFORM PRESENT-ELEMENT-.
— TSEQ-ADJUNCT
—       PUTS STRING, LXR, NNN OF AN ADJSET NODE ON TRANSFORM STACK.
TSEQ-ADJUNCT = IN ADJSET:
        IF PRESENT-ELEMENT- IS NOT EMPTY
        THEN AT LAST-ELEMENT- ITERATE VERIFY $TRANSFORM-ELS
        UNTIL GO LEFT FAILS.
   $TRANSFORM-ELS =
        IF BOTH $NOT-EMPTY
        AND ONE OF $STRING-TYPE, $NNN-TYPE, $LXR-TYPE,
   $ADJ-DESCENT-TYPE, $DESCENT-TYPE
        @THEN [AT PRESENT-ELEMENT-]
        BOTH IF EITHER PRESENT-ELEMENT- IS OCCURRING IN ADJADJ
        WHERE ELEMENT- ADJADJ [LAR] EXISTS
        OR BOTH PRESENT-ELEMENT- IS OCCURRING IN [NNN OR]
        NPOS
        WHERE ELEMENT- NNN EXISTS
        AND ELEMENT- LAR EXISTS
        @THEN $TRANSFORM-ELS
        AND BOTH TRANSFORM PRESENT-ELEMENT-
        AND IF PRESENT-ELEMENT- IS LAR
        WHERE EITHER COELEMENT- LAR EXISTS
        OR ELEMENT- LAR OF COELEMENT- ADJADJ EXISTS
        @THEN TRANSFORM PRESENT-ELEMENT-.
   $ADJ-DESCENT-TYPE =
        [* Recursive ADJADJ -> ADJADJ+LAR *]
        BOTH EITHER PRESENT-ELEMENT- IS ADJADJ
        OR PRESENT-ELEMENT- IS APOS
        AND EITHER ELEMENT- LAR OF ELEMENT- ADJADJ EXISTS
        OR DESCEND TO QN PASSING THROUGH ADJADJ.
   $NOT-EMPTY = PRESENT-ELEMENT IS NOT EMPTY.
   $NNN-TYPE = DESCEND TO NNN OR QN-TIME NOT PASSING THROUGH LXR.
— TSEQ-DSTG-NNN
—       PUTS RECURSIVE DSTG OR NNN ON TRANSFORM STACK.
TSEQ-DSTG-NNN = IN DSTG, NNN:
        IF VALUE IS DSTG OR NNN
        @THEN TRANSFORM PRESENT-ELEMENT-.
— TSEQ-LXR
—       PUTS RADJSET, LADJSET, PARENSTG, DASHSTG AND NON-ATOMIC
—       CORE OF AN LXR ON TRANSFORM STACK.
TSEQ-LXR = IN LXR:
        BOTH IF ELEMENT- RADJSET IS NOT EMPTY
        @THEN AT LAST-ELEMENT- ITERATE VERIFY $TRANSFORM-RADJ
        UNTIL GO LEFT FAILS
        AND BOTH AT VALUE ITERATE IF TEST FOR PARENSTG OR DASHSTG
        @THEN TRANSFORM PRESENT-ELEMENT
        UNTIL GO RIGHT FAILS
        AND BOTH IF CORE- IS NOT OF TYPE ATOM
        @THEN TRANSFORM PRESENT-ELEMENT-
        AND BOTH IF ELEMENT- LAUX EXISTS
        @THEN TRANSFORM PRESENT-ELEMENT-
        AND IF ELEMENT- LADJSET IS NOT EMPTY
        @THEN TRANSFORM PRESENT-ELEMENT-.
   $TRANSFORM-RADJ =
        IF BOTH NONE OF $IS-EMPTY, $HAS-FAIL-SEL, $HAS-ADJUNCT-ATT
        AND ONE OF $STRING-TYPE, $LXR-TYPE, $DESCENT-TYPE
        @THEN TRANSFORM PRESENT-ELEMENT-
        ELSE IF ALL OF $IS-PN-ADJUNCT, $HAS-ADJUNCT-ATT, $HAS-RADJ
        @THEN DO $HAS-RADJ-PN.
   $IS-PN-ADJUNCT = PRESENT-ELEMENT- IS PN.
   $HAS-RADJ = DESCEND TO LXR.
   $HAS-RADJ-PN =
        IF ELEMENT- RADJSET IS NOT EMPTY
        @THEN AT LAST-ELEMENT- ITERATE VERIFY $TRANSFORM-RADJ
        UNTIL GO LEFT FAILS.
   $IS-EMPTY = PRESENT-ELEMENT- IS EMPTY.
— TSEQ3A
—       PUTS ALL SA'S AND LCONNR OF PARSE-CONN ON TRANSFORM STACK.
TSEQ3A = IN PARSE-CONN:
        AT VALUE,
        LAST-ELEMENT- [SA] EXISTS;
        IF PRESENT-ELEMENT- IS NOT EMPTY THEN TRANSFORM PRESENT-ELEMENT-;
        GO LEFT; GO LEFT;
        IF PRESENT-ELEMENT- [FIRST SA] IS NOT EMPTY
        THEN TRANSFORM PRESENT-ELEMENT- [FIRST SA];
        GO RIGHT;
        TRANSFORM PRESENT-ELEMENT-[LCONNR].
— T-TIME-LOC
—       PUTS AN H-TMLOC AFTER VERB WHEN THERE IS NO HOST.
T-TIME-LOC = IN LNR:
        IF BOTH $NOT-FORMATED
        AND BOTH CORE-SELATT X-S OF CORE- X-CORE OF PRESENT-ELEMENT-
        X-PRE HAS MEMBER H-TMLOC
        AND X-CORE HAS NODE ATTRIBUTE TYPE-ATT X-TYPEATT
        WHERE X-TYPEATT HAS MEMBER TIME
        THEN ALL OF $FIND-FORMAT, $MK-EVENT-TIME, $PLACE-TIME.
   $MK-EVENT-TIME =
        AFTER ELEMENT- VERB OF X-FORMAT INSERT <EVENT-TIME>.
   $PLACE-TIME =
        X-PUTIN := X-PRE;
        DO PUTIN-SLOT(EVENT-TIME).
— T-CLEANUP-PALP
—       DELETES [PALPATE] IF TXRES IS NOT EMPTY.
T-CLEANUP-PALP = IN ASSERTION, FRAGMENT:
        IF FOLLOWING-ELEMENT IS FORMAT5 [OR FORMAT5F OR FORMAT5-MISC]
        WHERE DO $FIND-PALPATE
        THEN IF COELEMENT- NON-EMPTY OF X-PALP EXISTS
        THEN DELETE X-PALP.
   $FIND-PALPATE =
        DO FIND-SLOT(LVR);
        GO UP [TO NON-EMPTY];
        PRESENT-ELEMENT X-PALP IS NON-EMPTY.
— T-SA-CLEANUP
—       MOVES AN UNFORMATTED SA OR RV TO RV OF THE VERB.
—       E.G. PROTRUDE THE TONGUE OUT COMPLETELY.
T-SA-CLEANUP = IN RV, SA:
        IF PRESENT-ELEMENT- X-PRE IS NOT OCCURRING IN PARSE-CONN
        THEN AT VALUE OF [PRESENT-ELEMENT-] X-PRE
        ITERATE $FORMAT-PRECISIONS
        UNTIL GO RIGHT FAILS.
   $FORMAT-PRECISIONS =
        BOTH STORE IN X-SA-VALUE [* currently just below RV/SA *]
        AND IF NONE OF $EMPTY, $IS-FORMATED, $CORE-FORMATED
        THEN BOTH PRESENT-ELEMENT- X-PUTIN EXISTS
        AND $MOVE-TO-PRECISIONS;
        GO TO X-SA-VALUE.
   $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
   $MOVE-TO-PRECISIONS =
        BOTH DO $FIND-FORMAT
        AND DO PUTIN-SLOT(PRECISIONS).
   $CORE-FORMATED =
        EITHER AT CORE- DO $IS-FORMATED
        OR EITHER AT ELEMENT- LXR DO $IS-FORMATED [* NSTG under SA *]
        OR EITHER AT IMMEDIATE LXR DO $IS-FORMATED
        OR EITHER PRESENT-ELEMENT- IS PN WHERE AT ELEMENT-
        LNR OF NSTG OF NSTGO DO $IS-FORMATED
        OR PRESENT-ELEMENT- IS QN [* never happens *]
        WHERE AT LQR DO $IS-FORMATED.
— T-CLEANUP
—       IF A. A NODE HAS NOT BEEN FORMATTED, AND
—       B. IT OCCURS WITH H-BEH OR H-PTFUNC VERBS
—       THEN IT IS PLACED IN DESCR ALONG WITH VERB AS A UNIT.
T-CLEANUP= IN LXR, [NPN,] DSTG, NNN, QN, NQ:
        AT PRESENT-ELEMENT- X-PRE
        IF BOTH $CHECK-FRMTED
        AND NOT $IN-SS-DIAG-PTFUNC
        @THEN IF DO $CHECK-VERB
        THEN $PUT-IN-DESCR
        ELSE $MOVE-OBJECT.
   $IN-SS-DIAG-PTFUNC =
        ITERATE EITHER PRESENT-ELEMENT- IS OCCURRING IN PN
        WHERE ASCEND TO LNR PASSING THROUGH ADJSET1
        OR ASCEND TO LNR PASSING THROUGH ADJSET1
        UNTIL BOTH EITHER CORE- OF PRESENT-ELEMENT- X-FPRE HAS NODE
        ATTRIBUTE FORMAT-PT
        WHERE IMMEDIATE-NODE- IS DIAG OR INDIC
        [OR TXRES OR TTRES OR TESTRES OR PTFUNC]
        OR PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT
        WHERE IMMEDIATE-NODE- IS DIAG OR INDIC
        [OR TXRES OR TTRES OR TESTRES OR PTFUNC]
        AND GO TO X-FPRE
        SUCCEEDS.
   $CHECK-FRMTED =
        BOTH IF PRESENT-ELEMENT- IS QN OR NQ
        THEN BOTH IMMEDIATE PQUANT EXISTS
        WHERE DO $NOT-FORMATED
        AND AT ELEMENT- LQR DO $NOT-FORMATED
        ELSE IF BOTH PRESENT-ELEMENT- IS LDR
        AND $NOT-FORMATED
        THEN IMMEDIATE-NODE- IS NOT OF TYPE ADJSET
        ELSE $NOT-FORMATED [T-AGE]
        AND ITERATE $UNDER-OBJ
        UNTIL CORE- OF COELEMENT- VERBAL X-VERB EXISTS SUCCEEDS.
   $MOVE-OBJECT =
        [* Unformatted OBJECT is moved under RV of VERB *]
        IF AT X-VERB EITHER DO $IS-FORMATED
        WHERE IMMEDIATE-NODE- X-SLOT EXISTS
        OR CORE-ATT OF CORE EXISTS
        THEN BOTH IF BOTH X-PRE IS OF TYPE LXR
        AND AT X-PRE, IMMEDIATE PN EXISTS
        @THEN BOTH STORE IN X-PRE
        AND DO $CHK-FMT-P
        AND BOTH IF VALUE OF X-VERB IS LVR X-LVR-V
        THEN AFTER LAST-ELEMENT- OF RV OF X-LVR-V
        INSERT X-PRE
        ELSE AFTER LAST-ELEMENT- OF RV OF X-VERB
        INSERT X-PRE
        AND REPLACE X-PRE BY <NULL>.
   $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
   $CHK-FMT-P =
        IF ELEMENT- P HAS NODE ATTRIBUTE FORMAT-PT X-FPT
        THEN BOTH AT ELEMENT- P ERASE NODE ATTRIBUTE FORMAT-PT
        AND DELETE X-FPT.
   $UNDER-OBJ =
        EITHER IMMEDIATE PSTRING EXISTS OR TRUE;
        ASCEND TO OBJECT PASSING THROUGH QN OR PVO.
   $CHECK-VERB =
        BOTH CORE-SELATT HAS MEMBER [H-BEH OR] H-PTFUNC
        AND AT X-VERB DO $IS-FORMATED;
        IMMEDIATE-NODE- IS DESCR.
   $PUT-IN-DESCR =
        X-PUTIN:= X-PRE;
        DO PUTIN-SLOT(DESCR).
— T-NEG-PRED-PN
—       ATTACHES NEG TO ITS ARGUMENT IN OBJBE:PN OR RN/RA:PN
T-NEG-PREDPN = IN PN:
        IF ALL OF $PN-IN-OBJBE-OR-RX, $FIND-FORMAT
        THEN DO $MAIN-NEG.
   $PN-IN-OBJBE-OR-RX =
        BOTH EITHER IMMEDIATE-NODE- OF PRESENT-ELEMENT- X-PRE IS OBJBE
        WHERE BOTH IMMEDIATE OBJECT EXISTS
        @AND CORE- X-VCORE OF COELEMENT- VERB IS VBE
        OR IMMEDIATE-NODE- OF PRESENT-ELEMENT- IS RN OR RA
        AND CORE- X-PUTIN IS P;
        ELEMENT- LNR X-LNR OF NSTG OF ELEMENT- NSTGO OF X-PRE EXISTS;
        CORE- X-NCORE OF X-LNR EXISTS;
        EITHER X-PUTIN HAS NODE ATTRIBUTE SEM-CORE
        OR AT X-PUTIN, ASSIGN NODE ATTRIBUTE SEM-CORE WITH VALUE X-NCORE;
        EITHER X-PUTIN HAS NODE ATTRIBUTE TYPE-ATT
        OR BOTH X-TYPE := SYMBOL MODS
        AND AT X-PUTIN, ASSIGN NODE ATTRIBUTE TYPE-ATT WITH
        VALUE X-TYPE;
        CORE-ATT OF X-PUTIN HAS MEMBER H-NEG;
        X-PUTIN DOES NOT HAVE NODE ATTRIBUTE FORMAT-PT.
   $MAIN-NEG =
        X-LNR HAS NODE ATTRIBUTE FORMAT-PT X-SLOT;
        DO $CONSTRUCT-MODS;
        DO $SET-POINTERS [in PUTIN-SLOT].
   $CONSTRUCT-MODS =
        IF COELEMENT- MODS X-NOHOST-MOD OF X-SLOT EXISTS
        THEN TRUE
        ELSE AFTER X-SLOT
        INSERT <MODS> X-NOHOST-MOD (<NEG>+<MODAL>);
        IF AT ELEMENT- NEG X-NEG-MOD OF X-NOHOST-MOD
        DESCEND TO NON-EMPTY
        THEN AFTER LAST-ELEMENT- OF X-NEG-MOD
        INSERT <NON-EMPTY> X-FRMT-SLOT
        ELSE REPLACE X-NEG-MOD BY <NEG> (<NON-EMPTY> X-FRMT-SLOT).
— T-WRITE-SHML-TREE
—       OUTPUTS ONLY THE FORMAT PORTIONS OF THE PARSE TREE
—       IN PARENTHESIZED FORM WITH COMMENTS.
T-WRITE-SHML-TREE = IN SENTENCE:
        ITERATE AT ELEMENT- TEXTLET
        BOTH IF ELEMENT- MORESENT IS NOT EMPTY
        THEN $WRITE-ENDMARK
        AND BOTH AT ELEMENT- CENTER OF ELEMENT- ONESENT
        DO $WRITE-OUT-CENTER
        AND PRESENT-ELEMENT- IS TEXTLET
        UNTIL ELEMENT- MORESENT IS NOT EMPTY FAILS.
   $WRITE-ENDMARK =
        WRITE ON INFO '<CONNECTIVE><CONJOINED>';
        WRITE ON INFO '<CONN><N>';
        AT VALUE OF ELEMENT- ENDMARK OF ELEMENT- ONESENT,
        DO WRITE-WORDS;
        WRITE ON INFO '</N></CONN>';
        WRITE ON INFO '</CONJOINED></CONNECTIVE>';
        WRITE ON INFO END OF LINE;
        WRITE ON INFO END OF LINE.
   $WRITE-OUT-CENTER =
        AT VALUE OF IMMEDIATE-NODE-
        ITERATET $WHAT-TO-WRITE UNTIL $GO-TO-NEXT FAILS.
   $GO-TO-NEXT = [* skip SECTION node *]
        ITERATE GO RIGHT
        UNTIL TEST FOR CONNECTIVE OR CENTER OR INTRODUCER SUCCEEDS.
   $WHAT-TO-WRITE = VERIFY
        IF PRESENT-ELEMENT- IS CONNECTIVE
        THEN $FORMAT-CONJ
        ELSE IF PRESENT-ELEMENT- IS INTRODUCER
        THEN $FORMAT-OUT
        ELSE $CENTER-OUT.
   $CENTER-OUT =
        AT VALUE EITHER $IS-OUT-NODE
        OR $NEXT-IN-CENTER;
        ITERATE [BOTH WRITE ON INFO '(']
        [AND] $WRITE-CENTER
        UNTIL $NEXT-IN-CENTER FAILS;
        [WRITE ON INFO ')';] WRITE ON INFO END OF LINE.
   $NEXT-IN-CENTER =
        ITERATE GO RIGHT UNTIL $IS-OUT-NODE SUCCEEDS.
   $IS-OUT-NODE =
        PRESENT-ELEMENT- IS CONNECTIVE OR ASSERTION OR FRAGMENT X-PRE.
   $WRITE-CENTER =
        VERIFY IF PRESENT-ELEMENT- IS CONNECTIVE
        THEN $FORMAT-OUT
        ELSE $FORMAT-IT.
   $WRITE-FRMT =
        AT X-FRMT IF PRESENT-ELEMENT- HAS MEMBER NOFRMT
        THEN $WRITE-NOFRMT;
        WRITE ON INFO END OF LINE.
   $WRITE-NOFRMT =
        WRITE ON INFO '<NO-FORMAT/>'; WRITE ON INFO END OF LINE.
   $FORMAT-IT =
        DO R(FORMAT-TYPES) [GET FORMAT FOR ASSERT/FRAG];
        DO $FORMAT-OUT.
   $FORMAT-CONJ =
        STORE IN X-FORMAT;
        DO $WRITE-CONJ-NODE;
        WRITE ON INFO END OF LINE.
   $WRITE-CONJ-NODE =
        IF PRESENT-ELEMENT- IS CONNECTIVE X-FORMAT
        THEN BOTH ALL OF $COPY-NODES, $WRITE-IT
        AND BOTH $WRITE-CLOSE-NODE
        AND WRITE ON INFO END OF LINE.
   $FORMAT-OUT =
        STORE IN X-FORMAT;
        DO $WRITE-NODE;
        WRITE ON INFO END OF LINE.
   $WRITE-NODE =
        IF EITHER TEST FOR FORMAT-TYPES
        OR PRESENT-ELEMENT- IS CONNECTIVE X-FORMAT
        THEN [IF $EMPTY-SLOT THEN VERIFY $COPY-NODES]
        [ELSE] BOTH ALL OF $ADJUST-INST, $COPY-NODES, $WRITE-IT,
   $LEFTOVERS [write TEXTPLUS]
        AND BOTH $WRITE-CLOSE-NODE
        AND WRITE ON INFO END OF LINE.
   $ADJUST-INST = [* move INST under PRECISIONS *]
        IF ELEMENT- PRECISIONS X-PRECIS EXISTS
        THEN ITERATET BOTH AFTER LAST-ELEMENT- OF X-PRECIS
        INSERT X-INST, X-NEWINST
        AND DELETE X-INST
        UNTIL AT X-FORMAT, ELEMENT- INST X-INST EXISTS
        WHERE DO $TEST-CONTENTS
        FAILS.
        [IF BOTH ELEMENT- INST X-INST EXISTS]
        [ WHERE DO $TEST-CONTENTS]
        [ AND ELEMENT- PRECISIONS X-PRECIS EXISTS]
        [THEN BOTH BEFORE VALUE OF X-PRECIS]
        [ INSERT ALL ELEMENTS OF X-FORMAT]
        [ AND BOTH ITERATE AT X-PRECIS, DELETE VALUE]
        [ UNTIL VALUE OF X-PRECIS IS INST SUCCEEDS]
        [ AND BOTH AT VALUE OF X-PRECIS,]
        [ ITERATET DELETE X-FOL]
        [ UNTIL AT X-INST,]
        [ FOLLOWING-ELEMENT- X-FOL EXISTS FAILS]
        [ AND DELETE X-INST.]
   $EMPTY-SLOT = PRESENT-ELEMENT- IS EMPTY.
   $COPY-NODES =
        WRITE ON INFO '<'; WRITE ON INFO NODE NAME;
        WRITE ON INFO '>';
        EITHER TEST FOR FORMAT-TYPES
        OR IF BOTH GO DOWN
        @AND NOT $ANY-NULL
        THEN $COPY-NODES.
   $ANY-NULL =
        EITHER PRESENT-ELEMENT- IS NULL OR NULLN OR NULLC OR NULLWH
        OR PRESENT-ELEMENT- IS 'NULLN'.
   $WRITE-IT =
        ITERATE BOTH $WRITE-ATOM AND $GO-TO-NEXT-NODE
        UNTIL PRESENT-ELEMENT- IS IDENTICAL TO X-FORMAT SUCCEEDS.
   $WRITE-SLOT-NAME =
        IF PRESENT-ELEMENT- IS OF TYPE FORMAT-TYPES
        THEN BOTH WRITE ON INFO END OF LINE
        AND WRITE ON INFO '<'
        ELSE IF PRESENT-ELEMENT- IS OF TYPE MAJOR-DB-FIELDS
        THEN BOTH WRITE ON INFO END OF LINE
        AND WRITE ON INFO ' <'
        ELSE IF PRESENT-ELEMENT- IS OF TYPE MOD-DB-FIELDS
        THEN BOTH WRITE ON INFO END OF LINE
        AND WRITE ON INFO ' <'
        ELSE IF PRESENT-ELEMENT- IS OF TYPE CONN-DB-FIELDS
        THEN WRITE ON INFO ' <'
        ELSE BOTH WRITE ON INFO END OF LINE
        AND WRITE ON INFO ' <';
        WRITE ON INFO NODE NAME;
        WRITE ON INFO '>'.
   $WRITE-ATOM =
        IF PRESENT-ELEMENT- IS OF TYPE CT-DB-FIELDS
        WHERE DO $TEST-CONTENTS
        THEN $WRITE-SLOT-NAME
        ELSE IF BOTH PRESENT-ELEMENT- IS NON-EMPTY X-ET
        AND X-ET HAS NODE ATTRIBUTE FILLED-PT X-ATM
        THEN BOTH BOTH IF AT X-ET, NOT $LINKED-NODES
        THEN WRITE ON INFO ' '
        AND AT X-ATM ALL OF $WRITE-P-OF-LXR,
   $WRITE-CONTENTS,
   $WRITE-INTRO-ELEMS
        AND GO TO X-ET.
   $WRITE-INTRO-ELEMS = [* sweep other nodes in INTRODUCER *]
        IF IMMEDIATE-NODE OF X-ATM IS INTRODUCER
        THEN BOTH AT X-ATM, ITERATE $WRITE-INTRO-ELEM
        UNTIL GO RIGHT FAILS
        AND WRITE ON INFO END OF LINE.
   $WRITE-INTRO-ELEM =
        IF NONE OF $IS-FORMATED, $IS-WRITTEN
        THEN DO WRITE-WORDS.
   $LINKED-NODES =
        EITHER GO LEFT
        WHERE PRESENT-ELEMENT- IS NON-EMPTY
        OR BOTH IMMEDIATE-NODE- IS PRECISIONS
        AND ITERATE GO LEFT
        UNTIL $TEST-CONTENTS SUCCEEDS.
   $WRITE-P-OF-LXR =
        IF X-ATM IS LNR
        WHERE BOTH NOT $IN-PAREN
        AND PRESENT-ELEMENT- IS OCCURRING IN PN X-PN
        THEN IF AT ELEMENT- P X-P OF X-PN DO $NOT-FORMATED
        @THEN BOTH $FIND-UNFORMATED
        AND $WRITE-OUT-P
        ELSE $WRITE-OUT-P
        ELSE TRUE.
   $IN-PAREN =
        GO UP; PRESENT-ELEMENT- IS NSTG;
        GO UP; PRESENT-ELEMENT- IS PAREN-NSTG.
   $FIND-UNFORMATED = TRUE [* look for unformatted adjuncts *].
   $WRITE-OUT-P =
        AT X-P DO $WRITE-CONTENTS.
   $WRITE-CONTENTS =
        ITERATE BOTH $WRITE-SUBTREE AND $MOVE-D1-L2R
        UNTIL PRESENT-ELEMENT- IS IDENTICAL TO X-ATM SUCCEEDS.
   $WRITE-SUBTREE =
        IF PRESENT-ELEMENT- IS OF TYPE ATOM
        WHERE BOTH PRESENT-ELEMENT- DOES NOT HAVE NODE ATTRIBUTE
        CT-WRITTEN
        AND NOT $FORMATTED-SUBTREE
        THEN DO WRITE-WORDS.
   $FORMATTED-SUBTREE =
        PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT
        WHERE PRESENT-ELEMENT- IS NOT IDENTICAL TO X-ET.
   $MOVE-D1-L2R =
        EITHER BOTH NOT $FORMATTED-SUBTREE
        AND GO DOWN
        OR ITERATET GO UP
        UNTIL EITHER PRESENT-ELEMENT- IS IDENTICAL TO X-ATM
        OR GO RIGHT SUCCEEDS.
   $GO-TO-NEXT-NODE =
        EITHER BOTH $TEST-CONTENTS
        AND GO DOWN
        OR ITERATET GO UP
        UNTIL EITHER EITHER [* reaching starting point *]
        PRESENT-ELEMENT- IS OF TYPE FORMAT-TYPES
        OR BOTH BOTH PRESENT-ELEMENT- IS OF TYPE
        CT-DB-FIELDS
        AND EITHER DESCEND TO NON-EMPTY
        OR PRESENT-ELEMENT- IS OF TYPE
        VERBAL [MAJOR-DB-FIELDS]
        WHERE FOLLOWING-ELEMENT- IS OF
        TYPE MODIFIERS
        AND IF THE FOLLOWING-ELEMENT- X-MODS IS
        OF TYPE MODIFIERS
        THEN DO $HOST-AND-MODS
        ELSE BOTH $WRITE-CLOSE-NODE
        AND GO RIGHT
        OR GO RIGHT
        SUCCEEDS.
   $HOST-AND-MODS =
        IF PRESENT-ELEMENT- X-EMPTY-HOST IS OF TYPE VERBAL
        WHERE NOT DESCEND TO NON-EMPTY
        THEN $WRITE-SLOT-NAME;
        BOTH AT X-MODS, DO $PROCESS-MODIFIERS
        AND BOTH $WRITE-CLOSE-NODE [WRITE ON INFO ')']
        AND GO TO X-MODS
        WHERE EITHER GO RIGHT
        OR TRUE.
   $PROCESS-MODIFIERS =
        ITERATE $PROCESS-MODIFIER
        UNTIL GO RIGHT
        WHERE PRESENT-ELEMENT- IS OF TYPE MODIFIERS
        FAILS.
   $PROCESS-MODIFIER =
        BOTH STORE IN X-MODS
        AND STORE IN X-MOD;
        WRITE ON INFO END OF LINE;
        WRITE ON INFO ' <';
        WRITE ON INFO NODE NAME;
        WRITE ON INFO '> ';
        [IF EITHER PRESENT-ELEMENT- IS TENSE]
        [ OR PRESENT-ELEMENT- IS EVENT-TIME]
        [ WHERE VALUE IS NON-EMPTY]
        [THEN WRITE ON INFO ' ';]
        IF DESCEND TO NON-EMPTY
        THEN DO $MOD-FMT-TREE
        ELSE DO $LONE-MOD;
        WRITE ON INFO '</';
        WRITE ON INFO NODE NAME;
        WRITE ON INFO '>';
        GO TO X-MODS.
   $LONE-MOD =
        [WRITE ON INFO '= ';]
        X-MOD HAS NODE ATTRIBUTE FILLED-PT X-MODTREE;
        DO $PROCESS-MOD-TREE.
   $PROCESS-MOD-TREE =
        AT X-MODTREE
        ITERATE BOTH $WRITE-MODWORDS AND $MOVE-TO-NEXT
        UNTIL PRESENT-ELEMENT- IS IDENTICAL TO X-MODTREE SUCCEEDS;
        GO TO X-MOD.
   $MOD-FMT-TREE =
        AT VALUE OF X-MODS, DO $TRAVERSE-MODS.
   $TRAVERSE-MODS =
        ITERATE
        EITHER BOTH EITHER PRESENT-ELEMENT- IS MODS OR TENSE
        OR PRESENT-ELEMENT- IS OF TYPE MOD-DB-FIELDS
        AND AT VALUE, DO $TRAVERSE-MODS
        OR BOTH IF PRESENT-ELEMENT- IS NON-EMPTY X-MOD
        WHERE PRESENT-ELEMENT- HAS NODE ATTRIBUTE
        FILLED-PT X-MODTREE
        THEN $PROCESS-MOD-TREE
        AND DO $TRAVERSE-MODS-CHILDREN
        UNTIL PRESENT-ELEMENT- IS IDENTICAL TO X-MODS SUCCEEDS.
   $TRAVERSE-MODS-CHILDREN =
        EITHER BOTH BOTH PRESENT-ELEMENT- IS OF TYPE MOD-DB-FIELDS
        WHERE DO $TEST-CONTENTS
        AND $WRITE-MOD-NAME
        AND GO DOWN
        OR EITHER BOTH PRESENT-ELEMENT- IS DOUBLE-NEG
        AND GO DOWN
        OR ITERATET GO UP
        WHERE IF PRESENT-ELEMENT- IS OF TYPE MOD-DB-FIELDS
        THEN $WRITE-CLOSE-NODE
        UNTIL EITHER PRESENT-ELEMENT- IS IDENTICAL TO X-MODS
        OR GO RIGHT SUCCEEDS.
   $WRITE-CLOSE-NODE =
        WRITE ON INFO '</';
        WRITE ON INFO NODE NAME;
        WRITE ON INFO '>'.
   $TEST-CONTENTS =
        [* DESCEND TO NON-EMPTY is not a complete check *]
        [* -- Need also a check for a parse tree node *]
        [* doubly pointed to by two format tree nodes. *]
        DESCEND TO NON-EMPTY;
        PRESENT-ELEMENT- HAS NODE ATTRIBUTE FILLED-PT;
        PRESENT-ELEMENT- DOES NOT HAVE NODE ATTRIBUTE CT-WRITTEN.
   $WRITE-MOD-NAME =
        WRITE ON INFO END OF LINE;
        WRITE ON INFO ' <';
        WRITE ON INFO NODE NAME;
        WRITE ON INFO '> '.
   $WRITE-MODWORDS =
        IF PRESENT-ELEMENT- IS OF TYPE ATOM
        WHERE PRESENT-ELEMENT- DOES NOT HAVE NODE ATTRIBUTE CT-WRITTEN
        THEN DO WRITE-WORDS.
   $FORMATTED-MOD =
        PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT
        WHERE PRESENT-ELEMENT- IS NOT IDENTICAL TO X-MOD.
   $MOVE-TO-NEXT =
        EITHER BOTH NOT $FORMATTED-MOD
        AND GO DOWN
        OR ITERATET GO UP
        UNTIL EITHER PRESENT-ELEMENT- IS IDENTICAL TO X-MODTREE
        OR GO RIGHT
        SUCCEEDS.
   $LEFTOVERS =
        IF BOTH X-FORMAT IS OF TYPE FORMAT-TYPES
        AND GO LEFT
        WHERE PRESENT-ELEMENT- X-ASSERT IS ASSERTION OR FRAGMENT
        THEN VERIFY $CHK-LEFTOVERS.
   $CHK-LEFTOVERS =
        WRITE ON INFO END OF LINE;
        WRITE ON INFO ' <TEXTPLUS>';
        AT X-ASSERT [* Beginning of parse tree *],
        ITERATE VERIFY $WRITE-UNFORMATED UNTIL $MOVE-THROUGH-TREE FAILS;
        WRITE ON INFO '</TEXTPLUS>';
        WRITE ON INFO END OF LINE.
   $WRITE-UNFORMATED =
        IF $UNFORMATED-ATOM
        THEN VERIFY DO WRITE-WORDS.
   $UNFORMATED-ATOM =
        PRESENT-ELEMENT- IS OF TYPE ATOM
        WHERE NONE OF $IS-WRITTEN, $IS-FORMATED, $ANY-NULL,
   $CORE-OF-FORMATED.
   $IS-WRITTEN =
        PRESENT-ELEMENT- HAS NODE ATTRIBUTE CT-WRITTEN.
   $CORE-OF-FORMATED =
        [* IS CORE OF LXR IF IN LXR BUT NOT A LEFT OR *]
        [* RIGHT ADJUNCT. *]
        EITHER ASCEND TO PN NOT PASSING THROUGH ADJSET1
        OR EITHER ASCEND TO LXR NOT PASSING THROUGH ADJSET1
        OR EITHER ASCEND TO DSTG NOT PASSING THROUGH ADJSET1
        OR ASCEND TO NNN NOT PASSING THROUGH ADJSET1;
        DO $IS-FORMATED.
   $IS-FORMATED = PRESENT-ELEMENT- HAS NODE ATTRIBUTE FORMAT-PT.
   $MOVE-THROUGH-TREE =
        EITHER $GO-DOWN-PTREE
        OR ITERATET $GO-UP-PTREE UNTIL GO RIGHT SUCCEEDS.
   $GO-DOWN-PTREE =
        PRESENT-ELEMENT- IS NOT EMPTY;
        GO DOWN.
   $GO-UP-PTREE =
        GO UP;
        PRESENT-ELEMENT- IS NOT IDENTICAL TO X-ASSERT
        [* not already back to starting node *].
   $LXR-CHK =
        EITHER PRESENT-ELEMENT- IS OF TYPE LXR,
        OR PRESENT-ELEMENT- IS DSTG OR NNN.
   $MOVE-THROUGH-ADJ =
        EITHER $GO-DOWN-ADJ
        OR ITERATET $GO-UP-ADJ
        UNTIL BOTH PRESENT-ELEMENT- IS NOT IDENTICAL TO X-ADJ
        AND GO RIGHT SUCCEEDS.
   $GO-DOWN-ADJ =
        PRESENT-ELEMENT- IS NOT EMPTY;
        DO $NOT-FORMATED
        [* DO NOT GO THROUGH ENTIRE SUBSTRUCTURE IF *]
        [* IT HAS BEEN FORMATED *];
        IF PRESENT-ELEMENT- IS PN
        [* PN CASE- LP+P ARE WRITTEN OUT AS LEFT-ADJ *]
        [* OF CORE OF LNR IN NSTG OF PN IF CORE IS *]
        [* FORMATED -- DO NOT CHECK PN IN THIS CASE -*]
        [* IE. DO NOT GO DOWN FORMATED PN. *]
        THEN VERIFY AT LNR OF NSTG OF NSTGO DO $NOT-FORMATED;
        GO DOWN.
   $GO-UP-ADJ =
        PRESENT-ELEMENT- IS NOT IDENTICAL TO X-ADJ;
        GO UP;
        PRESENT-ELEMENT- IS NOT IDENTICAL TO X-ADJ [NOT BACK AT START].
— END-FORMATS