CIAUSTX ;MSC/IND/DKM - M syntax analyzer;04-May-2006 08:19;DKM
;;1.2;CIA UTILITIES;;Mar 20, 2007
;;Copyright 2000-2006, Medsphere Systems Corporation
;=================================================================
; Perform syntactic analysis of a line of M code.
; Inputs:
; CIAM = M statement(s)
; CIAO = Options:
; L = Line label allowed
; . = Dotted syntax allowed
; N = Do not init parsing tables
; D = Do not delete parsing tables
; Z = Process all Z-extensions as valid
; Outputs:
; Returns 0 if successfully parsed. Otherwise returns E^P^M
; where E is an error code (see ERRORS label), P is the
; character position where the error occurred, and M is the
; error message.
;=================================================================
ENTRY(CIAM,CIAO) ;
N CIAPSN,CIALEN,CIAERR,CIARN,CIAQT,CIAF,CIAPID,CIACMD
S CIAM=$$UP^XLFSTR(CIAM),CIAO=$$UP^XLFSTR($G(CIAO)),CIAPSN=1,CIALEN=$L(CIAM),CIAERR=0,CIAQT="""",CIAF=0,CIAPID="CIAUSTX",U="^"
D LOAD:CIAO'["N",PARSE:CIALEN
K:CIAO'["D" ^TMP(CIAPID,$J)
Q $S(CIAERR:CIAERR_U_$S(CIAPSN>CIALEN:CIALEN,1:CIAPSN)_U_$S(CIAERR<0:$$EC^%ZOSV,1:$P($T(ERRORS+CIAERR),";;",2)),1:0)
PARSE N CIAZ,CIAZ1
S @$$TRAP^CIAUOS("ERROR^CIAUSTX")
I CIAO["L" D Q:CIAERR
.S:$E(CIAM)'=" " CIAPSN=$$LABEL^CIAUSTX0
.I $$NEXT^CIAUSTX0("("),'$$NEXT^CIAUSTX0(")") D
..F CIAPSN=CIAPSN:1 D Q:$E(CIAM,CIAPSN)'=","!CIAERR
...S CIAPSN=$$NAME^CIAUSTX0(CIAPSN,"L%")
..Q:CIAERR
..S:'$$NEXT^CIAUSTX0(")") CIAERR=3
.S:" "'[$E(CIAM,CIAPSN) CIAERR=2
I CIAO["." F CIAPSN=CIAPSN:1:CIALEN+1 Q:". "'[$E(CIAM,CIAPSN)
F Q:CIAERR D SKPSPC Q:";"[$E(CIAM,CIAPSN) D
.S CIACMD=""
.F CIAPSN=CIAPSN:1 S CIAZ=$E(CIAM,CIAPSN) Q:CIAZ'?1A S CIACMD=CIACMD_CIAZ
.I CIACMD="" S CIAERR=4 Q
.I $D(^TMP(CIAPID,$J,"CMD",CIACMD)) S CIACMD=^(CIACMD)
.E I CIAO["Z" S CIACMD="PC;OPT;ARGS("":M"")"
.E S CIAERR=4 Q
.F CIARN=1:1:$L(CIACMD,";") D CMD^CIAUSTX0($P(CIACMD,";",CIARN)) Q:CIAERR!'CIARN
.I 'CIAERR," "'[$E(CIAM,CIAPSN) S CIAERR=2
.E S CIAPSN=CIAPSN+1
Q
; Skip over blanks
SKPSPC F Q:'$$NEXT^CIAUSTX0(" ")
Q
; Load tables
LOAD N CIAZ,CIAZ1,CIAZ2,CIAL
K ^TMP(CIAPID,$J)
F CIAL="CMD","FCN","SYS" D
.F CIAZ=1:1 S CIAZ1=$P($T(@CIAL+CIAZ),";;",2,999) Q:CIAZ1="" D
..S CIAZ2=$P(CIAZ1,";"),CIAZ1=$P(CIAZ1,";",2,999)
..F Q:CIAZ2="" D
...S ^TMP(CIAPID,$J,CIAL,$P(CIAZ2,","))=CIAZ1,CIAZ2=$P(CIAZ2,",",2,999)
Q
ERROR S CIAERR=-1
Q
CMD ;;*Commands*
;;B,BREAK;PC;OPT;ARGS()
;;C,CLOSE;PC;ARGS(":M")
;;D,DO;PC;OPT;LBL(2)
;;E,ELSE;NPC;OPT;ARGS()
;;F,FOR;NPC;OPT;FOR
;;G,GOTO;PC;LBL(1)
;;H,HALT,HANG;PC;OPT;EXP()
;;I,IF;NPC;OPT;ARGS()
;;J,JOB;PC;LBL(2)
;;K,KILL;PC;OPT;KILL
;;L,LOCK;PC;OPT;LOCK
;;M,MERGE;PC;MERGE
;;N,NEW;PC;OPT;NEW
;;O,OPEN;PC;ARGS(":M")
;;Q,QUIT;PC;OPT;EXP()
;;R,READ;PC;READ
;;S,SET;PC;SET
;;U,USE;PC;ARGS(":M")
;;V,VIEW;PC;ARGS(":M")
;;W,WRITE;PC;WRITE
;;X,XECUTE;PC;ARGS(":")
;;ZT,ZTRAP;PC;OPT;EXP()
;;ZS,ZSAVE;PC;OPT;EXP()
;;ZR,ZREMOVE;PC;OPT;LBL(1)
;;ZP,ZPRINT
;;
FCN ;;*Intrinsic functions*
;;A,ASCII;;1-2
;;C,CHAR;;1-999
;;D,DATA;;1-1;V
;;E,EXTRACT;S;1-3
;;F,FIND;;2-3
;;FN,FNUMBER;;2-3
;;G,GET;;1-2;V
;;J,JUSTIFY;;1-3
;;L,LENGTH;;1-2
;;N,NEXT;;1-2
;;NA,NAME;;1-2;V
;;O,ORDER;;1-2;V
;;P,PIECE;S;2-4
;;Q,QUERY;;1-2;V
;;R,RANDOM;;1-1
;;S,SELECT;:;1-999
;;T,TEXT;;1-1;L
;;TR,TRANSLATE;;2-3
;;V,VIEW;;1-999
;;
SYS ;;*System variables*
;;D,DEVICE
;;ET,ETRAP;SN
;;H,HOROLOG
;;I,IO
;;J,JOB
;;K,KEY
;;P,PRINCIPAL
;;S,STORAGE
;;SY,SYSTEM
;;T,TEST
;;TL,TLEVEL
;;TR,TRESTART
;;X;S
;;Y;S
;;ZT,ZTRAP;S
;;ZE,ZERROR;S
;;ES,ESTACK;N
;;EC,ECODE;S
ERRORS ;;*Error messages*
;;Bad variable name
;;Syntax error
;;Unbalanced parentheses
;;Unrecognized command
;;Postconditional not allowed
;;Missing operand
;;Unrecognized intrinsic function/variable
;;Incorrect number of arguments
;;Missing closing quote
;;Illegal pattern
;;Bad label name
;;Name too long
;;13
CIAUSTX ;MSC/IND/DKM - M syntax analyzer;04-May-2006 08:19;DKM
+1 ;;1.2;CIA UTILITIES;;Mar 20, 2007
+2 ;;Copyright 2000-2006, Medsphere Systems Corporation
+3 ;=================================================================
+4 ; Perform syntactic analysis of a line of M code.
+5 ; Inputs:
+6 ; CIAM = M statement(s)
+7 ; CIAO = Options:
+8 ; L = Line label allowed
+9 ; . = Dotted syntax allowed
+10 ; N = Do not init parsing tables
+11 ; D = Do not delete parsing tables
+12 ; Z = Process all Z-extensions as valid
+13 ; Outputs:
+14 ; Returns 0 if successfully parsed. Otherwise returns E^P^M
+15 ; where E is an error code (see ERRORS label), P is the
+16 ; character position where the error occurred, and M is the
+17 ; error message.
+18 ;=================================================================
ENTRY(CIAM,CIAO) ;
+1 NEW CIAPSN,CIALEN,CIAERR,CIARN,CIAQT,CIAF,CIAPID,CIACMD
+2 SET CIAM=$$UP^XLFSTR(CIAM)
SET CIAO=$$UP^XLFSTR($GET(CIAO))
SET CIAPSN=1
SET CIALEN=$LENGTH(CIAM)
SET CIAERR=0
SET CIAQT=""""
SET CIAF=0
SET CIAPID="CIAUSTX"
SET U="^"
+3 IF CIAO'["N"
DO LOAD
IF CIALEN
DO PARSE
+4 IF CIAO'["D"
KILL ^TMP(CIAPID,$JOB)
+5 QUIT $SELECT(CIAERR:CIAERR_U_$SELECT(CIAPSN>CIALEN:CIALEN,1:CIAPSN)_U_$SELECT(CIAERR<0:$$EC^%ZOSV,1:$PIECE($TEXT(ERRORS+CIAERR),";;",2)),1:0)
PARSE NEW CIAZ,CIAZ1
+1 SET @$$TRAP^CIAUOS("ERROR^CIAUSTX")
+2 IF CIAO["L"
Begin DoDot:1
+3 IF $EXTRACT(CIAM)'=" "
SET CIAPSN=$$LABEL^CIAUSTX0
+4 IF $$NEXT^CIAUSTX0("(")
IF '$$NEXT^CIAUSTX0(")")
Begin DoDot:2
+5 FOR CIAPSN=CIAPSN:1
Begin DoDot:3
+6 SET CIAPSN=$$NAME^CIAUSTX0(CIAPSN,"L%")
End DoDot:3
IF $EXTRACT(CIAM,CIAPSN)'=","!CIAERR
QUIT
+7 IF CIAERR
QUIT
+8 IF '$$NEXT^CIAUSTX0(")")
SET CIAERR=3
End DoDot:2
+9 IF " "'[$EXTRACT(CIAM,CIAPSN)
SET CIAERR=2
End DoDot:1
IF CIAERR
QUIT
+10 IF CIAO["."
FOR CIAPSN=CIAPSN:1:CIALEN+1
IF ". "'[$EXTRACT(CIAM,CIAPSN)
QUIT
+11 FOR
IF CIAERR
QUIT
DO SKPSPC
IF ";"[$EXTRACT(CIAM,CIAPSN)
QUIT
Begin DoDot:1
+12 SET CIACMD=""
+13 FOR CIAPSN=CIAPSN:1
SET CIAZ=$EXTRACT(CIAM,CIAPSN)
IF CIAZ'?1A
QUIT
SET CIACMD=CIACMD_CIAZ
+14 IF CIACMD=""
SET CIAERR=4
QUIT
+15 IF $DATA(^TMP(CIAPID,$JOB,"CMD",CIACMD))
SET CIACMD=^(CIACMD)
+16 IF '$TEST
IF CIAO["Z"
SET CIACMD="PC;OPT;ARGS("":M"")"
+17 IF '$TEST
SET CIAERR=4
QUIT
+18 FOR CIARN=1:1:$LENGTH(CIACMD,";")
DO CMD^CIAUSTX0($PIECE(CIACMD,";",CIARN))
IF CIAERR!'CIARN
QUIT
+19 IF 'CIAERR
IF " "'[$EXTRACT(CIAM,CIAPSN)
SET CIAERR=2
+20 IF '$TEST
SET CIAPSN=CIAPSN+1
End DoDot:1
+21 QUIT
+22 ; Skip over blanks
SKPSPC FOR
IF '$$NEXT^CIAUSTX0(" ")
QUIT
+1 QUIT
+2 ; Load tables
LOAD NEW CIAZ,CIAZ1,CIAZ2,CIAL
+1 KILL ^TMP(CIAPID,$JOB)
+2 FOR CIAL="CMD","FCN","SYS"
Begin DoDot:1
+3 FOR CIAZ=1:1
SET CIAZ1=$PIECE($TEXT(@CIAL+CIAZ),";;",2,999)
IF CIAZ1=""
QUIT
Begin DoDot:2
+4 SET CIAZ2=$PIECE(CIAZ1,";")
SET CIAZ1=$PIECE(CIAZ1,";",2,999)
+5 FOR
IF CIAZ2=""
QUIT
Begin DoDot:3
+6 SET ^TMP(CIAPID,$JOB,CIAL,$PIECE(CIAZ2,","))=CIAZ1
SET CIAZ2=$PIECE(CIAZ2,",",2,999)
End DoDot:3
End DoDot:2
End DoDot:1
+7 QUIT
ERROR SET CIAERR=-1
+1 QUIT
CMD ;;*Commands*
+1 ;;B,BREAK;PC;OPT;ARGS()
+2 ;;C,CLOSE;PC;ARGS(":M")
+3 ;;D,DO;PC;OPT;LBL(2)
+4 ;;E,ELSE;NPC;OPT;ARGS()
+5 ;;F,FOR;NPC;OPT;FOR
+6 ;;G,GOTO;PC;LBL(1)
+7 ;;H,HALT,HANG;PC;OPT;EXP()
+8 ;;I,IF;NPC;OPT;ARGS()
+9 ;;J,JOB;PC;LBL(2)
+10 ;;K,KILL;PC;OPT;KILL
+11 ;;L,LOCK;PC;OPT;LOCK
+12 ;;M,MERGE;PC;MERGE
+13 ;;N,NEW;PC;OPT;NEW
+14 ;;O,OPEN;PC;ARGS(":M")
+15 ;;Q,QUIT;PC;OPT;EXP()
+16 ;;R,READ;PC;READ
+17 ;;S,SET;PC;SET
+18 ;;U,USE;PC;ARGS(":M")
+19 ;;V,VIEW;PC;ARGS(":M")
+20 ;;W,WRITE;PC;WRITE
+21 ;;X,XECUTE;PC;ARGS(":")
+22 ;;ZT,ZTRAP;PC;OPT;EXP()
+23 ;;ZS,ZSAVE;PC;OPT;EXP()
+24 ;;ZR,ZREMOVE;PC;OPT;LBL(1)
+25 ;;ZP,ZPRINT
+26 ;;
FCN ;;*Intrinsic functions*
+1 ;;A,ASCII;;1-2
+2 ;;C,CHAR;;1-999
+3 ;;D,DATA;;1-1;V
+4 ;;E,EXTRACT;S;1-3
+5 ;;F,FIND;;2-3
+6 ;;FN,FNUMBER;;2-3
+7 ;;G,GET;;1-2;V
+8 ;;J,JUSTIFY;;1-3
+9 ;;L,LENGTH;;1-2
+10 ;;N,NEXT;;1-2
+11 ;;NA,NAME;;1-2;V
+12 ;;O,ORDER;;1-2;V
+13 ;;P,PIECE;S;2-4
+14 ;;Q,QUERY;;1-2;V
+15 ;;R,RANDOM;;1-1
+16 ;;S,SELECT;:;1-999
+17 ;;T,TEXT;;1-1;L
+18 ;;TR,TRANSLATE;;2-3
+19 ;;V,VIEW;;1-999
+20 ;;
SYS ;;*System variables*
+1 ;;D,DEVICE
+2 ;;ET,ETRAP;SN
+3 ;;H,HOROLOG
+4 ;;I,IO
+5 ;;J,JOB
+6 ;;K,KEY
+7 ;;P,PRINCIPAL
+8 ;;S,STORAGE
+9 ;;SY,SYSTEM
+10 ;;T,TEST
+11 ;;TL,TLEVEL
+12 ;;TR,TRESTART
+13 ;;X;S
+14 ;;Y;S
+15 ;;ZT,ZTRAP;S
+16 ;;ZE,ZERROR;S
+17 ;;ES,ESTACK;N
+18 ;;EC,ECODE;S
ERRORS ;;*Error messages*
+1 ;;Bad variable name
+2 ;;Syntax error
+3 ;;Unbalanced parentheses
+4 ;;Unrecognized command
+5 ;;Postconditional not allowed
+6 ;;Missing operand
+7 ;;Unrecognized intrinsic function/variable
+8 ;;Incorrect number of arguments
+9 ;;Missing closing quote
+10 ;;Illegal pattern
+11 ;;Bad label name
+12 ;;Name too long
+13 ;;13
