%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 Nov 22, 2024@17:52:23 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
