source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXAR3.m@ 635

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1LEXAR3 ; ISL Look-up Response (Help, Def, MAX) ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 ;
4HLP ; Help
5 N LEXRP,LEXMAX K LEX("HLP")
6 S LEXMAX=+($G(^TMP("LEXSCH",$J,"LST",0)))
7 I LEXUR["??" D EXT Q
8 S LEXRP=+($P(LEXUR,"?",2,229))
9 I LEXRP>0,LEXRP'>LEXMAX D Q
10 . S LEXRP=+($G(^TMP("LEXHIT",$J,LEXRP))) D DEF(LEXRP)
11 I LEXUR["?",LEXRP'["?",+LEXRP'>0 D STD
12 Q
13STD ; Standard Help LEX("HLP",
14 I +($G(LEX))=1 D STD2 Q
15 N LEXC S LEXC=+($G(LEX("HLP",0))),LEXC=LEXC+1,LEX("HLP",0)=LEXC
16 S:LEX'>LEXMAX LEX("HLP",LEXC)="Select 1-"_LEXMAX_", ^ (quit), or ?# (help on a term)"
17 S:LEX>LEXMAX LEX("HLP",LEXC)="Select 1-"_LEXMAX_", ^ (quit), ^# (jump - "_LEX_"), ?# (term help), or <Return> for more"
18 D:$D(LEX("LIST")) LST^LEXAR
19 Q
20STD2 ; Standard Help LEX("HLP",
21 K LEX("HLP") S LEXRP=+($G(^TMP("LEXHIT",$J,1))) D DEF(LEXRP)
22 N LEXC S LEXC=+($G(LEX("HLP",0))) I LEXC>0 S LEXC=LEXC+1,LEX("HLP",LEXC)="",LEX("HLP",0)=LEXC
23 S LEXC=LEXC+1,LEX("HLP",0)=LEXC,LEX("HLP",LEXC)="Enter ""Yes"" to select, ""No"" to ignore, ""^"" to quit or ""?"" for term help"
24 D:$D(LEX("LIST")) LST^LEXAR
25 Q
26EXT ; Extended Help LEX("HLP",
27 I +($G(LEX))=1 D EXT2 Q
28 N LEXCP,LEXTP,LEXM S LEXTP=LEX\LEXLL S:LEX#LEXLL>0 LEXTP=LEXTP+1
29 S LEXCP=LEXMAX\LEXLL S:LEXMAX#LEXLL>0 LEXCP=LEXCP+1
30 S LEXM=$S(LEXTP>LEXCP:1,1:0) N LEXS,LEXE,LEXJ,LEXH,LEXR,LEXSTR,LEXC
31 S LEXC=+($G(LEX("HLP",0))) S LEXC=LEXC+1
32 S (LEXS,LEXE,LEXJ,LEXH,LEXR,LEXSTR)=""
33 S LEXS="You may select 1-"_LEXMAX
34 S LEXE="enter an ^ to quit" S:LEXM LEXJ="enter ^# to jump to another entry on the list (up to "_LEX_")"
35 S LEXH="enter ?# to display the definition of an entry marked with an asterisk (*)"
36 S:LEXM LEXR="or press <Return> to continue."
37 S:'LEXM LEXR="or press <Return> to quit without making a selection."
38 S LEXSTR=LEXS S:LEXE'="" LEXSTR=LEXSTR_", "_LEXE S:LEXJ'="" LEXSTR=LEXSTR_", "_LEXJ
39 S:LEXH'="" LEXSTR=LEXSTR_", "_LEXH S:LEXR'="" LEXSTR=LEXSTR_", "_LEXR
40 I $L(LEXSTR)>74 D
41 . F Q:$L(LEXSTR)'>74 D
42 . . N LEXI F LEXI=74:-1:1 Q:$E(LEXSTR,LEXI)=" "
43 . . S LEX("HLP",LEXC)=$E(LEXSTR,1,(LEXI-1)),LEX("HLP",0)=LEXC
44 . . S LEXC=LEXC+1,LEXSTR=$E(LEXSTR,(LEXI+1),$L(LEXSTR))
45 . I $L(LEXSTR)>0,$L(LEXSTR)'>74 S LEXC=LEXC+1,LEX("HLP",LEXC)=LEXSTR,LEX("HLP",0)=LEXC
46 D:$D(LEX("LIST")) LST^LEXAR
47 Q
48EXT2 ; Extended help for one
49 N LEXS,LEXE,LEXH,LEXSTR,LEXC,LEXDEF,LEXRP
50 S (LEXS,LEXE,LEXJ,LEXC,LEXH,LEXR,LEXSTR)=""
51 S LEXRP=+($G(^TMP("LEXHIT",$J,1))) D DEF(LEXRP)
52 S LEXC=+($G(LEX("HLP",0))) I LEXC>0 S LEXC=LEXC+1,LEX("HLP",LEXC)="",LEX("HLP",0)=LEXC
53 S LEXC=LEXC+1
54 S LEXDEF=+($G(^TMP("LEXHIT",$J,1)))
55 S LEXDEF=$S($D(^LEX(757.01,+LEXDEF,3)):1,1:0)
56 S LEXS="There was only one term found. Enter ""Yes"" to select, ""No"" to ignore"
57 S LEXE="or an ""^"" to quit"
58 S LEXH="" S:+LEXDEF>0 LEXH="""?"" to display the term definition"
59 S LEXSTR=LEXS
60 S:LEXH'="" LEXSTR=LEXSTR_", "_LEXH
61 S:LEXE'="" LEXSTR=LEXSTR_", "_LEXE
62 I $L(LEXSTR)>74 D
63 . F Q:$L(LEXSTR)'>74 D
64 . . N LEXI F LEXI=74:-1:1 Q:$E(LEXSTR,LEXI)=" "
65 . . S LEX("HLP",LEXC)=$E(LEXSTR,1,(LEXI-1)),LEX("HLP",0)=LEXC
66 . . S LEXC=LEXC+1,LEXSTR=$E(LEXSTR,(LEXI+1),$L(LEXSTR))
67 . I $L(LEXSTR)>0,$L(LEXSTR)'>74 S LEXC=LEXC+1,LEX("HLP",LEXC)=LEXSTR,LEX("HLP",0)=LEXC
68 D:$D(LEX("LIST")) LST^LEXAR
69 Q
70DH ; Display help
71 N LEXI S LEXI=0
72 F S LEXI=$O(LEX("HLP",LEXI)) Q:+LEXI=0 W !," ",LEX("HLP",LEXI)
73 Q
74DA ; Display help
75 Q
76 N LEXI S LEXI=0
77 F S LEXI=$O(LEX("LIST",LEXI)) Q:+LEXI=0 W !," ",LEX("LIST",LEXI)
78 Q
79DEF(LEXIEN) ; Definition Help LEX("HLP",
80 N LEXR S (LEXR,LEXIEN)=+($G(LEXIEN))
81 D:$D(LEX("LIST")) LST^LEXAR Q:LEXIEN'>0
82 N LEXLN,LEXC S (LEXLN,LEXC)=0 K LEX("HLP")
83 I '$D(^LEX(757.01,LEXIEN,3,1)),$P($G(^LEX(757.01,LEXIEN,1)),"^",2)'=1 D
84 . S LEXIEN=+($G(^LEX(757.01,LEXIEN,1))),LEXIEN=+($G(^LEX(757,LEXIEN,0)))
85 I $D(^LEX(757.01,LEXIEN,0)),$L($G(^LEX(757.01,LEXIEN,3,1,0))) D
86 . S LEXC=1,LEX("HLP",LEXC)=$G(^LEX(757.01,LEXIEN,0)) S LEXC=LEXC+1
87 . S LEX("HLP",LEXC)="",LEXC("HLP",0)=LEXC
88 . F S LEXLN=$O(^LEX(757.01,LEXIEN,3,LEXLN)) Q:+LEXLN=0 D
89 . . S LEXC=LEXC+1 S LEX("HLP",LEXC)=^LEX(757.01,LEXIEN,3,LEXLN,0),LEX("HLP",0)=LEXC
90 I '$D(LEX("HLP")) D
91 . K LEX("HLP") S:$L($G(^LEX(757.01,LEXR,0))) LEX("HLP",1)="No definition found for "_$C(34)_^LEX(757.01,LEXR,0)_$C(34)
92 . S:'$L($G(^LEX(757.01,LEXR,0))) LEX("HLP",1)="No definition found"
93 D:$D(LEX("LIST")) LST^LEXAR
94 Q
Note: See TracBrowser for help on using the repository browser.