source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXAR.m@ 1484

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

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1LEXAR ;ISA/FJF/KER-Look-up (Interpret User Response) ; 05/14/2003
2 ;;2.0;LEXICON UTILITY;**3,19,25**;Sep 23, 1996;Build 1
3 ;
4 ; User Responses
5 ;
6 ; Numeric -----------------------------------------------
7 ;
8 ; # Select Entry
9 ;
10 ; Numeric^Comment ----------------------------------------
11 ;
12 ; IEN^COMMENT Application comment about term
13 ;
14 ; Up-Arrow -----------------------------------------------
15 ;
16 ; ^# Jump to # on list
17 ; ^ End dialog with the user
18 ; ^^ End dialog with the application
19 ;
20 ; Question -----------------------------------------------
21 ;
22 ; ? Standard help in LEX("HLP")
23 ; ?? Extended help in LEX("HLP")
24 ; ?# Definition for # in LEX("HLP")
25 ;
26 ; Null ---------------------------------------------------
27 ;
28 ; Advance the selection list
29 ;
30 ; String -------------------------------------------------
31 ;
32 ; Narrative Return and store Unresolved Narrative
33 ;
34 ; --------------------------------------------------------
35EN(LEXUR,LEXVDT) ; Interpret user response
36 I '$D(LEX) D APN Q
37 K LEX("HLP")
38 N LEXLL,LEXMAX
39 I $D(LEX("LIST",0)),+$G(^TMP("LEXSCH",$J,"NUM",0))>0 D
40 .S LEX=+$G(^TMP("LEXSCH",$J,"NUM",0))
41 I LEXUR="END",+LEX>0 S LEXUR="^"_LEX
42 S LEXLL=+$G(^TMP("LEXSCH",$J,"LEN",0))
43 S:LEXLL=0 LEXLL=5
44 S LEXMAX=+$G(^TMP("LEXSCH",$J,"LST",0))
45 S LEXUR=$G(LEXUR)
46 S (LEX("RES"),^TMP("LEXSCH",$J,"RES",0))=LEXUR
47 S ^TMP("LEXSCH",$J,"RES",1)="User Response"
48 ; Timed out/Quit
49 I LEXUR="DTOUT"!(LEXUR="QUIT") D EDA Q
50 ; Yes/No response list has one entry
51 I $G(LEX)=1,+LEXUR=0,LEXUR'["^" D
52 .I $E(LEXUR,1)="Y"!($E(LEXUR,1)="y") S LEXUR=1 Q
53 .I LEXUR["?" D HLP^LEXAR3 Q
54 .S LEXUR=""
55 ; Null (Page Down)
56 I LEXUR="" D NULL^LEXAR2 D END Q
57 ; Minus (Page Up)
58 I $E(LEXUR,1)="-" D LIST^LEXAL2("PGUP") D END Q
59 ; Help
60 I LEXUR["?" D HLP^LEXAR3 D END Q
61 ; Up Arrow
62 I LEXUR["^",$D(^TMP("LEXSCH",$J)) D UPA^LEXAR2(LEXUR) D END Q
63 ; Select
64 I +LEXUR>0,+LEXUR'>LEXMAX D SEL^LEXAR4(+LEXUR,$G(LEXVDT)) D END Q
65 ; User Unresolved Narrative
66 I LEXUR=$G(^TMP("LEXSCH",$J,"NAR",0)),+$G(^TMP("LEXSCH",$J,"UNR",0))=1 D D END Q
67 .D SAVE^LEXAR6
68APN ; Application Unresolved Narrative
69 I LEXUR["^",'$D(^TMP("LEXSCH",$J)),+LEXUR>0,$D(^LEX(757.01,+LEXUR,0)),$L($P(LEXUR,"^",2)) D Q
70 .K LEX
71 .D COM^LEXAR6(LEXUR)
72 D END
73 Q
74END ; End of Interpretation of the Users Response
75 I $D(^TMP("LEXSCH",$J)) D
76 .S (LEX("RES"),^TMP("LEXSCH",$J,"RES",0))=LEXUR
77 .S ^TMP("LEXSCH",$J,"RES",1)="User Response"
78 I $D(LEX("LIST",0)),+$G(^TMP("LEXSCH",$J,"NUM",0))>0 D
79 .S LEX=+$G(^TMP("LEXSCH",$J,"NUM",0))
80 Q
81SEL ; Selection made
82 K LEX("RES"),LEX("ERR"),LEX("LIST"),LEX("MIN"),LEX("MAX"),LEX("MAT"),LEX("HLP")
83 D NAR,EMF,KLST,KSCH
84 S:$D(LEX("SEL")) LEX=0
85 Q
86EDU ; End Dialog with the User
87 D NAR,EMF,KLST,KARL,KSCH
88 S LEX=0
89 Q
90EDA ; End Dialog with the Application
91 K LEX
92 D KLST,KSCH
93 Q
94LST ; List exist
95 D NAR,MAX,MIN,MAT,EML
96 Q
97 ;
98KLST ; Kill Global List
99 ; ^TMP("LEXFND",$J)
100 ; ^TMP("LEXHIT",$J)
101 K ^TMP("LEXFND",$J),^TMP("LEXHIT",$J)
102 Q
103KSCH ; Kill Search Variables
104 ; ^TMP("LEXSCH",$J)
105 I +$G(LEX)'=0 K ^TMP("LEXSCH",$J) ; PCH 3 Do not kill if not found condition exist
106 Q
107KARL ; Kill Array List and supporting variables
108 ; LEX("LIST"),LEX("MAT"),LEX("MIN"),LEX("MAX")
109 K LEX("LIST"),LEX("MAT"),LEX("MIN"),LEX("MAX")
110 K LEX("EXC"),LEX("EXM")
111 Q
112LEX ; Set LEX to the number of entries on the list
113 S:+$G(^TMP("LEXSCH",$J,"NUM",0))>0 LEX=+$G(^TMP("LEXSCH",$J,"NUM",0))
114 Q
115NAR ; Set LEX("NAR") to the user narrative
116 K LEX("NAR")
117 S:$L($G(^TMP("LEXSCH",$J,"NAR",0))) LEX("NAR")=$G(^TMP("LEXSCH",$J,"NAR",0))
118 Q
119MAX ; Set LEX("MAX") to the last entry reviewed by the user
120 K LEX("MAX")
121 S:+$G(^TMP("LEXSCH",$J,"LST",0))>0 LEX("MAX")=+$G(^TMP("LEXSCH",$J,"LST",0))
122 Q
123MIN ; Set LEX("MIN") to the first entry reviewed by the user
124 K LEX("MIN")
125 S:+$G(LEX("MAX"))>0 LEX("MIN")=1
126 Q
127EML ; Set LEX("EXM") post-selection IEN^Expression text
128 K LEX("EXM")
129 S:$L($G(^TMP("LEXSCH",$J,"EXM",2))) LEX("EXM")=$G(^TMP("LEXSCH",$J,"EXM",2))
130 Q
131EMF ; Set LEX("EXM") pre-selection LIST#^Expression text
132 K LEX("EXM")
133 I $L($G(^TMP("LEXSCH",$J,"EXM",0))),$L($G(^TMP("LEXSCH",$J,"EXM",1))) D
134 .S LEX("EXM")=$G(^TMP("LEXSCH",$J,"EXM",0))_"^"_$G(^TMP("LEXSCH",$J,"EXM",1))
135 Q
136MAT ; Set "matches found" string and top of list flag
137 ; LEX("MAT") # Matches found
138 ; ^TMP("LEXSCH",$J,"TOL",0) 1 - Top of list
139 ; 0 - Not top of list
140 K LEX("MAT")
141 I $D(LEX("SEL"))!('$D(^TMP("LEXSCH",$J)))!('$D(LEX("LIST"))) Q
142 N LEXOL,LEXL
143 S LEXOL=$G(^TMP("LEXSCH",$J,"TOL",0))
144 S LEXL=$O(LEX("LIST",0))
145 I LEXOL'=0,LEXL=1 S ^TMP("LEXSCH",$J,"TOL",0)=1
146 I LEXOL'=0,LEXL'=1 S ^TMP("LEXSCH",$J,"TOL",0)=0
147 I LEXOL=1,$L($G(^TMP("LEXSCH",$J,"MAT",0))) D
148 .S LEX("MAT")=$G(^TMP("LEXSCH",$J,"MAT",0))
149 Q
Note: See TracBrowser for help on using the repository browser.