%INDX52 ;SF-ISC/RWF - Add to list other routines called ;11/29/93 12:27 ;
;;7.3;TOOLKIT;;Apr 25, 1995
L1 S RTN="$",INDLC=0
F I=0:0 S RTN=$O(^UTILITY($J,1,RTN)) Q:RTN="" I '$D(^(RTN,52)) S ^(52)=1,S="$" F J=0:0 S S=$O(^UTILITY($J,1,RTN,"X",S)) Q:S="" D L21
S RTN="$",F52=0
F I52=0:0 S RTN=$O(^UTILITY($J,RTN)) Q:RTN="" I RTN'=1,'$D(^UTILITY($J,1,RTN)) D LOAD^%INDEX,BEG^%INDEX S F52=1
G L1:F52
K I52,F52 Q
L21 S X=$P(S," ") Q:$E(X)="%" Q:$D(^UTILITY($J,1,X)) Q:"DD^DI^XM"[$E(X,1,2) Q:"XQ^XQ1^XUS^"[$E(X,1,8)
X ^%ZOSF("TEST") Q:'$T ;I '$T S LAB=$P(^UTILITY($J,1,RTN,"X",S,0),",",1),LABO=0,ERR="W - Routine "_X_" is not in the current Account." G ^%INDX1
S ^UTILITY($J,X)="" Q
CASE ;Convert LC to UC.
S CM=$TR(CM,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZINDX52 803 printed Dec 13, 2024@02:42:37 Page 2
%INDX52 ;SF-ISC/RWF - Add to list other routines called ;11/29/93 12:27 ;
+1 ;;7.3;TOOLKIT;;Apr 25, 1995
L1 SET RTN="$"
SET INDLC=0
+1 FOR I=0:0
SET RTN=$ORDER(^UTILITY($JOB,1,RTN))
if RTN=""
QUIT
IF '$DATA(^(RTN,52))
SET ^(52)=1
SET S="$"
FOR J=0:0
SET S=$ORDER(^UTILITY($JOB,1,RTN,"X",S))
if S=""
QUIT
DO L21
+2 SET RTN="$"
SET F52=0
+3 FOR I52=0:0
SET RTN=$ORDER(^UTILITY($JOB,RTN))
if RTN=""
QUIT
IF RTN'=1
IF '$DATA(^UTILITY($JOB,1,RTN))
DO LOAD^%INDEX
DO BEG^%INDEX
SET F52=1
+4 if F52
GOTO L1
+5 KILL I52,F52
QUIT
L21 SET X=$PIECE(S," ")
if $EXTRACT(X)="%"
QUIT
if $DATA(^UTILITY($JOB,1,X))
QUIT
if "DD^DI^XM"[$EXTRACT(X,1,2)
QUIT
if "XQ^XQ1^XUS^"[$EXTRACT(X,1,8)
QUIT
+1 ;I '$T S LAB=$P(^UTILITY($J,1,RTN,"X",S,0),",",1),LABO=0,ERR="W - Routine "_X_" is not in the current Account." G ^%INDX1
XECUTE ^%ZOSF("TEST")
if '$TEST
QUIT
+2 SET ^UTILITY($JOB,X)=""
QUIT
CASE ;Convert LC to UC.
+1 SET CM=$TRANSLATE(CM,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+2 QUIT
