- LEXDFN ;ISL/KER - Default Names ;04/21/2014
- ;;2.0;LEXICON UTILITY;**6,80**;Sep 23, 1996;Build 1
- ;
- ; Global Variables
- ; ^LEX(757.31) N/A
- ; ^LEX(757.41) N/A
- ;
- ; External References
- ; $$LOW^XLFSTR ICR 10103
- ; $$UP^XLFSTR ICR 10103
- ;
- APPN(X) ; Application Name
- N LEXT,LEXA S (LEXA,LEXT)="",X=$G(X)
- I +X>0,$D(^LEXT(757.2,+X,0)) D
- . S LEXA=$P($G(^LEXT(757.2,+X,5)),"^",4)
- . Q:LEXA="" Q:'$D(^LEXT(757.2,"APPS",LEXA))
- . S LEXT=$P($G(^LEXT(757.2,+X,0)),"^",1)
- S:X'=""&(LEXT="") X="Unknown Application" S:LEXT'="" X=LEXT Q X
- DISN(X) ; Display Name
- N LEXT S LEXT="" S X=$G(X) I X'="" D
- . N LEXO,LEXC,LEXR S LEXC=$E(X,1,63),LEXO=$E(LEXC,1,($L(LEXC)-1))_$C($A($E(LEXC,$L(LEXC)))-1)_"~"
- . F S LEXO=$O(^LEX(757.31,"ADSP",LEXO)) Q:LEXO=""!(LEXO'[LEXC) D Q:LEXT'=""
- . . S LEXR=0 F S LEXR=$O(^LEX(757.31,"ADSP",LEXO,LEXR)) Q:+LEXR=0 D Q:LEXT'=""
- . . . I $G(^LEX(757.31,LEXR,1))=X S LEXT=$P($G(^LEX(757.31,LEXR,0)),"^",1)
- S:X'=""&(LEXT="") X="User Defined Display" S:LEXT'="" X=LEXT Q X
- FILN(X) ; Filter Name
- N LEXT S LEXT="" S X=$G(X) I X'="" D
- . N LEXO,LEXC,LEXR S LEXC=$E(X,1,63)
- . S LEXO=$E(LEXC,1,($L(LEXC)-1))_$C($A($E(LEXC,$L(LEXC)))-1)_"~"
- . F S LEXO=$O(^LEX(757.3,"AS",LEXO)) Q:LEXT'=""!(LEXO'[LEXC) D
- . . S LEXR=0 F S LEXR=$O(^LEX(757.3,"AS",LEXO,LEXR)) Q:+LEXR=0!(LEXT'="") D Q:LEXT'=""
- . . . S:$G(^LEX(757.3,+LEXR,1))=X LEXT=$P($G(^LEX(757.3,+LEXR,0)),"^",1)
- S:X'=""&(LEXT="") X="User Defined Filter" S:LEXT'="" X=LEXT Q X
- GBLN(X) ; Global Name
- S X=$G(X) Q:X="" "Unknown Global" Q:X'["^" "Unknown Global"
- Q:X'["(" "Unknown Global" N LEXT S LEXT=$G(@(X_"0)"))
- S LEXT=$P(LEXT,"^",1) Q:LEXT="" "Unknown Global"
- N LEXS,LEXK,LEXI S LEXS=""
- F LEXI=1:1:$L(LEXT," ") D
- . S LEXK=$$UP^XLFSTR($E($P(LEXT," ",LEXI),1))_$$LOW^XLFSTR($E($P(LEXT," ",LEXI),2,$L($P(LEXT," ",LEXI))))
- . S LEXS=LEXS_" "_LEXK
- S:$E(LEXS,1)=" " LEXS=$E(LEXS,2,$L(LEXS))
- S LEXT=LEXS Q:LEXT="" "Unknown Global"
- S X=LEXT_" Global" Q X
- IDXN(X) ;
- S X=$G(X) Q:X="" "Unknown Index" N LEXT,LEXA S LEXT="",LEXA=$E(X,2,$L(X))
- Q:LEXA="" "Unknown Index" Q:'$D(^LEXT(757.2,"AA",LEXA)) "Unknown Index"
- N LEXR S LEXR=$O(^LEXT(757.2,"AA",LEXA,0))
- Q:+LEXR=0 "Unknown Index" Q:'$D(^LEXT(757.2,+LEXR)) "Unknown Index"
- S LEXT=$P($G(^LEXT(757.2,LEXR,0)),"^",1)
- I +LEXR=1,LEXT'="" S X="Main "_LEXT_" word index" Q X
- I +LEXR>1,LEXT'="" S X=LEXT_" subset word index" Q X
- Q X
- OVRN(X) ; Overwrite
- S X=+($G(X)) Q:X=0 "Do not overwrite user defaults"
- Q "Overwrite user defaults"
- ;
- SCTN(X) ; Shortcuts Context
- N LEXT,LEXA S (LEXA,LEXT)="",X=$G(X)
- I +X>0,$D(^LEX(757.41,+X,0)) D
- . S LEXA=$P($G(^LEX(757.41,+X,0)),"^",1) Q:LEXA="" S LEXT=LEXA
- S:X'=""&(LEXT="") X="Unknown Shortcut Context" S:LEXT'="" X=LEXT Q X
- ;
- UNRN(X) ; Unresolved Narratives
- S X=+($G(X)) Q:X=0 "Do not use unresolved narratives"
- Q "Use unresolved narratives"
- ;
- MODI(X) ; Modifiers PCH 6 (added)
- S X=+($G(X)) Q:X=0 "Do not use modifiers"
- Q "Use modifiers"
- ;
- VOCN(X) ; Vocabulary
- N LEXT,LEXA,LEXR S LEXR=0,LEXT="",LEXA=X,X=""
- I +LEXA>0,$D(^LEXT(757.2,+LEXA)) D
- . S LEXT=$P($G(^LEXT(757.2,+LEXA,0)),"^",2) S:LEXT'="" LEXA=LEXT
- . S LEXT=$P($G(^LEXT(757.2,+LEXA,5)),"^",2) S:LEXT'="" LEXA=LEXT
- I $D(^LEXT(757.2,"AA",LEXA)) D Q X
- . S LEXR=$O(^LEXT(757.2,"AA",LEXA,0)) I +LEXR=0 S X="Unknown Vocabulary" Q
- . S X=$P($G(^LEXT(757.2,+LEXR,0)),"^",1) I X="" S X="Unknown Vocabulary" Q
- I $D(^LEXT(757.2,"AB",LEXA)) D Q X
- . S LEXR=$O(^LEXT(757.2,"AB",LEXA,0)) I +LEXR=0 S X="Unknown Vocabulary" Q
- . S LEXA=$P($G(^LEXT(757.2,+LEXR,5)),"^",2)
- . I LEXA="" S LEXA=$P($G(^LEXT(757.2,+LEXR,0)),"^",2)
- . I LEXA'="",$D(^LEXT(757.2,"AA",LEXA)) D
- . . S LEXR=$O(^LEXT(757.2,"AA",LEXA,0)) I +LEXR=0 S X="Unknown Vocabulary" Q
- . . S X=$P($G(^LEXT(757.2,+LEXR,0)),"^",1) I X="" S X="Unknown Vocabulary" Q
- . I X="" S X="Unknown Vocabulary"
- S:X="" X="Unknown Vocabulary" Q X
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXDFN 4017 printed Mar 13, 2025@21:12:09 Page 2
- LEXDFN ;ISL/KER - Default Names ;04/21/2014
- +1 ;;2.0;LEXICON UTILITY;**6,80**;Sep 23, 1996;Build 1
- +2 ;
- +3 ; Global Variables
- +4 ; ^LEX(757.31) N/A
- +5 ; ^LEX(757.41) N/A
- +6 ;
- +7 ; External References
- +8 ; $$LOW^XLFSTR ICR 10103
- +9 ; $$UP^XLFSTR ICR 10103
- +10 ;
- APPN(X) ; Application Name
- +1 NEW LEXT,LEXA
- SET (LEXA,LEXT)=""
- SET X=$GET(X)
- +2 IF +X>0
- IF $DATA(^LEXT(757.2,+X,0))
- Begin DoDot:1
- +3 SET LEXA=$PIECE($GET(^LEXT(757.2,+X,5)),"^",4)
- +4 if LEXA=""
- QUIT
- if '$DATA(^LEXT(757.2,"APPS",LEXA))
- QUIT
- +5 SET LEXT=$PIECE($GET(^LEXT(757.2,+X,0)),"^",1)
- End DoDot:1
- +6 if X'=""&(LEXT="")
- SET X="Unknown Application"
- if LEXT'=""
- SET X=LEXT
- QUIT X
- DISN(X) ; Display Name
- +1 NEW LEXT
- SET LEXT=""
- SET X=$GET(X)
- IF X'=""
- Begin DoDot:1
- +2 NEW LEXO,LEXC,LEXR
- SET LEXC=$EXTRACT(X,1,63)
- SET LEXO=$EXTRACT(LEXC,1,($LENGTH(LEXC)-1))_$CHAR($ASCII($EXTRACT(LEXC,$LENGTH(LEXC)))-1)_"~"
- +3 FOR
- SET LEXO=$ORDER(^LEX(757.31,"ADSP",LEXO))
- if LEXO=""!(LEXO'[LEXC)
- QUIT
- Begin DoDot:2
- +4 SET LEXR=0
- FOR
- SET LEXR=$ORDER(^LEX(757.31,"ADSP",LEXO,LEXR))
- if +LEXR=0
- QUIT
- Begin DoDot:3
- +5 IF $GET(^LEX(757.31,LEXR,1))=X
- SET LEXT=$PIECE($GET(^LEX(757.31,LEXR,0)),"^",1)
- End DoDot:3
- if LEXT'=""
- QUIT
- End DoDot:2
- if LEXT'=""
- QUIT
- End DoDot:1
- +6 if X'=""&(LEXT="")
- SET X="User Defined Display"
- if LEXT'=""
- SET X=LEXT
- QUIT X
- FILN(X) ; Filter Name
- +1 NEW LEXT
- SET LEXT=""
- SET X=$GET(X)
- IF X'=""
- Begin DoDot:1
- +2 NEW LEXO,LEXC,LEXR
- SET LEXC=$EXTRACT(X,1,63)
- +3 SET LEXO=$EXTRACT(LEXC,1,($LENGTH(LEXC)-1))_$CHAR($ASCII($EXTRACT(LEXC,$LENGTH(LEXC)))-1)_"~"
- +4 FOR
- SET LEXO=$ORDER(^LEX(757.3,"AS",LEXO))
- if LEXT'=""!(LEXO'[LEXC)
- QUIT
- Begin DoDot:2
- +5 SET LEXR=0
- FOR
- SET LEXR=$ORDER(^LEX(757.3,"AS",LEXO,LEXR))
- if +LEXR=0!(LEXT'="")
- QUIT
- Begin DoDot:3
- +6 if $GET(^LEX(757.3,+LEXR,1))=X
- SET LEXT=$PIECE($GET(^LEX(757.3,+LEXR,0)),"^",1)
- End DoDot:3
- if LEXT'=""
- QUIT
- End DoDot:2
- End DoDot:1
- +7 if X'=""&(LEXT="")
- SET X="User Defined Filter"
- if LEXT'=""
- SET X=LEXT
- QUIT X
- GBLN(X) ; Global Name
- +1 SET X=$GET(X)
- if X=""
- QUIT "Unknown Global"
- if X'["^"
- QUIT "Unknown Global"
- +2 if X'["("
- QUIT "Unknown Global"
- NEW LEXT
- SET LEXT=$GET(@(X_"0)"))
- +3 SET LEXT=$PIECE(LEXT,"^",1)
- if LEXT=""
- QUIT "Unknown Global"
- +4 NEW LEXS,LEXK,LEXI
- SET LEXS=""
- +5 FOR LEXI=1:1:$LENGTH(LEXT," ")
- Begin DoDot:1
- +6 SET LEXK=$$UP^XLFSTR($EXTRACT($PIECE(LEXT," ",LEXI),1))_$$LOW^XLFSTR($EXTRACT($PIECE(LEXT," ",LEXI),2,$LENGTH($PIECE(LEXT," ",LEXI))))
- +7 SET LEXS=LEXS_" "_LEXK
- End DoDot:1
- +8 if $EXTRACT(LEXS,1)=" "
- SET LEXS=$EXTRACT(LEXS,2,$LENGTH(LEXS))
- +9 SET LEXT=LEXS
- if LEXT=""
- QUIT "Unknown Global"
- +10 SET X=LEXT_" Global"
- QUIT X
- IDXN(X) ;
- +1 SET X=$GET(X)
- if X=""
- QUIT "Unknown Index"
- NEW LEXT,LEXA
- SET LEXT=""
- SET LEXA=$EXTRACT(X,2,$LENGTH(X))
- +2 if LEXA=""
- QUIT "Unknown Index"
- if '$DATA(^LEXT(757.2,"AA",LEXA))
- QUIT "Unknown Index"
- +3 NEW LEXR
- SET LEXR=$ORDER(^LEXT(757.2,"AA",LEXA,0))
- +4 if +LEXR=0
- QUIT "Unknown Index"
- if '$DATA(^LEXT(757.2,+LEXR))
- QUIT "Unknown Index"
- +5 SET LEXT=$PIECE($GET(^LEXT(757.2,LEXR,0)),"^",1)
- +6 IF +LEXR=1
- IF LEXT'=""
- SET X="Main "_LEXT_" word index"
- QUIT X
- +7 IF +LEXR>1
- IF LEXT'=""
- SET X=LEXT_" subset word index"
- QUIT X
- +8 QUIT X
- OVRN(X) ; Overwrite
- +1 SET X=+($GET(X))
- if X=0
- QUIT "Do not overwrite user defaults"
- +2 QUIT "Overwrite user defaults"
- +3 ;
- SCTN(X) ; Shortcuts Context
- +1 NEW LEXT,LEXA
- SET (LEXA,LEXT)=""
- SET X=$GET(X)
- +2 IF +X>0
- IF $DATA(^LEX(757.41,+X,0))
- Begin DoDot:1
- +3 SET LEXA=$PIECE($GET(^LEX(757.41,+X,0)),"^",1)
- if LEXA=""
- QUIT
- SET LEXT=LEXA
- End DoDot:1
- +4 if X'=""&(LEXT="")
- SET X="Unknown Shortcut Context"
- if LEXT'=""
- SET X=LEXT
- QUIT X
- +5 ;
- UNRN(X) ; Unresolved Narratives
- +1 SET X=+($GET(X))
- if X=0
- QUIT "Do not use unresolved narratives"
- +2 QUIT "Use unresolved narratives"
- +3 ;
- MODI(X) ; Modifiers PCH 6 (added)
- +1 SET X=+($GET(X))
- if X=0
- QUIT "Do not use modifiers"
- +2 QUIT "Use modifiers"
- +3 ;
- VOCN(X) ; Vocabulary
- +1 NEW LEXT,LEXA,LEXR
- SET LEXR=0
- SET LEXT=""
- SET LEXA=X
- SET X=""
- +2 IF +LEXA>0
- IF $DATA(^LEXT(757.2,+LEXA))
- Begin DoDot:1
- +3 SET LEXT=$PIECE($GET(^LEXT(757.2,+LEXA,0)),"^",2)
- if LEXT'=""
- SET LEXA=LEXT
- +4 SET LEXT=$PIECE($GET(^LEXT(757.2,+LEXA,5)),"^",2)
- if LEXT'=""
- SET LEXA=LEXT
- End DoDot:1
- +5 IF $DATA(^LEXT(757.2,"AA",LEXA))
- Begin DoDot:1
- +6 SET LEXR=$ORDER(^LEXT(757.2,"AA",LEXA,0))
- IF +LEXR=0
- SET X="Unknown Vocabulary"
- QUIT
- +7 SET X=$PIECE($GET(^LEXT(757.2,+LEXR,0)),"^",1)
- IF X=""
- SET X="Unknown Vocabulary"
- QUIT
- End DoDot:1
- QUIT X
- +8 IF $DATA(^LEXT(757.2,"AB",LEXA))
- Begin DoDot:1
- +9 SET LEXR=$ORDER(^LEXT(757.2,"AB",LEXA,0))
- IF +LEXR=0
- SET X="Unknown Vocabulary"
- QUIT
- +10 SET LEXA=$PIECE($GET(^LEXT(757.2,+LEXR,5)),"^",2)
- +11 IF LEXA=""
- SET LEXA=$PIECE($GET(^LEXT(757.2,+LEXR,0)),"^",2)
- +12 IF LEXA'=""
- IF $DATA(^LEXT(757.2,"AA",LEXA))
- Begin DoDot:2
- +13 SET LEXR=$ORDER(^LEXT(757.2,"AA",LEXA,0))
- IF +LEXR=0
- SET X="Unknown Vocabulary"
- QUIT
- +14 SET X=$PIECE($GET(^LEXT(757.2,+LEXR,0)),"^",1)
- IF X=""
- SET X="Unknown Vocabulary"
- QUIT
- End DoDot:2
- +15 IF X=""
- SET X="Unknown Vocabulary"
- End DoDot:1
- QUIT X
- +16 if X=""
- SET X="Unknown Vocabulary"
- QUIT X
