DIQGDDT ;SFISC/DCL-DATA DICTIONARY ATTRIBUTE TEXT ;8/15/96 13:29
;;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.
;
LIST(TYPE,DIDARRAY,TP,EQL) ;DO CALL
;TYPE="FILETXT" OR "FIELDTXT"
;DIDARRAY=TARGET ARRAY - IS LOCAL ARRAY PASSED BY REFERENCE WHICH WILL BE SEEDED WITH FILE OR FIELD ATTRIBUTES
;TP=TEXT PIECE USING ; AS DELIMITER
;EQL=EQUAL TO - NULL IS DEFAUL OR PIECE OF TXT
ENLST S:$G(TP)'>0 TP=4 S:$G(EQL)'>0 EQL=99
N DIQGI,DIQGX,DIQGY F DIQGI=1:1 S DIQGX=$T(@TYPE+DIQGI),DIQGY=$P(DIQGX,";",TP) Q:DIQGY="" D
.S DIDARRAY(DIQGY)=$P(DIQGX,";",EQL)
.S:$P(DIQGX,";",5)]"" DIDARRAY(DIQGY,"#(word-processing)")=$S($G(DIQGDFLG)["L":"",1:$P(DIQGX,";",5))
.I $P(DIQGX,";",6)]"" D
..N TYPE
..S TYPE=$P(DIQGX,";",7)
..N DIQGI,DIQGX,DIQGYS
..F DIQGI=1:1 S DIQGX=$T(@TYPE+DIQGI) Q:$P(DIQGX,";",4)="" D
...S DIQGYS=$P(DIQGX,";",4),DIDARRAY(DIQGY,"#",DIQGYS)=""
...Q
.Q
;DIQGI,DIQGY ARE SCRATCH VARIABLES USED TO BUILD ARRAY
;DIQGI INDEXES TEXT AND DIQGY CONTAINS THE ATTRIBUTE NAME
Q
DD N %,%ZISOS,A,D0,D1,D2,DA,DIC,DIW,DIWF,DIWL,DIWR,DIWT,DK,DL,DN,DX,I,POP,S,X,Y,DIQGF,DIQGFN
S DIC=1,DIC(0)="AEMQ" D ^DIC Q:Y'>0 ;Select file
S DIC="^DD("_+Y_",",DIQGFN=+Y
D F(DIQGFN,.DIQGF)
D ^%ZIS Q:POP U IO
S DIC="^DIC(",DA=DIQGFN
D EN^DIQ
S X=""
F S X=$O(^DIC(DIQGFN,0,X)) Q:X="" W !,X,"=",^(X)
S DIQGF="" F S DIQGF=$O(DIQGF(DIQGFN,DIQGF)) Q:DIQGF="" D
.W !,$$L("=",IOM),!,"DD NUMBER: ",DIQGF,!
.S DA="" F S DA=$O(DIQGF(DIQGFN,DIQGF,DA)) Q:DA="" D
..W !,$$L("-",IOM),!
..S DIC="^DD("_DIQGF_"," D EN^DIQ
..Q
.Q
W !!,"End of Report",!!
D ^%ZISC
Q
;
L(X,RM) Q $TR($J("",RM)," ",X)
;
F(DIQGDICN,DIQGFSTA,DIQGSEL,DIQGDEL) ;
; DIQGDICN file number
; DIQGFSTA Field Selected Target Array(can be passed by reference or
; as a reference)
; DIQGSEL Selection Marker(optional)
; DIQGDEL Deselection Marker (optional)
N %,%Y,DA,DDC,DIC,DIQGDWN,DIQGTGA,X,Y
I $D(@("^DIC("_DIQGDICN_",0)")) W !!?4,"'",$P(^(0),"^"),"' FILE",!
S:'$D(DIQGSEL) DIQGSEL="+" S:'$D(DIQGDEL) DIQGDEL="-"
S DIC="^DD("_DIQGDICN_",",DIC(0)="AEMQ",X=$E($G(DIQGFSTA)),DIQGTGA=(X="^"!(X=".")) S:X="." DIQGFSTA=$E(DIQGFSTA,2,99)
M S DIC("W")="W:$P(^(0),U,2) $S($P(^DD(+$P(^(0),U,2),.01,0),U,2)[""W"":"" (word-processing)"",1:"" (multiple)"") W:$D("_$S(DIQGTGA:"@DIQGFSTA@(DIQGDICN,+$E(DIC,5,99),+Y)",1:"DIQGFSTA(DIQGDICN,+$E(DIC,5,99),+Y)")_") DIQGSEL"
D ^DIC I Y'>0,$D(@(DIC_"0,""UP"")")) S DIC="^DD("_+^("UP")_"," G M ;Select field/back out of multiples
S DIQGDWN="" I Y>0,$P(@(DIC_+Y_",0)"),U,2) S DIQGDWN=+$P(^(0),U,2) I $P(^DD(+$P(^(0),U,2),.01,0),U,2)'["W" D T(DIQGDWN) S DIC="^DD("_DIQGDWN_"," G M
I Y>0,DIQGDWN>0 D T(DIQGDWN) G M
I Y>0 D T() G M
Q
T(DWN) ;
D @$S(DIQGTGA:"TAR(+$E(DIC,5,99),+Y,$G(DWN))",1:"TBR(+$E(DIC,5,99),+Y,$G(DWN))")
Q
TAR(DDFN,FLD,DWNFN) ;Target array is in DIQGFSTA As a global/local Reference
I DWNFN S @DIQGFSTA@(DIQGDICN,DWNFN)=DDFN_"^"_FLD
I '$D(@DIQGFSTA@(DIQGDICN,DDFN,FLD)) S @DIQGFSTA@(DIQGDICN,DDFN,FLD)=$S(DWNFN:DWNFN,1:"") Q
I DWNFN,$D(@DIQGFSTA@(DIQGDICN,DWNFN))>9 Q
N X S X=$G(@DIQGFSTA@(DIQGDICN,DDFN,FLD)) I X K @DIQGFSTA@(DIQGDICN,$P(X,"^"))
K @DIQGFSTA@(DIQGDICN,DDFN,FLD) W DIQGDEL Q
Q
TBR(DDFN,FLD,DWNFN) ;Target array DIQGFSTA is a local array passed By Reference
I DWNFN S DIQGFSTA(DIQGDICN,DWNFN)=DDFN_"^"_FLD
I '$D(DIQGFSTA(DIQGDICN,DDFN,FLD)) S DIQGFSTA(DIQGDICN,DDFN,FLD)=$S(DWNFN:DWNFN,1:"") Q
I DWNFN,$D(DIQGFSTA(DIQGDICN,DWNFN))>9 Q
N X S X=$G(DIQGFSTA(DIQGDICN,DDFN,FLD)) I X K DIQGFSTA(DIQGDICN,$P(X,"^"))
K DIQGFSTA(DIQGDICN,DDFN,FLD) W DIQGDEL Q
Q
;
;ATRBUTE FLD #;ATRBUTE NAME;1=WORD PROCESSING
FILETXT ;
;;.01;NAME;
;;1;GLOBAL NAME;
;;1.1;ENTRIES;
;;4;DESCRIPTION;1
;;20;DEVELOPER;
;;21;DATE;
;;31;DD ACCESS;
;;32;RD ACCESS;
;;33;WR ACCESS;
;;34;DEL ACCESS;
;;35;LAYGO ACCESS;
;;36;AUDIT ACCESS;
;;50;LOOKUP PROGRAM;
;;51;VERSION;
;;51.1;DISTRIBUTION PACKAGE;
;;51.2;PACKAGE REVISION DATA;
;;54;ARCHIVE FILE;
;;100.6;REQUIRED IDENTIFIERS;;1;RI
;;
FIELDTXT ;
;;.01;LABEL;
;;.1;TITLE;
;;.2;SPECIFIER;
;;.24;DECIMAL DEFAULT;
;;.25;TYPE;
;;.26;COMPUTE ALGORITHM;
;;.28;MULTIPLE-VALUED;
;;.3;POINTER;
;;.4;GLOBAL SUBSCRIPT LOCATION;
;;.5;INPUT TRANSFORM;
;;1.1;AUDIT;
;;1.2;AUDIT CONDITION;
;;2;OUTPUT TRANSFORM;
;;3;HELP-PROMPT;
;;4;XECUTABLE HELP;
;;8;READ ACCESS;
;;8.5;DELETE ACCESS;
;;9;WRITE ACCESS;
;;9.01;COMPUTED FIELDS USED;
;;10;SOURCE;
;;21;DESCRIPTION;1
;;23;TECHNICAL DESCRIPTION;1
;;50;DATE FIELD LAST EDITED;
;;200;FIELD LENGTH;
;
RI ;REQUIRED IDENTIFIERS
;;1;FIELD;
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIQGDDT 4931 printed Jan 18, 2025@03:54:36 Page 2
DIQGDDT ;SFISC/DCL-DATA DICTIONARY ATTRIBUTE TEXT ;8/15/96 13:29
+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 ;
LIST(TYPE,DIDARRAY,TP,EQL) ;DO CALL
+1 ;TYPE="FILETXT" OR "FIELDTXT"
+2 ;DIDARRAY=TARGET ARRAY - IS LOCAL ARRAY PASSED BY REFERENCE WHICH WILL BE SEEDED WITH FILE OR FIELD ATTRIBUTES
+3 ;TP=TEXT PIECE USING ; AS DELIMITER
+4 ;EQL=EQUAL TO - NULL IS DEFAUL OR PIECE OF TXT
ENLST if $GET(TP)'>0
SET TP=4
if $GET(EQL)'>0
SET EQL=99
+1 NEW DIQGI,DIQGX,DIQGY
FOR DIQGI=1:1
SET DIQGX=$TEXT(@TYPE+DIQGI)
SET DIQGY=$PIECE(DIQGX,";",TP)
if DIQGY=""
QUIT
Begin DoDot:1
+2 SET DIDARRAY(DIQGY)=$PIECE(DIQGX,";",EQL)
+3 if $PIECE(DIQGX,";",5)]""
SET DIDARRAY(DIQGY,"#(word-processing)")=$SELECT($GET(DIQGDFLG)["L":"",1:$PIECE(DIQGX,";",5))
+4 IF $PIECE(DIQGX,";",6)]""
Begin DoDot:2
+5 NEW TYPE
+6 SET TYPE=$PIECE(DIQGX,";",7)
+7 NEW DIQGI,DIQGX,DIQGYS
+8 FOR DIQGI=1:1
SET DIQGX=$TEXT(@TYPE+DIQGI)
if $PIECE(DIQGX,";",4)=""
QUIT
Begin DoDot:3
+9 SET DIQGYS=$PIECE(DIQGX,";",4)
SET DIDARRAY(DIQGY,"#",DIQGYS)=""
+10 QUIT
End DoDot:3
End DoDot:2
+11 QUIT
End DoDot:1
+12 ;DIQGI,DIQGY ARE SCRATCH VARIABLES USED TO BUILD ARRAY
+13 ;DIQGI INDEXES TEXT AND DIQGY CONTAINS THE ATTRIBUTE NAME
+14 QUIT
DD NEW %,%ZISOS,A,D0,D1,D2,DA,DIC,DIW,DIWF,DIWL,DIWR,DIWT,DK,DL,DN,DX,I,POP,S,X,Y,DIQGF,DIQGFN
+1 ;Select file
SET DIC=1
SET DIC(0)="AEMQ"
DO ^DIC
if Y'>0
QUIT
+2 SET DIC="^DD("_+Y_","
SET DIQGFN=+Y
+3 DO F(DIQGFN,.DIQGF)
+4 DO ^%ZIS
if POP
QUIT
USE IO
+5 SET DIC="^DIC("
SET DA=DIQGFN
+6 DO EN^DIQ
+7 SET X=""
+8 FOR
SET X=$ORDER(^DIC(DIQGFN,0,X))
if X=""
QUIT
WRITE !,X,"=",^(X)
+9 SET DIQGF=""
FOR
SET DIQGF=$ORDER(DIQGF(DIQGFN,DIQGF))
if DIQGF=""
QUIT
Begin DoDot:1
+10 WRITE !,$$L("=",IOM),!,"DD NUMBER: ",DIQGF,!
+11 SET DA=""
FOR
SET DA=$ORDER(DIQGF(DIQGFN,DIQGF,DA))
if DA=""
QUIT
Begin DoDot:2
+12 WRITE !,$$L("-",IOM),!
+13 SET DIC="^DD("_DIQGF_","
DO EN^DIQ
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 WRITE !!,"End of Report",!!
+17 DO ^%ZISC
+18 QUIT
+19 ;
L(X,RM) QUIT $TRANSLATE($JUSTIFY("",RM)," ",X)
+1 ;
F(DIQGDICN,DIQGFSTA,DIQGSEL,DIQGDEL) ;
+1 ; DIQGDICN file number
+2 ; DIQGFSTA Field Selected Target Array(can be passed by reference or
+3 ; as a reference)
+4 ; DIQGSEL Selection Marker(optional)
+5 ; DIQGDEL Deselection Marker (optional)
+6 NEW %,%Y,DA,DDC,DIC,DIQGDWN,DIQGTGA,X,Y
+7 IF $DATA(@("^DIC("_DIQGDICN_",0)"))
WRITE !!?4,"'",$PIECE(^(0),"^"),"' FILE",!
+8 if '$DATA(DIQGSEL)
SET DIQGSEL="+"
if '$DATA(DIQGDEL)
SET DIQGDEL="-"
+9 SET DIC="^DD("_DIQGDICN_","
SET DIC(0)="AEMQ"
SET X=$EXTRACT($GET(DIQGFSTA))
SET DIQGTGA=(X="^"!(X="."))
if X="."
SET DIQGFSTA=$EXTRACT(DIQGFSTA,2,99)
M SET DIC("W")="W:$P(^(0),U,2) $S($P(^DD(+$P(^(0),U,2),.01,0),U,2)[""W"":"" (word-processing)"",1:"" (multiple)"") W:$D("_$SELECT(DIQGTGA:"@DIQGFSTA@(DIQGDICN,+$E(DIC,5,99),+Y)",1:"DIQGFSTA(DIQGDICN,+$E(DIC,5,99),+Y)")_") DIQGSEL"
+1 ;Select field/back out of multiples
DO ^DIC
IF Y'>0
IF $DATA(@(DIC_"0,""UP"")"))
SET DIC="^DD("_+^("UP")_","
GOTO M
+2 SET DIQGDWN=""
IF Y>0
IF $PIECE(@(DIC_+Y_",0)"),U,2)
SET DIQGDWN=+$PIECE(^(0),U,2)
IF $PIECE(^DD(+$PIECE(^(0),U,2),.01,0),U,2)'["W"
DO T(DIQGDWN)
SET DIC="^DD("_DIQGDWN_","
GOTO M
+3 IF Y>0
IF DIQGDWN>0
DO T(DIQGDWN)
GOTO M
+4 IF Y>0
DO T()
GOTO M
+5 QUIT
T(DWN) ;
+1 DO @$SELECT(DIQGTGA:"TAR(+$E(DIC,5,99),+Y,$G(DWN))",1:"TBR(+$E(DIC,5,99),+Y,$G(DWN))")
+2 QUIT
TAR(DDFN,FLD,DWNFN) ;Target array is in DIQGFSTA As a global/local Reference
+1 IF DWNFN
SET @DIQGFSTA@(DIQGDICN,DWNFN)=DDFN_"^"_FLD
+2 IF '$DATA(@DIQGFSTA@(DIQGDICN,DDFN,FLD))
SET @DIQGFSTA@(DIQGDICN,DDFN,FLD)=$SELECT(DWNFN:DWNFN,1:"")
QUIT
+3 IF DWNFN
IF $DATA(@DIQGFSTA@(DIQGDICN,DWNFN))>9
QUIT
+4 NEW X
SET X=$GET(@DIQGFSTA@(DIQGDICN,DDFN,FLD))
IF X
KILL @DIQGFSTA@(DIQGDICN,$PIECE(X,"^"))
+5 KILL @DIQGFSTA@(DIQGDICN,DDFN,FLD)
WRITE DIQGDEL
QUIT
+6 QUIT
TBR(DDFN,FLD,DWNFN) ;Target array DIQGFSTA is a local array passed By Reference
+1 IF DWNFN
SET DIQGFSTA(DIQGDICN,DWNFN)=DDFN_"^"_FLD
+2 IF '$DATA(DIQGFSTA(DIQGDICN,DDFN,FLD))
SET DIQGFSTA(DIQGDICN,DDFN,FLD)=$SELECT(DWNFN:DWNFN,1:"")
QUIT
+3 IF DWNFN
IF $DATA(DIQGFSTA(DIQGDICN,DWNFN))>9
QUIT
+4 NEW X
SET X=$GET(DIQGFSTA(DIQGDICN,DDFN,FLD))
IF X
KILL DIQGFSTA(DIQGDICN,$PIECE(X,"^"))
+5 KILL DIQGFSTA(DIQGDICN,DDFN,FLD)
WRITE DIQGDEL
QUIT
+6 QUIT
+7 ;
+8 ;ATRBUTE FLD #;ATRBUTE NAME;1=WORD PROCESSING
FILETXT ;
+1 ;;.01;NAME;
+2 ;;1;GLOBAL NAME;
+3 ;;1.1;ENTRIES;
+4 ;;4;DESCRIPTION;1
+5 ;;20;DEVELOPER;
+6 ;;21;DATE;
+7 ;;31;DD ACCESS;
+8 ;;32;RD ACCESS;
+9 ;;33;WR ACCESS;
+10 ;;34;DEL ACCESS;
+11 ;;35;LAYGO ACCESS;
+12 ;;36;AUDIT ACCESS;
+13 ;;50;LOOKUP PROGRAM;
+14 ;;51;VERSION;
+15 ;;51.1;DISTRIBUTION PACKAGE;
+16 ;;51.2;PACKAGE REVISION DATA;
+17 ;;54;ARCHIVE FILE;
+18 ;;100.6;REQUIRED IDENTIFIERS;;1;RI
+19 ;;
FIELDTXT ;
+1 ;;.01;LABEL;
+2 ;;.1;TITLE;
+3 ;;.2;SPECIFIER;
+4 ;;.24;DECIMAL DEFAULT;
+5 ;;.25;TYPE;
+6 ;;.26;COMPUTE ALGORITHM;
+7 ;;.28;MULTIPLE-VALUED;
+8 ;;.3;POINTER;
+9 ;;.4;GLOBAL SUBSCRIPT LOCATION;
+10 ;;.5;INPUT TRANSFORM;
+11 ;;1.1;AUDIT;
+12 ;;1.2;AUDIT CONDITION;
+13 ;;2;OUTPUT TRANSFORM;
+14 ;;3;HELP-PROMPT;
+15 ;;4;XECUTABLE HELP;
+16 ;;8;READ ACCESS;
+17 ;;8.5;DELETE ACCESS;
+18 ;;9;WRITE ACCESS;
+19 ;;9.01;COMPUTED FIELDS USED;
+20 ;;10;SOURCE;
+21 ;;21;DESCRIPTION;1
+22 ;;23;TECHNICAL DESCRIPTION;1
+23 ;;50;DATE FIELD LAST EDITED;
+24 ;;200;FIELD LENGTH;
+25 ;
RI ;REQUIRED IDENTIFIERS
+1 ;;1;FIELD;
+2 ;;
