AZHLSCU9 ; IHS/ADC/GTH:KEU - UNDEF CHECKER. %INDEX SYNTAX CHECKER ;
;;5.0;AZHLSC;;JUL 10, 1996
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,PL,I)=0,(LL,LV)=1,(OP,CH)="",Q="""" ;D NEW S LL(LLO,8)=LL
;
PA2 S I=I+1,CH=$E(STR,I) 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:$E(STR,I+1)'="[" 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
D:CH?1P AR G PA2
;
DN D STR S X=CH D ADD,NEW S LI(LV)=LI,LV=LV+1,PL=PL+1 S:'$D(LI(LV)) LI(LV)=0 S LI=LI(LV),LI(LV-1,1)=LI
Q
UP 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),PL=PL-1
S X=EC D ADD S X=CH D ADD 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: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
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
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),F1=$P($T(FNC),",",F1)
S:$E(S,1,2)="TR" F1="TRANSLATE^2;3" S:$E(S,1,2)="FN" F1="FNUMBER^2;2"
S X="$"_F1,CH="" D ADD Q
SPV S X=S D ADD S CH=$E(S,2)
EXT ;EXTRINSIC
S X=S,CH="" D ADD
E 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 Q
PATQ F I=I+1:1 S CH=$E(STR,I) Q:CH=""!(CH=Q)
S I=I+1,CH=$E(STR,I) G:CH=Q PATQ Q
PEND D AR
Q
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 AZHLSCU9
AZHLSCU9 ; IHS/ADC/GTH:KEU - UNDEF CHECKER. %INDEX SYNTAX CHECKER ;
+1 ;;5.0;AZHLSC;;JUL 10, 1996
+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,PL,I)=0
SET (LL,LV)=1
SET (OP,CH)=""
SET Q=""""
+1 ;
PA2 SET I=I+1
SET CH=$EXTRACT(STR,I)
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 $EXTRACT(STR,I+1)'="["
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
GOTO PA2
+7 ;
DN DO STR
SET X=CH
DO ADD
DO NEW
SET LI(LV)=LI
SET LV=LV+1
SET PL=PL+1
IF '$DATA(LI(LV))
SET LI(LV)=0
SET LI=LI(LV)
SET LI(LV-1,1)=LI
+1 QUIT
UP 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)
SET PL=PL-1
+1 SET X=EC
DO ADD
SET X=CH
DO ADD
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 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 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 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 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;2"
+3 SET X="$"_F1
SET CH=""
DO ADD
QUIT
SPV SET X=S
DO ADD
SET CH=$EXTRACT(S,2)
EXT ;EXTRINSIC
+1 SET X=S
SET CH=""
DO ADD
E 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
QUIT
PATQ FOR I=I+1:1
SET CH=$EXTRACT(STR,I)
IF CH=""!(CH=Q)
QUIT
+1 SET I=I+1
SET CH=$EXTRACT(STR,I)
IF CH=Q
GOTO PATQ
QUIT
PEND DO AR
+1 QUIT
+2 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 AZHLSCU9
