DIM ;SFISC/JFW,GFT,TOAD-FileMan: M Syntax Checker, Main ;28APR2016
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
S %X=X,%END="",%ERR=0,%LAST="" G ER:X'?.ANP
;
GC ; get next command on line (*)
G ER:%ERR,LAST:";"[$E(%X) F Q:$E(%X)'=" " S %X=$E(%X,2,999)
G ER:"BCDEFGHIKLMNOQRSUWXZ"'[$E(%X)
S %LAST=%X D SEP G ER:%ERR S %COM=$P(%ARG,":") ; command word
I $L(%COM)>1 D G ER:%ERR
. I $T(COMMAND)'[(";"_%COM_";"),%COM'?1"Z"1.U S %ERR=1
. E S %COM=$E(%COM)
S %=$P(%ARG,":",2,99),%COM(1)=% I %ARG[":",%="" G ER ; command postcond
I %]"" D ^DIM1 G ER:%ERR
D SEP G ER:%ERR I %ARG="","CDGMORSUWXZ"[%COM G ER ; argument list
S %END=%ARG G @%COM
;
B G GC:%ARG=""&(%COM(1)=""),BK^DIM4
C G CL^DIM4
D G DG^DIM3
E G GC:%ARG=""&(%COM(1)=""),ER
F G ER:%COM(1)]""!(";"[$E(%X)),GC:%ARG="",FR^DIM3 ;GFT-DON'T END WITH 'F'
G G DG^DIM3
H G GC:%ARG=""&(%COM(1)="")&(%X]""),HN^DIM3:%ARG]"",ER Q
I G ER:%COM(1)]"",IX^DIM4
K G GC:%ARG=""&(%COM(1)="")&(%X]""),KL^DIM3:%ARG]"",ER
L G LK^DIM3
M G S
N G ER:%ARG=""&(%X=""),K
O G OP^DIM3
Q G ER:%ARG]"",GC:%ARG=""&(%COM(1)=""),BK^DIM4
R G RD^DIM4
S G ST^DIM4
U G OP^DIM3
W G WR^DIM4
X G IX^DIM4
Z G GC
;
SEP ; remove first " "-piece of %X into %ARG: parse commands (GC)
F %I=1:1 S %C=$E(%X,%I) D:%C="""" Q:" "[%C
. N %OUT S %OUT=0 F D Q:%OUT!%ERR
. . S %I=%I+1,%C=$E(%X,%I) I %C="" S %ERR=1 Q
. . Q:%C'="""" S %I=%I+1,%C=$E(%X,%I) Q:%C="""" S %OUT=1
S %ARG=$E(%X,1,%I-1),%I=%I+1,%X=$E(%X,%I,999)
Q
;
COMMAND ;;BREAK;CLOSE;DO;ELSE;FOR;GOTO;HALT;HANG;IF;KILL;LOCK;MERGE;NEW;OPEN;QUIT;READ;SET;USE;WRITE;XECUTE;
;
LAST ; check to ensure no trailing "," at end of command (GC)
S %L=$L(%LAST),$E(%LAST,%L+1-$L(%X),%L)=""
I $E(%END,$L(%END))="," G ER
;I $E(%X)="",$E(%LAST,%L)=" " G ER Trailing space is OK
G END
;
ER K X
END K %,%A,%A1,%A2,%ARG,%C1,%C,%COM,%END,%ERR,%H,%I,%L,%LAST,%P,%X,%Z Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIM 2162 printed Dec 13, 2024@02:49:23 Page 2
DIM ;SFISC/JFW,GFT,TOAD-FileMan: M Syntax Checker, Main ;28APR2016
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 SET %X=X
SET %END=""
SET %ERR=0
SET %LAST=""
if X'?.ANP
GOTO ER
+8 ;
GC ; get next command on line (*)
+1 if %ERR
GOTO ER
if ";"[$EXTRACT(%X)
GOTO LAST
FOR
if $EXTRACT(%X)'=" "
QUIT
SET %X=$EXTRACT(%X,2,999)
+2 if "BCDEFGHIKLMNOQRSUWXZ"'[$EXTRACT(%X)
GOTO ER
+3 ; command word
SET %LAST=%X
DO SEP
if %ERR
GOTO ER
SET %COM=$PIECE(%ARG,":")
+4 IF $LENGTH(%COM)>1
Begin DoDot:1
+5 IF $TEXT(COMMAND)'[(";"_%COM_";")
IF %COM'?1"Z"1.U
SET %ERR=1
+6 IF '$TEST
SET %COM=$EXTRACT(%COM)
End DoDot:1
if %ERR
GOTO ER
+7 ; command postcond
SET %=$PIECE(%ARG,":",2,99)
SET %COM(1)=%
IF %ARG[":"
IF %=""
GOTO ER
+8 IF %]""
DO ^DIM1
if %ERR
GOTO ER
+9 ; argument list
DO SEP
if %ERR
GOTO ER
IF %ARG=""
IF "CDGMORSUWXZ"[%COM
GOTO ER
+10 SET %END=%ARG
GOTO @%COM
+11 ;
B if %ARG=""&(%COM(1)="")
GOTO GC
GOTO BK^DIM4
C GOTO CL^DIM4
D GOTO DG^DIM3
E if %ARG=""&(%COM(1)="")
GOTO GC
GOTO ER
F ;GFT-DON'T END WITH 'F'
if %COM(1)]""!(";"[$EXTRACT(%X))
GOTO ER
if %ARG=""
GOTO GC
GOTO FR^DIM3
G GOTO DG^DIM3
H if %ARG=""&(%COM(1)="")&(%X]"")
GOTO GC
if %ARG]""
GOTO HN^DIM3
GOTO ER
QUIT
I if %COM(1)]""
GOTO ER
GOTO IX^DIM4
K if %ARG=""&(%COM(1)="")&(%X]"")
GOTO GC
if %ARG]""
GOTO KL^DIM3
GOTO ER
L GOTO LK^DIM3
M GOTO S
N if %ARG=""&(%X="")
GOTO ER
GOTO K
O GOTO OP^DIM3
Q if %ARG]""
GOTO ER
if %ARG=""&(%COM(1)="")
GOTO GC
GOTO BK^DIM4
R GOTO RD^DIM4
S GOTO ST^DIM4
U GOTO OP^DIM3
W GOTO WR^DIM4
X GOTO IX^DIM4
Z GOTO GC
+1 ;
SEP ; remove first " "-piece of %X into %ARG: parse commands (GC)
+1 FOR %I=1:1
SET %C=$EXTRACT(%X,%I)
if %C=""""
Begin DoDot:1
+2 NEW %OUT
SET %OUT=0
FOR
Begin DoDot:2
+3 SET %I=%I+1
SET %C=$EXTRACT(%X,%I)
IF %C=""
SET %ERR=1
QUIT
+4 if %C'=""""
QUIT
SET %I=%I+1
SET %C=$EXTRACT(%X,%I)
if %C=""""
QUIT
SET %OUT=1
End DoDot:2
if %OUT!%ERR
QUIT
End DoDot:1
if " "[%C
QUIT
+5 SET %ARG=$EXTRACT(%X,1,%I-1)
SET %I=%I+1
SET %X=$EXTRACT(%X,%I,999)
+6 QUIT
+7 ;
COMMAND ;;BREAK;CLOSE;DO;ELSE;FOR;GOTO;HALT;HANG;IF;KILL;LOCK;MERGE;NEW;OPEN;QUIT;READ;SET;USE;WRITE;XECUTE;
+1 ;
LAST ; check to ensure no trailing "," at end of command (GC)
+1 SET %L=$LENGTH(%LAST)
SET $EXTRACT(%LAST,%L+1-$LENGTH(%X),%L)=""
+2 IF $EXTRACT(%END,$LENGTH(%END))=","
GOTO ER
+3 ;I $E(%X)="",$E(%LAST,%L)=" " G ER Trailing space is OK
+4 GOTO END
+5 ;
ER KILL X
END KILL %,%A,%A1,%A2,%ARG,%C1,%C,%COM,%END,%ERR,%H,%I,%L,%LAST,%P,%X,%Z
QUIT
