ZINDX52.m

%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

%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