| 1 | XBFDINFO(FILE,FIELD,ROOT) ; IHS/ADC/GTH - RETURN FIELD INFORMATION ; [ 02/07/97 3:02 PM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | ; ATTENTION PROGRAMMERS: Use line label FLD() for entry.
|
|---|
| 5 | ; Do not use the first line for entry.
|
|---|
| 6 | ;
|
|---|
| 7 | ; Given a file/subfile number, a field number, and an array
|
|---|
| 8 | ; root, this routine will return information about the
|
|---|
| 9 | ; specified field. The information will be returned as
|
|---|
| 10 | ; subscripted variables from the root passed by the caller.
|
|---|
| 11 | ;
|
|---|
| 12 | ; The field information returned will be a subset of the
|
|---|
| 13 | ; following:
|
|---|
| 14 | ;
|
|---|
| 15 | ; ROOT("NAME") = name of field
|
|---|
| 16 | ; ROOT("NODE") = node in data global
|
|---|
| 17 | ; ROOT("PIECE") = piece in node
|
|---|
| 18 | ; ROOT("TYPE") = FileMan field type or "M" for multiple,
|
|---|
| 19 | ; or "C" for computed
|
|---|
| 20 | ; ROOT("SFILE") = subfile number if the field is a multiple
|
|---|
| 21 | ; ROOT("PFILE") = file number of pointed to file
|
|---|
| 22 | ; ROOT("PGBL") = gbl of pointed to file
|
|---|
| 23 | ; ROOT("DINUM") = existance indicates DINUM pointer
|
|---|
| 24 | ;
|
|---|
| 25 | ; ROOT("VPFILE",file) = variable pointer prefix. 'file' is
|
|---|
| 26 | ; pointed to file
|
|---|
| 27 | ; ROOT("VPGBL",file) = variable pointer gbl of pointed to
|
|---|
| 28 | ; file. 'file' is pointed to file
|
|---|
| 29 | ;
|
|---|
| 30 | ; Formal list:
|
|---|
| 31 | ;
|
|---|
| 32 | ; 1) FILE = file/subfile number (call by value)
|
|---|
| 33 | ; 2) FIELD = field number (call by value)
|
|---|
| 34 | ; 3) ROOT = array root (call by reference)
|
|---|
| 35 | ;
|
|---|
| 36 | START ;
|
|---|
| 37 | KILL ROOT
|
|---|
| 38 | NEW W,X,Y,Z
|
|---|
| 39 | Q:FILE'=+FILE
|
|---|
| 40 | Q:FIELD'=+FIELD
|
|---|
| 41 | Q:'$D(^DD(FILE,FIELD,0)) S X=^(0)
|
|---|
| 42 | S ROOT("NAME")=$P(X,"^",1)
|
|---|
| 43 | I $P(X,"^",2)["C" S ROOT("TYPE")="C" Q
|
|---|
| 44 | S ROOT("NODE")=$S(FIELD=.001:"",1:$P($P(X,"^",4),";",1))
|
|---|
| 45 | S ROOT("PIECE")=$S(FIELD=.001:"",1:$P($P(X,"^",4),";",2))
|
|---|
| 46 | S Y=$P(X,"^",2)
|
|---|
| 47 | S ROOT("TYPE")=$S(Y["F":"F",Y["C":"C",Y["D":"D",Y["K":"K",Y["N":"N",Y["P":"P",Y["S":"S",Y["V":"V",Y["K":"K",Y["W":"W",1:"?")
|
|---|
| 48 | I +$P(X,"^",2) S ROOT("SFILE")=+$P(X,"^",2),ROOT("TYPE")="M" I 1
|
|---|
| 49 | E S:Y["P" ROOT("PFILE")=+$P(Y,"P",2),ROOT("PGBL")=$P(X,"^",3),@($S($P(X,"^",5,99)["DINUM"&(FIELD=.01):"ROOT(""DINUM"")",1:"Z"))=""
|
|---|
| 50 | I Y["V" F Z=0:0 S Z=$O(^DD(FILE,FIELD,"V","B",Z)) Q:Z'=+Z S W=$O(^(Z,"")),ROOT("VPFILE",Z)=$P(^DD(FILE,FIELD,"V",W,0),"^",4),ROOT("VPGBL",Z)=^DIC(Z,0,"GL")
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | FLD(FILE,FIELD,ROOT) ;PEP - Return information about a field.
|
|---|
| 54 | G START
|
|---|
| 55 | ;
|
|---|
