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

LEXDFLS.m

Go to the documentation of this file. 
  1. LEXDFLS ;ISL/KER - Default Filter - Select ;04/21/2014
  1.  ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10
  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.3 Screens
  1.  ; Entry:  S X=$$EN^LEXDFLS
  1.  ;
  1.  ; Function returns a multi piece string
  1.  ;  
  1.  ; $Piece  1-X
  1.  ;
  1.  ;         Executable MUMPS code to be used as
  1.  ;         a filter (screen DIC("S") during
  1.  ;         searches
  1.  ;  
  1.  ; $Piece  Last piece
  1.  ;
  1.  ;         Name of the filter selected i.e., 
  1.  ;         "Problem List"  This will be null only
  1.  ;         when user input is "^^"
  1.  ;   
  1.  ; LEX    Array containing pointers to 757.3
  1.  ; LEXA   Users answer to selection
  1.  ; LEXC   Counter
  1.  ; LEXD   Display
  1.  ; LEXF   Re-display starting from #LEXF
  1.  ; LEXI   Incremental Counter
  1.  ; LEXL   Last entry displayed
  1.  ; LEXLN  Line counter
  1.  ; LEXR   Internal Entry Number (Record) in #757.3
  1.  ; LEXS   Selection
  1.  ; LEXT   Re-display up through #LEXT
  1.  ;  
  1. EN(LEXX) ; Select a predefined filter string
  1.  N X,Y,LEX,LEXC,LEXL,LEXR,LEXA,LEXD D TOT
  1.  S LEXD="",(LEXA,LEXX,LEXC,LEXR)=0
  1.  F  S LEXD=$O(^LEX(757.3,"B",LEXD)) Q:LEXD=""!(LEXA["^")!(+LEXX>0)  D
  1.  . S LEXR=0
  1.  . F  S LEXR=$O(^LEX(757.3,"B",LEXD,LEXR)) Q:+LEXR=0!(LEXA["^")!(+LEXX>0)  D
  1.  . . Q:$P($G(^LEX(757.3,LEXR,0)),"^",2)'="U"
  1.  . . S LEXC=LEXC+1,LEXL=LEXC
  1.  . . S LEX(LEXC)=LEXR,LEX(0)=LEXC
  1.  . . D W(LEXC,LEXR)
  1.  . . D ASK
  1.  D ASK S LEXX=+LEXX K LEX
  1.  I +LEXX>0 S LEXX=$G(^LEX(757.3,+LEXX,1))_"^"_$P($G(^LEX(757.3,+LEXX,0)),"^",1) Q LEXX
  1.  S:LEXA'["^^" LEXX="^No filter selected" S:LEXA["^^" LEXX="^"
  1.  Q LEXX
  1. ASK ;
  1.  ;I LEXC#5=0,+LEXX=0 S LEXA=$$SEL S:+LEXA>0&(+LEXA<(LEXC+1)) LEXX=+LEXA
  1.  ;I +LEXX=0,LEXA'["^",LEXC#5'=0 S LEXA=$$SEL S:+LEXA>0&(+LEXA<(LEXC+1)) LEXX=+LEXA
  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>LEXC  S LEXX=$G(LEX(+LEXA))
  1.  Q
  1. SEL ; Select from list
  1.  W ! N X,Y,DIR,DIRUT,DTOUT,DUOUT,DIROUT
  1.  S DIR(0)="NAO^1:"_LEXC
  1.  S DIR("A")="Select FILTER 1-"_LEXC_":  "
  1.  S (DIR("?"),DIR("??"))="^D SH^LEXDFLS"
  1.  D ^DIR S LEXA=Y
  1.  Q
  1. UOUT ; Up Arrow detected
  1.  S:LEXA="^^" LEXX="^"
  1.  S:LEXA="^" LEXX="^No filter 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 filter selected"
  1.  S LEXX="^No filter selected"
  1.  Q
  1. SH ; Show help
  1.  N LEXR S LEXR=+($E(X,2,$L(X))) I $E(X,1)="?",LEXR>0,LEXR<(LEX(0)+1) D
  1.  . S LEXR=LEX(LEXR) D:'$D(^LEX(757.3,LEXR,2,1)) NODES,STD Q:'$D(^LEX(757.3,LEXR,2,1))  D DES
  1.  D:$E(X,1)="?"&(LEXR<1!(LEXR>LEX(0))) STD D:$E(X,1)'="?" STD D RD
  1.  Q
  1. STD ; Standard Help
  1.  W !!,"Enter 1-",LEXC," to select a filter, or ""?"" for help, or ""?#"" for descriptive"
  1.  W !,"help on an entry flagged with an ""*"", or ""^"" to exit or <Return> for more."
  1.  Q
  1. DES ; Description Help
  1.  N LEXLN,LEXI S (LEXLN,LEXI)=0 W !!,?2,$P(^LEX(757.3,LEXR,0),"^",1),!
  1.  F  S LEXI=$O(^LEX(757.3,LEXR,2,LEXI)) Q:+LEXI=0  D
  1.  . W !,?4,^LEX(757.3,LEXR,2,LEXI,0) S LEXLN=LEXLN+1
  1.  D:LEXLN>4 EOP W ! Q
  1. NODES ; No Description Help Available
  1.  W !!,?2,$P(^LEX(757.3,LEXR,0),"^",1)," does not have a description",! Q
  1. RD ; Re-Display List
  1.  N LEXF,LEXT S LEXT=+($G(LEXL)),LEXF=(+(LEXT#5)-1)
  1.  S:LEXF<0 LEXF=4 S LEXF=LEXT-LEXF S 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. TOT ; Total Filters
  1.  N LEXD,LEXR,LEXC S LEXD="",LEXC=0
  1.  F  S LEXD=$O(^LEX(757.3,"B",LEXD)) Q:LEXD=""  S LEXR=0 D
  1.  . F  S LEXR=$O(^LEX(757.3,"B",LEXD,LEXR)) Q:+LEXR=0  D
  1.  . . Q:$P($G(^LEX(757.3,LEXR,0)),"^",2)'="U"
  1.  . . S LEXC=LEXC+1
  1.  W !!,LEXC," Filters found",! Q
  1. W(LEXC,LEXR) ; Write entry
  1.  W !,$J(LEXC,4),".  ",$P(^LEX(757.3,LEXR,0),"^",1)
  1.  W $S($D(^LEX(757.3,LEXR,2,1)):"  *",1:"") Q
  1. EOP ; End of Page 
  1.  W ! N X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT S DIR(0)="E" D ^DIR S:X[U LEXA="^" W ! Q