LEXSET4 ;ISL/KER - Setup Functions ;04/21/2014
;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
;
; Global Variables
; None
;
; External References
; ^DIC ICR 10006
;
NS(LEX) ; Look-up application namespace
N D,DIC,DTOUT,DUOUT D:'$D(LEXSAVE) SAVE K DIC S DIC("A")="Select APPLICATION: "
S DIC("W")="W ?35,$P($G(^LEXT(757.2,+Y,5)),U,5)"
S DIC="^LEXT(757.2,",DIC(0)="AEQM",D="AN"
S DIC("S")="I $L($P($G(^LEXT(757.2,Y,5)),U,5))"
D ^DIC S LEX="" S:+Y>0 LEX=$P($G(^LEXT(757.2,+Y,5)),U,5)
S:LEX="" LEX="LEX" K DIC,X,Y D:$D(LEXSAVE) RESTORE Q LEX
SS(LEX) ; Look-up subset (vocabulary)
D:'$D(LEXSAVE) SAVE
S:'$D(DIC("B")) DIC("B")="Lexicon" S DIC("A")="Select VOCABULARY: "
S DIC="^LEXT(757.2,",DIC(0)="AEQM",D="AA"
S DIC("S")="I $L($P($G(^LEXT(757.2,Y,0)),U,2))"
D ^DIC S LEX="" S:+Y>0 LEX=$P($G(^LEXT(757.2,+Y,0)),U,2)
S:LEX="" LEX="WRD" K DIC,X,Y D:$D(LEXSAVE) RESTORE Q LEX
SAVE ; Save look-up variables
S LEXSAVE="" S:$L($G(X)) LEXDX=X S:$L($G(DIC("A"))) LEXDA=DIC("A")
S:$L($G(DIC("B"))) LEXDB=DIC("B") S:$L($G(DIC("W"))) LEXDW=DIC("W") S:$L($G(DIC(0))) LEXD0=DIC(0)
Q
RESTORE ; Restore look-up variables
S:$L($G(LEXDX)) X=LEXDX K:'$L($G(LEXDX)) X S:$L($G(LEXD0)) DIC(0)=LEXD0 S:$L($G(LEXDA)) DIC("A")=LEXDA
S:$L($G(LEXDB)) DIC("B")=LEXDB S:$L($G(LEXDW)) DIC("W")=LEXDW K LEXDA,LEXD0,LEXDX,LEXDB,LEXDW,LEXSAVE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXSET4 1437 printed Nov 22, 2024@17:19:47 Page 2
LEXSET4 ;ISL/KER - Setup Functions ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; None
+5 ;
+6 ; External References
+7 ; ^DIC ICR 10006
+8 ;
NS(LEX) ; Look-up application namespace
+1 NEW D,DIC,DTOUT,DUOUT
if '$DATA(LEXSAVE)
DO SAVE
KILL DIC
SET DIC("A")="Select APPLICATION: "
+2 SET DIC("W")="W ?35,$P($G(^LEXT(757.2,+Y,5)),U,5)"
+3 SET DIC="^LEXT(757.2,"
SET DIC(0)="AEQM"
SET D="AN"
+4 SET DIC("S")="I $L($P($G(^LEXT(757.2,Y,5)),U,5))"
+5 DO ^DIC
SET LEX=""
if +Y>0
SET LEX=$PIECE($GET(^LEXT(757.2,+Y,5)),U,5)
+6 if LEX=""
SET LEX="LEX"
KILL DIC,X,Y
if $DATA(LEXSAVE)
DO RESTORE
QUIT LEX
SS(LEX) ; Look-up subset (vocabulary)
+1 if '$DATA(LEXSAVE)
DO SAVE
+2 if '$DATA(DIC("B"))
SET DIC("B")="Lexicon"
SET DIC("A")="Select VOCABULARY: "
+3 SET DIC="^LEXT(757.2,"
SET DIC(0)="AEQM"
SET D="AA"
+4 SET DIC("S")="I $L($P($G(^LEXT(757.2,Y,0)),U,2))"
+5 DO ^DIC
SET LEX=""
if +Y>0
SET LEX=$PIECE($GET(^LEXT(757.2,+Y,0)),U,2)
+6 if LEX=""
SET LEX="WRD"
KILL DIC,X,Y
if $DATA(LEXSAVE)
DO RESTORE
QUIT LEX
SAVE ; Save look-up variables
+1 SET LEXSAVE=""
if $LENGTH($GET(X))
SET LEXDX=X
if $LENGTH($GET(DIC("A")))
SET LEXDA=DIC("A")
+2 if $LENGTH($GET(DIC("B")))
SET LEXDB=DIC("B")
if $LENGTH($GET(DIC("W")))
SET LEXDW=DIC("W")
if $LENGTH($GET(DIC(0)))
SET LEXD0=DIC(0)
+3 QUIT
RESTORE ; Restore look-up variables
+1 if $LENGTH($GET(LEXDX))
SET X=LEXDX
if '$LENGTH($GET(LEXDX))
KILL X
if $LENGTH($GET(LEXD0))
SET DIC(0)=LEXD0
if $LENGTH($GET(LEXDA))
SET DIC("A")=LEXDA
+2 if $LENGTH($GET(LEXDB))
SET DIC("B")=LEXDB
if $LENGTH($GET(LEXDW))
SET DIC("W")=LEXDW
KILL LEXDA,LEXD0,LEXDX,LEXDB,LEXDW,LEXSAVE
+3 QUIT
