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

DIM3.m

Go to the documentation of this file.
  1. DIM3 ;SFISC/JFW,GFT,TOAD-FileMan: M Syntax Checker, Commands ;25MAR2010
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  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. ;
  1. DG ; DO and GET (D^DIM and G^DIM)
  1. G GC^DIM:%ARG=""!%ERR D PARS G ER:%ERR
  1. S %L=":" D PARS1 G ER:%ERR I %C=%L G ER:%A1="" S %=%A1 D ^DIM1
  1. I %A["@^" S %=%A D ^DIM1 G DG
  1. I %A["(",$E(%A)'="@",$E($P(%A,"^",2))'="@" D G ER:%ERR
  1. . I %COM'="D" S %ERR=1 Q
  1. . S %=%A
  1. . I %'?.E1"(".E1")" S %ERR=1 Q
  1. . S %C=$P(%,"("),%C1=$P(%C,"^",2,999),%I=$F(%,"(")-1
  1. . I %C=""!(%C?.E1"^") S %ERR=1 Q
  1. . I %C1]"",%C1'?1U.15AN,%C1'?1"%".15AN S %ERR=1 Q
  1. . S %C=$P(%C,"^") I %C]"",%C'?1U.15AN,%C'?1"%".15AN,%C'?1.15N S %ERR=1 Q
  1. . Q:$E(%,%I,%I+1)="()"
  1. . S (%(-1,2),%(-1,3))=0,%N=1,%(0,0)="P^",(%(0,1),%(0,2),%(0,3))=0
  1. . D GG^DIM1
  1. E D LABEL(0)
  1. G DG
  1. ;
  1. LABEL(OFFSET) ; labelref, entryref, and $TEXT argument (DG and TEXT^DIM1)
  1. S %L="^" D PARS1 Q:%ERR
  1. I %C=%L S:%A1=""!($E(%A1)="^") %ERR=1 S %=%A1 D VV,^DIM1 Q:%ERR
  1. S %=%A D VV:%'=+%&'OFFSET,^DIM1 Q
  1. ;
  1. KL ; KILL, LOCK, and NEW (K^DIM and LK)
  1. D PARS G ER:%ERR
  1. I %A="",%C="," G ER
  1. I %A?1"^"1UP.UN,%COM'="L" G ER
  1. I %A?1"(".E1")" D G KL
  1. . S %ARG("E")=$L(%ARG)
  1. . S %A=$E(%A,2,$L(%A)-1) S %ARG=%A_$S(%ARG]"":","_%ARG,1:"")
  1. S %=%A I %COM="L","+-"[$E(%A) S $E(%A)=""
  1. I %COM="N",'$$LNAME(%) G ER
  1. I %COM="K",$D(%ARG("E")),'$$LNAME(%) G ER
  1. I $D(%ARG("E")),$L(%ARG)'>%ARG("E") K %ARG("E")
  1. D VV,^DIM1 G GC^DIM:%ARG=""!%ERR
  1. G KL
  1. ;
  1. LK ; LOCK (L^DIM)
  1. S %A=%ARG,%L=":" S:"+-"[$E(%A) %A=$E(%A,2,999) D PARS1
  1. I %C=%L G ER:%A1="" S %=%A1 D ^DIM1
  1. S %ARG=%A G GC^DIM:%A="",KL
  1. ;
  1. HN ; HANG (H^DIM)
  1. S %=%ARG D ^DIM1 G GC^DIM
  1. ;
  1. OP ; OPEN and USE (O^DIM and U^DIM)
  1. G GC^DIM:%ARG=""!%ERR D PARS G ER:%ERR!(%C=","&(%A=""))
  1. G US:%COM="U" S %L=":" D PARS1 S %A2=%A,%A=%A1 S:%C=%L&(%A="") %ERR=1 D PARS1 G ER:%ERR!(%C=%L&(%A1=""))
  1. F %L="%A1","%A2" S %=@%L D ^DIM1 G OP:%ERR
  1. G OP
  1. US S %L=":" D PARS1 G ER:%C=%L&(%A1="") S %=%A D ^DIM1
  1. S %A=%A1 D PARS1 G ER:%C]"",OP
  1. ;
  1. FR ; FOR (F^DIM)
  1. S %L="=",%A=%ARG D PARS1 G ER:%ERR!(%A1="")!(%A="") S %ARG=%A1
  1. S %=%A G ER:%A?1"^".E D VV,^DIM1 G ER:%ERR
  1. FR1 G GC^DIM:%ARG=""!%ERR D PARS
  1. S %L=":" F %A=%A,%A1 D PARS1 G ER:%ERR!(%A=""&(%C=%L)) S %=%A D ^DIM1
  1. I %A1]"" S %=%A1 D ^DIM1
  1. G FR1
  1. ;
  1. PARS S (%A,%C)="" Q:%ERR S (%ERR,%I)=0
  1. INC D %INC D QT:%C="""",PARAN:%C="(" Q:%ERR G OUT:","[%C,INC
  1. QT D %INC Q:%C="""" G QT:%C]"" S %ERR=1 Q
  1. PARAN S %P=1 F %J=0:0 D %INC D QT:%C="""" S %P=%P+$S(%C="(":1,%C=")":-1,1:0) Q:'%P I %C="" S %ERR=1 Q
  1. Q
  1. OUT S %A=$E(%ARG,1,%I-1),%ARG=$E(%ARG,%I+1,999) Q
  1. %INC S %I=%I+1,%C=$E(%ARG,%I) Q
  1. ;
  1. PARS1 S (%A1,%C)="" Q:%ERR S (%ERR,%I)=0
  1. INCR D %INC1 D QT1:%C="""",PARAN1:%C="(" Q:%ERR=1 G OUT1:%L[%C,INCR
  1. OUT1 S %A1=$E(%A,%I+1,999),%A=$E(%A,1,%I-1) Q
  1. QT1 D %INC1 Q:%C="""" G QT1:%C]"" S %ERR=1 Q
  1. PARAN1 S %P=1 F %J=0:0 D %INC1 D QT1:%C="""" S %P=%P+$S(%C="(":1,%C=")":-1,1:0) Q:'%P I %C="" S %ERR=1 Q
  1. Q
  1. %INC1 S %I=%I+1,%C=$E(%A,%I) Q
  1. ;
  1. VV ; variable, label, or routine name (LABEL, KL, and FR)
  1. I '%ERR,%]"",%'["@",%'?1U.15UN,%'?1U.15UN1"(".E1")",%'?1"%".15UN1"(".E1")",%'?1"%".15UN,%'?1"^"1U.15UN1"(".E1")",%'?1"^%".15UN1"(".E1")",%'?1"^(".E1")",%'?1"^"1U.15UN S %ERR=1
  1. S:%["?@" %ERR=1 Q
  1. ;
  1. LNAME(%) ; lname (KL)
  1. I %?1(1A,1"%").7UN Q 1
  1. I %?1"@".E Q 1
  1. Q 0
  1. ;
  1. ER G ER^DIM