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

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

initial load of WorldVistAEHR

File size: 4.8 KB
Line 
1ARJTDIM ;SFISC/JFW,GFT,TOAD-FileMan: M Syntax Checker, Main ;5/27/2004 00:26
2 ;;3.0T1;OPENVISTA;;Jun 20, 2004
3 ;
4 ; Change History:
5 ; 2004 05 27 WV/TOAD: added "^[]" to FIND in Input
6 ;
7CHECK(CODE,FIND,FOUND) ; ** Parse & Evaluate a Line of Code **
8 ;
9 ; Input:
10 ; FIND = Optional. Code for special search to include.
11 ; Defaults to normal parsing with no special search.
12 ; "DSM" looks for potentially DSM-specific language elements.
13 ; "DSM2" is a tighter version, e.g., flag USE only if params.
14 ; "?(" looks for alternation in pattern match.
15 ; "?@" looks for pattern indirection.
16 ; "D" looks for DO commands (for testing).
17 ; "^[]" looks for extended global references.
18 ; each new special search must be hand-coded.
19 ; In/Output:
20 ; .FOUND = results of special search. 1 = successful.
21 ; .FOUND(language element) = # times that element was found.
22 ; for example, FOUND("D") means found DO command.
23 ; "DSM" search also returns FOUND("DSM",element).
24 ; Both of these in/outputs are cumulative. That is, if passed in
25 ; with values, they are additive; if not, they initialize.
26 ;
27 S FIND=$G(FIND)
28 S FOUND=+$G(FOUND) ; nothing special found
29 S %X=CODE ; parse buffer
30 S %END=""
31 S %ERR=0 ; no error so far
32 S %LAST=""
33 I CODE'?.ANP D I %X'?.ANP G ER ; no control characters allowed
34 . D DSM(,"CONTROL CHARACTER",FIND,.FOUND)
35 . S %X=$TR(%X,$C(9)," ")
36 ;
37GC ; get next command on line (*)
38 ;
39 ; Errors
40 G ER:%ERR ; bail out if we've found an error
41 G LAST:";"[$E(%X) ; we're done if the next item is a comment
42 ; otherwise it must be a command
43 I "BCDEFGHIKLMNOQRSUWXZ"'[$E(%X) D:$E(%X)="V" G ER
44 . D DSM("V","VIEW",FIND,.FOUND)
45 ;
46 ; Command words
47 S %LAST=%X D SEP G ER:%ERR ; extract command word with optional timeout
48 S %COM=$P(%ARG,":") ; separate command word from timeout
49 S %COMMAND=%COM ; unabbreviated command word
50 I $L(%COM)>1 D G ER:%ERR ; deal with spelled out command words
51 . I $T(COMMAND)'[(";"_%COM_";"),%COM'?1"Z"1.U S %ERR=1
52 . E S %COM=$E(%COM) ; re-abbreviate for later select
53 ;
54 ; Post-Conditions
55 S %=$P(%ARG,":",2,99) ; extract post-condition
56 S %COM(1)=% ; save it off
57 I %ARG[":",%="" G ER ; empty postcond is an error
58 I %]"" D ^ARJTDIM1 G ER:%ERR ; otherwise it better be an expr
59 ;
60 ; Argument List
61 D SEP G ER:%ERR ; extract argument list into %ARG
62 I %ARG="","CGMORSUWXZ"[%COM G ER ; some commands can be argumentless
63 S %END=%ARG
64 I $G(MAH) W !?10,%COM,!
65 G @%COM ; Handle each command as a separate case
66 ;
67B D DSM("B","BREAK",FIND,.FOUND)
68 G GC:%ARG=""&(%COM(1)="")
69 G BK^ARJTDIM4
70C D DSM("C","CLOSE",FIND,.FOUND)
71 G CL^ARJTDIM4
72D D ADD("D",.FOUND) S FOUND=FIND="D"!FOUND G DG^ARJTDIM3
73E D ADD("E",.FOUND) G GC:%ARG=""&(%COM(1)=""),ER
74F D ADD("F",.FOUND) G ER:%COM(1)]"",GC:%ARG="",FR^ARJTDIM3
75G D ADD("G",.FOUND) G DG^ARJTDIM3
76H D ADD("H",.FOUND) G GC:%ARG=""&(%COM(1)="")&(%X]""),HN^ARJTDIM3:%ARG]"",ER Q
77I D ADD("I",.FOUND) G ER:%COM(1)]"",IX^ARJTDIM4
78K D:'$D(ZZDNEW) ADD("K",.FOUND) K ZZDNEW
79 G GC:%ARG=""&(%COM(1)="")&(%X]"")
80 G KL^ARJTDIM3:%ARG]""
81 G ER
82L D ADD("L",.FOUND) G LK^ARJTDIM3
83M D ADD("M",.FOUND) G S
84N D ADD("N",.FOUND) G ER:%ARG=""&(%X="") S ZZDNEW=1 G K
85O D DSM("O","OPEN",FIND,.FOUND)
86 G OP^ARJTDIM3
87Q D ADD("Q",.FOUND) G ER:%ARG]"",GC:%ARG=""&(%COM(1)=""),BK^ARJTDIM4
88R D ADD("R",.FOUND) G RD^ARJTDIM4
89S D ADD("S",.FOUND) G ST^ARJTDIM4
90U D ADD("U",.FOUND) G OP^ARJTDIM3
91W D ADD("W",.FOUND) G WR^ARJTDIM4
92X D ADD("X",.FOUND) G IX^ARJTDIM4
93Z D DSM(%COM,%COMMAND,FIND,.FOUND) G GC ; don't parse args of Z commands
94 ;
95SEP ; remove first " "-piece of %X into %ARG: parse commands (GC)
96 F %I=1:1 S %C=$E(%X,%I) D:%C="""" Q:" "[%C
97 . N %OUT S %OUT=0 F D Q:%OUT!%ERR
98 . . S %I=%I+1,%C=$E(%X,%I) I %C="" S %ERR=1 Q
99 . . Q:%C'="""" S %I=%I+1,%C=$E(%X,%I) Q:%C="""" S %OUT=1
100 S %ARG=$E(%X,1,%I-1),%I=%I+1,%X=$E(%X,%I,999)
101 Q
102 ;
103COMMAND ;;BREAK;CLOSE;DO;ELSE;FOR;GOTO;HALT;HANG;IF;KILL;LOCK;MERGE;NEW;OPEN;QUIT;READ;SET;USE;WRITE;XECUTE;
104 ;
105LAST ; check to ensure no trailing "," or " " at end of command (GC)
106 S %L=$L(%LAST),$E(%LAST,%L+1-$L(%X),%L)=""
107 I $E(%END,$L(%END))="," G ER
108 I $E(%X)="",$E(%LAST,%L)=" " G ER
109 G END
110 ;
111ADD(ELEMENT,FOUND) ; record element found
112 ; Input: ELEMENT = code for element found, e.g., "F".
113 ; Output: .FOUND(ELEMENT) = increment # times found
114 S FOUND(ELEMENT)=$G(FOUND(ELEMENT))+1
115 Q ; end of DSM
116 ;
117DSM(ABBREV,ELEMENT,FIND,FOUND) ; record DSM-specific element found
118 ; Input:
119 ; ABBREV = code for element found, e.g., "V"
120 ; ELEMENT = name of element found, e.g., "VIEW".
121 ; Output:
122 ; .FOUND(ABBREV) = increment # times found
123 ; .FOUND("DSM",ELEMENT) = ditto
124 I $G(ABBREV)'="" D ADD(ABBREV,.FOUND)
125 I FIND["DSM" D
126 . S FOUND=1
127 . S FOUND("DSM",ELEMENT)=$G(FOUND("DSM",ELEMENT))+1
128 Q ; end of DSM
129 ;
130ER D ADD("ERROR",.FOUND) ;
131END K %,%A,%A1,%A2,%ARG,%C1,%C,%COM,%END,%ERR,%H,%I,%L,%LAST,%P,%X,%Z Q
Note: See TracBrowser for help on using the repository browser.