| 1 | LEXDFN2 ; ISL Default Names ; 09-23-96
|
|---|
| 2 | ;;2.0;LEXICON UTILITY;;Sep 23, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | AP(X) ; Application Pointer
|
|---|
| 5 | S X=$G(X) S X=$$NS(X) Q:X="" 1
|
|---|
| 6 | N LEXIEN,LEXNS
|
|---|
| 7 | I $L($G(X)),$D(^LEXT(757.2,"AN",X)) S X=$O(^LEXT(757.2,"AN",X,0)) Q X
|
|---|
| 8 | I $L($G(X)),$D(^LEXT(757.2,"B",X)) D I LEXNS'="" S X=LEXIEN Q X
|
|---|
| 9 | . S LEXIEN=$O(^LEXT(757.2,"B",X,0))
|
|---|
| 10 | . S LEXNS=$P($G(^LEXT(757.2,LEXIEN,5)),"^",5)
|
|---|
| 11 | I $L($G(X)),$D(^LEXT(757.2,"C",$$UP^XLFSTR(X))) D I LEXNS'="" S X=LEXIEN Q X
|
|---|
| 12 | . S LEXIEN=$O(^LEXT(757.2,"C",$$UP^XLFSTR(X),0))
|
|---|
| 13 | . S LEXNS=$P($G(^LEXT(757.2,LEXIEN,5)),"^",5)
|
|---|
| 14 | I $L($G(X)),$D(^LEXT(757.2,"APPS",X)) D I LEXNS'="" S X=LEXIEN Q X
|
|---|
| 15 | . S LEXIEN=$O(^LEXT(757.2,"APPS",X,0))
|
|---|
| 16 | . S LEXNS=$P($G(^LEXT(757.2,LEXIEN,5)),"^",5)
|
|---|
| 17 | Q 1
|
|---|
| 18 | NS(X) ; Namespace
|
|---|
| 19 | S X=$G(X) Q:X="" "LEX"
|
|---|
| 20 | I +X>0,$D(^LEXT(757.2,+X)) S X=$P($G(^LEXT(757.2,+X,5)),"^",5) S:X="" X="LEX" Q X
|
|---|
| 21 | I X'="",$D(^LEXT(757.2,"AA",X)) D S:X="" X="LEX" Q X
|
|---|
| 22 | . N LEXR S LEXR=$O(^LEXT(757.2,"AA",X,0)) I +LEXR>0,$D(^LEXT(757.2,+LEXR,0)) S X=$P($G(^LEXT(757.2,+LEXR,5)),"^",5)
|
|---|
| 23 | I X'="",$D(^LEXT(757.2,"AB",X)) D S:X="" X="LEX" Q X
|
|---|
| 24 | . N LEXR S LEXR=$O(^LEXT(757.2,"AB",X,0)) I +LEXR>0,$D(^LEXT(757.2,+LEXR,0)) S X=$P($G(^LEXT(757.2,+LEXR,5)),"^",5)
|
|---|
| 25 | I X'="",$D(^LEXT(757.2,"APPS",X)) D S:X="" X="LEX" Q X
|
|---|
| 26 | . N LEXR S LEXR=$O(^LEXT(757.2,"APPS",X,0)) I +LEXR>0,$D(^LEXT(757.2,+LEXR,0)) S X=$P($G(^LEXT(757.2,+LEXR,5)),"^",5)
|
|---|
| 27 | I X'="",$D(^LEXT(757.2,"AN",X)) D S:X="" X="LEX" Q X
|
|---|
| 28 | . N LEXR S LEXR=$O(^LEXT(757.2,"AN",X,0)) I +LEXR>0,$D(^LEXT(757.2,+LEXR,0)) S X=$P($G(^LEXT(757.2,+LEXR,5)),"^",5)
|
|---|
| 29 | I X'="",$D(^LEXT(757.2,"C",$$UP^XLFSTR(X))) D S:X="" X="LEX" Q X
|
|---|
| 30 | . N LEXR S LEXR=$O(^LEXT(757.2,"C",$$UP^XLFSTR(X),0)) I +LEXR>0,$D(^LEXT(757.2,+LEXR,0)) S X=$P($G(^LEXT(757.2,+LEXR,5)),"^",5)
|
|---|
| 31 | Q "LEX"
|
|---|
| 32 | MD(X) ; Mode/Subset
|
|---|
| 33 | S X=$G(X) Q:X="" "WRD"
|
|---|
| 34 | I $D(^LEXT(757.2,"AA",X)) D S:X="" X="WRD" Q X
|
|---|
| 35 | . N LEXR S LEXR=$O(^LEXT(757.2,"AA",X,0)) I +LEXR>0,$D(^LEXT(757.2,+LEXR,0)) S X=$$MODE(+LEXR)
|
|---|
| 36 | I $D(^LEXT(757.2,"AB",X)) D S:X="" X="WRD" Q X
|
|---|
| 37 | . N LEXR S LEXR=$O(^LEXT(757.2,"AB",X,0)) I +LEXR>0,$D(^LEXT(757.2,+LEXR,0)) S X=$$MODE(+LEXR)
|
|---|
| 38 | I $D(^LEXT(757.2,"APPS",X)) D S:X="" X="WRD" Q X
|
|---|
| 39 | . N LEXR S LEXR=$O(^LEXT(757.2,"APPS",X,0)) I +LEXR>0,$D(^LEXT(757.2,+LEXR,0)) S X=$$MODE(+LEXR)
|
|---|
| 40 | I $D(^LEXT(757.2,"AN",X)) D S:X="" X="WRD" Q X
|
|---|
| 41 | . N LEXR S LEXR=$O(^LEXT(757.2,"AN",X,0)) I +LEXR>0,$D(^LEXT(757.2,+LEXR,0)) S X=$$MODE(+LEXR)
|
|---|
| 42 | I $D(^LEXT(757.2,"C",$$UP^XLFSTR(X))) D S:X="" X="WRD" Q X
|
|---|
| 43 | . N LEXR S LEXR=$O(^LEXT(757.2,"C",$$UP^XLFSTR(X),0)) I +LEXR>0,$D(^LEXT(757.2,+LEXR,0)) S X=$$MODE(+LEXR)
|
|---|
| 44 | I +X>0,$D(^LEXT(757.2,+X)) S X=$$MODE(+X) S:X="" X="WRD" Q X
|
|---|
| 45 | Q "WRD"
|
|---|
| 46 | MODE(X) ;
|
|---|
| 47 | N LEXMD S X=+($G(X)) Q:X=0 "WRD"
|
|---|
| 48 | S LEXMD=$P($G(^LEXT(757.2,X,5)),"^",1) I LEXMD'="" S X=LEXMD Q X
|
|---|
| 49 | S LEXMD=$P($G(^LEXT(757.2,X,5)),"^",2) I LEXMD'="" S X=LEXMD Q X
|
|---|
| 50 | S LEXMD=$P($G(^LEXT(757.2,X,0)),"^",2) I LEXMD'="" S X=LEXMD Q X
|
|---|
| 51 | Q "WRD"
|
|---|
