- 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 Jan 18, 2025@03:50:22 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