- 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 Feb 18, 2025@23:35:45 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