XBLFAM ;IHS/SET/GTH - LISTS FILE ATTRIBUTES FOR MODELING ; [ 04/18/2003 9:05 AM ]
;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
;IHS/SET/GTH XB*3*9 10/29/2002 New routine.
; This routine lists the following file attributes, useful for
; moving to a spreadsheet, or other desktop ap, for database
; modeling activities:
;
; File #, File Name, Field #, Field Label, Field type, Desc/Help.,
; Min Length, Max Length
; The output is one line of data per field, semi-colon delimited.
;
; NOTE: Fields marked for deletion with a "*" preceeding the label
; are -not- processed.
;
; Thanks to George T. Huggins for the original routine.
;
START ;
; --- Display routine description.
D HOME^%ZIS,DT^DICRW
KILL ^UTILITY($J)
S ^UTILITY($J,"XBLFAM")=""
D EN^XBRPTL
KILL ^UTILITY($J)
;
; --- Start processing.
NEW QFLG
S QFLG=0
;
; --- Get file(s).
D ^XBDSET
Q:'$D(^UTILITY("XBDSET",$J))
;
; --- Select device.
W !
S %ZIS="Q",ZTSAVE("^UTILITY(""XBDSET"",$J,")=""
D EN^XUTMDEVQ("EN^XBLFAM","List Attributes for Modeling",.ZTSAVE,.%ZIS)
D EN^XBVK("ZT")
Q
;
EN ;EP - From TaskMan.
;
; --- Main loop: thru selected file(s).
NEW F,X
;
; F:File #
;
S F=0
F S F=$O(^UTILITY("XBDSET",$J,F)) Q:F'=+F D PAGE Q:QFLG D FIELDS(F) Q:QFLG
D ^%ZISC
Q
; --- End main loop.
FIELDS(F) ; Process fields in File F.
; Field #, File #, File Name, Field Label, Field type, Desc/Help.
NEW X,XB
S X=""
F XB=0:0 S XB=$O(^DD(F,XB)) Q:'(XB=+XB) D D:$Y>(IOSL-3) PAGE Q:QFLG
. I $E($P($G(^DD(F,XB,0)),"^",1))="*" Q ; field is deprecated.
. I $P(^DD(F,XB,0),"^",2) W $$OUTLINE,! D FIELDS(+$P(^DD(F,XB,0),"^",2)) Q ; Recurse sub-file.
. W $$OUTLINE,!
. Q
Q
; -------------------------------------------------------
OUTLINE() ;
; File #, File Name, Field #, Field Label, Field type, Desc/Help.,
; Min Length, Max Length
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)_";"
; -------------------------------------------------------
PAGE ; PAGE BREAK
NEW F,G,N,X
I IO=IO(0),$E(IOST,1,2)="C-" S QFLG='$$DIR^XBDIR("E") I 'QFLG W @IOF
Q
; -------------------------------------------------------
MINL(N,F) ; Return minimum length
NEW X
S X=$P(^DD(N,F,0),"^",2)
I X Q "-"
I '(X["F") Q "-"
S X=$P(^DD(N,F,0),"^",5,99)
Q +$E(X,$F(X,"$L(X)<"),$L(X))
; -------------------------------------------------------
MAXL(N,F) ; Return maximum length
NEW X
S X=$P(^DD(N,F,0),"^",2)
I X Q "-"
I '(X["F") Q "-"
S X=$P(^DD(N,F,0),"^",5,99)
Q +$E(X,$F(X,"$L(X)>"),$L(X))
; -------------------------------------------------------
NUMBER(F) ;;.001;NUMBER
Q F ; well, duh
; -------------------------------------------------------
LABEL(N,F) ;;.01;LABEL
Q $P($G(^DD(N,F,0)),"^",1)
; -------------------------------------------------------
TITLE(N,F) ;;.1;TITLE
Q $P($G(^DD(N,F,.1)),"^",1)
; -------------------------------------------------------
;;.12;VARIABLE POINTER (multiple)
; -------------------------------------------------------
;;.2;SPECIFIER
; -------------------------------------------------------
;;.23;LENGTH
; -------------------------------------------------------
;;.24;DECIMAL DEFAULT
; -------------------------------------------------------
TYPE(P) ;PEP;.25;TYPE
; Return TYPE of field. Input is the 2nd piece of the 0th node.
I P Q "<SUBFILE>"
NEW W
F W="BOOLEAN","COMPUTED","FREE TEXT","SET","DATE","NUMBER","POINTER","WORD-PROCESSING","K","Z" I P[$E(W) Q
I W="SET" S W=W_" <"_$TR($P($G(^DD(F,XB,0)),"^",3),";","|")_">"
I W="POINTER" S W=W_" to "_$$FNAME^XBFUNC(+$P(P,"P",2))_" file"
Q $S(W'="Z":W,1:"??")
; -------------------------------------------------------
;;.26;COMPUTE ALGORITHM
; -------------------------------------------------------
;;.27;SUB-FIELDS
; -------------------------------------------------------
;;.28;MULTIPLE-VALUED
; -------------------------------------------------------
;;.29;DEPTH OF SUB-FIELD
; -------------------------------------------------------
;;.3;POINTER
; -------------------------------------------------------
GSL(N,F) ;;.4;GLOBAL SUBSCRIPT LOCATION
Q 0
; -------------------------------------------------------
IT(N,F) ;;.5;INPUT TRANSFORM
Q $P($G(^DD(N,F,0)),"^",5,99)
; -------------------------------------------------------
;;1;CROSS-REFERENCE (multiple)
; -------------------------------------------------------
AUDIT(N,F) ;;1.1;AUDIT
Q $G(^DD(N,F,"AUDIT"))
; -------------------------------------------------------
;;1.2;AUDIT CONDITION
; -------------------------------------------------------
OT(N,F) ;;2;OUTPUT TRANSFORM
Q $G(^DD(N,F,2.1))
; -------------------------------------------------------
HP(N,F) ;;3;'HELP'-PROMPT
NEW X
S X=$G(^DD(N,F,3))
I '$L(X) Q ""
Q "HELP-PROMPT("_$G(^DD(N,F,3))_")"
; -------------------------------------------------------
XH(N,F) ;;4;XECUTABLE 'HELP'
Q $G(^DD(N,F,4))
; -------------------------------------------------------
RA(N,F) ;;8;READ ACCESS (OPTIONAL)
Q $G(^DD(N,F,8))
; -------------------------------------------------------
DA(N,F) ;;8.5;DELETE ACCESS (OPTIONAL)
Q $G(^DD(N,F,8.5))
; -------------------------------------------------------
WA(N,F) ;;9;WRITE ACCESS (OPTIONAL)
Q $G(^DD(N,F,9))
; -------------------------------------------------------
;;9.01;COMPUTED FIELDS USED
; -------------------------------------------------------
SRC(N,F) ;;10;SOURCE
Q $G(^DD(N,F,10))
; -------------------------------------------------------
;;11;DESTINATION (multiple)
; -------------------------------------------------------
;;12;POINTER SCREEN
; -------------------------------------------------------
;;12.1;CODE TO SET POINTER SCREEN
; -------------------------------------------------------
;;12.2;EXPRESSION FOR POINTER SCREEN
; -------------------------------------------------------
;;20;GROUP (multiple)
; -------------------------------------------------------
DESC(N,F) ;;21;DESCRIPTION (word-processing)
; Field DESCRIPTION and Help-Prompt. N=File, F=Field
NEW X,XB
S X=""
F XB=0:0 S XB=$O(^DD(N,F,21,XB)) Q:'XB S X=X_$G(^(XB,0))
I '$L(X) Q ""
Q "DESCRIPTION("_X_")"
; -------------------------------------------------------
TDESC(N,F) ;;23;TECHNICAL DESCRIPTION (word-processing)
NEW X,XB
S X=""
F XB=0:0 S XB=$O(^DD(N,F,23,XB)) Q:'XB S X=X_$G(^(XB,0))
I '$L(X) Q ""
Q "TECH_DESCRIPTION("_X_")"
; -------------------------------------------------------
DFLE(N,F) ;;50;DATE FIELD LAST EDITED
Q $$FMTE^XLFDT($G(^DD(N,F,"DT")))
; -------------------------------------------------------
;;999;TRIGGERED-BY POINTER (multiple)
; -------------------------------------------------------
;
XBLFAM ;IHS/SET/GTH - LISTS FILE ATTRIBUTES FOR MODELING ; [ 04/18/2003 9:05 AM ]
+1 ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
+2 ;IHS/SET/GTH XB*3*9 10/29/2002 New routine.
+3 ; This routine lists the following file attributes, useful for
+4 ; moving to a spreadsheet, or other desktop ap, for database
+5 ; modeling activities:
+6 ;
+7 ; File #, File Name, Field #, Field Label, Field type, Desc/Help.,
+8 ; Min Length, Max Length
+9 ; The output is one line of data per field, semi-colon delimited.
+10 ;
+11 ; NOTE: Fields marked for deletion with a "*" preceeding the label
+12 ; are -not- processed.
+13 ;
+14 ; Thanks to George T. Huggins for the original routine.
+15 ;
START ;
+1 ; --- Display routine description.
+2 DO HOME^%ZIS
DO DT^DICRW
+3 KILL ^UTILITY($JOB)
+4 SET ^UTILITY($JOB,"XBLFAM")=""
+5 DO EN^XBRPTL
+6 KILL ^UTILITY($JOB)
+7 ;
+8 ; --- Start processing.
+9 NEW QFLG
+10 SET QFLG=0
+11 ;
+12 ; --- Get file(s).
+13 DO ^XBDSET
+14 IF '$DATA(^UTILITY("XBDSET",$JOB))
QUIT
+15 ;
+16 ; --- Select device.
+17 WRITE !
+18 SET %ZIS="Q"
SET ZTSAVE("^UTILITY(""XBDSET"",$J,")=""
+19 DO EN^XUTMDEVQ("EN^XBLFAM","List Attributes for Modeling",.ZTSAVE,.%ZIS)
+20 DO EN^XBVK("ZT")
+21 QUIT
+22 ;
EN ;EP - From TaskMan.
+1 ;
+2 ; --- Main loop: thru selected file(s).
+3 NEW F,X
+4 ;
+5 ; F:File #
+6 ;
+7 SET F=0
+8 FOR
SET F=$ORDER(^UTILITY("XBDSET",$JOB,F))
IF F'=+F
QUIT
DO PAGE
IF QFLG
QUIT
DO FIELDS(F)
IF QFLG
QUIT
+9 DO ^%ZISC
+10 QUIT
+11 ; --- End main loop.
FIELDS(F) ; Process fields in File F.
+1 ; Field #, File #, File Name, Field Label, Field type, Desc/Help.
+2 NEW X,XB
+3 SET X=""
+4 FOR XB=0:0
SET XB=$ORDER(^DD(F,XB))
IF '(XB=+XB)
QUIT
Begin DoDot:1
+5 ; field is deprecated.
IF $EXTRACT($PIECE($GET(^DD(F,XB,0)),"^",1))="*"
QUIT
+6 ; Recurse sub-file.
IF $PIECE(^DD(F,XB,0),"^",2)
WRITE $$OUTLINE,!
DO FIELDS(+$PIECE(^DD(F,XB,0),"^",2))
QUIT
+7 WRITE $$OUTLINE,!
+8 QUIT
End DoDot:1
IF $Y>(IOSL-3)
DO PAGE
IF QFLG
QUIT
+9 QUIT
+10 ; -------------------------------------------------------
OUTLINE() ;
+1 ; File #, File Name, Field #, Field Label, Field type, Desc/Help.,
+2 ; Min Length, Max Length
+3 QUIT F_";"_$$FNAME^XBFUNC(F)_";"_XB_";"_$PIECE($GET(^DD(F,XB,0)),"^",1)_";"_$$TYPE($PIECE($GET(^DD(F,XB,0)),"^",2))_";"_$$HP(F,XB)_$$DESC(F,XB)_$$TDESC(F,XB)_";"_$$MINL(F,XB)_";"_$$MAXL(F,XB)_";"
+4 ; -------------------------------------------------------
PAGE ; PAGE BREAK
+1 NEW F,G,N,X
+2 IF IO=IO(0)
IF $EXTRACT(IOST,1,2)="C-"
SET QFLG='$$DIR^XBDIR("E")
IF 'QFLG
WRITE @IOF
+3 QUIT
+4 ; -------------------------------------------------------
MINL(N,F) ; Return minimum length
+1 NEW X
+2 SET X=$PIECE(^DD(N,F,0),"^",2)
+3 IF X
QUIT "-"
+4 IF '(X["F")
QUIT "-"
+5 SET X=$PIECE(^DD(N,F,0),"^",5,99)
+6 QUIT +$EXTRACT(X,$FIND(X,"$L(X)<"),$LENGTH(X))
+7 ; -------------------------------------------------------
MAXL(N,F) ; Return maximum length
+1 NEW X
+2 SET X=$PIECE(^DD(N,F,0),"^",2)
+3 IF X
QUIT "-"
+4 IF '(X["F")
QUIT "-"
+5 SET X=$PIECE(^DD(N,F,0),"^",5,99)
+6 QUIT +$EXTRACT(X,$FIND(X,"$L(X)>"),$LENGTH(X))
+7 ; -------------------------------------------------------
NUMBER(F) ;;.001;NUMBER
+1 ; well, duh
QUIT F
+2 ; -------------------------------------------------------
LABEL(N,F) ;;.01;LABEL
+1 QUIT $PIECE($GET(^DD(N,F,0)),"^",1)
+2 ; -------------------------------------------------------
TITLE(N,F) ;;.1;TITLE
+1 QUIT $PIECE($GET(^DD(N,F,.1)),"^",1)
+2 ; -------------------------------------------------------
+3 ;;.12;VARIABLE POINTER (multiple)
+4 ; -------------------------------------------------------
+5 ;;.2;SPECIFIER
+6 ; -------------------------------------------------------
+7 ;;.23;LENGTH
+8 ; -------------------------------------------------------
+9 ;;.24;DECIMAL DEFAULT
+10 ; -------------------------------------------------------
TYPE(P) ;PEP;.25;TYPE
+1 ; Return TYPE of field. Input is the 2nd piece of the 0th node.
+2 IF P
QUIT "<SUBFILE>"
+3 NEW W
+4 FOR W="BOOLEAN","COMPUTED","FREE TEXT","SET","DATE","NUMBER","POINTER","WORD-PROCESSING","K","Z"
IF P[$EXTRACT(W)
QUIT
+5 IF W="SET"
SET W=W_" <"_$TRANSLATE($PIECE($GET(^DD(F,XB,0)),"^",3),";","|")_">"
+6 IF W="POINTER"
SET W=W_" to "_$$FNAME^XBFUNC(+$PIECE(P,"P",2))_" file"
+7 QUIT $SELECT(W'="Z":W,1:"??")
+8 ; -------------------------------------------------------
+9 ;;.26;COMPUTE ALGORITHM
+10 ; -------------------------------------------------------
+11 ;;.27;SUB-FIELDS
+12 ; -------------------------------------------------------
+13 ;;.28;MULTIPLE-VALUED
+14 ; -------------------------------------------------------
+15 ;;.29;DEPTH OF SUB-FIELD
+16 ; -------------------------------------------------------
+17 ;;.3;POINTER
+18 ; -------------------------------------------------------
GSL(N,F) ;;.4;GLOBAL SUBSCRIPT LOCATION
+1 QUIT 0
+2 ; -------------------------------------------------------
IT(N,F) ;;.5;INPUT TRANSFORM
+1 QUIT $PIECE($GET(^DD(N,F,0)),"^",5,99)
+2 ; -------------------------------------------------------
+3 ;;1;CROSS-REFERENCE (multiple)
+4 ; -------------------------------------------------------
AUDIT(N,F) ;;1.1;AUDIT
+1 QUIT $GET(^DD(N,F,"AUDIT"))
+2 ; -------------------------------------------------------
+3 ;;1.2;AUDIT CONDITION
+4 ; -------------------------------------------------------
OT(N,F) ;;2;OUTPUT TRANSFORM
+1 QUIT $GET(^DD(N,F,2.1))
+2 ; -------------------------------------------------------
HP(N,F) ;;3;'HELP'-PROMPT
+1 NEW X
+2 SET X=$GET(^DD(N,F,3))
+3 IF '$LENGTH(X)
QUIT ""
+4 QUIT "HELP-PROMPT("_$GET(^DD(N,F,3))_")"
+5 ; -------------------------------------------------------
XH(N,F) ;;4;XECUTABLE 'HELP'
+1 QUIT $GET(^DD(N,F,4))
+2 ; -------------------------------------------------------
RA(N,F) ;;8;READ ACCESS (OPTIONAL)
+1 QUIT $GET(^DD(N,F,8))
+2 ; -------------------------------------------------------
DA(N,F) ;;8.5;DELETE ACCESS (OPTIONAL)
+1 QUIT $GET(^DD(N,F,8.5))
+2 ; -------------------------------------------------------
WA(N,F) ;;9;WRITE ACCESS (OPTIONAL)
+1 QUIT $GET(^DD(N,F,9))
+2 ; -------------------------------------------------------
+3 ;;9.01;COMPUTED FIELDS USED
+4 ; -------------------------------------------------------
SRC(N,F) ;;10;SOURCE
+1 QUIT $GET(^DD(N,F,10))
+2 ; -------------------------------------------------------
+3 ;;11;DESTINATION (multiple)
+4 ; -------------------------------------------------------
+5 ;;12;POINTER SCREEN
+6 ; -------------------------------------------------------
+7 ;;12.1;CODE TO SET POINTER SCREEN
+8 ; -------------------------------------------------------
+9 ;;12.2;EXPRESSION FOR POINTER SCREEN
+10 ; -------------------------------------------------------
+11 ;;20;GROUP (multiple)
+12 ; -------------------------------------------------------
DESC(N,F) ;;21;DESCRIPTION (word-processing)
+1 ; Field DESCRIPTION and Help-Prompt. N=File, F=Field
+2 NEW X,XB
+3 SET X=""
+4 FOR XB=0:0
SET XB=$ORDER(^DD(N,F,21,XB))
IF 'XB
QUIT
SET X=X_$GET(^(XB,0))
+5 IF '$LENGTH(X)
QUIT ""
+6 QUIT "DESCRIPTION("_X_")"
+7 ; -------------------------------------------------------
TDESC(N,F) ;;23;TECHNICAL DESCRIPTION (word-processing)
+1 NEW X,XB
+2 SET X=""
+3 FOR XB=0:0
SET XB=$ORDER(^DD(N,F,23,XB))
IF 'XB
QUIT
SET X=X_$GET(^(XB,0))
+4 IF '$LENGTH(X)
QUIT ""
+5 QUIT "TECH_DESCRIPTION("_X_")"
+6 ; -------------------------------------------------------
DFLE(N,F) ;;50;DATE FIELD LAST EDITED
+1 QUIT $$FMTE^XLFDT($GET(^DD(N,F,"DT")))
+2 ; -------------------------------------------------------
+3 ;;999;TRIGGERED-BY POINTER (multiple)
+4 ; -------------------------------------------------------
+5 ;
