| [613] | 1 | LEXAMD2 ; ISL Look-up Check Modifiers ; 10-15-97
|
|---|
| 2 | ;;2.0;LEXICON UTILITY;**6**;Sep 23, 1996;Build 1
|
|---|
| 3 | Q
|
|---|
| 4 | CHKMOD ; Check Modifiers
|
|---|
| 5 | S LEXE=+($G(LEXE)) Q:'$D(^LEX(757.01,LEXE,0))
|
|---|
| 6 | N LEXC,LEXMDOK,LEXM,LEXI S (LEXI,LEXC)=0
|
|---|
| 7 | F S LEXC=$O(^LEX(757.01,"APAR",LEXE,LEXC)) Q:+LEXC=0 D
|
|---|
| 8 | . S LEXMDOK=1 D CHKTKNS(LEXC) Q:'LEXMDOK
|
|---|
| 9 | . S LEXI=LEXI+1,LEXM(0)=LEXI,LEXM(LEXI)=LEXC
|
|---|
| 10 | I +($G(LEXM(0)))=1 D
|
|---|
| 11 | . Q:+($G(LEXM(1)))=0 Q:'$L($G(^LEX(757.01,+($G(LEXM(1))),0)))
|
|---|
| 12 | . S LEXE=+($G(LEXM(1))),LEXOK=1
|
|---|
| 13 | Q
|
|---|
| 14 | CHKTKNS(LEXE) ; Check tolkens
|
|---|
| 15 | N LEXM S LEXM=+($G(^LEX(757.01,LEXE,1))) Q:LEXM=0
|
|---|
| 16 | N LEXI,LEXOE,LEXC,LEXD S LEXOE=LEXE,LEXI=1
|
|---|
| 17 | F S LEXI=$O(LEXTKN(LEXI)) Q:+LEXI=0!('LEXMDOK) D Q:'LEXMDOK
|
|---|
| 18 | . N LEXT,LEXE S LEXT=LEXTKN(LEXI),LEXE=0,LEXMDOK=0
|
|---|
| 19 | . S LEXC=$$UP(^LEX(757.01,LEXOE,0))
|
|---|
| 20 | . S LEXD=$$UP(^LEX(757.01,LEXOE,2))
|
|---|
| 21 | . I LEXD[LEXT S LEXMDOK=1 Q
|
|---|
| 22 | . I LEXC[LEXT S LEXMDOK=1 Q
|
|---|
| 23 | . I $L(LEXT),$D(^LEX(757.01,LEXOE,5,"B",LEXT)) S LEXMDOK=1 Q
|
|---|
| 24 | . I $L(LEXT),$E($O(^LEX(757.01,LEXOE,5,"B",($E(LEXT,1,($L(LEXT)-1))_$C($A($E(LEXT,$L(LEXT)))-1)_"~"))),1,$L(LEXT))=LEXT S LEXMDOK=1 Q
|
|---|
| 25 | Q
|
|---|
| 26 | UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
