File:  [Coherent Logic Development] / freem_fileman / USER / DIM2.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:20 2025 UTC (5 weeks, 5 days ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

DIM2	;SFISC/XAK,GFT-MUMPS SYNTAX CHECKER ;10/31/91  3:26 PM
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
SUB	F %J=%I-1:-1 S %C1=$E(%,%J) Q:%C1'?1UN
	S %C1=$E(%,%J+1,%I-1) G ERR:%C1]""&(%C1'?1U.UN)&($E(%,%J,%I-1)'?1"%".UN) G:%C1]"" ERR:%[("."_%C1)
	S %(%N,0)=$S(%C1]""!($E(%,%J)="^"):"V^",$E(%,%J)="@":"@^",1:"0^"),%(%N,1)=0,%(%N,2)=0,%(%N,3)=0,%N=%N+1 G 1
UP	G ERR:%N=0!("(,"[$E(%,%I-1))!($E(%,%I+1)]""&("<>_[]:/\?'+-=!&#*),"""'[$E(%,%I+1))) S %N=%N-1,%(%N,1)=%(%N,1)+1,%F=$P(%(%N,0),"^",1) G:'%F UP1 S %F=$P(%(%N,0),"^",2)
	S %F1=%(%N,1) G ERR:(%F1<+%F)!(%F1>$P(%F,";",2))!(%(%N,2)&'(%(%N,3)))
UP1	K %(%N+1) G ERR:'%F&(%F'["V")&(%F'["@")&(%F'["P")&(%(%N,1)>1),1
AR	G ERR:%N<1!("(,"[$E(%,%I-1))!('%(%N-1,3)&%(%N-1,2))!("@("[$E(%,1,2)) S %(%N-1,1)=%(%N-1,1)+1,%(%N-1,3)=0 G 1
SEL	S %(%N-1,3)=%(%N-1,3)+1 G ERR:'%(%N-1,2)!(%(%N-1,3)>1),1
GLO	D %INC G ERR:$E(%,%I,999)'?1U.UN.P.E&("%("'[%C)
	G ERR:"=+-\/<>(,#!&*':@[]_"'[$E(%,%I-2)
B	S %I=%I-1 G 1
PAT	S %L1=1 G ERR:%I=1
C	D %INC
C1	I %C?.N G:%C="" ERR:'$D(%L1),FINISH:'%L1,ERR K %L1 G C
	I %C="." K %L1 D %INC G ERR:%C="",P:%C'?1N,C1
	I %C="@" G B
	I %C'?1U,%C'="""" G ERR:'$D(%L1),ERR:%L1,B
P	G ERR:$D(%L1) S %L1=0 I %C="""" D QUOTE G C
P1	I "AULPCNE"[%C S %L1=%C D %INC G P1:%C]""
	I %L1?.A G C1
ERR	S %ERR=1,%N=0
FINISH	G ERR:%N'=0 K %C,%,%F,%F1,%I,%J,%L1,%L2,%N,%T,%Z1,%Z2,%FN,%FZ Q
BINOP	S %Z1=""")%'" G OP
MTHOP	S %Z1=""")%" G OP
UNOP	S %Z1=""":<>+-'\/()%@#&!*=_][,",%Z2="""($+-=&!^%.@'" S:%C="'" %Z2=%Z2_"<>?[]" G OPCHK
OP	S %Z2="""($+-^%@'." G OPCHK
IND	G ERR:$E(%COM)="F" S %Z1="^?@(%+-=\/#*!&'_<>[]:,",%Z2="(+^-'$@%"""
OPCHK	S %L1=$E(%,%I-1),%L2=$E(%,%I+1) S:"[]&!<>="[%C&(%L1="'") %L1=$E(%,%I-2) I %Z1'[%L1,%L1'?1UN G ERR
	I (%Z2'[%L2)&(%L2'?1UN)!(%L2="") G ERR
	G ERR:%L2=""!(("+-'@"'[%C)&(%L1=""))!(%C="'"&(%L1?1UN)&("[]?=<>"'[%L2))
1	G GG^DIM1
	;
DATA	D %INC G ERR:%C="",DATA:"^@"[%C D %INC:%C="%",VAR G ERR:%ERR!("()"'[%C),GG1^DIM1
QUOTE	D %INC I %C="" S %ERR=1 Q
	G QUOTE:%C'="""" Q:$E(%,%I+1)'=%C  S %I=%I+1 G QUOTE
VAR	F %J=%I:1 S %C=$E(%,%J) Q:",<>?/\[]+-=_()*&#!':"[%C!((%C="@")&($E(%,%J+1)="(")&($E(%)="@"))  S:%C'?1UN %ERR=1 I (%C="^"),$D(%(%N-1,"F")),%(%N-1,"F")["TEXT" S %ERR=0 Q
	I %C="@"&'%ERR S %I=%J Q
	Q:%ERR  S %F=$E(%,%I,%J-1) S:%F]""&(%F'?1U.UN)&($E(%,%I-1,%J-1)'?1"%".UN)!(%F="^"&($E(%,%J)'="(")) %ERR=1 S %I=%J Q
%INC	S %I=%I+1,%C=$E(%,%I)
	Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>