Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEXSET4

LEXSET4.m

Go to the documentation of this file.
  1. LEXSET4 ;ISL/KER - Setup Functions ;04/21/2014
  1. ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
  1. ;
  1. ; Global Variables
  1. ; None
  1. ;
  1. ; External References
  1. ; ^DIC ICR 10006
  1. ;
  1. NS(LEX) ; Look-up application namespace
  1. N D,DIC,DTOUT,DUOUT D:'$D(LEXSAVE) SAVE K DIC S DIC("A")="Select APPLICATION: "
  1. S DIC("W")="W ?35,$P($G(^LEXT(757.2,+Y,5)),U,5)"
  1. S DIC="^LEXT(757.2,",DIC(0)="AEQM",D="AN"
  1. S DIC("S")="I $L($P($G(^LEXT(757.2,Y,5)),U,5))"
  1. D ^DIC S LEX="" S:+Y>0 LEX=$P($G(^LEXT(757.2,+Y,5)),U,5)
  1. S:LEX="" LEX="LEX" K DIC,X,Y D:$D(LEXSAVE) RESTORE Q LEX
  1. SS(LEX) ; Look-up subset (vocabulary)
  1. D:'$D(LEXSAVE) SAVE
  1. S:'$D(DIC("B")) DIC("B")="Lexicon" S DIC("A")="Select VOCABULARY: "
  1. S DIC="^LEXT(757.2,",DIC(0)="AEQM",D="AA"
  1. S DIC("S")="I $L($P($G(^LEXT(757.2,Y,0)),U,2))"
  1. D ^DIC S LEX="" S:+Y>0 LEX=$P($G(^LEXT(757.2,+Y,0)),U,2)
  1. S:LEX="" LEX="WRD" K DIC,X,Y D:$D(LEXSAVE) RESTORE Q LEX
  1. SAVE ; Save look-up variables
  1. S LEXSAVE="" S:$L($G(X)) LEXDX=X S:$L($G(DIC("A"))) LEXDA=DIC("A")
  1. S:$L($G(DIC("B"))) LEXDB=DIC("B") S:$L($G(DIC("W"))) LEXDW=DIC("W") S:$L($G(DIC(0))) LEXD0=DIC(0)
  1. Q
  1. RESTORE ; Restore look-up variables
  1. 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
  1. S:$L($G(LEXDB)) DIC("B")=LEXDB S:$L($G(LEXDW)) DIC("W")=LEXDW K LEXDA,LEXD0,LEXDX,LEXDB,LEXDW,LEXSAVE
  1. Q