source: cprs/branches/tmg-cprs/m_files/TMGMGRST.m

Last change on this file was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload
File size: 27.3 KB
Line 
1TMGMGRST ;TMG/kst/Custom version of ZTMGRSET and ZOSFGUX ;03/25/06
2 ;;1.0;TMG-LIB;**1**;11/01/04
3
4 ;"ZTMGRSET(INFO) & ZOSFGUX -- NON-INTERACTIVE versions of standard code.
5 ;"=============================================================================
6 ;"Kevin Toppenberg, MD 11-04
7 ;"
8 ;"Purpose:
9 ;"
10 ;"This library will provide optional NON-INTERACTIVE versions of standard code.
11 ;"
12 ;"ZTMGRSET(INFO)
13 ;"ZOSFGUX
14 ;"
15 ;"Dependancies:
16 ;" TMGQIO
17 ;" if TMGDEBUG defined, then requires TMGDEBUG.m
18 ;"=============================================================================
19
20ZTMGRSET(INFO) ;SF/RWF,PUG/TOAD - SET UP THE MGR ACCOUNT FOR THE SYSTEM ;10/29/2003 10:19
21 ;;8.0+;KERNEL;**34,36,69,94,121,127,136,191,275 (WorldVista Modified)**;JUL 10, 1995;
22 ;";;8.0;KERNEL;**34,36,69,94,121,127,136,191,275**;JUL 10, 1995;
23 ;"
24 ;"K. Toppenberg's changes made November, 2004
25 ;"
26 ;"Input:
27 ;" Note: INFO variable is completely an OPTIONAL parameter.
28 ;" If not supplied, interactive mode used
29 ;" INFO("SILENT-OUTPUT") -- 1 = output is supressed.
30 ;" INFO("SILENT-INPUT") -- 1 = User-interactive input is supressed.
31 ;"
32 ;" ** if in SILENT-INPUT mode, THEN the following data should be supplied:
33 ;" ----------------------
34 ;" INFO("CONTINUE") -- Should contain the answer the user would enter for question:
35 ;" "THIS MAY NOT BE THE MANAGER UCI... continue anyway?" (i.e. Y or N)
36 ;" INFO("OS") -- should have number that would be used to select OS to install (i.e. 1,2,3 etc.)
37 ;" INFO("RENAME") -- should have answer to "Rename fileman routines?" (i.e. Y or N)
38 ;" INFO("MGR-UCI,VOL") -- should have Managers UCI,VOL
39 ;" INFO("SIGNON-UCI,VOL") -- should have Sign-on UCI,VOL
40 ;" INFO("VOLUME-SET")--should have: NAME OF VOLUME SET (use same volume set as for 'Production')
41 ;" INFO("TEMP") -- should have temp directory for system
42 ;"Output:
43 ;" If in SILENT-OUTPUT mode, then output that would normally go to the screen, will be routed to this array
44 ;" NOTE: INFO SHOULD BE PASSED BY REFERENCE if user wants this information passed back out.
45 ;" INFO("TEXT","LINES")=Number of output lines
46 ;" INFO("TEXT",1)= 1st output line
47 ;" INFO("TEXT",2)= 2nd output line, etc...
48 ;
49 ;
50
51 IF '$data(DBIndent) NEW DBIndent SET DBIndent=0
52 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"ZTMGRSET^TMGMGRST")
53
54 N %D,%S,I,OSMAX,U,X,X1,X2,Y,Z1,Z2,ZTOS,ZTMODE,SCR
55 NEW ABORT SET ABORT=0 ;//kt
56 NEW SILNTOUT SET SILNTOUT=$get(INFO("SILENT-OUTPUT"),0) ;//kt
57 NEW SILENTIN SET SILENTIN=$GET(INFO("SILENT-INPUT"),0) ;//KT
58 KILL INFO("TEXT") ;//kt
59
60 S ZTMODE=0
61A
62 DO OUTP^TMGQIO(SILNTOUT,"!","!","ZTMGRSET","!","Version ",$P($T(ZTMGRSET+1),";",3)," ",$P($T(ZTMGRSET+1),";",5))
63 DO OUTP^TMGQIO(SILNTOUT,"!","!","HELLO! I'm here to help initialize the current account.")
64
65 ;
66 SET Y=0 ;//kt added
67 I $D(^%ZOSF("UCI")) X ^%ZOSF("UCI")
68 new CurUCI set CurUCI=Y
69 I CurUCI'["MG" DO QUIT:(ABORT=1)
70 . write !,!,"CurUCI=",CurUCI,!
71 . DO OUTP^TMGQIO(SILNTOUT,$C(7),"!","!","THIS MAY NOT BE THE MANAGER UCI.","!")
72 . DO OUTP^TMGQIO(SILNTOUT," I think it is ",CurUCI,". Should I continue anyway? N//")
73 . DO INP^TMGQIO(.X,SILENTIN,120,$GET(INFO("CONTINUE")))
74 . IF "Yy"'[$E(X_"N") DO OUTP^TMGQIO(SILNTOUT,"QUITING.","!") SET ABORT=1 QUIT
75 ;
76 S ZTOS=$$OS()
77 I ZTOS'>0 DO OUTP^TMGQIO(SILNTOUT,"!","Can't determine the OS type. Exiting ZTMGRSET.") QUIT
78 ;
79 I ZTMODE D QUIT:(ABORT=1)
80 . DO OUTP^TMGQIO(SILNTOUT,"!","!","Patch number to load: ")
81 . DO INP^TMGQIO(.PCNM,SILENTIN,,$get(INFO("PATCHNUM")))
82 . IF (PCNM<1)!(PCNM>999) DO QUIT
83 . . DO OUTP^TMGQIO(SILNTOUT,"!","!","Need a Patch number to load. Exiting ZTMGRSET")
84 . . SET ABORT=1
85 . S SCR="I $P($T(+2^@X),"";"",5)?.E1P1"_$C(34)_PCNM_$C(34)_"1P.E"
86 ;
87 ;
88 K ^%ZOSF("MASTER"),^("SIGNOFF") ;Remove old nodes.
89 ;
90DOIT
91 DO OUTP^TMGQIO(SILNTOUT,"!","!","I will now rename a group of routines specific to your operating system.","!")
92 D @ZTOS
93 D ALL
94 D GLOBALS:'ZTMODE
95 ;
96 DO OUTP^TMGQIO(SILNTOUT,"!","!","Completed ZTMGRSET^TMGMGRST.","!","So I guess this is 'Goodbye'.","!","!")
97 ;
98 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"ZTMGRSET^TMGMGRST")
99
100 Q
101 ;
102 ;==============================================================================================
103 ;==============================================================================================
104 ;
105RELOAD ;Reload any patched routines
106 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"RELOAD^TMGMGRST")
107 N %D,%S,I,OSMAX,U,X,X1,X2,Y,Z1,Z2,ZTOS,ZTMODE,SCR
108 S ZTMODE=1 G A
109 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"OS^TMGMGRST")
110 Q
111 ;
112 ;==============================================================================================
113 ;==============================================================================================
114 ;
115OS() ;Select the OS
116 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"OS^TMGMGRST")
117 N Y,X1,X
118 S U="^",SCR="I 1" F I=1:1:20 S X=$T(@I) Q:X="" S OSMAX=I
119B
120 S Y=0,ZTOS=0 I $D(^%ZOSF("OS")) D
121 . S X1=$P(^%ZOSF("OS"),U),ZTOS=$$OSNUM
122 . DO OUTP^TMGQIO(SILNTOUT,"!","I think you are using ",X1)
123 DO OUTP^TMGQIO(SILNTOUT,"!","Which MUMPS system should I install?","!")
124 DO OUTP^TMGQIO(SILNTOUT,"!",0," = Abort;")
125 F I=1:1:OSMAX DO OUTP^TMGQIO(SILNTOUT,"!",I," = ",$P($T(@I),";",3))
126 DO OUTP^TMGQIO(SILNTOUT,"!","System: ")
127 IF ZTOS DO OUTP^TMGQIO(SILNTOUT,ZTOS,"//")
128 DO INP^TMGQIO(.X,SILENTIN,300,$get(INFO("OS"),U))
129 IF X="" S X=ZTOS
130 IF (X=U)!(X=0) DO OUTP^TMGQIO(SILNTOUT,"!") SET X=0 GOTO OSQ
131 I X<1!(X>OSMAX) DO OUTP^TMGQIO(SILNTOUT,"!","NOT A VALID OS CHOICE") GOTO B
132OSQ
133 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"OS^TMGMGRST")
134 QUIT X
135 ;
136
137OSNUM() ;Return the OS number
138 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"OSNUM^TMGMGRST")
139 N I,X1,X2,Y S Y=0,X1=$P($G(^%ZOSF("OS")),"^")
140 F I=1:1 S X2=$T(@I) Q:X2="" I X2[X1 S Y=I QUIT
141 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"OSNUM^TMGMGRST")
142 QUIT Y
143 ;
144
145ALL
146 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"ALL^TMGMGRST")
147 DO OUTP^TMGQIO(SILNTOUT,"!","!","Now to load routines common to all systems.")
148 D TM,ETRAP,DEV,OTHER,FM
149 I ZTOS=7!(ZTOS=8) D
150 . S ^%ZE="D ^ZE"
151 E D ;With ZLoad, ZSave, ZInsert
152 . DO OUTP^TMGQIO(SILNTOUT,"!","Installing ^%Z editor")
153 . D ^ZTEDIT
154 I 'ZTMODE DO
155 . DO OUTP^TMGQIO(SILNTOUT,"!","Setting ^%ZIS('C')")
156 . K ^%ZIS("C")
157 . S ^%ZIS("C")="G ^%ZISC"
158 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"ALL^TMGMGRST")
159 Q
160 ;
161
162TM ;Taskman
163 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"TM^TMGMGRST")
164 S %S="ZTLOAD^ZTLOAD1^ZTLOAD2^ZTLOAD3^ZTLOAD4^ZTLOAD5^ZTLOAD6^ZTLOAD7"
165 S %D="%ZTLOAD^%ZTLOAD1^%ZTLOAD2^%ZTLOAD3^%ZTLOAD4^%ZTLOAD5^%ZTLOAD6^%ZTLOAD7"
166 D MOVE
167 S %S="ZTM^ZTM0^ZTM1^ZTM2^ZTM3^ZTM4^ZTM5^ZTM6"
168 S %D="%ZTM^%ZTM0^%ZTM1^%ZTM2^%ZTM3^%ZTM4^%ZTM5^%ZTM6"
169 D MOVE
170 S %S="ZTMS^ZTMS0^ZTMS1^ZTMS2^ZTMS3^ZTMS4^ZTMS5^ZTMS7^ZTMSH"
171 ;I ZTOS=7!(ZTOS=8) S $P(%S,U,1)="ZTMSGTM"
172 S %D="%ZTMS^%ZTMS0^%ZTMS1^%ZTMS2^%ZTMS3^%ZTMS4^%ZTMS5^%ZTMS7^%ZTMSH"
173 D MOVE
174 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"TM^TMGMGRST")
175 Q
176
177FM ;Rename the FileMan routines
178 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"FM^TMGMGRST")
179 I ZTMODE=1 GOTO FMQ ;"Only ask on full install
180 DO INP^TMGQIO(.X,SILENTIN,600,$get(INFO("RENAME"),"N"),"!","!","Want to rename the FileMan routines: No//")
181 GOTO:"Yy"'[$E(X_"N") FMQ
182 S %S="DIDT^DIDTC^DIRCR",%D="%DT^%DTC^%RCR"
183 D MOVE
184FMQ
185 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"FM^TMGMGRST")
186 QUIT
187 ;
188 ;
189ETRAP ;Error Trap
190 S %S="ZTER^ZTER1",%D="%ZTER^%ZTER1"
191 D MOVE
192 Q
193 ;
194 ;
195OTHER
196 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"OTHER^TMGMGRST")
197 S %S="ZTPP^ZTP1^ZTPTCH^ZTRDEL^ZTMOVE"
198 S %D="%ZTPP^%ZTP1^%ZTPTCH^%ZTRDEL^%ZTMOVE"
199 D MOVE
200 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"OTHER^TMGMGRST")
201 Q
202 ;
203 ;
204DEV
205 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"DEV^TMGMGRST")
206 S %S="ZIS^ZIS1^ZIS2^ZIS3^ZIS5^ZIS6^ZIS7^ZISC^ZISP^ZISS^ZISS1^ZISS2^ZISTCP^ZISUTL"
207 S %D="%ZIS^%ZIS1^%ZIS2^%ZIS3^%ZIS5^%ZIS6^%ZIS7^%ZISC^%ZISP^%ZISS^%ZISS1^%ZISS2^%ZISTCP^%ZISUTL"
208 D MOVE
209 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"DEV^TMGMGRST")
210 Q
211 ;
212 ;
213RUM ;Build the routines for Capacity Management (CM)
214 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"RUM^TMGMGRST")
215 S %S=""
216 I ZTOS=1 S %S="ZOSVKRV^ZOSVKSVE^ZOSVKSVS^ZOSVKSD" ;DSM
217 I ZTOS=2 S %S="ZOSVKRM^ZOSVKSME^ZOSVKSMS^ZOSVKSD" ;MSM
218 I ZTOS=3 S %S="ZOSVKRO^ZOSVKSOE^ZOSVKSOS^ZOSVKSD" ;OpenM
219 I ZTOS=7!(ZTOS=8) S %S="ZOSVKRG^ZOSVKSGE^ZOSVKSGS^ZOSVKSD" ;GT.M
220 S %D="%ZOSVKR^%ZOSVKSE^%ZOSVKSS^%ZOSVKSD"
221 D MOVE
222 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"RUM^TMGMGRST")
223 Q
224 ;
225 ;
226ZOSF(X) ;
227 ;"Note: KT made change to this function. It used to be that it would be
228 ;" called as do ZOSF("FUNCTION"). Now it should be called like this:
229 ;" ZOSF("^FUNCTION"). The old fuction would automatically prefix
230 ;" all calls with a '^'. I took this out so that calls to functions
231 ;" contained in this module are possible.
232 ;
233 ;"IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"ZOSF^TMGMGRST")
234 X SCR
235 I $T DO @(X)
236 ;"IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"ZOSF^TMGMGRST")
237 Q
238 ;
239 ;
2401 ;;VAX DSM(V6), VAX DSM(V7)
241 S %S="ZOSVVXD^ZTBKCVXD^ZIS4VXD^ZISFVXD^ZISHVXD^XUCIVXD^ZISETVXD"
242 D DES,MOVE
243 S %S="ZOSV2VXD^ZTMDCL",%D="%ZOSV2^%ZTMDCL"
244 D MOVE,RUM,ZOSF("^ZOSFVXD")
245 Q
246 ;
247 ;
2482 ;;MSM-PC/PLUS, MSM for NT or UNIX
249 DO OUTP^TMGQIO(SILNTOUT,"!","- Use autostart to do ZTMB don't resave as STUSER.")
250 S %S="ZOSVMSM^ZTBKCMSM^ZIS4MSM^ZISFMSM^ZISHMSM^XUCIMSM^ZISETMSM"
251 D DES,MOVE
252 S %S="ZOSV2MSM",%D="%ZOSV2"
253 D MOVE,RUM,ZOSF("^ZOSFMSM")
254 I $$VERSION^%ZOSV(1)["UNIX" S %S="ZISHMSU",%D="%ZISH" D MOVE
255 Q
256 ;
257 ;
2583 ;;OpenM for NT, Cache/NT, Cache/VMS
259 S %S="ZOSVONT^^ZIS4ONT^ZISFONT^ZISHONT^XUCIONT"
260 D DES,MOVE
261 S %S="ZISTCPS",%D="%ZISTCPS"
262 D MOVE,RUM,ZOSF("^ZOSFONT")
263 Q
264 ;
265 ;
2664 ;;Datatree, DTM-PC, DT-MAX
267 S %S="ZOSVDTM^ZTBKCDTM^ZIS4DTM^ZISFDTM^ZISHDTM^XUCIDTM^ZISETDTM"
268 D DES,MOVE
269 S %S="ZOSV1DTM^ZTMB",%D="%ZOSV1^%ustart"
270 D MOVE,ZOSF("^ZOSFDTM")
271 Q
272 ;
273 ;
2745 ;;MVX,ISM VAX
275 S %S="ZOSVMSQ^ZTBKCMSQ^ZIS4MSQ^ZISFMSQ^ZISHMSQ^XUCIMSQ^ZISETMSQ"
276 D DES,MOVE
277 S %S="ZTMB",%D="ZSTU"
278 D MOVE,ZOSF("^ZOSFMSQ")
279 Q
280 ;
281 ;
2826 ;;ISM (UNIX, Open VMS)
283 S %S="ZOSVIS2^^ZIS4IS2^ZISFIS2^ZISHIS2^XUCIIS2^ZISETIS2"
284 D DES,MOVE
285 S %S="ZTMB",%D="ZSTU"
286 D MOVE,ZOSF("^ZOSFIS2")
287 Q
288 ;
289 ;
2907 ;;GT.M (VMS)
291 S %S="ZOSVGTM^ZTBKCGTM^ZIS4GTM^ZISFGTM^ZISHGTM^XUCIGTM^ZISETGTM"
292 D DES,MOVE
293 S %S="ZOSV2GTM^ZISTCPS",%D="%ZOSV2^%ZISTCPS"
294 D MOVE,ZOSF("^ZOSFGTM")
295 Q
296 ;
297 ;
2988 ;;GT.M (Unix)
299 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"8^TMGMGRST")
300 S %S="ZOSVGUX^ZTBKCGUX^ZIS4GTM^ZISFGTM^ZISHGUX^XUCIGTM^ZISETGUX"
301 ;S %S="ZOSVGUX^ZIS4GTM^ZISFGTM^ZISHGUX^XUCIGTM" ;//kt removed 2 files that were missing
302 D DES
303 D MOVE
304 S %S="ZOSV2GTM^ZISTCPS",%D="%ZOSV2^%ZISTCPS"
305 D MOVE
306 D ZOSF("ZOSFGUX")
307 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"8^TMGMGRST")
308 Q
309 ;
310 ;
31110 ;;NOT SUPPORTED
312 Q
313 ;
314 ;
315MOVE ; rename % routines
316 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"MOVE^TMGMGRST")
317 N %,X,Y
318 F %=1:1:$L(%D,"^") D
319 . S X=$P(%S,U,%) ; from
320 . S Y=$P(%D,U,%) ; to
321 . DO OUTP^TMGQIO(SILNTOUT,"!","Routine: ",X)
322 . NEW INDENT SET INDENT=12-$LENGTH(X)
323 . IF INDENT>0 DO OUTP^TMGQIO(SILNTOUT,"?"_INDENT)
324 . DO OUTP^TMGQIO(SILNTOUT," --> ",Y)
325 . SET INDENT=12-$LENGTH(Y)
326 . DO OUTP^TMGQIO(SILNTOUT,"?"_INDENT)
327 . Q:(X="")!(Y="")
328 . I $TEXT(^@X)="" DO QUIT
329 . . DO OUTP^TMGQIO(SILNTOUT,"Missing")
330 . X SCR
331 . Q:'$T
332 . IF $$COPY(X,Y)=0 DO
333 . . DO OUTP^TMGQIO(SILNTOUT,"Loaded")
334 . . ;"DO OUTP^TMGQIO(SILNTOUT,"?10","Saved as ",Y)
335 . ELSE DO
336 . . DO OUTP^TMGQIO(SILNTOUT,"Missing (Failed Copy)")
337 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"MOVE^TMGMGRST")
338 QUIT
339 ;
340 ;
341COPY(FROM,TO) ;
342 ;"Purpose: To copy file FROM to TO, getting directory path from $ZRO
343 ;"Input: FROM-- a filename without path or '.m' extension
344 ;" TO-- a filename without path or '.m' extension
345 ;"Result: 0: no error 1=error
346 ;
347 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"COPY^TMGMGRST")
348 NEW RESULT SET RESULT=0
349 I ZTOS'=7,ZTOS'=8 DO GOTO CPQ
350 . X "ZL @FROM ZS @TO"
351 ;
352 ;"For GT.M below
353 ;"--------------
354 ;
355 N PATH,COPY
356 SET FROM=$GET(FROM)_".m"
357 SET TO=$TR($GET(TO),"%","_")_".m"
358 S PATH=$$GETPATH(.FROM)
359 IF PATH="" SET RESULT=1 GOTO CPQ ;"QUIT 1
360 IF $EXTRACT(PATH,$LENGTH(PATH))'="/" SET PATH=PATH_"/" ;"Ensure path ends in '/'.
361 S COPY=$S(ZTOS=7:"COPY",1:"cp")
362 ZSYSTEM COPY_" "_PATH_FROM_" "_PATH_TO
363 SET RESULT=$ZSYSTEM
364 ;
365 ;"IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBIndent,"M2")
366 ;
367 ;
368CPQ
369 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"COPY^TMGMGRST")
370 QUIT RESULT
371 ;
372GETPATH(FILE)
373 ;"Note: This function is for GTM, which has a path sequence that may be searched for files.
374 ;"Purpose: To take file, and look through file path to determine which path the file
375 ;" exists in.
376 ;" e.g. if $ZRO="ObjDir1(SourceDir1 SourceDir2) ObjDir2(SourceDir3 SourceDir4)"
377 ;" then this function will look in SourceDir's 1..4 to see which one contains
378 ;" FILE. Functions will return the appropriate SourceDir
379 ;"Input:FILE: the filename to look for, with extension. e.g. "XUP.m"
380 ;"Result: Will return the source directory, e.g. /usr/local/OpenVistA/r
381 ;
382 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"GETPATH^TMGMGRST")
383 NEW LASTDIR SET LASTDIR=""
384 NEW RESULT SET RESULT=""
385 NEW PATH SET PATH=""
386 ;
387 FOR DO QUIT:(RESULT'="")!(LASTDIR="")
388 . SET LASTDIR=$$R(LASTDIR)
389 . IF LASTDIR="" QUIT
390 . ;"DO OUTP^TMGQIO(SILNTOUT,"!","Looking in: ",LASTDIR)
391 . SET PATH=LASTDIR
392 . IF $$FEXISTS(PATH,FILE) DO
393 . . SET RESULT=PATH
394 . ELSE DO
395 ;
396 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"GETPATH^TMGMGRST")
397 QUIT RESULT
398 ;
399 ;
400R(LASTDIR) ; routine directory for GT.M
401 ;"Notice: The comments here only apply to GTM for Linux (#8).
402 ;" I don't have details about GT.M for VMS (#7) so I have not implemented
403 ;" cyclic directory evaluation. LASTDIR will be ignored.
404 ;"INPUT: LASTDIR - OPTIONAL. This is the directory returned last time fuction called, to
405 ;" allow for cycling through all possible directories.
406 ;"NOTE: The Syntax for $ZRO is as follows:
407 ;" ObjectDir1(SourceDir1) ObjectDir2(SourceDir1 SourceDir2 ...) ObjectDir3() ObjectDir4
408 ;" This shows elements are separated by spaces.
409 ;" Note that each element starts with the directory for .o files
410 ;" Each object directory has an optional (SourceDir) immediately following it
411 ;" if (Dir) is present, it contains one or more source directories (separated by spaces)
412 ;" if () is empty (i.e. "()") then no source directory is available.
413 ;" if (Dir) is absent (i.e. ""), then object dir is used to search for source .m files
414 ;"Result: will return the next directory, or "" if none.
415 ;"
416 ;"IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"R^TMGMGRST")
417 NEW RESULT SET RESULT=""
418 SET LASTDIR=$GET(LASTDIR)
419 ;"if LASTDIR'="" W "Will look for dir AFTER ",LASTDIR,!
420 I ZTOS=7 DO
421 . SET RESULT=$P($ZRO,",",1)
422 IF ZTOS=8 DO ;"GT.M for Linux
423 . NEW SECTION
424 . NEW PRIORFND SET PRIORFND=0
425 . NEW ELEMENT SET ELEMENT=" "
426 . NEW DIVPTS ;"Array to hold cut points of $ZRO. Setup in GETSECTN
427 . SET DIVPTS("MAX")=0
428 . FOR SECTION=1:1 DO QUIT:(RESULT'="")!(SECTION>DIVPTS("MAX")+1)
429 . . SET ELEMENT=$$GETSECTN($ZRO,SECTION,.DIVPTS) ;"gets 'ObjDir(SrceDir1 SrceDir2 ...)' etc.
430 . . NEW SOURCES SET SOURCES=""
431 . . IF (ELEMENT["(")&(ELEMENT[")") DO
432 . . . SET SOURCES=$PIECE(ELEMENT,"(",2)
433 . . . SET SOURCES=$PIECE(SOURCES,")",1) ;"Get just (..) part -- the source file paths.
434 . . ELSE DO
435 . . . SET SOURCES=ELEMENT ;"i.e. for ObjectDir [i.e. not ObjectDir()] format.
436 . . IF (ELEMENT="")!(SOURCES="") QUIT
437 . . NEW PART
438 . . NEW PATH SET PATH=" "
439 . . FOR PART=1:1 DO QUIT:(RESULT'="")!(PATH="")
440 . . . SET PATH=$PIECE(SOURCES," ",PART) ;"returns 'SourceDir1' etc.
441 . . . IF PATH="" QUIT
442 . . . IF (LASTDIR="")!(PRIORFND) SET RESULT=PATH
443 . . . ELSE IF PATH=LASTDIR SET PRIORFND=1
444 ;
445 ;"OLDER CODE
446 ;". NEW temp
447 ;". SET temp=$ZRO
448 ;". IF $ZRO["(" DO
449 ;". SET temp=$P($ZRO,"(",2)
450 ;". SET temp=$P(temp,")",1)
451 ;". SET RESULT=$P(temp," ",1)_"/"
452 ;
453 ;"IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"R^TMGMGRST")
454
455 QUIT RESULT
456 ;
457 ;
458GETSECTN(S,NUM,DIVPTS)
459 ;"Purpose: To parse a string as follows:
460 ;" Expected format of S:
461 ;" ObjectDir(SourceDir1 SourceDir2 ...) ObjectDir2(SourceDir1 SourceDir2 ...) ...
462 ;" or ObjectDir ObjectDir2(SourceDir1 SourceDir2 ...) ObjectDir() ... etc.
463 ;" --- so major sections are divided by spaces, with optional () with optional contents.
464 ;" --- there is no nesting of parentheses.
465 ;" If NUM=1, return ObjectDir(SourceDir1 SourceDir2 ...)
466 ;" If NUM=2, return ObjectDir2(SourceDir1 SourceDir2 ...) etc.
467 ;" Notice: Spaces in ObjectDir name are NOT SUPPORTED
468 ;" Notice: If more than one space separates sections, will be treated as extra section
469 ;"INPUT: S -- string as above
470 ;" NUM -- the section number to get (1..n)
471 ;" DIVPTS -- [OPTIONAL] PASS BY REFERENCE. If empty, then will be filled
472 ;" with the indexes of the dividing spaces
473 ;" e.g. DIVPTS(1)=12 DIVPTS(2)=25 DIVPTS(3)=41 DIVPTS("MAX")=3
474 ;" If not empty, then this will be used return the requested section.
475 ;
476 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"GETSECTN^TMGMGRST")
477 ;
478 NEW RESULT SET RESULT=""
479 NEW START SET START=0
480 NEW END SET END=9999
481 NEW PTIDX SET PTIDX=0
482 NEW SECTION SET SECTION=0
483 NEW MAXIDX
484 ;
485 SET S=$GET(S)
486 SET NUM=$GET(NUM,0)
487 ;
488 ;Fill Array of division points if empty
489 IF $DATA(DIVPTS)'=11 DO
490 . NEW INPAREN SET INPAREN=0
491 . NEW I,CH
492 . FOR I=1:1:$LENGTH(S) DO
493 . . SET CH=$EXTRACT(S,I)
494 . . IF CH="(" SET INPAREN=1 QUIT
495 . . IF CH=")" SET INPAREN=0 QUIT
496 . . IF (CH=" ")&(INPAREN=0) DO
497 . . . SET PTIDX=PTIDX+1
498 . . . SET DIVPTS(PTIDX)=I
499 . . . SET DIVPTS("MAX")=PTIDX
500 ;
501 IF (NUM>0)&(NUM'>DIVPTS("MAX")+1) DO
502 . SET PTIDX=$ORDER(DIVPTS(0))
503 . ;" 1 2 3 <-- Section #'2
504 . ;"xxxxx xxxxxx xxxxx <-- sample S
505 . ;" ^ ^ <-- DIVPTS 1 & 2
506 . IF NUM>1 SET START=DIVPTS(NUM-1)+1 ;"default START=0
507 . IF NUM'>DIVPTS("MAX") SET END=DIVPTS(NUM)-1 ;"default END=9999
508 . SET RESULT=$EXTRACT(S,START,END)
509 ;
510 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"GETSECTN^TMGMGRST")
511 QUIT RESULT
512 ;
513 ;
514FEXISTS(PATH,FNAME)
515 ;"Purpose: To determine if file FNAME exists on HFS
516 ;"Input: PATH: full path up to, but not including, filename. e.g. '/home/user/'
517 ;" FNAME: name of the file to open. e.g. 'myfile.txt'
518 ;"Result: 1=file exists, 0=file doesn't exist
519 ;"IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"FEXISTS^TMGMGRST")
520 NEW RESULT SET RESULT=0
521 IF ($DATA(PATH)'=0)!($DATA(FNAME)'=0) DO
522 . NEW HANDLE SET HANDLE=""
523 . DO OPEN^%ZISH(HANDLE,PATH,FNAME,"R") ;"Try to access file
524 . IF POP=0 DO ;"POP=0 means file opened, ergo file exists.
525 . . SET RESULT=1
526 . . DO CLOSE^%ZISH(HANDLE) ;"close file... we don't need it.
527 ;"IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"FEXISTS^TMGMGRST")
528 QUIT RESULT
529 ;
530 ;
531SPLITF(IN,PATH,FNAME,NODEDIV)
532 ;"Purpose: To take a string with path and filename and
533 ;" cleave into a path string and a filename string
534 ;"Input: IN: Initial string to parse. e.g. /home/user1/somefile.txt
535 ;" PATH & FNAME: vars SHOULD BE PASSED BY REFERENCE -- to take out results
536 ;" The character used to divide nodes, e.g. '/' OPTIONAL .. defaults to '/'
537 ;"Output:PATH: the path part of IN, e.g. '/home/user1/'
538 ;" FNAME: the filename part of IN, e.g. 'somefile.txt'
539 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"SPLITF^TMGMGRST")
540 SET NODEDIV=$GET(NODEDIV,"/")
541 SET PATH=$GET(PATH)
542 SET FNAME=$GET(IN)
543 NEW DONE SET DONE=0
544 FOR DO QUIT:(DONE=1)
545 IF FNAME[NODEDIV DO
546 . SET PATH=PATH_$PIECE(FNAME,NODEDIV,1)_NODEDIV
547 . SET FNAME=$PIECE(FNAME,NODEDIV,2,256)
548 ELSE SET DONE=1
549 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"SPLITF^TMGMGRST")
550 QUIT
551 ;
552 ;
553DES
554 S %D="%ZOSV^%ZTBKC1^%ZIS4^%ZISF^%ZISH^%XUCI^ZISETUP"
555 Q
556 ;
557 ;
558GLOBALS ;Set node zero of file #3.05 & #3.07
559 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"GLOBALS^TMGMGRST")
560 DO OUTP^TMGQIO(SILNTOUT,"!","!","Now, I will check your % globals.")
561 DO OUTP^TMGQIO(SILNTOUT,"..........")
562 F %="^%ZIS","^%ZISL","^%ZTER","^%ZUA" S:'$D(@%) @%=""
563 S:$D(^%ZTSK(0))[0 ^%ZTSK(-1)=100,^%ZTSCH=""
564 S Z1=$G(^%ZTSK(-1),-1),Z2=$G(^%ZTSK(0))
565 I Z1'=$P(Z2,"^",3) S:Z1'>0 ^%ZTSK(-1)=+Z2 S ^%ZTSK(0)="TASK'S^14.4^"_^%ZTSK(-1)
566 S:$D(^%ZUA(3.05,0))[0 ^%ZUA(3.05,0)="FAILED ACCESS ATTEMPTS LOG^3.05^^"
567 S:$D(^%ZUA(3.07,0))[0 ^%ZUA(3.07,0)="PROGRAMMER MODE LOG^3.07^^"
568 DO OUTP^TMGQIO(SILNTOUT,"... Done")
569 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"GLOBALS^TMGMGRST")
570 Q
571 ;
572 ;
573NAME() ;Setup the static names for this system
574 ;"Input -- none
575 ;"Result -- 0=normal exit 1=error
576 ;
577 ;"WRITE "IN CUSTOM NAME FUNCTION",!
578 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"NAME^TMGMGRST")
579 ;
580 NEW RETRY SET RETRY=0
581 NEW ABORT SET ABORT=0
582 NEW RESULT SET RESULT=1
583 ;
584MGR
585 IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBIndent,"M1")
586
587 IF ABORT=1 GOTO NMQ
588 SET RETRY=0
589 DO OUTP^TMGQIO(SILNTOUT,"!","!","ENTER NAME OF MANAGER'S UCI,VOLUME SET: "_^%ZOSF("MGR")_"// ")
590 DO INP^TMGQIO(.X,SILENTIN,$G(DTIME,9999),$get(INFO("MGR-UCI,VOL")))
591 IF X="" SET X=^%ZOSF("MGR")
592 IF X="^" DO OUTP^TMGQIO(SILNTOUT,"!","SKIPPING...") GOTO NMQ
593 I X]"" DO IF (RETRY=1) goto MGR
594 . X ^("UCICHECK")
595 . IF 0[Y DO
596 . . SET RETRY=1
597 . . IF SILENTIN=1 DO
598 . . . DO OUTP^TMGQIO(SILNTOUT,"!","Invalid Manager's UCI,VOLUME SET")
599 . . . SET ABORT=1
600 S ^%ZOSF("MGR")=X
601 ;
602 IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBIndent,"M2")
603 ;
604PROD
605 IF ABORT=1 GOTO NMQ
606 SET RETRY=0
607 DO OUTP^TMGQIO(SILNTOUT,"!","ENTER PRODUCTION (SIGN-ON) UCI,VOLUME SET: "_^%ZOSF("PROD")_"// ")
608 DO INP^TMGQIO(.X,SILENTIN,$S($G(DTIME):DTIME,1:9999),$get(INFO("SIGNON-UCI,VOL")))
609 IF X="" SET X=^%ZOSF("PROD")
610 IF X="^" DO OUTP^TMGQIO(SILNTOUT,"!","SKIPPING...") GOTO NMQ
611 I X]"" DO IF (RETRY=1) goto PROD
612 . X ^("UCICHECK")
613 . IF 0[Y DO
614 . . DO OUTP^TMGQIO(SILNTOUT,"!","Invalid Sign-On UCI,VOLUME SET","!")
615 . . SET RETRY=1
616 . . IF SILENTIN=1 SET ABORT=1
617 S ^%ZOSF("PROD")=X
618 ;
619 IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBIndent,"M3")
620 ;
621VOL
622 IF ABORT=1 GOTO NMQ
623 SET RETRY=0
624 DO OUTP^TMGQIO(SILNTOUT,"!","ENTER NAME OF VOLUME SET (use same volume set as for 'Production'): "_^%ZOSF("VOL")_"//")
625 DO INP^TMGQIO(.X,SILENTIN,$G(DTIME,9999),$get(INFO("VOLUME-SET")))
626 IF X="" SET X=^%ZOSF("VOL")
627 IF X="^" DO OUTP^TMGQIO(SILNTOUT,"!","SKIPPING...") GOTO NMQ
628 I X]"" DO IF (RETRY=1) goto VOL
629 . IF (X'?3U)!(^%ZOSF("PROD")'[X) DO
630 . . DO OUTP^TMGQIO(SILNTOUT,"MUST be 3 upper-case letters.")
631 . . DO OUTP^TMGQIO(SILNTOUT,"Also, MUST be same Volume Set entered above.")
632 . . SET RETRY=1
633 . . IF SILENTIN=1 DO
634 . . . DO OUTP^TMGQIO(SILNTOUT,"!","Invalid VOLUME SET")
635 . . . SET ABORT=1
636 SET ^%ZOSF("VOL")=X
637 ;
638 IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBIndent,"M4")
639 ;
640 ;"KT copied/modified TMP section from ZOSFGUX (GT.M/Linux specific)
641TMP ;Get the temp directory
642 IF ABORT=1 GOTO NMQ
643 IF $GET(ZTOS)=8 DO GOTO TMP:(RETRY=1)
644 . DO OUTP^TMGQIO(SILNTOUT,"!","Enter the temp directory for the system: '"_^%ZOSF("TMP")_"'//")
645 . DO INP^TMGQIO(.X,SILENTIN,$S($G(DTIME):DTIME,1:9999),$get(INFO("TEMP")))
646 . IF X="" SET X=^%ZOSF("TMP")
647 . IF SILENTIN=0 SET ABORT=1 QUIT
648 . ELSE DO QUIT:(RETRY=1)!(ABORT=1)
649 . . IF X="" SET ABORT=1 DO OUTP^TMGQIO(SILNTOUT,"SKIPPING...") QUIT
650 . . IF X'?1"/".E SET RETRY=1 QUIT
651 . S ^%ZOSF("TMP")=X
652 . DO OUTP^TMGQIO(SILNTOUT,"!","^%ZOSF setup")
653
654 DO OUTP^TMGQIO(SILNTOUT,"!")
655 SET RESULT=0
656
657 IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBIndent,"M5")
658
659NMQ
660 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"NAME^TMGMGRST")
661 QUIT RESULT
662 ;
663 ;
664 ;"=====================================================================================
665 ;"=====================================================================================
666 ;"=====================================================================================
667 ;"Note: ZOSFGUX used to be a separate file. I included it here for modification.
668
669ZOSFGUX ;SFISC/MVB,PUG/TOAD - ZOSF Table for GT.M for Unix ;10 Feb 2003 6:37 pm
670 ;;8.0;KERNEL;**275**;Jul 10, 1995
671 ;; for GT.M for Unix, version 4.3
672 ;
673 IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"ZOSFGUX^TMGMGRST")
674 S %Y=1
675 S DTIME=$G(DTIME,600)
676 K ^%ZOSF("MASTER"),^%ZOSF("SIGNOFF")
677 I $get(^%ZOSF("VOL"))="" S ^%ZOSF("VOL")="ROU"
678 ;"I '$D(^%ZOSF("VOL")) S ^%ZOSF("VOL")="ROU"
679 K ZO
680 F I="MGR","PROD","VOL","TMP" DO
681 . IF $D(^%ZOSF(I)) SET ZO(I)=^%ZOSF(I)
682 F I=1:2 DO QUIT:Z=""
683 . S Z=$P($TEXT(Z+I),";;",2)
684 . Q:Z=""
685 . S X=$P($TEXT(Z+1+I),";;",2,99)
686 . IF Z="OS" S $P(^%ZOSF(Z),"^")=X
687 . IF Z'="OS" S ^%ZOSF(Z)=$S($D(ZO(Z)):ZO(Z),1:X)
688 ;
689OS2 ;"was OS when this was a separate file.
690 S ^%ZOSF("OS")="GT.M (Unix)^19"
691 ;
692 ;
693 ;"I (KT) found the original code for Prod,Vol etc to be same as the NAME function in ZTMGRSET, so
694 ;" I'll just use the modifications already made there. I will add the TMP part to NAME()
695 IF $$NAME()=1 GOTO ZXQUIT ;"Note, I'm not here making note error returned (doesn't do anything)
696
697ZXQUIT
698 IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"ZOSFGUX^TMGMGRST")
699 ;"write "LEAVING CUSTOM ZOSF",!
700 Q
701 ;
702 ;
703Z ;
704 ;;ACTJ
705 ;;S Y=$$ACTJ^%ZOSV()
706 ;;AVJ
707 ;;S Y=$$AVJ^%ZOSV()
708 ;;BRK
709 ;;U $I:(CENABLE)
710 ;;DEL
711 ;;N %RD,%OD S %RD=$P($S($ZRO["(":$P($P($ZRO,"(",2),")"),1:$ZRO)," ")_"/",%OD=$S($ZRO["(":$P($ZRO,"(",1)_"/",1:%RD) ZSYSTEM "rm -f "_%RD_X_".m" ZSYSTEM "rm -f "_%OD_X_".o"
712 ;;EOFF
713 ;;U $I:(NOECHO)
714 ;;EON
715 ;;U $I:(ECHO)
716 ;;EOT
717 ;;S Y=$ZA\1024#2 ; <=====
718 ;;ERRTN
719 ;;^%ZTER
720 ;;ETRP
721 ;;Q
722 ;;GD
723 ;;G ^%GD
724 ;;$INC
725 ;;0
726 ;;JOBPARAM
727 ;;G JOBPAR^%ZOSV
728 ;;LABOFF
729 ;;U IO:(NOECHO) ; <=====
730 ;;LOAD
731 ;;D LOAD^%ZOSV2(X) ;S %N=0 F XCNP=XCNP+1:1 S %N=%N+1,%=$T(+%N^@X) Q:$L(%)=0 S @(DIF_XCNP_",0)")=%
732 ;;LPC
733 ;;S Y="" ; <=====
734 ;;MAGTAPE
735 ;;S %MT("BS")="*1",%MT("FS")="*2",%MT("WTM")="*3",%MT("WB")="*4",%MT("REW")="*5",%MT("RB")="*6",%MT("REL")="*7",%MT("WHL")="*8",%MT("WEL")="*9" ; <=====
736 ;;MAXSIZ
737 ;;Q
738 ;;MGR
739 ;;VAH,ROU
740 ;;MTBOT
741 ;;S Y=$ZA\32#2 ; <=====
742 ;;MTERR
743 ;;S Y=$ZA\32768#2 ; <=====
744 ;;MTONLINE
745 ;;S Y=$ZA\64#2 ; <=====
746 ;;MTWPROT
747 ;;S Y=$ZA\4#2 ; <=====
748 ;;NBRK
749 ;;U $I:(NOCENABLE)
750 ;;NO-PASSALL
751 ;;U $I:(NOPASSTHRU)
752 ;;NO-TYPE-AHEAD
753 ;;U $I:(NOTYPEAHEAD)
754 ;;PASSALL
755 ;;U $I:(PASSTHRU)
756 ;;PRIINQ
757 ;;S Y=$$PRIINQ^%ZOSV()
758 ;;PRIORITY
759 ;;QUIT ;G PRIORITY^%ZOSV
760 ;;PROD
761 ;;VAH,ROU
762 ;;PROGMODE
763 ;;S Y=$$PROGMODE^%ZOSV()
764 ;;RD
765 ;;G ^%RD
766 ;;RESJOB
767 ;;Q:'$D(DUZ) Q:'$D(^XUSEC("XUMGR",+DUZ)) N XQZ S XQZ="^FORCEX[MGR]" D DO^%XUCI ; <=====
768 ;;RM
769 ;;U $I:WIDTH=$S(X<256:X,1:0)
770 ;;RSEL
771 ;;K ^UTILITY($J) D ^%RSEL S X="" X "F S X=$O(%ZR(X)) Q:X="""" S ^UTILITY($J,X)=""""" K %ZR
772 ;;RSUM
773 ;;S Y=0 F %=1,3:1 S %1=$T(+%^@X),%3=$F(%1," ") Q:'%3 S %3=$S($E(%1,%3)'=";":$L(%1),$E(%1,%3+1)=";":$L(%1),1:%3-2) F %2=1:1:%3 S Y=$A(%1,%2)*%2+Y
774 ;;SS
775 ;;D ^ZSY
776 ;;SAVE
777 ;;D SAVE^%ZOSV2(X) ;N %I,%F S %I=$I,%F=$P($S($ZRO["(":$P($P($ZRO,"(",2),")"),1:$ZRO)," ")_"/"_X_".m" O %F:(NEWVERSION) U %F X "F S XCN=$O(@(DIE_XCN_"")"")) Q:+XCN'=XCN S %=@(DIE_XCN_"",0)"") Q:$E(%,1)=""$"" I $E(%)'="";"" W %,!" C %F U %I
778 ;;SIZE
779 ;;S Y=0 F I=1:1 S %=$T(+I) Q:%="" S Y=Y+$L(%)+2 ; <=====
780 ;;TEST
781 ;;I X]"",$T(^@X)]""
782 ;;TMK
783 ;;S Y=$ZA\16384#2
784 ;;TMP
785 ;;/tmp/
786 ;;TRAP
787 ;;$ZT="G "_X
788 ;;TRMOFF
789 ;;U $I:(TERMINATOR="")
790 ;;TRMON
791 ;;U $I:(TERMINATOR=$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,127))
792 ;;TRMRD
793 ;;S Y=$A($ZB)
794 ;;TYPE-AHEAD
795 ;;U $I:(TYPEAHEAD)
796 ;;UCI
797 ;;S Y=^%ZOSF("PROD")
798 ;;UCICHECK
799 ;;S Y=1
800 ;;UPPERCASE
801 ;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
802 ;;XY
803 ;;S $X=DX,$Y=DY ; <=====
804 ;;VOL
805 ;;ROU
806 ;;ZD
807 ;;S Y=$$HTE^XLFDT(X,2) I $L($P(Y,"/"))=1 S Y=0_Y
Note: See TracBrowser for help on using the repository browser.