XINDX52.m

XINDX52 ;SF-ISC/RWF - Add to list other routines called ;02/06/97  16:45 [ 04/02/2003   8:47 AM ]

 ;;7.3;TOOLKIT;**1001**;APR 1, 2003

 ;;7.3;TOOLKIT;**20**;Apr 25, 1995

L1 S RTN="$",INDLC=0

 ;Loop thru routines and see what is called

 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

 ;Look for routines that haven't been INDEXed

 F I52=0:0 S RTN=$O(^UTILITY($J,RTN)) Q:RTN=""  I RTN'=1,'$D(^UTILITY($J,1,RTN)) D LOAD^XINDEX,BEG^XINDEX S F52=1

 G L1:F52

 K I52,F52 Q

L21 ;Check that should add to list

 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 ^XINDX1

 S ^UTILITY($J,X)="" Q

CASE(%) ;Convert LC to UC.

 Q $TR(%,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

XINDX52   ;SF-ISC/RWF - Add to list other routines called ;02/06/97  16:45 [ 04/02/2003   8:47 AM ]

 +1       ;;7.3;TOOLKIT;**1001**;APR 1, 2003

 +2       ;;7.3;TOOLKIT;**20**;Apr 25, 1995

L1         SET RTN="$"

           SET INDLC=0

 +1       ;Loop thru routines and see what is called

 +2        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

 +3        SET RTN="$"

           SET F52=0

 +4       ;Look for routines that haven't been INDEXed

 +5        FOR I52=0:0

               SET RTN=$ORDER(^UTILITY($JOB,RTN))

               IF RTN=""

                   QUIT 

               IF RTN'=1

                   IF '$DATA(^UTILITY($JOB,1,RTN))

                       DO LOAD^XINDEX

                       DO BEG^XINDEX

                       SET F52=1

 +6        IF F52

               GOTO L1

 +7        KILL I52,F52

           QUIT 

L21       ;Check that should add to list

 +1        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 

 +2       ;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 ^XINDX1

           XECUTE ^%ZOSF("TEST")

           IF '$TEST

               QUIT 

 +3        SET ^UTILITY($JOB,X)=""

           QUIT 

CASE(%)   ;Convert LC to UC.

 +1        QUIT $TRANSLATE(%,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")