- XINDEX ;ISC/REL,GFT,GRK,RWF - INDEX & CROSS-REFERENCE ;08/04/08 13:19
- ;;7.3;TOOLKIT;**20,27,48,61,66,68,110,121,128,132,133**;Apr 25, 1995;Build 16
- ; Per VHA Directive 2004-038, this routine should not be modified.
- G ^XINDX6
- SEP F I=1:1 S CH=$E(LIN,I) D QUOTE:CH=Q Q:" "[CH
- S ARG=$E(LIN,1,I-1) S:CH=" " I=I+1 S LIN=$E(LIN,I,999) Q
- QUOTE F I=I+1:1 S CH=$E(LIN,I) Q:CH=""!(CH=Q)
- Q:CH]"" S ERR=6 G ^XINDX1
- ALIVE ;enter here from taskman
- D SETUP^XINDX7 ;Get ready to process
- A2 S RTN=$O(^UTILITY($J,RTN)) G ^XINDX5:RTN=""
- S INDLC=(RTN?1"|"1.4L.NP) D LOAD:'INDLC&'$D(^UTILITY($J,1,RTN,0))
- I $D(ZTQUEUED),$$S^%ZTLOAD S RTN="~",IND("QUIT")=1,ZTSTOP=1 G A2
- I 'INDDS,INDLC W !!?10,"Data Dictionaries",! S INDDS=1
- D BEG
- G A2
- ;
- LOAD S X=RTN,XCNP=0,DIF="^UTILITY("_$J_",1,RTN,0," X ^%ZOSF("TEST") Q:'$T X ^%ZOSF("LOAD") S ^UTILITY($J,1,RTN,0,0)=XCNP-1
- I $D(^UTILITY($J,1,RTN,0,0)) S ^UTILITY($J,1,RTN,"RSUM")="B"_$$SUMB^XPDRSUM($NA(^UTILITY($J,1,RTN,0)))
- Q
- BEG ;
- S %=INDLC*5 W:$X+10+%>IOM ! W RTN,$J("",10+%-$L(RTN))
- S (IND("DO"),IND("SZT"),IND("SZC"),LABO)=0,LC=$G(^UTILITY($J,1,RTN,0,0))
- I LC="" W !,">>>Routine '",RTN,"' not found <<<",! Q
- S TXT="",LAB=$P(^UTILITY($J,1,RTN,0,1,0)," ") I RTN'=$P(LAB,"(") D E^XINDX1(17)
- I 'INDLC,LAB["(" D E^XINDX1(55) S LAB=$P(LAB,"(")
- ;if M routine(not compiled template or DD) and has more than 2 lines, check lines 1 & 2
- I 'INDLC,LC>2 D
- . N LABO S LABO=1
- . S LIN=$G(^UTILITY($J,1,RTN,0,1,0)),TXT=1
- . ;check 1st line (site/dev - ) patch 128
- . I $P(LIN,";",2,4)'?.E1"/".E.1"-".E D E^XINDX1(62)
- . S LIN=$G(^UTILITY($J,1,RTN,0,2,0)),TXT=2
- . ;check 2nd line (;;nn.nn[TV]nn;package;.anything)
- . I $P(LIN,";",3,99)'?1.2N1"."1.2N.1(1"T",1"V").2N1";"1A.APN1";".E D E^XINDX1(44) ;patch 132
- . I $L(INP(11)) X INP(11) ;Version number check
- . I $L(INP(12)) X INP(12) ;Patch number check
- B5 F TXT=1:1:LC S LIN=^UTILITY($J,1,RTN,0,TXT,0),LN=$L(LIN),IND("SZT")=IND("SZT")+LN+2 D LN,ST ;Process Line
- S LAB="",LABO=0,TXT=0,^UTILITY($J,1,RTN,0)=IND("SZT")_"^"_LC_"^"_IND("SZC")
- I IND("SZT")>INP("MAX"),'INDLC S ERR=35,ERR(1)=IND("SZT") D ^XINDX1
- I IND("SZT")-IND("SZC")>INP("CMAX"),'INDLC S ERR=58,ERR(1)=IND("SZT")-IND("SZC") D ^XINDX1
- D POSTRTN
- Q
- ;Proccess one line, LN = Length, LIN = Line.
- LN K V S (ARG,GRB,IND("COM"),IND("DOL"),IND("F"))="",X=$P(LIN," ")
- I '$L(X) S LABO=LABO+1 G CD
- S (IND("COM"),LAB)=$P(X,"("),ARG=$P($P(X,"(",2),")"),LABO=0,IND("PP")=X?1.8E1"(".E1")"
- D:$L(ARG) NE^XINDX3 ;Process formal parameters as New list.
- I 'INDLC,'$$VT^XINDX2(LAB) D E^XINDX1($S(LAB=$$CASE^XINDX52(LAB):37,1:55)) ;Check for bad labels
- I $D(^UTILITY($J,1,RTN,"T",LAB)) D E^XINDX1(15) G CD ;DUP label
- S ^UTILITY($J,1,RTN,"T",LAB)=""
- CD I LN>245 D:'(LN=246&($E(RTN,1,3)="|dd")) E^XINDX1(19) ;patch 119
- D:LIN'?1.ANP E^XINDX1(18)
- S LIN=$P(LIN," ",2,999),IND("LCC")=1
- I LIN="" D E^XINDX1(42) Q ;Blank line ;p110
- S I=0 ;Watch the scope of I, counts dots
- I " ."[$E(LIN) D S X=$L($E(LIN,1,I),".")-1,LIN=$E(LIN,I,999)
- . F I=1:1:245 Q:". "'[$E(LIN,I)
- . Q
- ;check dots against Do level IND("DO"), IND("DOL")=dot level
- D:'I&$G(IND("DO1")) E^XINDX1(51) S IND("DO1")=0 S:'I IND("DO")=0
- I I D:X>IND("DO") E^XINDX1(51) S (IND("DO"),IND("DOL"))=X
- ;Count Comment lines, skip ;; lines
- I $E(LIN)=";",$E(LIN,2)'=";" S IND("SZC")=IND("SZC")+$L(LIN) ;p110
- ;Process commands on line.
- EE I LIN="" D ^XINDX2 Q
- S COM=$E(LIN),GK="",ARG=""
- I COM=";" S LIN="" G EE ;p110
- I COM=" " S ERR=$S(LIN?1." ":13,1:0),LIN=$S(ERR:"",1:$E(LIN,2,999)) D:ERR ^XINDX1 G EE
- D SEP
- S CM=$P(ARG,":",1),POST=$P(ARG,":",2,999),IND("COM")=IND("COM")_$C(9)_COM,ERR=48
- D:ARG[":"&(POST']"") ^XINDX1 S:POST]"" GRB=GRB_$C(9)_POST,IND("COM")=IND("COM")_":"
- ;SAC now allows lowercase commands
- I CM?.E1L.E S CM=$$CASE^XINDX52(CM),COM=$E(CM) ;I IND("LCC") S IND("LCC")=0 D E^XINDX1(47)
- I CM="" D E^XINDX1(21) G EE ;Missing command
- S CX=$G(IND("CMD",CM)) I CX="" D G:CX="" EE
- . I $E(CM)="Z" S CX="^Z" Q ;Proccess Z commands
- . D E^XINDX1(1) S LIN="" Q
- S CX=$P(CX,"^",2,9)
- D SEP I '$L(LIN),CH=" " D E^XINDX1(13) ;trailing space
- I ARG="","CGJMORSUWX"[COM S ERR=49 G ^XINDX1
- I CX>0 D E^XINDX1(CX) S CX=""
- D:$L(CX) @CX S:ARG'="" GRB=GRB_$C(9)_ARG G EE
- B S ERR=25 G ^XINDX1
- C S ERR=29 G ^XINDX1
- D G DG1^XINDX4
- E Q:ARG="" S ERR=7 G ^XINDX1
- F G:ARG]"" FR^XINDX4 S IND("F")=1 Q
- G G DG^XINDX4
- H Q:ARG'="" S ERR=32 G ^XINDX1
- J S ERR=36,ARG="" G ^XINDX1
- K S ERR=$S(ARG?1"(".E:22,ARG?." ":23,1:0) D:ERR ^XINDX1
- G KL^XINDX3
- L G LO^XINDX4
- M G S^XINDX3
- N G NE^XINDX3
- O S ERR=34 D ^XINDX1,O^XINDX3 Q
- Q Q:ARG="" G Q^XINDX4
- R S RDTIME=0 G RD^XINDX3
- S G S^XINDX3
- TR Q ;What to process. p110
- U S ARG=$S("$"'=$E(ARG):$P(ARG,":"),1:ARG) Q
- V S ARG="",ERR=20 G ^XINDX1
- W G WR^XINDX4
- X G XE^XINDX4
- Z S ERR=2 D ^XINDX1 G ZC^XINDX4
- ;
- ;Save off items from line.
- ST S R=LAB_$S(LABO:"+"_LABO,1:"")
- ;Local variable, Global, Marked Items, Naked global, Internal ref, eXternal ref., Tag ref.
- S LOC="" F S LOC=$O(V(LOC)),S="" Q:LOC="" F S S=$O(V(LOC,S)) Q:S="" D SET
- S ^UTILITY($J,1,RTN,"COM",TXT)=IND("COM")
- Q
- ;
- SET I V(LOC,S)]"" F %="!","~" I V(LOC,S)[%,$G(^UTILITY($J,1,RTN,LOC,S))'[% S ^(S)=$G(^(S))_%
- S %=0
- SE2 S ARG=$G(^UTILITY($J,1,RTN,LOC,S,%)) I $L(ARG)>230 S %=%+1 G SE2
- S ^UTILITY($J,1,RTN,LOC,S,%)=ARG_R_V(LOC,S)_","
- Q
- ;
- POSTRTN ;Do more overall checking
- N V,E,T,T1,T2
- S T="" ;Check for missing Labels
- F S T=$O(^UTILITY($J,1,RTN,"I",T)),T2=T Q:T="" S T1=$G(^(T,0)) D
- . Q:$E(T2,1,2)="@("
- . S:$E(T2,1,2)="$$" T2=$E(T2,3,99)
- . I T2]"",'$D(^UTILITY($J,1,RTN,"T",$P(T2,"+",1))) D
- . . F I=1:1:$L(T1,",")-1 S LAB=$P(T1,",",I),LABO=+$P(LAB,"+",2),LAB=$P(LAB,"+"),E=14,E(1)=T D E^XINDX1(.E)
- . . Q
- . Q
- S LAB="",LABO=0 ;Check for valid label names
- I 'INDLC F S LAB=$O(^UTILITY($J,1,RTN,"T",LAB)) Q:LAB="" D
- . I '$$VA^XINDX2(LAB) D E^XINDX1(55) Q
- . D:'$$VT^XINDX2(LAB) E^XINDX1(37)
- . Q
- S LAB="",LABO=0 ;Check for valid variable names.
- F S LAB=$O(^UTILITY($J,1,RTN,"L",LAB)) Q:LAB="" D
- . D VLNF^XINDX3($P(LAB,"("))
- . Q
- Q
- ;
- QUICK ;Quick, Just get a routine an print the results
- D QUICK^XINDX6()
- Q
- XINDEX ;ISC/REL,GFT,GRK,RWF - INDEX & CROSS-REFERENCE ;08/04/08 13:19
- +1 ;;7.3;TOOLKIT;**20,27,48,61,66,68,110,121,128,132,133**;Apr 25, 1995;Build 16
- +2 ; Per VHA Directive 2004-038, this routine should not be modified.
- +3 GOTO ^XINDX6
- SEP FOR I=1:1
- SET CH=$EXTRACT(LIN,I)
- IF CH=Q
- DO QUOTE
- IF " "[CH
- QUIT
- +1 SET ARG=$EXTRACT(LIN,1,I-1)
- IF CH=" "
- SET I=I+1
- SET LIN=$EXTRACT(LIN,I,999)
- QUIT
- QUOTE FOR I=I+1:1
- SET CH=$EXTRACT(LIN,I)
- IF CH=""!(CH=Q)
- QUIT
- +1 IF CH]""
- QUIT
- SET ERR=6
- GOTO ^XINDX1
- ALIVE ;enter here from taskman
- +1 ;Get ready to process
- DO SETUP^XINDX7
- A2 SET RTN=$ORDER(^UTILITY($JOB,RTN))
- IF RTN=""
- GOTO ^XINDX5
- +1 SET INDLC=(RTN?1"|"1.4L.NP)
- IF 'INDLC&'$DATA(^UTILITY($JOB,1,RTN,0))
- DO LOAD
- +2 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET RTN="~"
- SET IND("QUIT")=1
- SET ZTSTOP=1
- GOTO A2
- +3 IF 'INDDS
- IF INDLC
- WRITE !!?10,"Data Dictionaries",!
- SET INDDS=1
- +4 DO BEG
- +5 GOTO A2
- +6 ;
- LOAD SET X=RTN
- SET XCNP=0
- SET DIF="^UTILITY("_$JOB_",1,RTN,0,"
- XECUTE ^%ZOSF("TEST")
- IF '$TEST
- QUIT
- XECUTE ^%ZOSF("LOAD")
- SET ^UTILITY($JOB,1,RTN,0,0)=XCNP-1
- +1 IF $DATA(^UTILITY($JOB,1,RTN,0,0))
- SET ^UTILITY($JOB,1,RTN,"RSUM")="B"_$$SUMB^XPDRSUM($NAME(^UTILITY($JOB,1,RTN,0)))
- +2 QUIT
- BEG ;
- +1 SET %=INDLC*5
- IF $X+10+%>IOM
- WRITE !
- WRITE RTN,$JUSTIFY("",10+%-$LENGTH(RTN))
- +2 SET (IND("DO"),IND("SZT"),IND("SZC"),LABO)=0
- SET LC=$GET(^UTILITY($JOB,1,RTN,0,0))
- +3 IF LC=""
- WRITE !,">>>Routine '",RTN,"' not found <<<",!
- QUIT
- +4 SET TXT=""
- SET LAB=$PIECE(^UTILITY($JOB,1,RTN,0,1,0)," ")
- IF RTN'=$PIECE(LAB,"(")
- DO E^XINDX1(17)
- +5 IF 'INDLC
- IF LAB["("
- DO E^XINDX1(55)
- SET LAB=$PIECE(LAB,"(")
- +6 ;if M routine(not compiled template or DD) and has more than 2 lines, check lines 1 & 2
- +7 IF 'INDLC
- IF LC>2
- Begin DoDot:1
- +8 NEW LABO
- SET LABO=1
- +9 SET LIN=$GET(^UTILITY($JOB,1,RTN,0,1,0))
- SET TXT=1
- +10 ;check 1st line (site/dev - ) patch 128
- +11 IF $PIECE(LIN,";",2,4)'?.E1"/".E.1"-".E
- DO E^XINDX1(62)
- +12 SET LIN=$GET(^UTILITY($JOB,1,RTN,0,2,0))
- SET TXT=2
- +13 ;check 2nd line (;;nn.nn[TV]nn;package;.anything)
- +14 ;patch 132
- IF $PIECE(LIN,";",3,99)'?1.2N1"."1.2N.1(1"T",1"V").2N1";"1A.APN1";".E
- DO E^XINDX1(44)
- +15 ;Version number check
- IF $LENGTH(INP(11))
- XECUTE INP(11)
- +16 ;Patch number check
- IF $LENGTH(INP(12))
- XECUTE INP(12)
- End DoDot:1
- B5 ;Process Line
- FOR TXT=1:1:LC
- SET LIN=^UTILITY($JOB,1,RTN,0,TXT,0)
- SET LN=$LENGTH(LIN)
- SET IND("SZT")=IND("SZT")+LN+2
- DO LN
- DO ST
- +1 SET LAB=""
- SET LABO=0
- SET TXT=0
- SET ^UTILITY($JOB,1,RTN,0)=IND("SZT")_"^"_LC_"^"_IND("SZC")
- +2 IF IND("SZT")>INP("MAX")
- IF 'INDLC
- SET ERR=35
- SET ERR(1)=IND("SZT")
- DO ^XINDX1
- +3 IF IND("SZT")-IND("SZC")>INP("CMAX")
- IF 'INDLC
- SET ERR=58
- SET ERR(1)=IND("SZT")-IND("SZC")
- DO ^XINDX1
- +4 DO POSTRTN
- +5 QUIT
- +6 ;Proccess one line, LN = Length, LIN = Line.
- LN KILL V
- SET (ARG,GRB,IND("COM"),IND("DOL"),IND("F"))=""
- SET X=$PIECE(LIN," ")
- +1 IF '$LENGTH(X)
- SET LABO=LABO+1
- GOTO CD
- +2 SET (IND("COM"),LAB)=$PIECE(X,"(")
- SET ARG=$PIECE($PIECE(X,"(",2),")")
- SET LABO=0
- SET IND("PP")=X?1.8E1"(".E1")"
- +3 ;Process formal parameters as New list.
- IF $LENGTH(ARG)
- DO NE^XINDX3
- +4 ;Check for bad labels
- IF 'INDLC
- IF '$$VT^XINDX2(LAB)
- DO E^XINDX1($SELECT(LAB=$$CASE^XINDX52(LAB):37,1:55))
- +5 ;DUP label
- IF $DATA(^UTILITY($JOB,1,RTN,"T",LAB))
- DO E^XINDX1(15)
- GOTO CD
- +6 SET ^UTILITY($JOB,1,RTN,"T",LAB)=""
- CD ;patch 119
- IF LN>245
- IF '(LN=246&($EXTRACT(RTN,1,3)="|dd"))
- DO E^XINDX1(19)
- +1 IF LIN'?1.ANP
- DO E^XINDX1(18)
- +2 SET LIN=$PIECE(LIN," ",2,999)
- SET IND("LCC")=1
- +3 ;Blank line ;p110
- IF LIN=""
- DO E^XINDX1(42)
- QUIT
- +4 ;Watch the scope of I, counts dots
- SET I=0
- +5 IF " ."[$EXTRACT(LIN)
- Begin DoDot:1
- +6 FOR I=1:1:245
- IF ". "'[$EXTRACT(LIN,I)
- QUIT
- +7 QUIT
- End DoDot:1
- SET X=$LENGTH($EXTRACT(LIN,1,I),".")-1
- SET LIN=$EXTRACT(LIN,I,999)
- +8 ;check dots against Do level IND("DO"), IND("DOL")=dot level
- +9 IF 'I&$GET(IND("DO1"))
- DO E^XINDX1(51)
- SET IND("DO1")=0
- IF 'I
- SET IND("DO")=0
- +10 IF I
- IF X>IND("DO")
- DO E^XINDX1(51)
- SET (IND("DO"),IND("DOL"))=X
- +11 ;Count Comment lines, skip ;; lines
- +12 ;p110
- IF $EXTRACT(LIN)=";"
- IF $EXTRACT(LIN,2)'=";"
- SET IND("SZC")=IND("SZC")+$LENGTH(LIN)
- +13 ;Process commands on line.
- EE IF LIN=""
- DO ^XINDX2
- QUIT
- +1 SET COM=$EXTRACT(LIN)
- SET GK=""
- SET ARG=""
- +2 ;p110
- IF COM=";"
- SET LIN=""
- GOTO EE
- +3 IF COM=" "
- SET ERR=$SELECT(LIN?1." ":13,1:0)
- SET LIN=$SELECT(ERR:"",1:$EXTRACT(LIN,2,999))
- IF ERR
- DO ^XINDX1
- GOTO EE
- +4 DO SEP
- +5 SET CM=$PIECE(ARG,":",1)
- SET POST=$PIECE(ARG,":",2,999)
- SET IND("COM")=IND("COM")_$CHAR(9)_COM
- SET ERR=48
- +6 IF ARG["
- DO ^XINDX1
- IF POST]""
- SET GRB=GRB_$CHAR(9)_POST
- SET IND("COM")=IND("COM")_":"
- +7 ;SAC now allows lowercase commands
- +8 ;I IND("LCC") S IND("LCC")=0 D E^XINDX1(47)
- IF CM?.E1L.E
- SET CM=$$CASE^XINDX52(CM)
- SET COM=$EXTRACT(CM)
- +9 ;Missing command
- IF CM=""
- DO E^XINDX1(21)
- GOTO EE
- +10 SET CX=$GET(IND("CMD",CM))
- IF CX=""
- Begin DoDot:1
- +11 ;Proccess Z commands
- IF $EXTRACT(CM)="Z"
- SET CX="^Z"
- QUIT
- +12 DO E^XINDX1(1)
- SET LIN=""
- QUIT
- End DoDot:1
- IF CX=""
- GOTO EE
- +13 SET CX=$PIECE(CX,"^",2,9)
- +14 ;trailing space
- DO SEP
- IF '$LENGTH(LIN)
- IF CH=" "
- DO E^XINDX1(13)
- +15 IF ARG=""
- IF "CGJMORSUWX"[COM
- SET ERR=49
- GOTO ^XINDX1
- +16 IF CX>0
- DO E^XINDX1(CX)
- SET CX=""
- +17 IF $LENGTH(CX)
- DO @CX
- IF ARG'=""
- SET GRB=GRB_$CHAR(9)_ARG
- GOTO EE
- B SET ERR=25
- GOTO ^XINDX1
- C SET ERR=29
- GOTO ^XINDX1
- D GOTO DG1^XINDX4
- E IF ARG=""
- QUIT
- SET ERR=7
- GOTO ^XINDX1
- F IF ARG]""
- GOTO FR^XINDX4
- SET IND("F")=1
- QUIT
- G GOTO DG^XINDX4
- H IF ARG'=""
- QUIT
- SET ERR=32
- GOTO ^XINDX1
- J SET ERR=36
- SET ARG=""
- GOTO ^XINDX1
- K SET ERR=$SELECT(ARG?1"(".E:22,ARG?." ":23,1:0)
- IF ERR
- DO ^XINDX1
- +1 GOTO KL^XINDX3
- L GOTO LO^XINDX4
- M GOTO S^XINDX3
- N GOTO NE^XINDX3
- O SET ERR=34
- DO ^XINDX1
- DO O^XINDX3
- QUIT
- Q IF ARG=""
- QUIT
- GOTO Q^XINDX4
- R SET RDTIME=0
- GOTO RD^XINDX3
- S GOTO S^XINDX3
- TR ;What to process. p110
- QUIT
- U SET ARG=$SELECT("$"'=$EXTRACT(ARG):$PIECE(ARG,":"),1:ARG)
- QUIT
- V SET ARG=""
- SET ERR=20
- GOTO ^XINDX1
- W GOTO WR^XINDX4
- X GOTO XE^XINDX4
- Z SET ERR=2
- DO ^XINDX1
- GOTO ZC^XINDX4
- +1 ;
- +2 ;Save off items from line.
- ST SET R=LAB_$SELECT(LABO:"+"_LABO,1:"")
- +1 ;Local variable, Global, Marked Items, Naked global, Internal ref, eXternal ref., Tag ref.
- +2 SET LOC=""
- FOR
- SET LOC=$ORDER(V(LOC))
- SET S=""
- IF LOC=""
- QUIT
- FOR
- SET S=$ORDER(V(LOC,S))
- IF S=""
- QUIT
- DO SET
- +3 SET ^UTILITY($JOB,1,RTN,"COM",TXT)=IND("COM")
- +4 QUIT
- +5 ;
- SET IF V(LOC,S)]""
- FOR %="!","~"
- IF V(LOC,S)[%
- IF $GET(^UTILITY($JOB,1,RTN,LOC,S))'[%
- SET ^(S)=$GET(^(S))_%
- +1 SET %=0
- SE2 SET ARG=$GET(^UTILITY($JOB,1,RTN,LOC,S,%))
- IF $LENGTH(ARG)>230
- SET %=%+1
- GOTO SE2
- +1 SET ^UTILITY($JOB,1,RTN,LOC,S,%)=ARG_R_V(LOC,S)_","
- +2 QUIT
- +3 ;
- POSTRTN ;Do more overall checking
- +1 NEW V,E,T,T1,T2
- +2 ;Check for missing Labels
- SET T=""
- +3 FOR
- SET T=$ORDER(^UTILITY($JOB,1,RTN,"I",T))
- SET T2=T
- IF T=""
- QUIT
- SET T1=$GET(^(T,0))
- Begin DoDot:1
- +4 IF $EXTRACT(T2,1,2)="@("
- QUIT
- +5 IF $EXTRACT(T2,1,2)="$$"
- SET T2=$EXTRACT(T2,3,99)
- +6 IF T2]""
- IF '$DATA(^UTILITY($JOB,1,RTN,"T",$PIECE(T2,"+",1)))
- Begin DoDot:2
- +7 FOR I=1:1:$LENGTH(T1,",")-1
- SET LAB=$PIECE(T1,",",I)
- SET LABO=+$PIECE(LAB,"+",2)
- SET LAB=$PIECE(LAB,"+")
- SET E=14
- SET E(1)=T
- DO E^XINDX1(.E)
- +8 QUIT
- End DoDot:2
- +9 QUIT
- End DoDot:1
- +10 ;Check for valid label names
- SET LAB=""
- SET LABO=0
- +11 IF 'INDLC
- FOR
- SET LAB=$ORDER(^UTILITY($JOB,1,RTN,"T",LAB))
- IF LAB=""
- QUIT
- Begin DoDot:1
- +12 IF '$$VA^XINDX2(LAB)
- DO E^XINDX1(55)
- QUIT
- +13 IF '$$VT^XINDX2(LAB)
- DO E^XINDX1(37)
- +14 QUIT
- End DoDot:1
- +15 ;Check for valid variable names.
- SET LAB=""
- SET LABO=0
- +16 FOR
- SET LAB=$ORDER(^UTILITY($JOB,1,RTN,"L",LAB))
- IF LAB=""
- QUIT
- Begin DoDot:1
- +17 DO VLNF^XINDX3($PIECE(LAB,"("))
- +18 QUIT
- End DoDot:1
- +19 QUIT
- +20 ;
- QUICK ;Quick, Just get a routine an print the results
- +1 DO QUICK^XINDX6()
- +2 QUIT