Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEXDFN2

LEXDFN2.m

Go to the documentation of this file.
  1. LEXDFN2 ;ISL/KER - Default Names ;04/21/2014
  1. ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
  1. ;
  1. ; Global Variables
  1. ; None
  1. ;
  1. ; External References
  1. ; $$UP^XLFSTR ICR 10103
  1. ;
  1. AP(X) ; Application Pointer
  1. S X=$G(X) S X=$$NS(X) Q:X="" 1
  1. N LEXIEN,LEXNS
  1. I $L($G(X)),$D(^LEXT(757.2,"AN",X)) S X=$O(^LEXT(757.2,"AN",X,0)) Q X
  1. I $L($G(X)),$D(^LEXT(757.2,"B",X)) D I LEXNS'="" S X=LEXIEN Q X
  1. . S LEXIEN=$O(^LEXT(757.2,"B",X,0))
  1. . S LEXNS=$P($G(^LEXT(757.2,LEXIEN,5)),"^",5)
  1. I $L($G(X)),$D(^LEXT(757.2,"C",$$UP^XLFSTR(X))) D I LEXNS'="" S X=LEXIEN Q X
  1. . S LEXIEN=$O(^LEXT(757.2,"C",$$UP^XLFSTR(X),0))
  1. . S LEXNS=$P($G(^LEXT(757.2,LEXIEN,5)),"^",5)
  1. I $L($G(X)),$D(^LEXT(757.2,"APPS",X)) D I LEXNS'="" S X=LEXIEN Q X
  1. . S LEXIEN=$O(^LEXT(757.2,"APPS",X,0))
  1. . S LEXNS=$P($G(^LEXT(757.2,LEXIEN,5)),"^",5)
  1. Q 1
  1. NS(X) ; Namespace
  1. S X=$G(X) Q:X="" "LEX"
  1. I +X>0,X?1N.N,$D(^LEXT(757.2,+X)) S X=$P($G(^LEXT(757.2,+X,5)),"^",5) S:X="" X="LEX" Q X
  1. I X'="",$D(^LEXT(757.2,"AA",X)) D S:X="" X="LEX" Q X
  1. . 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)
  1. I X'="",$D(^LEXT(757.2,"AB",X)) D S:X="" X="LEX" Q X
  1. . 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)
  1. I X'="",$D(^LEXT(757.2,"APPS",X)) D S:X="" X="LEX" Q X
  1. . 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)
  1. I X'="",$D(^LEXT(757.2,"AN",X)) D S:X="" X="LEX" Q X
  1. . 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)
  1. I X'="",$D(^LEXT(757.2,"C",$$UP^XLFSTR(X))) D S:X="" X="LEX" Q X
  1. . 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)
  1. Q "LEX"
  1. MD(X) ; Mode/Subset
  1. S X=$G(X) Q:X="" "WRD"
  1. I $D(^LEXT(757.2,"AA",X)) D S:X="" X="WRD" Q X
  1. . N LEXR S LEXR=$O(^LEXT(757.2,"AA",X,0)) I +LEXR>0,$D(^LEXT(757.2,+LEXR,0)) S X=$$MODE(+LEXR)
  1. I $D(^LEXT(757.2,"AB",X)) D S:X="" X="WRD" Q X
  1. . N LEXR S LEXR=$O(^LEXT(757.2,"AB",X,0)) I +LEXR>0,$D(^LEXT(757.2,+LEXR,0)) S X=$$MODE(+LEXR)
  1. I $D(^LEXT(757.2,"APPS",X)) D S:X="" X="WRD" Q X
  1. . N LEXR S LEXR=$O(^LEXT(757.2,"APPS",X,0)) I +LEXR>0,$D(^LEXT(757.2,+LEXR,0)) S X=$$MODE(+LEXR)
  1. I $D(^LEXT(757.2,"AN",X)) D S:X="" X="WRD" Q X
  1. . N LEXR S LEXR=$O(^LEXT(757.2,"AN",X,0)) I +LEXR>0,$D(^LEXT(757.2,+LEXR,0)) S X=$$MODE(+LEXR)
  1. I $D(^LEXT(757.2,"C",$$UP^XLFSTR(X))) D S:X="" X="WRD" Q X
  1. . 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)
  1. I +X>0,$D(^LEXT(757.2,+X)) S X=$$MODE(+X) S:X="" X="WRD" Q X
  1. Q "WRD"
  1. MODE(X) ;
  1. N LEXMD S X=+($G(X)) Q:X=0 "WRD"
  1. S LEXMD=$P($G(^LEXT(757.2,X,5)),"^",1) I LEXMD'="" S X=LEXMD Q X
  1. S LEXMD=$P($G(^LEXT(757.2,X,5)),"^",2) I LEXMD'="" S X=LEXMD Q X
  1. S LEXMD=$P($G(^LEXT(757.2,X,0)),"^",2) I LEXMD'="" S X=LEXMD Q X
  1. Q "WRD"