- 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 Feb 19, 2025@00:19:56 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
