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

MAGDGL.m

Go to the documentation of this file.
  1. MAGDGL ;WOIFO/EdM - Global Lister ; 05/27/2005 09:23
  1. ;;3.0;IMAGING;**11,51**;26-August-2005
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. ; Call Global Variable Lister
  1. N DTIME,I,MAX,N,WILD,OUT,T,X
  1. S DTIME=$G(DTIME,300),MAX=20
  1. F D Q:WILD=""
  1. . W !,"Global Variable name: ^" R WILD:DTIME E S WILD=""
  1. . S:WILD="^" WILD=""
  1. . Q:WILD=""
  1. . S:$E(WILD,1)'="^" WILD="^"_WILD
  1. . S (N,START)=0 F D Q:N<MAX Q:X["^"
  1. . . K OUT
  1. . . D LIST(.OUT,WILD,MAX,START)
  1. . . I OUT(1)<0 D Q
  1. . . . W !,"Error in processing:",!,OUT(1),!
  1. . . . W !,"Enter a ""wildcard"" that indicates what part of which"
  1. . . . W !,"global variable is to be displayed."
  1. . . . W !,"The following examples show the options:"
  1. . . . W !," ^MAG(2005,0) - one single node"
  1. . . . W !," ^MAG(2005,,100) - 2nd subscript may have any value"
  1. . . . W !," ^MAG(2005,50:200,100) - 2nd subscript must be between 50 and 200"
  1. . . . W !," ^MAG(2005,""B"",::%S[""JOHN"" - third subscript must contain specific text"
  1. . . . W !," ^MAG(2005,,0:0:%D[""JOHN"" - data must contain specific text"
  1. . . . S X="^"
  1. . . . Q
  1. . . S I=1,N=0 F S I=$O(OUT(I)) Q:I="" D
  1. . . . S N=N+2
  1. . . . W !,OUT(I) S T=$O(OUT(I)) Q:T=""
  1. . . . W " = ",OUT(T) S I=T
  1. . . . F D Q:T=""
  1. . . . . S T=$O(OUT(T)) Q:T="" I OUT(T)'="" S T="" Q
  1. . . . . S T=$O(OUT(T)) Q:T="" W OUT(T) S I=T
  1. . . . . Q
  1. . . . Q
  1. . . I N<MAX S X="^" Q
  1. . . W !!,"More? YES// " R X:DTIME E S X="^"
  1. . . I X="" S X="YES" W X
  1. . . I "Yy"'[$E(X_"^",1) S X="^" Q
  1. . . S START=OUT(1)
  1. . . Q
  1. . Q
  1. Q
  1. ;
  1. LIST(OUT,WILD,MAX,START) ; RPC = MAG DICOM LIST GLOBAL VARIABLE
  1. N %D,E,I,L,M,N,NODE,OK,Q,REF,X
  1. I $D(RPC0) D Q:'OK
  1. . N KEY,LIST,RET
  1. . S KEY="MAG SYSTEM",LIST(1)=KEY D OWNSKEY^XUSRB(.RET,.LIST,DUZ)
  1. . S OK=$G(RET(1))
  1. . S:'OK OUT(1)="-13,Calling user does not have security key "_KEY
  1. . Q
  1. I $E($G(WILD),1)'="^" S OUT(1)="-1,Invalid wild-card: "_WILD Q
  1. S NODE=0,START=$G(START)\1 S:START<1 START=0
  1. S (N,M)=1,Q=0,REF(1,1,1)="" F I=1:1:$L(WILD) D
  1. . S E=$E(WILD,I)
  1. . I Q S REF(1,N,M)=REF(1,N,M)_E S:E="""" Q=0 Q
  1. . I E="""" S Q=1,REF(1,N,M)=REF(1,N,M)_E Q
  1. . I "()"[E S N=N+1,REF(1,N)=E,N=N+1,M=1,REF(1,N,1)="" Q
  1. . I E="," D Q
  1. . . I N=1 S M=M+1,REF(1,1,M)=E,M=M+1,REF(1,1,M)="" Q
  1. . . S N=N+1,REF(1,N)=E,N=N+1,M=1,REF(1,N,1)=""
  1. . . Q
  1. . I N=1,"[|]"[E S M=M+1,REF(1,N,M)=E,M=M+1,REF(1,N,M)="" Q
  1. . I " :"[E S M=M+1,REF(1,N,M)=E,M=M+1,REF(1,N,M)="" Q
  1. . S REF(1,N,M)=REF(1,N,M)_E
  1. . Q
  1. K:REF(1,N,M)="" REF(1,N,M)
  1. S REF="",I="" F S I=$O(REF(1,1,I)) Q:I="" S REF=REF_REF(1,1,I)
  1. S X="-2,Invalid Global Variable Name "_REF D
  1. . N $ET
  1. . S $ET="S X=X_$EC,$EC="""" Q"
  1. . S X=$D(@REF)
  1. . Q
  1. I X<0 S OUT(1)=X Q
  1. S N=0 D TRAVERSE(3,REF_"(")
  1. S OUT(1)=NODE
  1. Q
  1. ;
  1. TRAVERSE(LEV,ROOT) N FROM,IF,NAME,%S,SEP,TO
  1. S NAME=ROOT_"%S)",(FROM,TO,IF)=""
  1. I $O(REF(1,LEV,1))="",$G(REF(1,LEV,1))="" D Q
  1. . S %S="" F S %S=$O(@NAME) Q:%S="" D SHOW Q:N'<MAX
  1. . Q
  1. I $O(REF(1,LEV,1))="" D Q
  1. . S %S=REF(1,LEV,1)
  1. . D:%S'=""
  1. . . N $ET
  1. . . S $ET="S OK=""-6,Error in subscript-value ""_%S_"": ""_$EC,$EC="""" Q"
  1. . . X "S %S="_%S
  1. . . Q
  1. . D SHOW
  1. . Q
  1. F SEP=2:2 D Q:'SEP
  1. . I '$O(REF(1,LEV,SEP-2)) S SEP=0 Q
  1. . S (FROM,TO,IF)=""
  1. . I $G(REF(1,LEV,SEP)," ")=" " S %S=REF(1,LEV,SEP-1) D SHOW Q
  1. . S FROM=$G(REF(1,LEV,SEP-1)),TO=$G(REF(1,LEV,SEP+1)),SEP=SEP+2
  1. . S IF="" I $G(REF(1,LEV,SEP))=":" S IF=$G(REF(1,LEV,SEP+1)),SEP=SEP+2
  1. . D:FROM'=""
  1. . . N $ET
  1. . . S $ET="S OK=""-4,Error in from-value ""_FROM_"": ""_$EC,$EC="""" Q"
  1. . . X "S FROM="_FROM
  1. . . Q
  1. . D:TO'=""
  1. . . N $ET
  1. . . S $ET="S OK=""-5,Error in to-value ""_TO_"": ""_$EC,$EC="""" Q"
  1. . . X "S TO="_TO
  1. . . Q
  1. . S %S=FROM F D SHOW S %S=$O(@NAME) Q:%S="" I TO'="" Q:%S]]TO
  1. . Q
  1. Q
  1. ;
  1. Q(X) I +X=X Q X
  1. N E,I,R
  1. S R="" F I=1:1:$L(X) S E=$E(X,I),R=R_E S:E="""" R=R_E
  1. Q """"_R_""""
  1. ;
  1. SHOW N A,C,I,NM,OK,X
  1. Q:%S=""
  1. S OK='$L(IF)
  1. I IF["%S",IF'["%D" D Q:'OK
  1. . N $ET
  1. . S $ET="S OK=""-3,Error in ""_IF_"": ""_$EC,$EC="""" Q"
  1. . X "I "_IF_" S OK=1"
  1. . Q
  1. D:$D(@NAME)#2
  1. . S %D=@NAME I IF'="" D Q:'OK
  1. . . N $ET
  1. . . S $ET="S OK=""-3,Error in ""_IF_"": ""_$EC,$EC="""" Q"
  1. . . X "I "_IF_" S OK=1"
  1. . . Q
  1. . I OK<0 W !,OK Q
  1. . S NODE=NODE+1 I START>0 S START=START-1 Q
  1. . S NM=$NA(@NAME)
  1. . S X="""",C=0 F I=1:1:$L(%D) D
  1. . . S A=$A(%D,I)
  1. . . I A>31,A<127,'C S X=X_$C(A) S:A=34 X=X_$C(A) Q
  1. . . I A>31,A<127 S C=0,X=X_")_"""_$C(A) S:A=34 X=X_$C(A) Q
  1. . . I X="""" S X="$C("_A,C=1 Q
  1. . . I C S X=X_","_A Q
  1. . . S X=X_"""_$C("_A,C=1
  1. . . Q
  1. . S X=X_$S(C:")",1:"""")
  1. . F D Q:X=""
  1. . . S N=N+1,OUT(N+1)=NM,NM=""
  1. . . S N=N+1,OUT(N+1)=$E(X,1,250),X=$E(X,251,$L(X))
  1. . . Q
  1. . Q
  1. Q:N'<MAX
  1. Q:$G(REF(1,LEV+1))=")"
  1. D:OK TRAVERSE(LEV+2,ROOT_$$Q(%S)_",")
  1. Q
  1. ;