- %INDEX ;ISC/REL,GFT,GRK,RWF - INDEX & CROSS-REFERENCE ;08/11/94 13:29
- ;;7.3;TOOLKIT;;Apr 25, 1995
- G ^%INDX6
- 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 ^%INDX1
- ALIVE ;enter here from taskman
- D SETUP^%INDX6 ;Get ready to process
- A2 S RTN=$O(^UTILITY($J,RTN)) G ^%INDX5:RTN="" S INDLC=(RTN?1"|"1.4L.NP) D LOAD:'INDLC,BEG G A2
- Q
- 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
- Q
- BEG I $D(ZTQUEUED),$$S^%ZTLOAD S RTN="~",IND("QUIT")=1,ZTSTOP=1 Q
- I 'INDDS,INDLC W !!?10,"Data Dictionaries",! S INDDS=1
- S %=INDLC*5 W:$X+1+%>IOM ! W RTN,$J("",10+%-$L(RTN)) S LC=^UTILITY($J,1,RTN,0,0)
- S LABO=0,LAB=$P($P(^UTILITY($J,1,RTN,0,1,0)," "),"(") I RTN'=LAB S ERR=17 D ^%INDX1
- I 'INDLC,LC>2,$P(^UTILITY($J,1,RTN,0,2,0)," ",2,99)'?1";;".E1N.E S ERR=44 D ^%INDX1
- B5 S (IND("DO"),CCN)=0 F TXT=1:1:LC S LIN=^UTILITY($J,1,RTN,0,TXT,0),LN=$L(LIN),CCN=CCN+LN+2 D LN,ST
- S LAB="",LABO=0,^UTILITY($J,1,RTN,0)=CCN_"^"_LC I CCN>5000,'INDLC S ERR=35,ERR(1)=CCN D ^%INDX1
- BC S LAB=$O(^UTILITY($J,1,RTN,"I",LAB)),L=LAB G:$E(L,1,2)="@(" BC I LAB="" Q
- S:$E(L,1,2)="$$" L=$E(L,3,99) G BC:L']"",BC:$D(^UTILITY($J,1,RTN,"T",$P(L,"+",1))) S ERR=14 D ^%INDX1 G BC
- ;Proccess one line.
- LN K V S (GRB,IND("COM"))="",IND("DO1")=0 I $P(LIN," ",1)="" S LABO=LABO+1 G CD
- S X=$P(LIN," "),(IND("COM"),LAB)=$P(X,"("),GRB=$P($P(X,"(",2),")"),LABO=0,IND("PP")=X?1.8E1"(".E1")"
- I $D(^UTILITY($J,1,RTN,"T",LAB)) S ERR=15 D ^%INDX1 G CD
- S ^UTILITY($J,1,RTN,"T",LAB)="" I 'INDLC,'$$VT^%INDX2(LAB) S ERR=37 D ^%INDX1
- CD S ERR=19 D:LN>245 ^%INDX1 S ERR=18 D:LIN'?1.ANP ^%INDX1
- S I=0,LIN=$P(LIN," ",2,999),IND("LCC")=1,ERR=42 G:LIN="" ^%INDX1 ;Watch the scope of I.
- 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
- S:'I IND("DO")=0 I I S ERR=51 D:X>IND("DO") ^%INDX1 S IND("DO")=X
- ;Process commands on line.
- EE I LIN="" D ^%INDX2 Q
- S COM=$E(LIN),GK="" I COM=";" S LIN="" G EE
- I COM=" " S ERR=$S(LIN?1." ":13,1:0),LIN=$E(LIN,2,999) S:ERR LIN="" D:ERR ^%INDX1 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']"") ^%INDX1 S:POST]"" GRB=GRB_$C(9)_POST,IND("COM")=IND("COM")_":"
- I CM?.E1L.E D CASE^%INDX52 S COM=$E(CM) I IND("LCC") S IND("LCC")=0,ERR=47 D ^%INDX1
- I "BCDEFGHIJKLNOQRSUVWXZ"'[COM S ERR=1 G ^%INDX1
- I $L(CM)>1,$E(CM)'="Z",$P($T(CMD),";;",2,999)'[(","_CM_",") S ERR=1 G ^%INDX1
- D SEP I '$L(LIN),CH=" " S ERR=13 D ^%INDX1 ;trailing space
- I ARG="","CGJORSUWX"[COM S ERR=49 G ^%INDX1
- D:"BCDEFGHJKLNOQRSUVWXZ"[COM @COM S:ARG'="" GRB=GRB_$C(9)_ARG G EE
- B S ERR=25 G ^%INDX1
- C S ERR=29 G ^%INDX1
- D G DG1^%INDX4
- E Q:ARG="" S ERR=7 G ^%INDX1
- F G:ARG]"" FR^%INDX4 Q
- G G DG^%INDX4
- H Q:ARG'="" S ERR=32 G ^%INDX1
- J S ERR=36,ARG="" G ^%INDX1
- K S ERR=$S(ARG?1"(".E:22,ARG?." ":23,1:0) D:ERR ^%INDX1
- G KL^%INDX3
- L G LO^%INDX4
- N G NE^%INDX3
- O S ERR=34 D ^%INDX1,O^%INDX3 Q
- P Q
- Q Q:ARG="" G Q^%INDX4
- R S RDTIME=0 G RD^%INDX3
- S G S^%INDX3
- U S ARG=$P(ARG,":") Q
- V S ARG="",ERR=20 G ^%INDX1
- W G WR^%INDX4
- X G XE^%INDX4
- Z S ERR=2 D ^%INDX1 G ZC^%INDX4
- CMD ;;,BREAK,CLOSE,DO,ELSE,FOR,GOTO,HALT,HANG,IF,KILL,NEW,LOCK,OPEN,PRINT,QUIT,READ,SET,USE,VIEW,WRITE,XECUTE,
- 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 S %=0
- I V(LOC,S)]"","!~"[V(LOC,S),$G(^UTILITY($J,1,RTN,LOC,S))'[V(LOC,S) S ^(S)=$G(^(S))_V(LOC,S)
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZINDEX 3894 printed Mar 13, 2025@21:47:31 Page 2
- %INDEX ;ISC/REL,GFT,GRK,RWF - INDEX & CROSS-REFERENCE ;08/11/94 13:29
- +1 ;;7.3;TOOLKIT;;Apr 25, 1995
- +2 GOTO ^%INDX6
- 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 ^%INDX1
- ALIVE ;enter here from taskman
- +1 ;Get ready to process
- DO SETUP^%INDX6
- A2 SET RTN=$ORDER(^UTILITY($JOB,RTN))
- if RTN=""
- GOTO ^%INDX5
- SET INDLC=(RTN?1"|"1.4L.NP)
- if 'INDLC
- DO LOAD
- DO BEG
- GOTO A2
- +1 QUIT
- 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 QUIT
- BEG IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET RTN="~"
- SET IND("QUIT")=1
- SET ZTSTOP=1
- QUIT
- +1 IF 'INDDS
- IF INDLC
- WRITE !!?10,"Data Dictionaries",!
- SET INDDS=1
- +2 SET %=INDLC*5
- if $X+1+%>IOM
- WRITE !
- WRITE RTN,$JUSTIFY("",10+%-$LENGTH(RTN))
- SET LC=^UTILITY($JOB,1,RTN,0,0)
- +3 SET LABO=0
- SET LAB=$PIECE($PIECE(^UTILITY($JOB,1,RTN,0,1,0)," "),"(")
- IF RTN'=LAB
- SET ERR=17
- DO ^%INDX1
- +4 IF 'INDLC
- IF LC>2
- IF $PIECE(^UTILITY($JOB,1,RTN,0,2,0)," ",2,99)'?1";;".E1N.E
- SET ERR=44
- DO ^%INDX1
- B5 SET (IND("DO"),CCN)=0
- FOR TXT=1:1:LC
- SET LIN=^UTILITY($JOB,1,RTN,0,TXT,0)
- SET LN=$LENGTH(LIN)
- SET CCN=CCN+LN+2
- DO LN
- DO ST
- +1 SET LAB=""
- SET LABO=0
- SET ^UTILITY($JOB,1,RTN,0)=CCN_"^"_LC
- IF CCN>5000
- IF 'INDLC
- SET ERR=35
- SET ERR(1)=CCN
- DO ^%INDX1
- BC SET LAB=$ORDER(^UTILITY($JOB,1,RTN,"I",LAB))
- SET L=LAB
- if $EXTRACT(L,1,2)="@("
- GOTO BC
- IF LAB=""
- QUIT
- +1 if $EXTRACT(L,1,2)="$$"
- SET L=$EXTRACT(L,3,99)
- if L']""
- GOTO BC
- if $DATA(^UTILITY($JOB,1,RTN,"T",$PIECE(L,"+",1)))
- GOTO BC
- SET ERR=14
- DO ^%INDX1
- GOTO BC
- +2 ;Proccess one line.
- LN KILL V
- SET (GRB,IND("COM"))=""
- SET IND("DO1")=0
- IF $PIECE(LIN," ",1)=""
- SET LABO=LABO+1
- GOTO CD
- +1 SET X=$PIECE(LIN," ")
- SET (IND("COM"),LAB)=$PIECE(X,"(")
- SET GRB=$PIECE($PIECE(X,"(",2),")")
- SET LABO=0
- SET IND("PP")=X?1.8E1"(".E1")"
- +2 IF $DATA(^UTILITY($JOB,1,RTN,"T",LAB))
- SET ERR=15
- DO ^%INDX1
- GOTO CD
- +3 SET ^UTILITY($JOB,1,RTN,"T",LAB)=""
- IF 'INDLC
- IF '$$VT^%INDX2(LAB)
- SET ERR=37
- DO ^%INDX1
- CD SET ERR=19
- if LN>245
- DO ^%INDX1
- SET ERR=18
- if LIN'?1.ANP
- DO ^%INDX1
- +1 ;Watch the scope of I.
- SET I=0
- SET LIN=$PIECE(LIN," ",2,999)
- SET IND("LCC")=1
- SET ERR=42
- if LIN=""
- GOTO ^%INDX1
- +2 IF " ."[$EXTRACT(LIN)
- Begin DoDot:1
- +3 FOR I=1:1:245
- if ". "'[$EXTRACT(LIN,I)
- QUIT
- +4 QUIT
- End DoDot:1
- SET X=$LENGTH($EXTRACT(LIN,1,I),".")-1
- SET LIN=$EXTRACT(LIN,I,999)
- +5 if 'I
- SET IND("DO")=0
- IF I
- SET ERR=51
- if X>IND("DO")
- DO ^%INDX1
- SET IND("DO")=X
- +6 ;Process commands on line.
- EE IF LIN=""
- DO ^%INDX2
- QUIT
- +1 SET COM=$EXTRACT(LIN)
- SET GK=""
- IF COM=";"
- SET LIN=""
- GOTO EE
- +2 IF COM=" "
- SET ERR=$SELECT(LIN?1." ":13,1:0)
- SET LIN=$EXTRACT(LIN,2,999)
- if ERR
- SET LIN=""
- if ERR
- DO ^%INDX1
- GOTO EE
- +3 DO SEP
- +4 SET CM=$PIECE(ARG,":",1)
- SET POST=$PIECE(ARG,":",2,999)
- SET IND("COM")=IND("COM")_$CHAR(9)_COM
- SET ERR=48
- if ARG["
- DO ^%INDX1
- if POST]""
- SET GRB=GRB_$CHAR(9)_POST
- SET IND("COM")=IND("COM")_":"
- +5 IF CM?.E1L.E
- DO CASE^%INDX52
- SET COM=$EXTRACT(CM)
- IF IND("LCC")
- SET IND("LCC")=0
- SET ERR=47
- DO ^%INDX1
- +6 IF "BCDEFGHIJKLNOQRSUVWXZ"'[COM
- SET ERR=1
- GOTO ^%INDX1
- +7 IF $LENGTH(CM)>1
- IF $EXTRACT(CM)'="Z"
- IF $PIECE($TEXT(CMD),";;",2,999)'[(","_CM_",")
- SET ERR=1
- GOTO ^%INDX1
- +8 ;trailing space
- DO SEP
- IF '$LENGTH(LIN)
- IF CH=" "
- SET ERR=13
- DO ^%INDX1
- +9 IF ARG=""
- IF "CGJORSUWX"[COM
- SET ERR=49
- GOTO ^%INDX1
- +10 if "BCDEFGHJKLNOQRSUVWXZ"[COM
- DO @COM
- if ARG'=""
- SET GRB=GRB_$CHAR(9)_ARG
- GOTO EE
- B SET ERR=25
- GOTO ^%INDX1
- C SET ERR=29
- GOTO ^%INDX1
- D GOTO DG1^%INDX4
- E if ARG=""
- QUIT
- SET ERR=7
- GOTO ^%INDX1
- F if ARG]""
- GOTO FR^%INDX4
- QUIT
- G GOTO DG^%INDX4
- H if ARG'=""
- QUIT
- SET ERR=32
- GOTO ^%INDX1
- J SET ERR=36
- SET ARG=""
- GOTO ^%INDX1
- K SET ERR=$SELECT(ARG?1"(".E:22,ARG?." ":23,1:0)
- if ERR
- DO ^%INDX1
- +1 GOTO KL^%INDX3
- L GOTO LO^%INDX4
- N GOTO NE^%INDX3
- O SET ERR=34
- DO ^%INDX1
- DO O^%INDX3
- QUIT
- P QUIT
- Q if ARG=""
- QUIT
- GOTO Q^%INDX4
- R SET RDTIME=0
- GOTO RD^%INDX3
- S GOTO S^%INDX3
- U SET ARG=$PIECE(ARG,":")
- QUIT
- V SET ARG=""
- SET ERR=20
- GOTO ^%INDX1
- W GOTO WR^%INDX4
- X GOTO XE^%INDX4
- Z SET ERR=2
- DO ^%INDX1
- GOTO ZC^%INDX4
- CMD ;;,BREAK,CLOSE,DO,ELSE,FOR,GOTO,HALT,HANG,IF,KILL,NEW,LOCK,OPEN,PRINT,QUIT,READ,SET,USE,VIEW,WRITE,XECUTE,
- 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")
- QUIT
- SET SET %=0
- +1 IF V(LOC,S)]""
- IF "!~"[V(LOC,S)
- IF $GET(^UTILITY($JOB,1,RTN,LOC,S))'[V(LOC,S)
- SET ^(S)=$GET(^(S))_V(LOC,S)
- 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)_","
- QUIT
