Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIM1

DIM1.m

Go to the documentation of this file.
  1. DIM1 ;SFISC/JFW,GFT,TOAD - M Syntax Checker, Exprs ; Dec 13, 2009
  1. ;;22.2;VA FileMan;**18**;Jan 05, 2016;Build 2
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. Q:%ERR N %A,%A1 S (%I,%N,%ERR,%(-1,2),%(-1,3))=0
  1. ;
  1. GG ; expr, expratom, expritem, subscript, parameter (called everywhere)
  1. D %INC G:%C="" FINISH^DIM2
  1. G E:%C=";"!($A(%C)>95)!($A(%C)<33)
  1. G QUOTE:%C="""",FUNC:%C="$",SUB^DIM2:%C="(",UP^DIM2:%C=")"
  1. G AR^DIM2:%C=",",SEL^DIM2:%C=":",GLO^DIM2:%C="^"
  1. EXP I %C="E",$E(%,%I-1)?1N D G E:%ERR S %I=%I-1 G GG
  1. . S %L1=$E(%,%I+1)
  1. . I %L1'?1(1N,1"+",1"-") S %ERR=1 Q
  1. . N %OUT S %OUT=0 F %I=%I+2:1 D Q:%ERR!%OUT
  1. . . S %C=$E(%,%I)
  1. . . I "<>=!&'[]+-*/\#_?,:)"[%C S %OUT=1 Q
  1. . . I %C'?1N S %ERR=1 Q
  1. I %C?1(1U,1"%") D VAR^DIM2
  1. G E:%ERR,GG:%C=""
  1. G PAT^DIM2:%C="?",BINOP^DIM2:"=[]<>&!"[%C,MTHOP^DIM2:"/\*#_"[%C
  1. G UNOP^DIM2:"'+-"[%C,IND^DIM2:%C="@"
  1. PERIOD I %C="." D G E:%ERR
  1. . I $P($G(%(%N-1,0)),"^")="P" D Q
  1. . . N %C S %C=$E(%,%I+1) I %C?1N Q ; decimal pass by value
  1. . . I %C'="@",%C'?1U,%C'="%" S %ERR=1 ; bad pass by reference
  1. . D %INC N %L1,%P S %L1=$E(%,%I-2),%P="':=+-\/<>[](,*&!_#"
  1. . I %L1?1N,%C?1N Q ; 4.2
  1. . I %P[%L1,%C?1N Q ; +.2
  1. . S %ERR=1 ; illegal period
  1. I %C?1N,$E(%,%I+1)]"" G E:$E(%,%I+1)'?1(1NP,1"E")
  1. GG1 ;
  1. I %C]"","$(),:"""[%C S %I=%I-1
  1. G GG
  1. ;
  1. QUOTE ; strlit (GG)
  1. F %J=0:0 D %INC Q:%C=""!(%C="""")
  1. G E:%C=""!("[]()><\/+-=&!_#*,;:'"""'[$E(%,%I+1)) D:$D(%(%N-1,"F")) FN:%(%N-1,"F")["FN" G E:%ERR,GG
  1. ;
  1. FUNC ; intrinsics & extrinsics, mainly intrinsic functions (GG)
  1. D %INC G EXT:%C="$",E:%C'?1U,SPV:$E(%,%I,999)'?.U1"(".E,FUNC1:%C="Z"!($E(%,%I+1)="(")
  1. S %T=$E(%,%I,$F(%,"(",%I)-2)
  1. I %T="ST"!(%T="STACK") G E ; SAC
  1. F %F1="FNUMBER^2;3","TRANSLATE^2;3","NAME^1;2","QLENGTH^1;1","QSUBSCRIPT^2;2","REVERSE^1;1" G FUNC2:$E(%F1,1,2)=%T,FUNC2:$P(%F1,"^")=%T
  1. FNC ;;,ASCII^1;2,CHAR^1;999,DATA^1;1,EXTRACT^1;3,FIND^2;3,GET^1;2,JUSTIFY^2;3,LENGTH^1;2,ORDER^1;2,PIECE^2;4,QUERY^1;1,RANDOM^1;1,SELECT^1;999,TEXT^1;1,VIEW^1;999,ZFUNC^1;999
  1. G E:$T(FNC)'[(","_%T_"^")
  1. FUNC1 S %F1=$P($T(FNC),",",$F("ACDEFGJLOPQRSTVZ",%C)) G E:%F1=""
  1. FUNC2 S %I=$F(%,"(",%I)-1,%(%N,0)="1^"_$P(%F1,"^",2),%(%N,1)=0,%(%N,2)=0,%(%N,3)=0,%(%N,"F")=%F1,%N=%N+1 S:$E(%F1)="S" %(%N-1,2)=1
  1. I ",DATA,NAME,ORDER,QUERY,GET,"[(","_$P(%F1,"^")_",") G DATA^DIM2
  1. I $E(%F1)="T",$E(%F1,2)'="R" D I %ERR G ERR^DIM2
  1. . S %A=%I,%I=$F(%,")",%A)-1,%N=%N-1,%A=$P($E(%,%A,%I-1),"(",2,99)
  1. . I %A?1"+"1N.E S %A=$E(%A,2,999)
  1. . N %,%I,%N S %=%A D LABEL^DIM3(1)
  1. G GG
  1. ;
  1. SPV ; intrinsic special variables (FUNC)
  1. I $E(%,%I+1)?1U S %I=%I+1,%C=%C_$E(%,%I) G SPV
  1. I ",D,EC,ES,ET,K,P,Q,ST,SY,TL,TR,"[(","_%C_",") G E ; SAC
  1. I "HIJSTXYZ"[%C&(%C?1U)!(%C?1"Z".U) G GG
  1. I "[],)><=_&#!'+-*\/?"'[$E(%,%I+1) G E
  1. I ",DEVICE,ECODE,ESTACK,ETRAP,KEY,PRINCIPAL,QUIT,STACK,SYSTEM,TLEVEL,TRESTART,"[(","_%C_",") G E ; SAC
  1. I ",HOROLOG,IO,JOB,STORAGE,TEST,"[(","_%C_",") G GG
  1. E G ERR^DIM2
  1. ;
  1. %INC S %I=%I+1,%C=$E(%,%I) Q
  1. ;
  1. FN ; literal string argument 2 of $FNUMBER (QUOTE)
  1. Q:%(%N-1,1)'=1 F %FZ=%I-1:-1 S %FN=$E(%,%FZ) Q:%FN=""""
  1. S %FN=$TR($E(%,%FZ+1,%I-1),"pt","PT")
  1. F %FZ=1:1 Q:$E(%FN,%FZ)="" I "+-,TP"'[$E(%FN,%FZ) S %ERR=1 Q
  1. Q:%ERR I %FN["P" F %FZ=1:1 Q:$E(%FN,%FZ)="" I "+-T"[$E(%FN,%FZ) S %ERR=1 Q
  1. Q
  1. ;
  1. EXT ; extrinsic functions and variables (FUNC)
  1. D %INC
  1. F %I=%I+1:1 S %C1=$E(%,%I) Q:%C1?1PC&("^%"'[%C1)!(%C1="") S %C=%C_%C1
  1. G:%C="" E G:%C?.E1"^" E G:%C["^^" E
  1. S %C1=$P(%C,"^",2) I %C1]"",%C1'?1U.15AN,%C1'?1"%".15AN G E
  1. S %C=$P(%C,"^") I %C]"",%C'?1U.15AN,%C'?1"%".15AN,%C'?1.16N G E ;p18
  1. I $E(%,%I)="(",$E(%,%I+1)'=")" S %(%N,0)="P^",(%(%N,1),%(%N,2),%(%N,3))=0,%N=%N+1 G GG
  1. S %I=%I+$S($E(%,%I,%I+1)="()":1,1:-1)
  1. G GG:"[],)><=_&#!'+-*/\?:"[$E(%,%I+1),E