- %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 Mar 13, 2025@21:47:44 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
