source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXDFLS.m@ 1211

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1LEXDFLS ; ISL Default Filter - Select ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 ;
4 ; Special Look-up in file 757.3 Screens
5 ; Entry: S X=$$EN^LEXDFLS
6 ;
7 ; Function returns a multi piece string
8 ;
9 ; $Piece 1-X
10 ;
11 ; Executable MUMPS code to be used as
12 ; a filter (screen DIC("S") during
13 ; searches
14 ;
15 ; $Piece Last piece
16 ;
17 ; Name of the filter selected i.e.,
18 ; "Problem List" This will be null only
19 ; when user input is "^^"
20 ;
21 ; LEX Array containing pointers to 757.3
22 ; LEXA Users answer to selection
23 ; LEXC Counter
24 ; LEXD Display
25 ; LEXF Re-display starting from #LEXF
26 ; LEXI Incremental Counter
27 ; LEXL Last entry displayed
28 ; LEXLN Line counter
29 ; LEXR Internal Entry Number (Record) in #757.3
30 ; LEXS Selection
31 ; LEXT Re-display up through #LEXT
32 ;
33EN(LEXX) ; Select a predefined filter string
34 N X,Y,LEX,LEXC,LEXL,LEXR,LEXA,LEXD D TOT
35 S LEXD="",(LEXA,LEXX,LEXC,LEXR)=0
36 F S LEXD=$O(^LEX(757.3,"B",LEXD)) Q:LEXD=""!(LEXA["^")!(+LEXX>0) D
37 . S LEXR=0
38 . F S LEXR=$O(^LEX(757.3,"B",LEXD,LEXR)) Q:+LEXR=0!(LEXA["^")!(+LEXX>0) D
39 . . Q:$P($G(^LEX(757.3,LEXR,0)),"^",2)'="U"
40 . . S LEXC=LEXC+1,LEXL=LEXC
41 . . S LEX(LEXC)=LEXR,LEX(0)=LEXC
42 . . D W(LEXC,LEXR)
43 . . D ASK
44 D ASK S LEXX=+LEXX K LEX
45 I +LEXX>0 S LEXX=$G(^LEX(757.3,+LEXX,1))_"^"_$P($G(^LEX(757.3,+LEXX,0)),"^",1) Q LEXX
46 S:LEXA'["^^" LEXX="^No filter selected" S:LEXA["^^" LEXX="^"
47 Q LEXX
48ASK ;
49 ;I LEXC#5=0,+LEXX=0 S LEXA=$$SEL S:+LEXA>0&(+LEXA<(LEXC+1)) LEXX=+LEXA
50 ;I +LEXX=0,LEXA'["^",LEXC#5'=0 S LEXA=$$SEL S:+LEXA>0&(+LEXA<(LEXC+1)) LEXX=+LEXA
51 Q:+LEXX>0 Q:LEXA["^" Q:+LEXR>0&(LEXC#5'=0)
52 Q:+LEXR=0&(LEXC#5=0)
53 D SEL Q:+LEXA'>0 Q:LEXA>LEXC S LEXX=$G(LEX(+LEXA))
54 Q
55SEL ; Select from list
56 W ! N X,Y,DIR,DIRUT,DTOUT,DUOUT,DIROUT
57 S DIR(0)="NAO^1:"_LEXC
58 S DIR("A")="Select FILTER 1-"_LEXC_": "
59 S (DIR("?"),DIR("??"))="^D SH^LEXDFLS"
60 D ^DIR S LEXA=Y
61 Q
62UOUT ; Up Arrow detected
63 S:LEXA="^^" LEXX="^"
64 S:LEXA="^" LEXX="^No filter selected"
65 Q
66VAL ; No Un Arrow (value)
67 I +LEXX>0 D Q
68 . I $D(^LEX(757.41,+LEXX)) D Q
69 . . S LEXX=LEXX_"^"_$P($G(^LEX(757.41,+LEXX,0)),"^",1)
70 . S LEXX="^No filter selected"
71 S LEXX="^No filter selected"
72 Q
73SH ; Show help
74 N LEXR S LEXR=+($E(X,2,$L(X))) I $E(X,1)="?",LEXR>0,LEXR<(LEX(0)+1) D
75 . S LEXR=LEX(LEXR) D:'$D(^LEX(757.3,LEXR,2,1)) NODES,STD Q:'$D(^LEX(757.3,LEXR,2,1)) D DES
76 D:$E(X,1)="?"&(LEXR<1!(LEXR>LEX(0))) STD D:$E(X,1)'="?" STD D RD
77 Q
78STD ; Standard Help
79 W !!,"Enter 1-",LEXC," to select a filter, or ""?"" for help, or ""?#"" for descriptive"
80 W !,"help on an entry flagged with an ""*"", or ""^"" to exit or <Return> for more."
81 Q
82DES ; Description Help
83 N LEXLN,LEXI S (LEXLN,LEXI)=0 W !!,?2,$P(^LEX(757.3,LEXR,0),"^",1),!
84 F S LEXI=$O(^LEX(757.3,LEXR,2,LEXI)) Q:+LEXI=0 D
85 . W !,?4,^LEX(757.3,LEXR,2,LEXI,0) S LEXLN=LEXLN+1
86 D:LEXLN>4 EOP W ! Q
87NODES ; No Description Help Available
88 W !!,?2,$P(^LEX(757.3,LEXR,0),"^",1)," does not have a description",! Q
89RD ; Re-Display List
90 N LEXF,LEXT S LEXT=+($G(LEXL)),LEXF=(+(LEXT#5)-1)
91 S:LEXF<0 LEXF=4 S LEXF=LEXT-LEXF S LEXF=LEXF-1
92 F S LEXF=$O(LEX(LEXF)) Q:+LEXF=0!(LEXF'<(LEXT+1)) D
93 . W:LEXF=1 ! D W(LEXF,LEX(LEXF))
94 Q
95TOT ; Total Filters
96 N LEXD,LEXR,LEXC S LEXD="",LEXC=0
97 F S LEXD=$O(^LEX(757.3,"B",LEXD)) Q:LEXD="" S LEXR=0 D
98 . F S LEXR=$O(^LEX(757.3,"B",LEXD,LEXR)) Q:+LEXR=0 D
99 . . Q:$P($G(^LEX(757.3,LEXR,0)),"^",2)'="U"
100 . . S LEXC=LEXC+1
101 W !!,LEXC," Filters found",! Q
102W(LEXC,LEXR) ; Write entry
103 W !,$J(LEXC,4),". ",$P(^LEX(757.3,LEXR,0),"^",1)
104 W $S($D(^LEX(757.3,LEXR,2,1)):" *",1:"") Q
105EOP ; End of Page
106 W ! N X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT S DIR(0)="E" D ^DIR S:X[U LEXA="^" W ! Q
Note: See TracBrowser for help on using the repository browser.