%INDX9 ;SF/RWF - %INDEX SYNTAX CHECKER ;8/18/93 12:22 ;
;;7.3;TOOLKIT;;Apr 25, 1995
D PARSE S LI=0,AC=255 F %=0:0 S %=$O(LV(%)) Q:%'>0 S LI(%)=0
Q
;LV is a set of Linked Values
PARSE K LV,LI S (ERR,LI,I)=0,(LL,LV)=1,(OP,CH)="",Q="""" ;D NEW S LL(LLO,8)=LL
;
PA2 S I=I+1,CH=$E(STR,I),CH1=$E(STR,I+1) G:CH="" PEND
G E:CH=";"!(CH'?1ANP) I """$()"[CH D QUOTE:CH=Q,FUNC:CH="$",DN:CH="(",UP:CH=")" G PA2
I CH="^",I=LL G PA2:CH1'="[" S I=I+1,X=$E(STR,LL,I) D ADD S LL=I+1 G PA2
I CH?1A!(CH="%") D VAR G PA2
I CH?1N D NUM G PA2
S:"+-#'/*&![]<>?"[CH OP=CH I CH="?",",!"'[$E(STR,I-1) D AR,PAT G PA2
I CH?1P D AR,E^%INDX1(21):(CH_CH1=",,")
G PA2
;
DN D STR S X=CH D ADD,NEW S LI(LV)=LI,LV=LV+1 S:'$D(LI(LV)) LI(LV)=0 S LI=LI(LV),LI(LV-1,1)=LI
Q
UP I LV<2 D E^%INDX1(5) Q
D STR S EC=LI-LI(LV-1,1),X=$C(10) D ADD,NEW S LI(LV)=LI,LV=LV-1,LI=LI(LV)
S X=EC D ADD S X=CH D ADD I CH1]"",CH1'?1P D E^%INDX1(46)
Q
NEW S LL=I+1
Q
AR D STR S X=CH D ADD,NEW Q
STR S X=$E(STR,LL,I-1) Q:'$L(X) ;Drop into ADD
ADD S LI=LI+1,LV(LV,LI)=X Q
Q
QUOTE F I=I+1:1 S CH=$E(STR,I) Q:CH=""!(CH=Q)
I $E(STR,I+1)=Q S I=I+1 G QUOTE
I OP'="?",$E(STR,I+1)]"","[]()<>\/+-=&!_#*,:'"'[$E(STR,I+1) S ERR=46 G ^%INDX1
Q:CH]"" S ERR=6 D ^%INDX1 Q
VAR F J=I+1:1 S CH=$E(STR,J) Q:CH'?1AN
S I=J-1 Q
NUM F J=I+1:1 S CH=$E(STR,J) Q:"0123456789."'[CH!(CH="")
I CH="E" S CH=$E(STR,J+1) I CH?1N!("+-"[CH) S I=J G NUM
I CH]"",CH'?1P S ERR=53 D ^%INDX1
S I=J-1 Q
INC S I=I+1,CH=$E(STR,I)
Q
FUNC D INC S X=CH D VAR S S=$E(STR,LL,I),LL=I+1 G EXT:S["$$" G SPV:CH'="("
S S=$E(S,2,9),F1=$F("ACDEFGJLNOPQRSTVZ",X),ERR=3 G:F1'>1 ^%INDX1 S F1=$P($T(FNC),",",F1)
S:$E(S,1,2)="TR" F1="TRANSLATE^2;3" S:$E(S,1,2)="FN" F1="FNUMBER^2;3"
I "ZV"[X S ERR=$S("Z"[X:31,1:27) D ^%INDX1
I $L(S)>1,X'["Z",$P(F1,S)]"" S ERR=3 D ^%INDX1
S X="$"_F1,CH="" D ADD Q
SPV S X=S D ADD S CH=$E(S,2) I "HIJSTXYZ"'[CH S ERR=4 G ^%INDX1
I CH="Z" S ERR=28 G ^%INDX1
I $L(S)>2,",$HOROLOG,$IO,$STORAGE,$TEST,$X,$Y,"'[(","_S_",") S ERR=4 G ^%INDX1
EXT ;EXTRINSIC
S X=S,CH="" D ADD Q
E S ERR=11 D ^%INDX1 Q ;
PAT F I=I+1:1 S CH=$E(STR,I) D PATQ:CH=Q I CH=""!(CH'?1N&("ACELNPU."'[CH)) Q
S I=I-1 I ":),@+-_*/\!&'"'[CH D E^%INDX1(16),SEP Q
Q
PATQ F I=I+1:1 S CH=$E(STR,I) Q:CH=""!(CH=Q)
S ERR=6,I=I+1,CH=$E(STR,I) D:$E(STR,I-1)="" ^%INDX1 G:CH=Q PATQ Q
PEND D AR,E^%INDX1(5):LV>1,E^%INDX1(21):($G(LV(1,1))=",") ;LV>1 means mis-match ()
Q
SEP ;Find sep
Q
FNC ;;,ASCII^1;2,CHAR^1;999,DATA^1;1,EXTRACT^1;3,FIND^2;3,GET^1;1,JUSTIFY^2;3,LENGTH^1;2,NEXT^1;1,ORDER^1;1,PIECE^2;4,QUERY^1;1,RANDOM^1;1,SELECT^1;999,TEXT^1;1,VIEW^1;999,
TEST S STR="@^(0)" D %INDX9
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZINDX9 2663 printed Dec 13, 2024@02:42:41 Page 2
%INDX9 ;SF/RWF - %INDEX SYNTAX CHECKER ;8/18/93 12:22 ;
+1 ;;7.3;TOOLKIT;;Apr 25, 1995
+2 DO PARSE
SET LI=0
SET AC=255
FOR %=0:0
SET %=$ORDER(LV(%))
if %'>0
QUIT
SET LI(%)=0
+3 QUIT
+4 ;LV is a set of Linked Values
PARSE ;D NEW S LL(LLO,8)=LL
KILL LV,LI
SET (ERR,LI,I)=0
SET (LL,LV)=1
SET (OP,CH)=""
SET Q=""""
+1 ;
PA2 SET I=I+1
SET CH=$EXTRACT(STR,I)
SET CH1=$EXTRACT(STR,I+1)
if CH=""
GOTO PEND
+1 if CH=";"!(CH'?1ANP)
GOTO E
IF """$()"[CH
if CH=Q
DO QUOTE
if CH="$"
DO FUNC
if CH="("
DO DN
if CH=")"
DO UP
GOTO PA2
+2 IF CH="^"
IF I=LL
if CH1'="["
GOTO PA2
SET I=I+1
SET X=$EXTRACT(STR,LL,I)
DO ADD
SET LL=I+1
GOTO PA2
+3 IF CH?1A!(CH="%")
DO VAR
GOTO PA2
+4 IF CH?1N
DO NUM
GOTO PA2
+5 if "+-#'/*&![]<>?"[CH
SET OP=CH
IF CH="?"
IF ",!"'[$EXTRACT(STR,I-1)
DO AR
DO PAT
GOTO PA2
+6 IF CH?1P
DO AR
if (CH_CH1=",,")
DO E^%INDX1(21)
+7 GOTO PA2
+8 ;
DN DO STR
SET X=CH
DO ADD
DO NEW
SET LI(LV)=LI
SET LV=LV+1
if '$DATA(LI(LV))
SET LI(LV)=0
SET LI=LI(LV)
SET LI(LV-1,1)=LI
+1 QUIT
UP IF LV<2
DO E^%INDX1(5)
QUIT
+1 DO STR
SET EC=LI-LI(LV-1,1)
SET X=$CHAR(10)
DO ADD
DO NEW
SET LI(LV)=LI
SET LV=LV-1
SET LI=LI(LV)
+2 SET X=EC
DO ADD
SET X=CH
DO ADD
IF CH1]""
IF CH1'?1P
DO E^%INDX1(46)
+3 QUIT
NEW SET LL=I+1
+1 QUIT
AR DO STR
SET X=CH
DO ADD
DO NEW
QUIT
STR ;Drop into ADD
SET X=$EXTRACT(STR,LL,I-1)
if '$LENGTH(X)
QUIT
ADD SET LI=LI+1
SET LV(LV,LI)=X
QUIT
+1 QUIT
QUOTE FOR I=I+1:1
SET CH=$EXTRACT(STR,I)
if CH=""!(CH=Q)
QUIT
+1 IF $EXTRACT(STR,I+1)=Q
SET I=I+1
GOTO QUOTE
+2 IF OP'="?"
IF $EXTRACT(STR,I+1)]""
IF "[]()<>\/+-=&!_#*,:'"'[$EXTRACT(STR,I+1)
SET ERR=46
GOTO ^%INDX1
+3 if CH]""
QUIT
SET ERR=6
DO ^%INDX1
QUIT
VAR FOR J=I+1:1
SET CH=$EXTRACT(STR,J)
if CH'?1AN
QUIT
+1 SET I=J-1
QUIT
NUM FOR J=I+1:1
SET CH=$EXTRACT(STR,J)
if "0123456789."'[CH!(CH="")
QUIT
+1 IF CH="E"
SET CH=$EXTRACT(STR,J+1)
IF CH?1N!("+-"[CH)
SET I=J
GOTO NUM
+2 IF CH]""
IF CH'?1P
SET ERR=53
DO ^%INDX1
+3 SET I=J-1
QUIT
INC SET I=I+1
SET CH=$EXTRACT(STR,I)
+1 QUIT
FUNC DO INC
SET X=CH
DO VAR
SET S=$EXTRACT(STR,LL,I)
SET LL=I+1
if S["$$"
GOTO EXT
if CH'="("
GOTO SPV
+1 SET S=$EXTRACT(S,2,9)
SET F1=$FIND("ACDEFGJLNOPQRSTVZ",X)
SET ERR=3
if F1'>1
GOTO ^%INDX1
SET F1=$PIECE($TEXT(FNC),",",F1)
+2 if $EXTRACT(S,1,2)="TR"
SET F1="TRANSLATE^2;3"
if $EXTRACT(S,1,2)="FN"
SET F1="FNUMBER^2;3"
+3 IF "ZV"[X
SET ERR=$SELECT("Z"[X:31,1:27)
DO ^%INDX1
+4 IF $LENGTH(S)>1
IF X'["Z"
IF $PIECE(F1,S)]""
SET ERR=3
DO ^%INDX1
+5 SET X="$"_F1
SET CH=""
DO ADD
QUIT
SPV SET X=S
DO ADD
SET CH=$EXTRACT(S,2)
IF "HIJSTXYZ"'[CH
SET ERR=4
GOTO ^%INDX1
+1 IF CH="Z"
SET ERR=28
GOTO ^%INDX1
+2 IF $LENGTH(S)>2
IF ",$HOROLOG,$IO,$STORAGE,$TEST,$X,$Y,"'[(","_S_",")
SET ERR=4
GOTO ^%INDX1
EXT ;EXTRINSIC
+1 SET X=S
SET CH=""
DO ADD
QUIT
E ;
SET ERR=11
DO ^%INDX1
QUIT
PAT FOR I=I+1:1
SET CH=$EXTRACT(STR,I)
if CH=Q
DO PATQ
IF CH=""!(CH'?1N&("ACELNPU."'[CH))
QUIT
+1 SET I=I-1
IF ":),@+-_*/\!&'"'[CH
DO E^%INDX1(16)
DO SEP
QUIT
+2 QUIT
PATQ FOR I=I+1:1
SET CH=$EXTRACT(STR,I)
if CH=""!(CH=Q)
QUIT
+1 SET ERR=6
SET I=I+1
SET CH=$EXTRACT(STR,I)
if $EXTRACT(STR,I-1)=""
DO ^%INDX1
if CH=Q
GOTO PATQ
QUIT
PEND ;LV>1 means mis-match ()
DO AR
if LV>1
DO E^%INDX1(5)
if ($GET(LV(1,1))=",")
DO E^%INDX1(21)
+1 QUIT
SEP ;Find sep
+1 QUIT
FNC ;;,ASCII^1;2,CHAR^1;999,DATA^1;1,EXTRACT^1;3,FIND^2;3,GET^1;1,JUSTIFY^2;3,LENGTH^1;2,NEXT^1;1,ORDER^1;1,PIECE^2;4,QUERY^1;1,RANDOM^1;1,SELECT^1;999,TEXT^1;1,VIEW^1;999,
TEST SET STR="@^(0)"
DO %INDX9
