source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXDCXS.m@ 701

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1LEXDCXS ; ISL Default Context - Select ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 ;
4 ; Special Look-up in file 757.41 Shortcut Context
5 ;
6 ; Entry: S X=$$EN^LEXDCXS
7 ;
8 ; Function returns a two piece string
9 ;
10 ; $P 1 Pointer to file 757.41, and a valid
11 ; value for LEXCTX (context user default)
12 ; This will be null if input is "^"
13 ;
14 ; $P 2 Name of context selected. This will
15 ; be null only when user input is "^^"
16 ;
17 ; LEX Array containing pointers to 757.41
18 ; LEXA Users answer to selection
19 ; LEXC Counter
20 ; LEXE Edit/non-edit Counter
21 ; LEXF Re-display starting from #LEXF
22 ; LEXI Incremental Counter
23 ; LEXL Last entry displayed
24 ; LEXR Internal Entry Number (Record) in #757.41
25 ; LEXT Re-display up through #LEXT
26 ; LEXX Returned value
27 ;
28EN(LEXX) ; Entry: S X=$$EN^LEXDCXS
29 N X,Y,LEX,LEXC,LEXL,LEXR,LEXA,LEXE S LEXE=$$CNT D TOT
30 S LEXA="",(LEXX,LEXC,LEXR)=0
31 F S LEXR=$O(^LEX(757.41,LEXR)) Q:+LEXR=0!(LEXA["^")!(+LEXX>0) D
32 . I $D(LEXEDIT),$P($G(^LEX(757.41,LEXR,0)),"^",2)'=1 Q
33 . S LEXC=LEXC+1,LEXL=LEXC
34 . S LEX(LEXC)=LEXR,LEX(0)=LEXC
35 . D:LEXE>1 W(LEXC,LEXR)
36 . D:LEXE=1 WO(LEXR)
37 ; D ASK
38 D ASK I LEXA["^" D UOUT Q LEXX
39 D VAL Q LEXX
40ASK ; Ask for user input
41 Q:+LEXX>0 Q:LEXA["^" Q:+LEXR>0&(LEXC#5'=0)
42 Q:+LEXR=0&(LEXC#5=0)
43 D SEL Q:+LEXA'>0 Q:LEXA>LEXE S LEXX=$G(LEX(+LEXA))
44 Q
45SEL ; Select from list
46 I LEXE=1 D ONE Q
47 W ! N X,Y,DIR,DIRUT,DTOUT,DUOUT,DIROUT
48 S DIR(0)="NAO^1:"_LEXC
49 S DIR("A")="Select SHORTCUT CONTEXT 1-"_LEXC_": // "
50 S (DIR("?"),DIR("??"))="^D SH^LEXDCXS"
51 D ^DIR S LEXA=Y
52 Q
53ONE ;
54 W ! N X,Y,DIR,DIRUT,DTOUT,DUOUT,DIROUT
55 S DIR(0)="YAO"
56 S DIR("A")=" Ok? // "
57 S (DIR("?"),DIR("??"))="^D SO^LEXDCXS"
58 D ^DIR S LEXA=$S(+Y>0:1,1:0)
59 Q
60UOUT ; Up Arrow detected
61 S:LEXA="^^" LEXX="^"
62 S:LEXA="^" LEXX="^No context selected"
63 Q
64VAL ; No Un Arrow (value)
65 I +LEXX>0 D Q
66 . I $D(^LEX(757.41,+LEXX)) D Q
67 . . S LEXX=LEXX_"^"_$P($G(^LEX(757.41,+LEXX,0)),"^",1)
68 . S LEXX="^No context selected"
69 S LEXX="^No context selected"
70 Q
71SH ; Show help
72 N LEXR S LEXR=+($E(X,2,$L(X)))
73 I $E(X,1)="?",LEXR>0,LEXR<(LEX(0)+1) D
74 . S LEXR=LEX(LEXR) D:'$D(^LEX(757.41,LEXR,1,1)) NODES,STD
75 . Q:'$D(^LEX(757.41,LEXR,1,1)) D DES
76 D:$E(X,1)="?"&(LEXR<1!(LEXR>LEX(0))) STD
77 D:$E(X,1)'="?" STD D RD
78 Q
79SO ; Show one help
80 N LEXR S LEXR=1
81 I $E(X,1)="?",LEXR>0,LEXR<(LEX(0)+1) D
82 . S LEXR=LEX(LEXR) D:'$D(^LEX(757.41,LEXR,1,1)) NODES,STDO
83 . Q:'$D(^LEX(757.41,LEXR,1,1)) D DES
84 D:$E(X,1)'="?" STDO D RDO
85 Q
86STD ; Standard Help
87 W !!,"Enter 1-",LEXC," to select a Shortcut Context, "
88 W "or ""?"" for help, or ""?#"" for descriptive"
89 W !,"help on an entry flagged with an ""*"", or ""^"" "
90 W "to exit or <Return> for more."
91 Q
92STDO ; Standard Help - One
93 W !!,"One Shortcut Context available to edit, "
94 W "enter ""Yes"" to select, or ""^"" to exit."
95 Q
96DES ; Description Help
97 N LEXI S LEXI=0 W !!,?2,$P(^LEX(757.41,LEXR,0),"^",1),!
98 F S LEXI=$O(^LEX(757.41,LEXR,1,LEXI)) Q:+LEXI=0 D
99 . W !,?4,^LEX(757.41,LEXR,1,LEXI,0)
100 W ! Q
101NODES ; No Description Available
102 W !!,?2,$P(^LEX(757.41,LEXR,0),"^",1)
103 W " does not have a description",! Q
104RD ; Re-Display List (MULTIPLE)
105 N LEXF,LEXT S LEXT=+($G(LEXL)),LEXF=(+(LEXT#5)-1)
106 S:LEXF<0 LEXF=4 S LEXF=LEXT-LEXF,LEXF=LEXF-1
107 F S LEXF=$O(LEX(LEXF)) Q:+LEXF=0!(LEXF'<(LEXT+1)) D
108 . W:LEXF=1 ! D W(LEXF,LEX(LEXF))
109 Q
110RDO ; Re-Display List (ONE)
111 N LEXR S LEXR=LEX(1) W ! D WO(LEXR)
112 Q
113W(LEXC,LEXR) ; Write entry
114 W !,$J(LEXC,4),". ",$P(^LEX(757.41,LEXR,0),"^",1)
115 W $S($D(^LEX(757.41,LEXR,1)):" *",1:"") Q
116WO(LEXR) ; Write one entry
117 W !,$P(^LEX(757.41,LEXR,0),"^",1) W $S($D(^LEX(757.41,LEXR,1)):" *",1:"") Q
118TOT ; Total Context
119 N LEXR,LEXC S (LEXR,LEXC)=0 F S LEXR=$O(^LEX(757.41,LEXR)) Q:+LEXR=0 D
120 . Q:$D(LEXEDIT)&($P($G(^LEX(757.41,LEXR,0)),"^",2)'=1) S LEXC=LEXC+1
121 I $D(LEXEDIT) D Q
122 . W:LEXC>1 !!,LEXC," SHORTCUT CONTEXT(s) found which can be edited",!
123 . W:LEXC=1 !!,"Only ",LEXC," SHORTCUT CONTEXT found which can be edited",!
124 W:LEXC>1 !!,LEXC," SHORTCUT CONTEXT(s) found",! W:LEXC=1 !!,"Only ",LEXC," SHORTCUT CONTEXT found",!
125 Q
126CNT(X) ; Count
127 N LEXR,LEXC S (LEXR,LEXC)=0 F S LEXR=$O(^LEX(757.41,LEXR)) Q:+LEXR=0 D
128 . Q:$D(LEXEDIT)&($P($G(^LEX(757.41,LEXR,0)),"^",2)'=1) S LEXC=LEXC+1
129 S X=LEXC Q X
Note: See TracBrowser for help on using the repository browser.