LEXSET4.m

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 ---LEXSET4   1437     printed  Apr 09, 2024@21:08:17                                                                                                                                                                                                     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