source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIM2.m@ 1446

Last change on this file since 1446 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1DIM2 ;SFISC/XAK,GFT,TOAD-FileMan: M Syntax Checker, Exprs ;06:48 PM 1 Jul 1998
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;12277;4186487;4104;
5 ;
6SUB ; "(": open paren situations (GG^DIM1)
7 F %J=%I-1:-1 S %C1=$E(%,%J) Q:%C1'?1(1UN,1"%")
8 S %C1=$E(%,%J+1,%I-1)
9 I %C1]"",%C1'?1(1U,1"%").UN G ERR
10 I %C1]"",%[("."_%C1) G ERR
11 S %(%N,0)=$S(%C1]""!($E(%,%J)="^"):"V^",$E(%,%J)="@":"@^",1:"0^")
12 S %(%N,1)=0,%(%N,2)=0,%(%N,3)=0,%N=%N+1 G 1
13 ;
14UP ; ")": close paren situations (GG^DIM1)
15 I %N=0 G ERR
16 I "(,"[$E(%,%I-1),$P($G(%(%N-1,0)),"^")'["P" G ERR
17 I $E(%,%I+1)]"","<>_[]:/\?'+-=!&#*),"""'[$E(%,%I+1) G ERR
18 S %N=%N-1,%(%N,1)=%(%N,1)+1,%F=$P(%(%N,0),"^") I %F D G ERR:%ERR
19 . S %F=$P(%(%N,0),"^",2),%F1=%(%N,1)
20 . I %F1<+%F S %ERR=1 Q ; not enough commas for this function
21 . I %F1>$P(%F,";",2) S %ERR=1 Q ; too many commas for this function
22 . I %(%N,2),'%(%N,3) S %ERR=1 ; we're in $S and haven't yet hit a :
23 K %(%N+1)
24 I '%F,%F'["V",%F'["@",%F'["P",%(%N,1)>1 G ERR
25 G 1
26 ;
27AR ; ",": comma situations -- "P" below means "parameters" (GG^DIM1)
28 I %N<1 G ERR
29 I "(,"[$E(%,%I-1),$P($G(%(%N-1,0)),"^")'["P" G ERR
30 I '%(%N-1,3),%(%N-1,2) G ERR
31 I "@("[$E(%,1,2) G ERR
32 S %(%N-1,1)=%(%N-1,1)+1,%(%N-1,3)=0 G 1
33 ;
34SEL ; ":": $SELECT delimiter (GG^DIM1)
35 S %(%N-1,3)=%(%N-1,3)+1 G ERR:'%(%N-1,2)!(%(%N-1,3)>1),1
36 ;
37GLO ; "^": global reference (GG^DIM1)
38 D %INC G ERR:$E(%,%I,999)'?1U.UN.P.E&("%("'[%C)
39 G ERR:"=+-\/<>(,#!&*':@[]_"'[$E(%,%I-2)
40 S %I=%I-1 G 1
41 ;
42PAT ; "?": pattern match (GG^DIM1)
43 G ERR:%I=1,1:$E(%,%I+1)="@" D %INC,PATTERN G ERR:%ERR S %I=%I-1 G 1
44 ;
45PATTERN F D PATATOM Q:%C'?1N&(%C'=".")!%ERR
46 Q
47PATATOM D REPCOUNT Q:%ERR
48 I %C="""" D STRLIT,%INC:'%ERR Q
49 I %C="(" D ALTRN8 Q
50 D PATCODE
51 Q
52REPCOUNT ;
53 I %C'?1N,%C'="." S %ERR=1 Q
54 N FROM S FROM=+$E(%,%I,999) I %C?1N D INTLIT Q:%ERR
55 I %C="." D %INC
56 Q:%C'?1N I +$E(%,%I,999)<FROM S %ERR=1 Q
57 D INTLIT Q
58INTLIT I %C'?1N S %ERR=1 Q
59 F D %INC Q:%C'?1N
60 Q
61STRLIT F D %INC Q:%C="" I %C="""" Q:$E(%,%I+1)'="""" S %I=%I+1
62 I %C="" S %ERR=1
63 Q
64PATCODE I "ACELNPU"'[%C!(%C="") S %ERR=1 Q
65 F D %INC Q:%C="" Q:"ACELNPU"'[%C
66 Q
67ALTRN8 I %C'="(" S %ERR=1 Q
68 D %INC,PATATOM Q:%ERR
69 F Q:","'[%C D %INC,PATATOM Q:%ERR
70 I %C'=")" S %ERR=1 Q
71 D %INC
72 Q
73 ;
74BINOP ; binary operator (GG^DIM1)
75 S %Z1=""")%'",%Z2="""($+-^%@'." G OPCHK
76 ;
77MTHOP ; math or relational operator (GG^DIM1)
78 S %Z1=""")%",%Z2="""($+-^%@'." G OPCHK
79 ;
80UNOP ; unary operator (GG^DIM1)
81 S %Z1=""":<>+-'\/()%@#&!*=_][,"
82 S %Z2="""($+-=&!^%.@'" I %C="'" S %Z2=%Z2_"<>?[]"
83 G OPCHK
84 ;
85IND ; "@": indirection (GG^DIM1)
86 I $E(%COM)="F" G ERR
87 S %Z1="^?@(%+-=\/#*!&'_<>[]:,.",%Z2="""(+^-'$@%" G OPCHK
88 ;
89OPCHK ; ensure that the characters before and after the operator are OK
90 S %L1=$E(%,%I-1),%L2=$E(%,%I+1) I %L1="'","[]&!<>="[%C S %L1=$E(%,%I-2)
91 I %L1="","+-'@"'[%C G ERR ; binary: require before
92 I %L1'?1UN,%Z1'[%L1 G ERR ; all: screen before
93 F %F="*","]" I %C=%F,%L2=%F S %I=%I+1,%L2=$E(%,%I+1) Q
94 I %L2="" G ERR ; all: require after
95 I %L2'?1UN,%Z2'[%L2 G ERR ; all: screen after
96 I %C="'","!&[]?=<>"'[%L2,%L1?1UN G ERR ; unary ': not binary
97 G 1
98 ;
991 ; common exit point for all of ^DIM2
100 G GG^DIM1
101 ;
102DATA ; glvn arguments of $D,$G,$NA,$O, & $Q functions (FUNC^DIM1)
103 D %INC G ERR:%C="",ERR:%C=")",DATA:"^@"[%C D VAR
104 G ERR:"@(,)"'[%C!%ERR,GG1^DIM1
105 ;
106VAR ; variables encountered while parsing exprs (DATA, GG^DIM1)
107 N %START S %START=%I-1 I $E(%,%START)="^" S %START=%START-1
108 I %C="%" D %INC
109 N OUT S OUT=0 F %J=%I:1 S %C=$E(%,%J) D Q:OUT
110 . I ",<>?/\[]+-=_()*&#!':"[%C S OUT=1 Q
111 . I %C="@",$E(%,%J+1)="(",$E(%,%START)="@" S OUT=1 Q
112 . I %C'?1UN S %ERR=1
113 . I %C="^",$D(%(%N-1,"F")),%(%N-1,"F")["TEXT" S %ERR=0,OUT=1
114 Q:%ERR
115 I %C="@" S %I=%J Q
116 S %F=$E(%,%I,%J-1)
117 I %F="^",$E(%,%J)'="(" S %ERR=1
118 I %F]"",%F'?1U.UN,$E(%,%I-1,%J-1)'?1"%".UN S %ERR=1
119 S %I=%J Q
120 ;
121%INC S %I=%I+1,%C=$E(%,%I)
122 Q
123 ;
124ERR S %ERR=1,%N=0
125FINISH G ERR:%N'=0 K %C,%,%F,%F1,%I,%J,%L1,%L2,%N,%T,%Z1,%Z2,%FN,%FZ
126Q Q
Note: See TracBrowser for help on using the repository browser.