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 Dec 13, 2024@02:07:39 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
