- 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
