source: IHS-VA_UTILITIES-XB/trunk/XBLFAM.m@ 1168

Last change on this file since 1168 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.
File size: 6.6 KB
RevLine 
[641]1XBLFAM ;IHS/SET/GTH - LISTS FILE ATTRIBUTES FOR MODELING ; [ 04/18/2003 9:05 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;IHS/SET/GTH XB*3*9 10/29/2002 New routine.
4 ; This routine lists the following file attributes, useful for
5 ; moving to a spreadsheet, or other desktop ap, for database
6 ; modeling activities:
7 ;
8 ; File #, File Name, Field #, Field Label, Field type, Desc/Help.,
9 ; Min Length, Max Length
10 ; The output is one line of data per field, semi-colon delimited.
11 ;
12 ; NOTE: Fields marked for deletion with a "*" preceeding the label
13 ; are -not- processed.
14 ;
15 ; Thanks to George T. Huggins for the original routine.
16 ;
17START ;
18 ; --- Display routine description.
19 D HOME^%ZIS,DT^DICRW
20 KILL ^UTILITY($J)
21 S ^UTILITY($J,"XBLFAM")=""
22 D EN^XBRPTL
23 KILL ^UTILITY($J)
24 ;
25 ; --- Start processing.
26 NEW QFLG
27 S QFLG=0
28 ;
29 ; --- Get file(s).
30 D ^XBDSET
31 Q:'$D(^UTILITY("XBDSET",$J))
32 ;
33 ; --- Select device.
34 W !
35 S %ZIS="Q",ZTSAVE("^UTILITY(""XBDSET"",$J,")=""
36 D EN^XUTMDEVQ("EN^XBLFAM","List Attributes for Modeling",.ZTSAVE,.%ZIS)
37 D EN^XBVK("ZT")
38 Q
39 ;
40EN ;EP - From TaskMan.
41 ;
42 ; --- Main loop: thru selected file(s).
43 NEW F,X
44 ;
45 ; F:File #
46 ;
47 S F=0
48 F S F=$O(^UTILITY("XBDSET",$J,F)) Q:F'=+F D PAGE Q:QFLG D FIELDS(F) Q:QFLG
49 D ^%ZISC
50 Q
51 ; --- End main loop.
52FIELDS(F) ; Process fields in File F.
53 ; Field #, File #, File Name, Field Label, Field type, Desc/Help.
54 NEW X,XB
55 S X=""
56 F XB=0:0 S XB=$O(^DD(F,XB)) Q:'(XB=+XB) D D:$Y>(IOSL-3) PAGE Q:QFLG
57 . I $E($P($G(^DD(F,XB,0)),"^",1))="*" Q ; field is deprecated.
58 . I $P(^DD(F,XB,0),"^",2) W $$OUTLINE,! D FIELDS(+$P(^DD(F,XB,0),"^",2)) Q ; Recurse sub-file.
59 . W $$OUTLINE,!
60 . Q
61 Q
62 ; -------------------------------------------------------
63OUTLINE() ;
64 ; File #, File Name, Field #, Field Label, Field type, Desc/Help.,
65 ; Min Length, Max Length
66 Q F_";"_$$FNAME^XBFUNC(F)_";"_XB_";"_$P($G(^DD(F,XB,0)),"^",1)_";"_$$TYPE($P($G(^DD(F,XB,0)),"^",2))_";"_$$HP(F,XB)_$$DESC(F,XB)_$$TDESC(F,XB)_";"_$$MINL(F,XB)_";"_$$MAXL(F,XB)_";"
67 ; -------------------------------------------------------
68PAGE ; PAGE BREAK
69 NEW F,G,N,X
70 I IO=IO(0),$E(IOST,1,2)="C-" S QFLG='$$DIR^XBDIR("E") I 'QFLG W @IOF
71 Q
72 ; -------------------------------------------------------
73MINL(N,F) ; Return minimum length
74 NEW X
75 S X=$P(^DD(N,F,0),"^",2)
76 I X Q "-"
77 I '(X["F") Q "-"
78 S X=$P(^DD(N,F,0),"^",5,99)
79 Q +$E(X,$F(X,"$L(X)<"),$L(X))
80 ; -------------------------------------------------------
81MAXL(N,F) ; Return maximum length
82 NEW X
83 S X=$P(^DD(N,F,0),"^",2)
84 I X Q "-"
85 I '(X["F") Q "-"
86 S X=$P(^DD(N,F,0),"^",5,99)
87 Q +$E(X,$F(X,"$L(X)>"),$L(X))
88 ; -------------------------------------------------------
89NUMBER(F) ;;.001;NUMBER
90 Q F ; well, duh
91 ; -------------------------------------------------------
92LABEL(N,F) ;;.01;LABEL
93 Q $P($G(^DD(N,F,0)),"^",1)
94 ; -------------------------------------------------------
95TITLE(N,F) ;;.1;TITLE
96 Q $P($G(^DD(N,F,.1)),"^",1)
97 ; -------------------------------------------------------
98 ;;.12;VARIABLE POINTER (multiple)
99 ; -------------------------------------------------------
100 ;;.2;SPECIFIER
101 ; -------------------------------------------------------
102 ;;.23;LENGTH
103 ; -------------------------------------------------------
104 ;;.24;DECIMAL DEFAULT
105 ; -------------------------------------------------------
106TYPE(P) ;PEP;.25;TYPE
107 ; Return TYPE of field. Input is the 2nd piece of the 0th node.
108 I P Q "<SUBFILE>"
109 NEW W
110 F W="BOOLEAN","COMPUTED","FREE TEXT","SET","DATE","NUMBER","POINTER","WORD-PROCESSING","K","Z" I P[$E(W) Q
111 I W="SET" S W=W_" <"_$TR($P($G(^DD(F,XB,0)),"^",3),";","|")_">"
112 I W="POINTER" S W=W_" to "_$$FNAME^XBFUNC(+$P(P,"P",2))_" file"
113 Q $S(W'="Z":W,1:"??")
114 ; -------------------------------------------------------
115 ;;.26;COMPUTE ALGORITHM
116 ; -------------------------------------------------------
117 ;;.27;SUB-FIELDS
118 ; -------------------------------------------------------
119 ;;.28;MULTIPLE-VALUED
120 ; -------------------------------------------------------
121 ;;.29;DEPTH OF SUB-FIELD
122 ; -------------------------------------------------------
123 ;;.3;POINTER
124 ; -------------------------------------------------------
125GSL(N,F) ;;.4;GLOBAL SUBSCRIPT LOCATION
126 Q 0
127 ; -------------------------------------------------------
128IT(N,F) ;;.5;INPUT TRANSFORM
129 Q $P($G(^DD(N,F,0)),"^",5,99)
130 ; -------------------------------------------------------
131 ;;1;CROSS-REFERENCE (multiple)
132 ; -------------------------------------------------------
133AUDIT(N,F) ;;1.1;AUDIT
134 Q $G(^DD(N,F,"AUDIT"))
135 ; -------------------------------------------------------
136 ;;1.2;AUDIT CONDITION
137 ; -------------------------------------------------------
138OT(N,F) ;;2;OUTPUT TRANSFORM
139 Q $G(^DD(N,F,2.1))
140 ; -------------------------------------------------------
141HP(N,F) ;;3;'HELP'-PROMPT
142 NEW X
143 S X=$G(^DD(N,F,3))
144 I '$L(X) Q ""
145 Q "HELP-PROMPT("_$G(^DD(N,F,3))_")"
146 ; -------------------------------------------------------
147XH(N,F) ;;4;XECUTABLE 'HELP'
148 Q $G(^DD(N,F,4))
149 ; -------------------------------------------------------
150RA(N,F) ;;8;READ ACCESS (OPTIONAL)
151 Q $G(^DD(N,F,8))
152 ; -------------------------------------------------------
153DA(N,F) ;;8.5;DELETE ACCESS (OPTIONAL)
154 Q $G(^DD(N,F,8.5))
155 ; -------------------------------------------------------
156WA(N,F) ;;9;WRITE ACCESS (OPTIONAL)
157 Q $G(^DD(N,F,9))
158 ; -------------------------------------------------------
159 ;;9.01;COMPUTED FIELDS USED
160 ; -------------------------------------------------------
161SRC(N,F) ;;10;SOURCE
162 Q $G(^DD(N,F,10))
163 ; -------------------------------------------------------
164 ;;11;DESTINATION (multiple)
165 ; -------------------------------------------------------
166 ;;12;POINTER SCREEN
167 ; -------------------------------------------------------
168 ;;12.1;CODE TO SET POINTER SCREEN
169 ; -------------------------------------------------------
170 ;;12.2;EXPRESSION FOR POINTER SCREEN
171 ; -------------------------------------------------------
172 ;;20;GROUP (multiple)
173 ; -------------------------------------------------------
174DESC(N,F) ;;21;DESCRIPTION (word-processing)
175 ; Field DESCRIPTION and Help-Prompt. N=File, F=Field
176 NEW X,XB
177 S X=""
178 F XB=0:0 S XB=$O(^DD(N,F,21,XB)) Q:'XB S X=X_$G(^(XB,0))
179 I '$L(X) Q ""
180 Q "DESCRIPTION("_X_")"
181 ; -------------------------------------------------------
182TDESC(N,F) ;;23;TECHNICAL DESCRIPTION (word-processing)
183 NEW X,XB
184 S X=""
185 F XB=0:0 S XB=$O(^DD(N,F,23,XB)) Q:'XB S X=X_$G(^(XB,0))
186 I '$L(X) Q ""
187 Q "TECH_DESCRIPTION("_X_")"
188 ; -------------------------------------------------------
189DFLE(N,F) ;;50;DATE FIELD LAST EDITED
190 Q $$FMTE^XLFDT($G(^DD(N,F,"DT")))
191 ; -------------------------------------------------------
192 ;;999;TRIGGERED-BY POINTER (multiple)
193 ; -------------------------------------------------------
194 ;
Note: See TracBrowser for help on using the repository browser.