IBDFU1A.m

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 ---IBDFU1A   1209     printed  Apr 09, 2024@21:38:40                                                                                                                                                                                                     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