| 1 | LEXSET4 ; ISL Setup Functions                      ; 09-23-96 | 
|---|
| 2 | ;;2.0;LEXICON UTILITY;;Sep 23, 1996 | 
|---|
| 3 | ; | 
|---|
| 4 | NS(LEX) ; Look-up application namespace | 
|---|
| 5 | N D,DIC,DTOUT,DUOUT D:'$D(LEXSAVE) SAVE K DIC S DIC("A")="Select APPLICATION:  " | 
|---|
| 6 | S DIC("W")="W ?35,$P($G(^LEXT(757.2,+Y,5)),U,5)" | 
|---|
| 7 | S DIC="^LEXT(757.2,",DIC(0)="AEQM",D="AN" | 
|---|
| 8 | S DIC("S")="I $L($P($G(^LEXT(757.2,Y,5)),U,5))" | 
|---|
| 9 | D ^DIC S LEX="" S:+Y>0 LEX=$P($G(^LEXT(757.2,+Y,5)),U,5) | 
|---|
| 10 | S:LEX="" LEX="LEX" K DIC,X,Y D:$D(LEXSAVE) RESTORE Q LEX | 
|---|
| 11 | SS(LEX) ; Look-up subset (vocabulary) | 
|---|
| 12 | D:'$D(LEXSAVE) SAVE | 
|---|
| 13 | S:'$D(DIC("B")) DIC("B")="Lexicon" S DIC("A")="Select VOCABULARY:  " | 
|---|
| 14 | S DIC="^LEXT(757.2,",DIC(0)="AEQM",D="AA" | 
|---|
| 15 | S DIC("S")="I $L($P($G(^LEXT(757.2,Y,0)),U,2))" | 
|---|
| 16 | D ^DIC S LEX="" S:+Y>0 LEX=$P($G(^LEXT(757.2,+Y,0)),U,2) | 
|---|
| 17 | S:LEX="" LEX="WRD" K DIC,X,Y D:$D(LEXSAVE) RESTORE Q LEX | 
|---|
| 18 | SAVE ; Save look-up variables | 
|---|
| 19 | S LEXSAVE="" S:$L($G(X)) LEXDX=X S:$L($G(DIC("A"))) LEXDA=DIC("A") | 
|---|
| 20 | S:$L($G(DIC("B"))) LEXDB=DIC("B") S:$L($G(DIC("W"))) LEXDW=DIC("W") S:$L($G(DIC(0))) LEXD0=DIC(0) | 
|---|
| 21 | Q | 
|---|
| 22 | RESTORE ; Restore look-up variables | 
|---|
| 23 | 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 | 
|---|
| 24 | S:$L($G(LEXDB)) DIC("B")=LEXDB S:$L($G(LEXDW)) DIC("W")=LEXDW K LEXDA,LEXD0,LEXDX,LEXDB,LEXDW,LEXSAVE | 
|---|
| 25 | Q | 
|---|