103 lines
4.0 KiB
Mathematica
103 lines
4.0 KiB
Mathematica
|
XBLFSETS ;IHS/SET/GTH - LISTS FILE SETS ; [ 04/18/2003 9:06 AM ]
|
||
|
|
;;4.0;XB;;Jul 20, 2009;Build 2
|
||
|
|
;IHS/SET/GTH XB*3*9 10/29/2002 New Routine.
|
||
|
|
; This routine lists the following file information, useful for
|
||
|
|
; moving to a spreadsheet, or other desktop ap, for database
|
||
|
|
; Reference Terminology Modeling (RTM) activities:
|
||
|
|
; CodeSetID;Acronym;Name;Requirement;Source;Information;
|
||
|
|
; Note;DataType;MinSize;MaxSize;File #;Field #
|
||
|
|
; The output is one line of data per field, semi-colon delimited.
|
||
|
|
; Only fields of type SET are reported. Y/N fields are skipped.
|
||
|
|
; (See routine for more info.)
|
||
|
|
MORE ;
|
||
|
|
; CodeSetID: This is an identifier that is used to uniquely identify
|
||
|
|
; the codeset. Some of these codeset ids are the formal
|
||
|
|
; standard identifier such as "ICD 9-CM" or "ISO 3166";
|
||
|
|
; others have been assigned an unofficial codeset id.
|
||
|
|
; Acronym: This is an abbreviated name for the codeset.
|
||
|
|
; Name: This is the name of the codeset.
|
||
|
|
; Requirement: This is an indicator that specifies the codeset is
|
||
|
|
; required by regulation. An "H" denotes that the codeset
|
||
|
|
; is required for HIPAA; an "O" denotes a requirement by
|
||
|
|
; the Office of Management and Budget (OMB).
|
||
|
|
; Source: This is the originating source of the codeset.
|
||
|
|
; Information: This is information about the codeset or the location
|
||
|
|
; of information about the codeset.
|
||
|
|
; Note: This contains notes that may assist in locating, using,
|
||
|
|
; documenting, etc., the codeset.
|
||
|
|
; DateType: This is the datatype of the codeset.
|
||
|
|
; MinSize: This is the maximum character size of the coded value.
|
||
|
|
; MaxSize: This is the minimum character size of the coded value.
|
||
|
|
;
|
||
|
|
START ;
|
||
|
|
; --- Display routine description.
|
||
|
|
D HOME^%ZIS,DT^DICRW
|
||
|
|
KILL ^UTILITY($J)
|
||
|
|
S ^UTILITY($J,"XBLFSETS")=""
|
||
|
|
D EN^XBRPTL
|
||
|
|
KILL ^UTILITY($J)
|
||
|
|
; --- Get file(s).
|
||
|
|
D ^XBDSET
|
||
|
|
Q:'$D(^UTILITY("XBDSET",$J))
|
||
|
|
S XBIHS=$$DIR^XBDIR("N^500:999:0","Enter the beginning CodeSet ID number",500,"The response must be a number")
|
||
|
|
Q:Y="^"
|
||
|
|
; --- Select device.
|
||
|
|
W !
|
||
|
|
S %ZIS="Q",ZTSAVE("^UTILITY(""XBDSET"",$J,")="",ZTSAVE("XBIHS")=""
|
||
|
|
D EN^XUTMDEVQ("EN^XBLFSETS","List File Sets",.ZTSAVE,.%ZIS)
|
||
|
|
D EN^XBVK("ZT")
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
EN ;EP - from TaskMan.
|
||
|
|
VARS ;;F,N,X,W;Single-char work vars.
|
||
|
|
; F:File #
|
||
|
|
NEW XBQFLG,@($P($T(VARS),";",3))
|
||
|
|
S (XBQFLG,F)=0
|
||
|
|
F S F=$O(^UTILITY("XBDSET",$J,F)) Q:F'=+F D PAGE Q:XBQFLG D FIELDS(F) Q:XBQFLG
|
||
|
|
D ^%ZISC
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
FIELDS(F) ; Process fields in File F.
|
||
|
|
NEW X,XB
|
||
|
|
S XB=0
|
||
|
|
F S XB=$O(^DD(F,XB)) Q:'(XB=+XB) D D:$Y>(IOSL-3) PAGE Q:XBQFLG
|
||
|
|
. I $E($P($G(^DD(F,XB,0)),"^",1))="*" Q ; field is deprecated.
|
||
|
|
. I $P(^DD(F,XB,0),"^",2) D FIELDS($P(^(0),"^",2)) Q ; Recurse sub-file.
|
||
|
|
. S X=$$TYPE($P($G(^DD(F,XB,0)),"^",2))
|
||
|
|
. I X'="SET" Q ; Process only SETs.
|
||
|
|
. I $P($$FINFO(F,XB),"<",2)="1:YES|0:NO|>" Q ; Skip Y/N fields.
|
||
|
|
. ; CodeSetID;Acronym;Name;Requirement;Source
|
||
|
|
. S XBIHS=XBIHS+1
|
||
|
|
. W "IHS"_$J(XBIHS,3,0)_";;"_$P($G(^DD(F,XB,0)),"^",1)_";;;"
|
||
|
|
. ; Information;Note;DataType;MinSize;MaxSize;File #;Field #
|
||
|
|
. W $$DESC(F,XB)_";"_$$FINFO(F,XB)_";"_$$TYPE($P($G(^DD(F,XB,0)),"^",2))_";;;"_F_";"_XB_";"
|
||
|
|
. W !
|
||
|
|
. Q
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
DESC(N,F) ; Field DESCRIPTION and Help-Prompt. N=File, F=Field
|
||
|
|
NEW X,XB
|
||
|
|
S X=""
|
||
|
|
S X="File Number "_N_", '"_$$FNAME^XBFUNC(N)_"', Field # "_F_", In Global "_$$FGLOB^XBFUNC(N)_", DESCRIPTION <"
|
||
|
|
F XB=0:0 S XB=$O(^DD(N,F,21,XB)) Q:'XB S X=X_$G(^(XB,0))
|
||
|
|
S X=X_"> HELP-PROMPT <"_$G(^DD(N,F,3))_">"
|
||
|
|
Q X
|
||
|
|
;
|
||
|
|
TYPE(P) ; Return TYPE of field. Input is the 2nd piece of the 0th node.
|
||
|
|
NEW W
|
||
|
|
F W="BOOLEAN","COMPUTED","FREE TEXT","SET","DATE","NUMBER","POINTER","K","Z" I P[$E(W) Q
|
||
|
|
Q $S(W'="Z":W,1:"?")
|
||
|
|
;
|
||
|
|
FINFO(N,F) ; Return SET values, or Pointed-To. N=File, F=Field
|
||
|
|
NEW T
|
||
|
|
S T=$$TYPE($P(^DD(N,F,0),"^",2))
|
||
|
|
I T="SET" Q "Values <"_$TR($P($G(^DD(N,F,0)),"^",3),";","|")_">"
|
||
|
|
I T="POINTER" Q " Points to "_$$FNAME^XBFUNC(+$P($P(^DD(N,F,0),"^",2),"P",2))_" file"
|
||
|
|
Q "?"
|
||
|
|
;
|
||
|
|
PAGE ; PAGE BREAK
|
||
|
|
NEW F,G,N,X
|
||
|
|
I IO=IO(0),$E(IOST,1,2)="C-" S XBQFLG='$$DIR^XBDIR("E") I 'XBQFLG W @IOF
|
||
|
|
Q
|
||
|
|
;
|