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

    1: DIM4	;SFISC/JFW-MUMPS SYNTAX CHECKER ;3/20/91  5:21 PM
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: BK	I %ARG]"" S %=%ARG D ^DIM1 G ER:%ERR
    5: 	G GC^DIM
    6: CL	G ER:%ERR I %ARG]"" F %Z=0:0 D S S %=%A D ^DIM1 G:%ARG=""!%ERR GC^DIM
    7: IX	G GC^DIM:%ARG=""!%ERR D S S %L=":" D S1 I %C=%L S %=%A1 D ^DIM1 G ER:%A1=""!%ERR
    8: 	S %=%A D ^DIM1 G IX
    9: ST	G GC^DIM:%ARG=""!%ERR D S G ER:%ERR!(%A=""&(%C=","))
   10: 	I %A?1"@".E S %=%A D ^DIM1 G ST
   11: 	S %L="=" D S1 G ER:(%A="")!(%A1="") S %=%A1 D ^DIM1 G ER:%ERR
   12: 	I %A?1"(".E1")" S %A=$E(%A,2,$L(%A)-1) G STM
   13: 	S %=%A D VV,^DIM1 G ST
   14: STM	G ST:%ERR!(%A="") S %L="," D S1 G ER:%ERR!(%C=%L&(%A1=""))
   15: 	S %=%A D VV,^DIM1 S %A=%A1 G STM
   16: RD	G GC^DIM:%ARG=""!%ERR D S G ER:%ERR!(%C=","&(%A=""))
   17: 	I "!#?"[$E(%A,1) S %I=0 D FRM G RD
   18: 	I %A?1"""".E G ER:$P(%A,"""",3)'="" S %=%A D ^DIM1 G RD
   19: 	I %A?1"*".E S %A=$E(%A,2,999)
   20: 	G ER:%A?1"^".E S %L=":" D S1 G ER:%ERR!(%C=%L&(%A1=""))!(%A="")
   21: 	S %=%A D VV,^DIM1 S %=%A1 D ^DIM1 G RD
   22: WR	G GC^DIM:%ARG=""!%ERR D S G ER:%ERR!(%A=""&(%C=","))
   23: 	I "!#?"[$E(%A,1) S %I=0 D FRM G WR
   24: 	S:%A?1"*".E %A=$E(%A,2,999) S %=%A D ^DIM1 G WR
   25: FRM	S %I=%I+1,%C=$E(%A,%I) Q:%C=""  I "!#?"'[%C S %ERR=1 Q
   26: 	G FRM:"!#"[%C S %=$E(%A,%I+1,999) D ^DIM1 Q
   27: S	S (%A,%C)="" Q:%ERR  S (%ERR,%I)=0
   28: INC	D %INC D QT:%C="""",P:%C="(" Q:%ERR  G OUT:","[%C,INC
   29: QT	D %INC Q:%C=""""  G QT:%C]"" S %ERR=1 Q
   30: P	S %P=1 F %J=0:0 D %INC D QT:%C="""" S %P=%P+$S(%C="(":1,%C=")":-1,1:0) Q:'%P  I %C="" S %ERR=1 Q
   31: 	Q
   32: OUT	S %A=$E(%ARG,1,%I-1),%ARG=$E(%ARG,%I+1,999) Q
   33: %INC	S %I=%I+1,%C=$E(%ARG,%I) Q
   34: 	;
   35: S1	S (%A1,%C)="" Q:%ERR  S (%ERR,%I)=0
   36: INCR	D %INC1 D QT1:%C="""",P1:%C="(" Q:%ERR  G OUT1:%L[%C,INCR
   37: OUT1	S %A1=$E(%A,%I+1,999),%A=$E(%A,1,%I-1) Q
   38: QT1	D %INC1 Q:%C=""""  G QT1:%C]"" S %ERR=1 Q
   39: P1	S %P=1 F %J=0:0 D %INC1 D QT1:%C="""" S %P=%P+$S(%C="(":1,%C=")":-1,1:0) Q:'%P  I %C="" S %ERR=1 Q
   40: 	Q
   41: %INC1	S %I=%I+1,%C=$E(%A,%I) Q
   42: VV	I '%ERR,%]"",%'["@",%'?1U.UN,%'?1U.UN1"(".E1")",%'?1"%".UN1"(".E1")",%'?1"%".UN,%'?1"^"1U.UN1"(".E1")",%'?1"^%".UN1"(".E1")",%'?1"^(".E1")",%'?1"^"1U.UN,%'?1"$"1U,%'?1"$P".E!(%COM'="S") S %ERR=1
   43: 	Q
   44: ER	G ER^DIM

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