XINDX52.m

XINDX52 ;SF-ISC/RWF - Add to list other routines called ;3/26/98  08:43

 ;;7.3;TOOLKIT;**20,140**;Apr 25, 1995;Build 40

 ; Per VHA Directive 2004-038, this routine should not be modified.

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

 I X'["&",X'["@" S ^UTILITY($J,X)="" Q

CASE(%) ;Convert LC to UC.

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XINDX52   935     printed  Apr 09, 2024@21:43:48                                                                                                                                                                                                      Page 2

XINDX52   ;SF-ISC/RWF - Add to list other routines called ;02/06/97  16:45

 +1       ;;7.3;TOOLKIT;**20**;Apr 25, 1995;Build 4

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")