source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXSET4.m@ 1704

Last change on this file since 1704 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1LEXSET4 ; ISL Setup Functions ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 ;
4NS(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
11SS(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
18SAVE ; 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
22RESTORE ; 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
Note: See TracBrowser for help on using the repository browser.