source: WorldVistAEHR/trunk/r/CAPACITY_MANAGEMENT_TOOLS-KMPD-KMPL/KMPDU2.m@ 1639

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

initial load of WorldVistAEHR
File size: 6.4 KB
RevLine 
[613]1KMPDU2 ;OAK/RAK - CM Tools Routine Utilities ;7/22/04 09:06
2 ;;2.0;CAPACITY MANAGEMENT TOOLS;**2**;Mar 22, 2002
3 ;
4IRSRC(KMPDDA) ;-- extrinsic function - check for local mods in INSTALL file
5 ;-----------------------------------------------------------------------
6 ; KMPDDA... DA as defined in fileman programmers manual.
7 ;
8 ; Return: "NO" - no local mods.
9 ; "YES" - local mods.
10 ;
11 ; This extrinsic function is called from computed field #573099 (LOCAL
12 ; MODIFICATIONS) in file #9.7 (INSTALL).
13 ;-----------------------------------------------------------------------
14 ;
15 Q:'$G(KMPDDA) "NO"
16 ;
17 N I,RTN,RETURN
18 S I=0,RETURN="NO"
19 F S I=$O(^XPD(9.7,KMPDDA,"RTN",I)) Q:'I D Q:RETURN="YES"
20 .Q:'$D(^XPD(9.7,KMPDDA,"RTN",I,0)) S RTN=$P(^(0),U)
21 .S:$$ROUSRC1(RTN,"LOCAL MOD/") RETURN="YES"
22 .;S:$$ROUSRC1(RTN,"/LOCAL MOD/") RETURN="YES"
23 ;
24 Q RETURN
25 ;
26ROUFIND(KMPDY,KMPDRNM,KMPDGBL) ;-- find routines.
27 ;-----------------------------------------------------------------------
28 ; KMPDRNM.. Routine name to search for.
29 ; KMPDGBL... Global to store data. Stored in format:
30 ; RoutineName^RoutineSize^Checksum
31 ;-----------------------------------------------------------------------
32 ;
33 K KMPDY
34 ;
35 S KMPDRNM=$G(KMPDRNM),KMPDGBL=$G(KMPDGBL)
36 ;
37 I KMPDGBL="" S KMPDY="[Global for storage is not defined]" Q
38 ;
39 N DATA,LN,ROU,RTN,X,Y
40 ;
41 ; kill global with check for ^tmp or ^utility.
42 D KILL^KMPDU(.DATA,KMPDGBL)
43 ; if error.
44 I $E(DATA)="[" S KMPDY=DATA Q
45 ;
46 S KMPDY=$NA(@KMPDGBL)
47 ;
48 ; if no asterisk (*) then look for routine.
49 I KMPDRNM'["*" D Q
50 .; if routine name greater than 8 characters
51 .I $L(KMPDRNM)>8 S @KMPDGBL@(0)="<"_KMPDRNM_" is greater than 8 characters>" Q
52 .; if routine not defined.
53 .I '$D(^$ROUTINE(KMPDRNM)) S @KMPDGBL@(0)="<Routine "_KMPDRNM_" not defined>" Q
54 .; if defined.
55 .S $P(@KMPDGBL@(0),U)=KMPDRNM
56 .; checksum
57 .S X=KMPDRNM X ^%ZOSF("RSUM") S $P(@KMPDGBL@(0),U,2)=Y
58 ;
59 ; remove "*" if any.
60 S:$E(KMPDRNM,$L(KMPDRNM))="*" KMPDRNM=$E(KMPDRNM,1,$L(KMPDRNM)-1)
61 S (ROU,RTN)=KMPDRNM,LN=0
62 S ROU=$E(ROU,1,$L(ROU)-1)
63 S ROU=ROU_$C(($A($E(KMPDRNM,$L(KMPDRNM)))-1))_"zz"
64 F S ROU=$O(^$ROUTINE(ROU)) Q:ROU=""!($E(ROU,1,$L(RTN))'=RTN) D
65 .S $P(@KMPDGBL@(LN),U)=ROU
66 .; checksum
67 .S X=ROU X ^%ZOSF("RSUM") S $P(@KMPDGBL@(LN),U,2)=Y
68 .S LN=LN+1
69 ;
70 S:'$D(@KMPDGBL) KMPDY(0)="<No Data To Report>"
71 ;
72 Q
73 ;
74ROUINQ(KMPDY,KMPDROU) ;-- routine inquiry.
75 ;----------------------------------------------------------------------
76 ; KMPDROU.. Routine(s) to search (this may be a partial name.
77 ;----------------------------------------------------------------------
78 ;
79 K KMPDY
80 ;
81 S KMPDROU=$G(KMPDROU)
82 I KMPDROU="" S KMPDY(0)="[Routine name not defined]" Q
83 I '$D(^$ROUTINE(KMPDROU)) S KMPDY(0)="[Routine '"_KMPDROU_"' not defined]" Q
84 ;
85 N DIF,I,LN,ROU,X,XCNP
86 ;
87 S DIF="ROU(",XCNP=0
88 S X=KMPDROU X ^%ZOSF("TEST")
89 I '$T S KMPDY(0)="[Routine '"_KMPDROU_"' not defined]" Q
90 X ^%ZOSF("LOAD")
91 S (I,LN)=0
92 F S I=$O(ROU(I)) Q:'I I $D(ROU(I,0)) D
93 .S KMPDY(LN)=ROU(I,0),LN=LN+1
94 ;
95 S:'$D(KMPDY) KMPDY(0)="[Unable to load routine]"
96 ;
97 Q
98 ;
99ROUSRC(KMPDY,KMPDROU,KMPDTXT) ;-- routine search
100 ;----------------------------------------------------------------------
101 ; KMPDROU.. Routine(s) to search (this may be a partial name.
102 ; KMPDTXT.. Text to search for in routine.
103 ;----------------------------------------------------------------------
104 ;
105 K KMPDY
106 ;
107 S KMPDROU=$G(KMPDROU),KMPDTXT=$$UP^XLFSTR($G(KMPDTXT))
108 ;
109 I KMPDROU="" S KMPDY(0)="[Routine(s) not defined]" Q
110 ;
111 I KMPDTXT="" S KMPDY(0)="[Search Text not defined]" Q
112 ;
113 N LN,RN,RTN,STAR
114 ;
115 S RTN=KMPDROU,STAR=$E(RTN,$L(RTN))
116 S:STAR="*" RTN=$E(RTN,1,$L(RTN)-1)
117 ;
118 ; if just one routine.
119 I STAR'="*" D Q
120 .; if match.
121 .I $$ROUSRC1(RTN,KMPDTXT) S KMPDY(0)=RTN Q
122 .; else no match.
123 .S KMPDY(0)="<No Matches Found>"
124 ;
125 S RN=RTN,LN=0
126 F S RN=$O(^$ROUTINE(RN)) Q:RN=""!($E(RN,1,$L(RTN))'=RTN) D
127 .; if match.
128 .I $$ROUSRC1(RN,KMPDTXT) S KMPDY(LN)=RN,LN=LN+1 Q
129 ;
130 S:'$D(KMPDY) KMPDY(0)="<No Matches Found>"
131 ;
132 Q
133 ;
134ROUSRC1(KMPDROU,KMPDTXT) ;-- extrinsic function - check for text.
135 ;----------------------------------------------------------------------
136 ; KMPDROU.. Routine(s) to search (this may be a partial name.
137 ; KMPDTXT.. Text to search for in routine.
138 ;
139 ; Return: 0 - no match.
140 ; 1 - match.
141 ;----------------------------------------------------------------------
142 ;
143 S KMPDROU=$G(KMPDROU),KMPDTXT=$$UP^XLFSTR($G(KMPDTXT))
144 ;
145 Q:KMPDROU="" 0
146 Q:KMPDTXT="" 0
147 ;
148 N DIF,I,RETURN,ROU,X,XCNP
149 ;
150 S DIF="ROU(",(I,RETURN,XCNP)=0,RETURN=0
151 S X=KMPDROU X ^%ZOSF("TEST")
152 Q:'$T 0
153 X ^%ZOSF("LOAD")
154 F S I=$O(ROU(I)) Q:'I I $D(ROU(I,0)) D Q:RETURN
155 .I $$UP^XLFSTR(ROU(I,0))[KMPDTXT S RETURN=1
156 ;
157 Q RETURN
158 ;
159ROUSRC2(KMPDY,KMPDROU,KMPDTXT,KMPDGBL) ;-- search for text in routine.
160 ;----------------------------------------------------------------------
161 ; KMPDROU.. Routine(s) to search.
162 ; KMPDTXT.. Text to search for in routine.
163 ; KMPDGBL... Global to store data.
164 ;-----------------------------------------------------------------------
165 ;
166 K KMPDY
167 ;
168 S KMPDROU=$G(KMPDROU),KMPDGBL=$G(KMPDGBL)
169 ;
170 I KMPDGBL="" S KMPDY="[Global for storage is not defined]" Q
171 ;
172 N DATA,DIF,I,LABEL,LN,OFFSET,ONE,ROU,RTN,X,XCNP
173 ;
174 ; kill global with check for ^tmp or ^utility.
175 D KILL^KMPDU(.DATA,KMPDGBL)
176 ; if error.
177 I $E(DATA)="[" S KMPDY=DATA Q
178 ;
179 S KMPDY=$NA(@KMPDGBL)
180 ;
181 S KMPDROU=$G(KMPDROU),KMPDTXT=$$UP^XLFSTR($G(KMPDTXT))
182 ;
183 I KMPDROU="" S @KMPDGBL@(0)="[Routine(s) name not defined]" Q
184 I KMPDTXT="" S @KMPDGBL@(0)="[Search text not defined]" Q
185 ;
186 S ONE=1
187 ; remove "*" if any.
188 I $E(KMPDROU,$L(KMPDROU))="*" D
189 .S KMPDROU=$E(KMPDROU,1,$L(KMPDROU)-1)
190 .S ONE=0
191 ; get ready to $order.
192 S RTN=KMPDROU
193 S DATA=KMPDROU
194 S DATA=$E(DATA,1,$L(DATA)-1)
195 S DATA=DATA_$C(($A($E(KMPDROU,$L(KMPDROU)))-1))_"zz"
196 S KMPDROU=DATA
197 ;
198 S ROU=KMPDROU,LN=0
199 F S ROU=$O(^$ROUTINE(ROU)) Q:ROU=""!($E(ROU,1,$L(RTN))'=RTN) D Q:ONE
200 .K ROUT
201 .S DIF="ROUT(",(I,OFFSET,XCNP)=0,LABEL=ROU
202 .S X=ROU X ^%ZOSF("TEST") Q:'$T
203 .X ^%ZOSF("LOAD")
204 .F S I=$O(ROUT(I)) Q:'I I $D(ROUT(I,0)) D
205 ..S OFFSET=OFFSET+1
206 ..; if new label.
207 ..I $E(ROUT(I,0))'=" " S LABEL=$$ROULABEL^KMPDU2(ROUT(I,0)),OFFSET=0
208 ..; quit if no match.
209 ..Q:$$UP^XLFSTR(ROUT(I,0))'[KMPDTXT
210 ..S @KMPDGBL@(LN)=ROU_"^"_LABEL_$S(OFFSET:"+"_OFFSET,1:"")_" "_ROUT(I,0)
211 ..S LN=LN+1
212 ;
213 S:'$D(@KMPDGBL) @KMPDGBL@(0)="<No Match Found>"
214 ;
215 Q
216 ;
217ROULABEL(TEXT) ;-- routine label.
218 Q:$G(TEXT)="" ""
219 N I,LABEL
220 S LABEL=""
221 F I=1:1 Q:$E(TEXT,I)=" "!($E(TEXT,I)="(") S LABEL=$E(TEXT,0,I)
222 Q LABEL
Note: See TracBrowser for help on using the repository browser.