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

LEXDCXS.m

Go to the documentation of this file. 
  1. LEXDCXS ;ISL/KER - Default Context - Select ;04/21/2014
  1.  ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
  1.  ;               
  1.  ; Global Variables
  1.  ;    ^LEX(757.41)        N/A
  1.  ;               
  1.  ; External References
  1.  ;    ^DIR                ICR  10026
  1.  ;               
  1.  ; Special Look-up in file 757.41 Shortcut Context
  1.  ;
  1.  ; Entry:  S X=$$EN^LEXDCXS
  1.  ;
  1.  ; Function returns a two piece string
  1.  ;  
  1.  ; $P 1    Pointer to file 757.41, and a valid
  1.  ;         value for LEXCTX (context user default)
  1.  ;         This will be null if input is "^"
  1.  ;  
  1.  ; $P 2    Name of context selected.  This will
  1.  ;         be null only when user input is "^^"
  1.  ;   
  1.  ; LEX    Array containing pointers to 757.41
  1.  ; LEXA   Users answer to selection
  1.  ; LEXC   Counter
  1.  ; LEXE   Edit/non-edit Counter
  1.  ; LEXF   Re-display starting from #LEXF
  1.  ; LEXI   Incremental Counter
  1.  ; LEXL   Last entry displayed
  1.  ; LEXR   Internal Entry Number (Record) in #757.41
  1.  ; LEXT   Re-display up through #LEXT
  1.  ; LEXX   Returned value
  1.  ;  
  1. EN(LEXX) ; Entry:  S X=$$EN^LEXDCXS
  1.  N X,Y,LEX,LEXC,LEXL,LEXR,LEXA,LEXE S LEXE=$$CNT D TOT
  1.  S LEXA="",(LEXX,LEXC,LEXR)=0
  1.  F  S LEXR=$O(^LEX(757.41,LEXR)) Q:+LEXR=0!(LEXA["^")!(+LEXX>0)  D
  1.  . I $D(LEXEDIT),$P($G(^LEX(757.41,LEXR,0)),"^",2)'=1 Q
  1.  . S LEXC=LEXC+1,LEXL=LEXC
  1.  . S LEX(LEXC)=LEXR,LEX(0)=LEXC
  1.  . D:LEXE>1 W(LEXC,LEXR)
  1.  . D:LEXE=1 WO(LEXR)
  1.  ; D ASK
  1.  D ASK I LEXA["^" D UOUT Q LEXX
  1.  D VAL Q LEXX
  1. ASK ; Ask for user input
  1.  Q:+LEXX>0  Q:LEXA["^"  Q:+LEXR>0&(LEXC#5'=0)
  1.  Q:+LEXR=0&(LEXC#5=0)
  1.  D SEL Q:+LEXA'>0  Q:LEXA>LEXE  S LEXX=$G(LEX(+LEXA))
  1.  Q
  1. SEL ; Select from list
  1.  I LEXE=1 D ONE Q
  1.  W ! N X,Y,DIR,DIRUT,DTOUT,DUOUT,DIROUT
  1.  S DIR(0)="NAO^1:"_LEXC
  1.  S DIR("A")="Select SHORTCUT CONTEXT 1-"_LEXC_":  //  "
  1.  S (DIR("?"),DIR("??"))="^D SH^LEXDCXS"
  1.  D ^DIR S LEXA=Y
  1.  Q
  1. ONE ;
  1.  W ! N X,Y,DIR,DIRUT,DTOUT,DUOUT,DIROUT
  1.  S DIR(0)="YAO"
  1.  S DIR("A")="  Ok?  //  "
  1.  S (DIR("?"),DIR("??"))="^D SO^LEXDCXS"
  1.  D ^DIR S LEXA=$S(+Y>0:1,1:0)
  1.  Q
  1. UOUT ; Up Arrow detected
  1.  S:LEXA="^^" LEXX="^"
  1.  S:LEXA="^" LEXX="^No context selected"
  1.  Q
  1. VAL ; No Un Arrow (value)
  1.  I +LEXX>0 D  Q
  1.  . I $D(^LEX(757.41,+LEXX)) D  Q
  1.  . . S LEXX=LEXX_"^"_$P($G(^LEX(757.41,+LEXX,0)),"^",1)
  1.  . S LEXX="^No context selected"
  1.  S LEXX="^No context selected"
  1.  Q
  1. SH ; Show help
  1.  N LEXR S LEXR=+($E(X,2,$L(X)))
  1.  I $E(X,1)="?",LEXR>0,LEXR<(LEX(0)+1) D
  1.  . S LEXR=LEX(LEXR) D:'$D(^LEX(757.41,LEXR,1,1)) NODES,STD
  1.  . Q:'$D(^LEX(757.41,LEXR,1,1))  D DES
  1.  D:$E(X,1)="?"&(LEXR<1!(LEXR>LEX(0))) STD
  1.  D:$E(X,1)'="?" STD D RD
  1.  Q
  1. SO ; Show one help
  1.  N LEXR S LEXR=1
  1.  I $E(X,1)="?",LEXR>0,LEXR<(LEX(0)+1) D
  1.  . S LEXR=LEX(LEXR) D:'$D(^LEX(757.41,LEXR,1,1)) NODES,STDO
  1.  . Q:'$D(^LEX(757.41,LEXR,1,1))  D DES
  1.  D:$E(X,1)'="?" STDO D RDO
  1.  Q
  1. STD ; Standard Help
  1.  W !!,"Enter 1-",LEXC," to select a Shortcut Context, "
  1.  W "or ""?"" for help, or ""?#"" for descriptive"
  1.  W !,"help on an entry flagged with an ""*"", or ""^"" "
  1.  W "to exit or <Return> for more."
  1.  Q
  1. STDO ; Standard Help - One
  1.  W !!,"One Shortcut Context available to edit, "
  1.  W "enter ""Yes"" to select, or ""^"" to exit."
  1.  Q
  1. DES ; Description Help
  1.  N LEXI S LEXI=0 W !!,?2,$P(^LEX(757.41,LEXR,0),"^",1),!
  1.  F  S LEXI=$O(^LEX(757.41,LEXR,1,LEXI)) Q:+LEXI=0  D
  1.  . W !,?4,^LEX(757.41,LEXR,1,LEXI,0)
  1.  W ! Q
  1. NODES ; No Description Available
  1.  W !!,?2,$P(^LEX(757.41,LEXR,0),"^",1)
  1.  W " does not have a description",! Q
  1. RD ; Re-Display List (MULTIPLE)
  1.  N LEXF,LEXT S LEXT=+($G(LEXL)),LEXF=(+(LEXT#5)-1)
  1.  S:LEXF<0 LEXF=4 S LEXF=LEXT-LEXF,LEXF=LEXF-1
  1.  F  S LEXF=$O(LEX(LEXF)) Q:+LEXF=0!(LEXF'<(LEXT+1))  D
  1.  . W:LEXF=1 ! D W(LEXF,LEX(LEXF))
  1.  Q
  1. RDO ; Re-Display List (ONE)
  1.  N LEXR S LEXR=LEX(1) W ! D WO(LEXR)
  1.  Q
  1. W(LEXC,LEXR) ; Write entry
  1.  W !,$J(LEXC,4),".  ",$P(^LEX(757.41,LEXR,0),"^",1)
  1.  W $S($D(^LEX(757.41,LEXR,1)):"  *",1:"") Q
  1. WO(LEXR) ; Write one entry
  1.  W !,$P(^LEX(757.41,LEXR,0),"^",1) W $S($D(^LEX(757.41,LEXR,1)):"  *",1:"") Q
  1. TOT ; Total Context
  1.  N LEXR,LEXC S (LEXR,LEXC)=0 F  S LEXR=$O(^LEX(757.41,LEXR)) Q:+LEXR=0  D
  1.  . Q:$D(LEXEDIT)&($P($G(^LEX(757.41,LEXR,0)),"^",2)'=1)  S LEXC=LEXC+1
  1.  I $D(LEXEDIT) D  Q
  1.  . W:LEXC>1 !!,LEXC," SHORTCUT CONTEXT(s) found which can be edited",!
  1.  . W:LEXC=1 !!,"Only ",LEXC," SHORTCUT CONTEXT found which can be edited",!
  1.  W:LEXC>1 !!,LEXC," SHORTCUT CONTEXT(s) found",! W:LEXC=1 !!,"Only ",LEXC," SHORTCUT CONTEXT found",!
  1.  Q
  1. CNT(X) ; Count
  1.  N LEXR,LEXC S (LEXR,LEXC)=0 F  S LEXR=$O(^LEX(757.41,LEXR)) Q:+LEXR=0  D
  1.  . Q:$D(LEXEDIT)&($P($G(^LEX(757.41,LEXR,0)),"^",2)'=1)  S LEXC=LEXC+1
  1.  S X=LEXC Q X