source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIM4.m@ 1710

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

initial load of WorldVistAEHR

File size: 2.9 KB
RevLine 
[613]1DIM4 ;SFISC/JFW,GFT,TOAD-FileMan: M Syntax Checker, Commands ;5/6/97 09:10
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;12279;3292224;3060;
5 ;
6BK ; BREAK and QUIT (B^DIM and Q^DIM)
7 I %ARG]"" S %=%ARG D ^DIM1 G ER:%ERR
8 G GC^DIM
9 ;
10CL ; CLOSE (C^DIM)
11 G ER:%ERR I %ARG]"" F %Z=0:0 D S S %=%A D ^DIM1 G:%ARG=""!%ERR GC^DIM
12 G GC^DIM
13 ;
14IX ; IF and XECUTE (I^DIM and X^DIM)
15 G GC^DIM:%ARG=""!%ERR D S S %L=":" D S1 I %C=%L S %=%A1 D ^DIM1 G ER:%A1=""!%ERR
16 S %=%A D ^DIM1 G IX
17 ;
18ST ; SET and MERGE (S^DIM and M^DIM)
19 G GC^DIM:%ARG=""!%ERR D S G ER:%ERR!(%A=""&(%C=","))
20 I %A?1"@".E S %=%A D ^DIM1 G ST
21 S %L="=" D S1 G ER:(%A="")!(%A1="") S %=%A1 G ER:%COM="M"&'$$GLVN(%) D ^DIM1 G ER:%ERR
22 I %A?1"(".E1")" S %A=$E(%A,2,$L(%A)-1) G ER:%COM="M",STM
23 D VV G ST
24 ;
25STM ; SET (x,y)=... (ST)
26 G ST:%ERR!(%A=""),ER:%A?1",".E S %L="," D S1 G ER:%ERR!(%C=%L&(%A1=""))
27 D VV S %A=%A1 G STM
28 ;
29RD ; READ (R^DIM)
30 G GC^DIM:%ARG=""!%ERR D S G ER:%ERR!(%C=","&(%A=""))
31 I "!#?"[$E(%A,1) S %I=0 D FRM G RD
32 I %A?1"""".E G ER:$P(%A,"""",3)'="" S %=%A D ^DIM1 G RD
33 I %A?1"*".E S %A=$E(%A,2,999)
34 I $E(%A)="^","^TMP^XTMP^"'[$P(%A,"(") G ER
35 F %L=":","#" D G ER:%ERR
36 . D S1 Q:%ERR
37 . I %A="" S %ERR=1 Q
38 . I %A1="",%C=%L S %ERR=1 Q
39 . S %=%A1 D ^DIM1
40 D VV G ER:%ERR,RD
41 ;
42WR ; WRITE (W^DIM)
43 G GC^DIM:%ARG=""!%ERR D S G ER:%ERR!(%A=""&(%C=","))
44 I "!#?/"[$E(%A) S %I=0 D FRM G WR
45 S:%A?1"*".E %A=$E(%A,2,999) S %=%A D ^DIM1 G WR
46 ;
47FRM ; format (RD and WR)
48 S %I=%I+1,%C=$E(%A,%I) Q:%C="" G FRM:"!#"[%C
49 S %=$E(%A,%I+1,999) I %]"",%C="?" D ^DIM1 Q
50 I %C="/",%COM="W" S:%?1"?".E %="A"_$E(%,2,999) I %?1AN.E D ^DIM1 Q
51 S %ERR=1 Q
52 ;
53S ; split at first comma: end of first argument (*)
54 S (%A,%C)="" Q:%ERR S (%ERR,%I)=0
55INC D %INC D QT:%C="""",P:%C="(" Q:%ERR G OUT:","[%C,INC
56QT D %INC Q:%C="""" G QT:%C]"" S %ERR=1 Q
57P 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
58 Q
59OUT S %A=$E(%ARG,1,%I-1),%ARG=$E(%ARG,%I+1,999) Q
60%INC S %I=%I+1,%C=$E(%ARG,%I) Q
61 ;
62S1 ; split at first instance of %L (*)
63 S (%A1,%C)="" Q:%ERR S (%ERR,%I)=0
64INCR D %INC1 D QT1:%C="""",P1:%C="(" Q:%ERR G OUT1:%L[%C,INCR
65OUT1 S %A1=$E(%A,%I+1,999),%A=$E(%A,1,%I-1) Q
66QT1 D %INC1 Q:%C="""" G QT1:%C]"" S %ERR=1 Q
67P1 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
68 Q
69%INC1 S %I=%I+1,%C=$E(%A,%I) Q
70 ;
71VV ; glvn or setleft (ST, STM, and RD)
72 S %=%A Q:%ERR
73 I %]"",$$GLVN(%)=0 D
74 .I %COM'="S" S %ERR=1 Q
75 .I %["(",(%?1"$P".E)!(%?1"$E".E) Q
76 .I %="$X"!(%="$Y") Q
77 .I %="$D"!(%="$DEVICE")!(%="$K")!(%="$KEY")!(%="$EC")!(%="$ECODE")!(%="$ET")!(%="$ETRAP") S %ERR=1 Q ; SAC
78 .S %ERR=1
79 D ^DIM1:'%ERR Q
80 ;
81GLVN(%) ; glvn (not counting subscript syntax)
82 I %?.1"^"1U.UN Q 1
83 I %?.1"^"1U.UN1"("1.E1")" Q 1
84 I %?.1"^"1"%".UN Q 1
85 I %?.1"^"1"%".UN1"("1.E1")" Q 1
86 I %?1"^("1.E1")" Q 1
87 I %?1"^$"1.U1"("1.E1")" Q 1
88 I %?1"@"1.E Q 1
89 Q 0
90 ;
91ER G ER^DIM
Note: See TracBrowser for help on using the repository browser.