XBFDINFO.m

XBFDINFO(FILE,FIELD,ROOT) ; IHS/ADC/GTH - RETURN FIELD INFORMATION ; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 ;

 ;  ATTENTION PROGRAMMERS:  Use line label FLD() for entry.

 ;           Do not use the first line for entry.

 ;

 ; Given a file/subfile number, a field number, and an array

 ; root, this routine will return information about the

 ; specified field.  The information will be returned as

 ; subscripted variables from the root passed by the caller.

 ;

 ; The field information returned will be a subset of the

 ; following:

 ;

 ;  ROOT("NAME")   = name of field

 ;  ROOT("NODE")   = node in data global

 ;  ROOT("PIECE")  = piece in node

 ;  ROOT("TYPE")   = FileMan field type or "M" for multiple,

 ;                   or "C" for computed

 ;  ROOT("SFILE")  = subfile number if the field is a multiple

 ;  ROOT("PFILE")  = file number of pointed to file

 ;  ROOT("PGBL")   = gbl of pointed to file

 ;  ROOT("DINUM")  = existance indicates DINUM pointer

 ;

 ;  ROOT("VPFILE",file) = variable pointer prefix.  'file' is

 ;                        pointed to file

 ;  ROOT("VPGBL",file)  = variable pointer gbl of pointed to

 ;                        file.  'file' is pointed to file

 ;

 ; Formal list:

 ;

 ; 1)  FILE   = file/subfile number (call by value)

 ; 2)  FIELD  = field number (call by value)

 ; 3)  ROOT   = array root (call by reference)

 ;

START ;

 KILL ROOT

 NEW W,X,Y,Z

 Q:FILE'=+FILE

 Q:FIELD'=+FIELD

 Q:'$D(^DD(FILE,FIELD,0))  S X=^(0)

 S ROOT("NAME")=$P(X,"^",1)

 I $P(X,"^",2)["C" S ROOT("TYPE")="C" Q

 S ROOT("NODE")=$S(FIELD=.001:"",1:$P($P(X,"^",4),";",1))

 S ROOT("PIECE")=$S(FIELD=.001:"",1:$P($P(X,"^",4),";",2))

 S Y=$P(X,"^",2)

 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:"?")

 I +$P(X,"^",2) S ROOT("SFILE")=+$P(X,"^",2),ROOT("TYPE")="M" I 1

 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"))=""

 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")

 Q

 ;

FLD(FILE,FIELD,ROOT) ;PEP - Return information about a field.

 G START

 ;

XBFDINFO(FILE,FIELD,ROOT) ; IHS/ADC/GTH - RETURN FIELD INFORMATION ; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

 +3       ;  ATTENTION PROGRAMMERS:  Use line label FLD() for entry.

 +4       ;           Do not use the first line for entry.

 +5       ;

 +6       ; Given a file/subfile number, a field number, and an array

 +7       ; root, this routine will return information about the

 +8       ; specified field.  The information will be returned as

 +9       ; subscripted variables from the root passed by the caller.

 +10      ;

 +11      ; The field information returned will be a subset of the

 +12      ; following:

 +13      ;

 +14      ;  ROOT("NAME")   = name of field

 +15      ;  ROOT("NODE")   = node in data global

 +16      ;  ROOT("PIECE")  = piece in node

 +17      ;  ROOT("TYPE")   = FileMan field type or "M" for multiple,

 +18      ;                   or "C" for computed

 +19      ;  ROOT("SFILE")  = subfile number if the field is a multiple

 +20      ;  ROOT("PFILE")  = file number of pointed to file

 +21      ;  ROOT("PGBL")   = gbl of pointed to file

 +22      ;  ROOT("DINUM")  = existance indicates DINUM pointer

 +23      ;

 +24      ;  ROOT("VPFILE",file) = variable pointer prefix.  'file' is

 +25      ;                        pointed to file

 +26      ;  ROOT("VPGBL",file)  = variable pointer gbl of pointed to

 +27      ;                        file.  'file' is pointed to file

 +28      ;

 +29      ; Formal list:

 +30      ;

 +31      ; 1)  FILE   = file/subfile number (call by value)

 +32      ; 2)  FIELD  = field number (call by value)

 +33      ; 3)  ROOT   = array root (call by reference)

 +34      ;

START     ;

 +1        KILL ROOT

 +2        NEW W,X,Y,Z

 +3        IF FILE'=+FILE

               QUIT 

 +4        IF FIELD'=+FIELD

               QUIT 

 +5        IF '$DATA(^DD(FILE,FIELD,0))

               QUIT 

           SET X=^(0)

 +6        SET ROOT("NAME")=$PIECE(X,"^",1)

 +7        IF $PIECE(X,"^",2)["C"

               SET ROOT("TYPE")="C"

               QUIT 

 +8        SET ROOT("NODE")=$SELECT(FIELD=.001:"",1:$PIECE($PIECE(X,"^",4),";",1))

 +9        SET ROOT("PIECE")=$SELECT(FIELD=.001:"",1:$PIECE($PIECE(X,"^",4),";",2))

 +10       SET Y=$PIECE(X,"^",2)

 +11       SET ROOT("TYPE")=$SELECT(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:"?")

 +12       IF +$PIECE(X,"^",2)

               SET ROOT("SFILE")=+$PIECE(X,"^",2)

               SET ROOT("TYPE")="M"

               IF 1

 +13      IF '$TEST

               IF Y["P"

                   SET ROOT("PFILE")=+$PIECE(Y,"P",2)

                   SET ROOT("PGBL")=$PIECE(X,"^",3)

                   SET @($SELECT($PIECE(X,"^",5,99)["DINUM"&(FIELD=.01):"ROOT(""DINUM"")",1:"Z"))=""

 +14       IF Y["V"

               FOR Z=0:0

                   SET Z=$ORDER(^DD(FILE,FIELD,"V","B",Z))

                   IF Z'=+Z

                       QUIT 

                   SET W=$ORDER(^(Z,""))

                   SET ROOT("VPFILE",Z)=$PIECE(^DD(FILE,FIELD,"V",W,0),"^",4)

                   SET ROOT("VPGBL",Z)=^DIC(Z,0,"GL")

 +15       QUIT 

 +16      ;

FLD(FILE,FIELD,ROOT) ;PEP - Return information about a field.

 +1        GOTO START

 +2       ;