| [641] | 1 | XBLFSETS ;IHS/SET/GTH - LISTS FILE SETS ; [ 04/18/2003 9:06 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 information, useful for
|
|---|
| 5 | ; moving to a spreadsheet, or other desktop ap, for database
|
|---|
| 6 | ; Reference Terminology Modeling (RTM) activities:
|
|---|
| 7 | ; CodeSetID;Acronym;Name;Requirement;Source;Information;
|
|---|
| 8 | ; Note;DataType;MinSize;MaxSize;File #;Field #
|
|---|
| 9 | ; The output is one line of data per field, semi-colon delimited.
|
|---|
| 10 | ; Only fields of type SET are reported. Y/N fields are skipped.
|
|---|
| 11 | ; (See routine for more info.)
|
|---|
| 12 | MORE ;
|
|---|
| 13 | ; CodeSetID: This is an identifier that is used to uniquely identify
|
|---|
| 14 | ; the codeset. Some of these codeset ids are the formal
|
|---|
| 15 | ; standard identifier such as "ICD 9-CM" or "ISO 3166";
|
|---|
| 16 | ; others have been assigned an unofficial codeset id.
|
|---|
| 17 | ; Acronym: This is an abbreviated name for the codeset.
|
|---|
| 18 | ; Name: This is the name of the codeset.
|
|---|
| 19 | ; Requirement: This is an indicator that specifies the codeset is
|
|---|
| 20 | ; required by regulation. An "H" denotes that the codeset
|
|---|
| 21 | ; is required for HIPAA; an "O" denotes a requirement by
|
|---|
| 22 | ; the Office of Management and Budget (OMB).
|
|---|
| 23 | ; Source: This is the originating source of the codeset.
|
|---|
| 24 | ; Information: This is information about the codeset or the location
|
|---|
| 25 | ; of information about the codeset.
|
|---|
| 26 | ; Note: This contains notes that may assist in locating, using,
|
|---|
| 27 | ; documenting, etc., the codeset.
|
|---|
| 28 | ; DateType: This is the datatype of the codeset.
|
|---|
| 29 | ; MinSize: This is the maximum character size of the coded value.
|
|---|
| 30 | ; MaxSize: This is the minimum character size of the coded value.
|
|---|
| 31 | ;
|
|---|
| 32 | START ;
|
|---|
| 33 | ; --- Display routine description.
|
|---|
| 34 | D HOME^%ZIS,DT^DICRW
|
|---|
| 35 | KILL ^UTILITY($J)
|
|---|
| 36 | S ^UTILITY($J,"XBLFSETS")=""
|
|---|
| 37 | D EN^XBRPTL
|
|---|
| 38 | KILL ^UTILITY($J)
|
|---|
| 39 | ; --- Get file(s).
|
|---|
| 40 | D ^XBDSET
|
|---|
| 41 | Q:'$D(^UTILITY("XBDSET",$J))
|
|---|
| 42 | S XBIHS=$$DIR^XBDIR("N^500:999:0","Enter the beginning CodeSet ID number",500,"The response must be a number")
|
|---|
| 43 | Q:Y="^"
|
|---|
| 44 | ; --- Select device.
|
|---|
| 45 | W !
|
|---|
| 46 | S %ZIS="Q",ZTSAVE("^UTILITY(""XBDSET"",$J,")="",ZTSAVE("XBIHS")=""
|
|---|
| 47 | D EN^XUTMDEVQ("EN^XBLFSETS","List File Sets",.ZTSAVE,.%ZIS)
|
|---|
| 48 | D EN^XBVK("ZT")
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | EN ;EP - from TaskMan.
|
|---|
| 52 | VARS ;;F,N,X,W;Single-char work vars.
|
|---|
| 53 | ; F:File #
|
|---|
| 54 | NEW XBQFLG,@($P($T(VARS),";",3))
|
|---|
| 55 | S (XBQFLG,F)=0
|
|---|
| 56 | F S F=$O(^UTILITY("XBDSET",$J,F)) Q:F'=+F D PAGE Q:XBQFLG D FIELDS(F) Q:XBQFLG
|
|---|
| 57 | D ^%ZISC
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | FIELDS(F) ; Process fields in File F.
|
|---|
| 61 | NEW X,XB
|
|---|
| 62 | S XB=0
|
|---|
| 63 | F S XB=$O(^DD(F,XB)) Q:'(XB=+XB) D D:$Y>(IOSL-3) PAGE Q:XBQFLG
|
|---|
| 64 | . I $E($P($G(^DD(F,XB,0)),"^",1))="*" Q ; field is deprecated.
|
|---|
| 65 | . I $P(^DD(F,XB,0),"^",2) D FIELDS($P(^(0),"^",2)) Q ; Recurse sub-file.
|
|---|
| 66 | . S X=$$TYPE($P($G(^DD(F,XB,0)),"^",2))
|
|---|
| 67 | . I X'="SET" Q ; Process only SETs.
|
|---|
| 68 | . I $P($$FINFO(F,XB),"<",2)="1:YES|0:NO|>" Q ; Skip Y/N fields.
|
|---|
| 69 | . ; CodeSetID;Acronym;Name;Requirement;Source
|
|---|
| 70 | . S XBIHS=XBIHS+1
|
|---|
| 71 | . W "IHS"_$J(XBIHS,3,0)_";;"_$P($G(^DD(F,XB,0)),"^",1)_";;;"
|
|---|
| 72 | . ; Information;Note;DataType;MinSize;MaxSize;File #;Field #
|
|---|
| 73 | . W $$DESC(F,XB)_";"_$$FINFO(F,XB)_";"_$$TYPE($P($G(^DD(F,XB,0)),"^",2))_";;;"_F_";"_XB_";"
|
|---|
| 74 | . W !
|
|---|
| 75 | . Q
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | DESC(N,F) ; Field DESCRIPTION and Help-Prompt. N=File, F=Field
|
|---|
| 79 | NEW X,XB
|
|---|
| 80 | S X=""
|
|---|
| 81 | S X="File Number "_N_", '"_$$FNAME^XBFUNC(N)_"', Field # "_F_", In Global "_$$FGLOB^XBFUNC(N)_", DESCRIPTION <"
|
|---|
| 82 | F XB=0:0 S XB=$O(^DD(N,F,21,XB)) Q:'XB S X=X_$G(^(XB,0))
|
|---|
| 83 | S X=X_"> HELP-PROMPT <"_$G(^DD(N,F,3))_">"
|
|---|
| 84 | Q X
|
|---|
| 85 | ;
|
|---|
| 86 | TYPE(P) ; Return TYPE of field. Input is the 2nd piece of the 0th node.
|
|---|
| 87 | NEW W
|
|---|
| 88 | F W="BOOLEAN","COMPUTED","FREE TEXT","SET","DATE","NUMBER","POINTER","K","Z" I P[$E(W) Q
|
|---|
| 89 | Q $S(W'="Z":W,1:"?")
|
|---|
| 90 | ;
|
|---|
| 91 | FINFO(N,F) ; Return SET values, or Pointed-To. N=File, F=Field
|
|---|
| 92 | NEW T
|
|---|
| 93 | S T=$$TYPE($P(^DD(N,F,0),"^",2))
|
|---|
| 94 | I T="SET" Q "Values <"_$TR($P($G(^DD(N,F,0)),"^",3),";","|")_">"
|
|---|
| 95 | I T="POINTER" Q " Points to "_$$FNAME^XBFUNC(+$P($P(^DD(N,F,0),"^",2),"P",2))_" file"
|
|---|
| 96 | Q "?"
|
|---|
| 97 | ;
|
|---|
| 98 | PAGE ; PAGE BREAK
|
|---|
| 99 | NEW F,G,N,X
|
|---|
| 100 | I IO=IO(0),$E(IOST,1,2)="C-" S XBQFLG='$$DIR^XBDIR("E") I 'XBQFLG W @IOF
|
|---|
| 101 | Q
|
|---|
| 102 | ;
|
|---|
