IBDFU1A ;ALB/CJM - ENCOUNTER FORM (read data field description);NOV 16,1992
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;utilities
FLDDESCR(IBFLD) ;IBFLD should be a pointer to the IB DATA FIELD file
;parses the 0 NODE and returns the fields
;returns 1 if the field description is not found
N NODE
Q:'$G(IBFLD) 0
S:$G(IBFLD) NODE=$G(^IBE(357.5,IBFLD,0))
Q:NODE="" 0
S FLDNAME=$P(NODE,"^",1)
S BLK=$P(NODE,"^",2)
S RTN=$P(NODE,"^",3)
S LASTITEM=$P(NODE,"^",4)
S ITEM=+$P(NODE,"^",5)
S LABEL=$P(NODE,"^",6)
S DISPLAY=$P(NODE,"^",7)
S XIO=+$P(NODE,"^",10)
S YIO=+$P(NODE,"^",11)
S HIO=+$P(NODE,"^",12)
S SPACING=$P(NODE,"^",13)
S WIO=+$P(NODE,"^",14)
Q 1
SFLDDSCR(IBFLD,LAST) ;gets the next subfield - LAST is the last subfield processed, IBFLD is the field
;outputs - LABEL,XIO,YIO,WIO,XLAB,YLAB,PIECE,LENGTH,LAST
;returns 0 if no more subfields, LAST otherwise
;
N NODE
F S LAST=$O(^IBE(357.5,IBFLD,2,LAST)) Q:'LAST S NODE=$G(^IBE(357.5,IBFLD,2,LAST,0)) I NODE'="" D Q
.S LABEL=$P(NODE,"^",1),DISPLAY=$P(NODE,"^",3),XLAB=$P(NODE,"^",4),YLAB=$P(NODE,"^",5),YIO=$P(NODE,"^",6),XIO=$P(NODE,"^",7),WIO=$P(NODE,"^",8),PIECE=$P(NODE,"^",9)
Q LAST
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFU1A 1209 printed Dec 13, 2024@02:53:31 Page 2
IBDFU1A ;ALB/CJM - ENCOUNTER FORM (read data field description);NOV 16,1992
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;utilities
FLDDESCR(IBFLD) ;IBFLD should be a pointer to the IB DATA FIELD file
+1 ;parses the 0 NODE and returns the fields
+2 ;returns 1 if the field description is not found
+3 NEW NODE
+4 if '$GET(IBFLD)
QUIT 0
+5 if $GET(IBFLD)
SET NODE=$GET(^IBE(357.5,IBFLD,0))
+6 if NODE=""
QUIT 0
+7 SET FLDNAME=$PIECE(NODE,"^",1)
+8 SET BLK=$PIECE(NODE,"^",2)
+9 SET RTN=$PIECE(NODE,"^",3)
+10 SET LASTITEM=$PIECE(NODE,"^",4)
+11 SET ITEM=+$PIECE(NODE,"^",5)
+12 SET LABEL=$PIECE(NODE,"^",6)
+13 SET DISPLAY=$PIECE(NODE,"^",7)
+14 SET XIO=+$PIECE(NODE,"^",10)
+15 SET YIO=+$PIECE(NODE,"^",11)
+16 SET HIO=+$PIECE(NODE,"^",12)
+17 SET SPACING=$PIECE(NODE,"^",13)
+18 SET WIO=+$PIECE(NODE,"^",14)
+19 QUIT 1
SFLDDSCR(IBFLD,LAST) ;gets the next subfield - LAST is the last subfield processed, IBFLD is the field
+1 ;outputs - LABEL,XIO,YIO,WIO,XLAB,YLAB,PIECE,LENGTH,LAST
+2 ;returns 0 if no more subfields, LAST otherwise
+3 ;
+4 NEW NODE
+5 FOR
SET LAST=$ORDER(^IBE(357.5,IBFLD,2,LAST))
if 'LAST
QUIT
SET NODE=$GET(^IBE(357.5,IBFLD,2,LAST,0))
IF NODE'=""
Begin DoDot:1
+6 SET LABEL=$PIECE(NODE,"^",1)
SET DISPLAY=$PIECE(NODE,"^",3)
SET XLAB=$PIECE(NODE,"^",4)
SET YLAB=$PIECE(NODE,"^",5)
SET YIO=$PIECE(NODE,"^",6)
SET XIO=$PIECE(NODE,"^",7)
SET WIO=$PIECE(NODE,"^",8)
SET PIECE=$PIECE(NODE,"^",9)
End DoDot:1
QUIT
+7 QUIT LAST
