source: IHS-VA_UTILITIES-XB/XBLFAM.m@ 641

Last change on this file since 641 was 641, checked in by Sam Habiel, 14 years ago

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
File size: 6.6 KB
Line 
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.