- 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 ---[H[J[2J[HXINDX52 935 printed Feb 19, 2025@00:06:33 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")
