1 | DIQGDDT ;SFISC/DCL-DATA DICTIONARY ATTRIBUTE TEXT ;8/15/96 13:29
|
---|
2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | LIST(TYPE,DIDARRAY,TP,EQL) ;DO CALL
|
---|
5 | ;TYPE="FILETXT" OR "FIELDTXT"
|
---|
6 | ;DIDARRAY=TARGET ARRAY - IS LOCAL ARRAY PASSED BY REFERENCE WHICH WILL BE SEEDED WITH FILE OR FIELD ATTRIBUTES
|
---|
7 | ;TP=TEXT PIECE USING ; AS DELIMITER
|
---|
8 | ;EQL=EQUAL TO - NULL IS DEFAUL OR PIECE OF TXT
|
---|
9 | ENLST S:$G(TP)'>0 TP=4 S:$G(EQL)'>0 EQL=99
|
---|
10 | N DIQGI,DIQGX,DIQGY F DIQGI=1:1 S DIQGX=$T(@TYPE+DIQGI),DIQGY=$P(DIQGX,";",TP) Q:DIQGY="" D
|
---|
11 | .S DIDARRAY(DIQGY)=$P(DIQGX,";",EQL)
|
---|
12 | .S:$P(DIQGX,";",5)]"" DIDARRAY(DIQGY,"#(word-processing)")=$S($G(DIQGDFLG)["L":"",1:$P(DIQGX,";",5))
|
---|
13 | .I $P(DIQGX,";",6)]"" D
|
---|
14 | ..N TYPE
|
---|
15 | ..S TYPE=$P(DIQGX,";",7)
|
---|
16 | ..N DIQGI,DIQGX,DIQGYS
|
---|
17 | ..F DIQGI=1:1 S DIQGX=$T(@TYPE+DIQGI) Q:$P(DIQGX,";",4)="" D
|
---|
18 | ...S DIQGYS=$P(DIQGX,";",4),DIDARRAY(DIQGY,"#",DIQGYS)=""
|
---|
19 | ...Q
|
---|
20 | .Q
|
---|
21 | ;DIQGI,DIQGY ARE SCRATCH VARIABLES USED TO BUILD ARRAY
|
---|
22 | ;DIQGI INDEXES TEXT AND DIQGY CONTAINS THE ATTRIBUTE NAME
|
---|
23 | Q
|
---|
24 | 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
|
---|
25 | S DIC=1,DIC(0)="AEMQ" D ^DIC Q:Y'>0 ;Select file
|
---|
26 | S DIC="^DD("_+Y_",",DIQGFN=+Y
|
---|
27 | D F(DIQGFN,.DIQGF)
|
---|
28 | D ^%ZIS Q:POP U IO
|
---|
29 | S DIC="^DIC(",DA=DIQGFN
|
---|
30 | D EN^DIQ
|
---|
31 | S X=""
|
---|
32 | F S X=$O(^DIC(DIQGFN,0,X)) Q:X="" W !,X,"=",^(X)
|
---|
33 | S DIQGF="" F S DIQGF=$O(DIQGF(DIQGFN,DIQGF)) Q:DIQGF="" D
|
---|
34 | .W !,$$L("=",IOM),!,"DD NUMBER: ",DIQGF,!
|
---|
35 | .S DA="" F S DA=$O(DIQGF(DIQGFN,DIQGF,DA)) Q:DA="" D
|
---|
36 | ..W !,$$L("-",IOM),!
|
---|
37 | ..S DIC="^DD("_DIQGF_"," D EN^DIQ
|
---|
38 | ..Q
|
---|
39 | .Q
|
---|
40 | W !!,"End of Report",!!
|
---|
41 | D ^%ZISC
|
---|
42 | Q
|
---|
43 | ;
|
---|
44 | L(X,RM) Q $TR($J("",RM)," ",X)
|
---|
45 | ;
|
---|
46 | F(DIQGDICN,DIQGFSTA,DIQGSEL,DIQGDEL) ;
|
---|
47 | ; DIQGDICN file number
|
---|
48 | ; DIQGFSTA Field Selected Target Array(can be passed by reference or
|
---|
49 | ; as a reference)
|
---|
50 | ; DIQGSEL Selection Marker(optional)
|
---|
51 | ; DIQGDEL Deselection Marker (optional)
|
---|
52 | N %,%Y,DA,DDC,DIC,DIQGDWN,DIQGTGA,X,Y
|
---|
53 | I $D(@("^DIC("_DIQGDICN_",0)")) W !!?4,"'",$P(^(0),"^"),"' FILE",!
|
---|
54 | S:'$D(DIQGSEL) DIQGSEL="+" S:'$D(DIQGDEL) DIQGDEL="-"
|
---|
55 | S DIC="^DD("_DIQGDICN_",",DIC(0)="AEMQ",X=$E($G(DIQGFSTA)),DIQGTGA=(X="^"!(X=".")) S:X="." DIQGFSTA=$E(DIQGFSTA,2,99)
|
---|
56 | 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"
|
---|
57 | D ^DIC I Y'>0,$D(@(DIC_"0,""UP"")")) S DIC="^DD("_+^("UP")_"," G M ;Select field/back out of multiples
|
---|
58 | 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
|
---|
59 | I Y>0,DIQGDWN>0 D T(DIQGDWN) G M
|
---|
60 | I Y>0 D T() G M
|
---|
61 | Q
|
---|
62 | T(DWN) ;
|
---|
63 | D @$S(DIQGTGA:"TAR(+$E(DIC,5,99),+Y,$G(DWN))",1:"TBR(+$E(DIC,5,99),+Y,$G(DWN))")
|
---|
64 | Q
|
---|
65 | TAR(DDFN,FLD,DWNFN) ;Target array is in DIQGFSTA As a global/local Reference
|
---|
66 | I DWNFN S @DIQGFSTA@(DIQGDICN,DWNFN)=DDFN_"^"_FLD
|
---|
67 | I '$D(@DIQGFSTA@(DIQGDICN,DDFN,FLD)) S @DIQGFSTA@(DIQGDICN,DDFN,FLD)=$S(DWNFN:DWNFN,1:"") Q
|
---|
68 | I DWNFN,$D(@DIQGFSTA@(DIQGDICN,DWNFN))>9 Q
|
---|
69 | N X S X=$G(@DIQGFSTA@(DIQGDICN,DDFN,FLD)) I X K @DIQGFSTA@(DIQGDICN,$P(X,"^"))
|
---|
70 | K @DIQGFSTA@(DIQGDICN,DDFN,FLD) W DIQGDEL Q
|
---|
71 | Q
|
---|
72 | TBR(DDFN,FLD,DWNFN) ;Target array DIQGFSTA is a local array passed By Reference
|
---|
73 | I DWNFN S DIQGFSTA(DIQGDICN,DWNFN)=DDFN_"^"_FLD
|
---|
74 | I '$D(DIQGFSTA(DIQGDICN,DDFN,FLD)) S DIQGFSTA(DIQGDICN,DDFN,FLD)=$S(DWNFN:DWNFN,1:"") Q
|
---|
75 | I DWNFN,$D(DIQGFSTA(DIQGDICN,DWNFN))>9 Q
|
---|
76 | N X S X=$G(DIQGFSTA(DIQGDICN,DDFN,FLD)) I X K DIQGFSTA(DIQGDICN,$P(X,"^"))
|
---|
77 | K DIQGFSTA(DIQGDICN,DDFN,FLD) W DIQGDEL Q
|
---|
78 | Q
|
---|
79 | ;
|
---|
80 | ;ATRBUTE FLD #;ATRBUTE NAME;1=WORD PROCESSING
|
---|
81 | FILETXT ;
|
---|
82 | ;;.01;NAME;
|
---|
83 | ;;1;GLOBAL NAME;
|
---|
84 | ;;1.1;ENTRIES;
|
---|
85 | ;;4;DESCRIPTION;1
|
---|
86 | ;;20;DEVELOPER;
|
---|
87 | ;;21;DATE;
|
---|
88 | ;;31;DD ACCESS;
|
---|
89 | ;;32;RD ACCESS;
|
---|
90 | ;;33;WR ACCESS;
|
---|
91 | ;;34;DEL ACCESS;
|
---|
92 | ;;35;LAYGO ACCESS;
|
---|
93 | ;;36;AUDIT ACCESS;
|
---|
94 | ;;50;LOOKUP PROGRAM;
|
---|
95 | ;;51;VERSION;
|
---|
96 | ;;51.1;DISTRIBUTION PACKAGE;
|
---|
97 | ;;51.2;PACKAGE REVISION DATA;
|
---|
98 | ;;54;ARCHIVE FILE;
|
---|
99 | ;;100.6;REQUIRED IDENTIFIERS;;1;RI
|
---|
100 | ;;
|
---|
101 | FIELDTXT ;
|
---|
102 | ;;.01;LABEL;
|
---|
103 | ;;.1;TITLE;
|
---|
104 | ;;.2;SPECIFIER;
|
---|
105 | ;;.24;DECIMAL DEFAULT;
|
---|
106 | ;;.25;TYPE;
|
---|
107 | ;;.26;COMPUTE ALGORITHM;
|
---|
108 | ;;.28;MULTIPLE-VALUED;
|
---|
109 | ;;.3;POINTER;
|
---|
110 | ;;.4;GLOBAL SUBSCRIPT LOCATION;
|
---|
111 | ;;.5;INPUT TRANSFORM;
|
---|
112 | ;;1.1;AUDIT;
|
---|
113 | ;;1.2;AUDIT CONDITION;
|
---|
114 | ;;2;OUTPUT TRANSFORM;
|
---|
115 | ;;3;HELP-PROMPT;
|
---|
116 | ;;4;XECUTABLE HELP;
|
---|
117 | ;;8;READ ACCESS;
|
---|
118 | ;;8.5;DELETE ACCESS;
|
---|
119 | ;;9;WRITE ACCESS;
|
---|
120 | ;;9.01;COMPUTED FIELDS USED;
|
---|
121 | ;;10;SOURCE;
|
---|
122 | ;;21;DESCRIPTION;1
|
---|
123 | ;;23;TECHNICAL DESCRIPTION;1
|
---|
124 | ;;50;DATE FIELD LAST EDITED;
|
---|
125 | ;;200;FIELD LENGTH;
|
---|
126 | ;
|
---|
127 | RI ;REQUIRED IDENTIFIERS
|
---|
128 | ;;1;FIELD;
|
---|
129 | ;;
|
---|