Routine: IBDF10A

IBDF10A ;ALB/CJM - ENCOUNTER FORM - (shifting data fields,lines,text areas,blocks);3/29/93

 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

FLDS(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT) ;shifts all of the data fields in IBBLK falling within the rectangle defined by TOP,BOTTOM,LEFT,RIGHT by AMOUNT

 ;WAY="D" for down, "U" for up, "L" for left, "R" for right

 N SUB,NODE,IBX,IBY,FLD,PIECE,POS,VERT,SIZE,BLKSIZE

 S VERT=$S("UD"[WAY:1,1:0)

 S BLKSIZE=$S(VERT:IBBLK("H"),1:IBBLK("W"))

 ;shifts to the left or up are negative

 S:"UL"[WAY AMOUNT=AMOUNT*(-1)

 S FLD="" F  S FLD=$O(^IBE(357.5,"C",IBBLK,FLD)) Q:'FLD  D

 .S PIECE=$S(VERT:11,1:10)

 .S NODE=$G(^IBE(357.5,FLD,0)) Q:NODE=""

 .S IBX=$P(NODE,"^",10),IBY=$P(NODE,"^",11),POS=$P(NODE,"^",PIECE) I $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D

 ..S SIZE=$S(VERT:$P(NODE,"^",12),1:$S($L($P(NODE,"^",6))>$P(NODE,"^",14):$L($P(NODE,"^",6)),1:$P(NODE,"^",14)))

 ..S $P(^IBE(357.5,FLD,0),"^",PIECE)=$S(("LU"[WAY)&(POS+AMOUNT<0):0,("RD"[WAY)&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

 .S SUB=0 F  S SUB=$O(^IBE(357.5,FLD,2,SUB)) Q:'SUB  D

 ..S NODE=$G(^IBE(357.5,FLD,2,SUB,0)) Q:NODE=""

 ..S PIECE=$S(VERT:5,1:4) S POS=$P(NODE,"^",PIECE),IBX=$P(NODE,"^",4),IBY=$P(NODE,"^",5) I $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D

 ...S SIZE=$S(VERT:1,1:$L($P(NODE,"^",1)))

 ...S $P(^IBE(357.5,FLD,2,SUB,0),"^",PIECE)=$S(("LU"[WAY)&(POS+AMOUNT<0):0,("RD"[WAY)&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

 ..S PIECE=$S(VERT:6,1:7) S POS=$P(NODE,"^",PIECE),IBX=$P(NODE,"^",7),IBY=$P(NODE,"^",6) I $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D

 ...S SIZE=$S(VERT:1,1:$P(NODE,"^",8))

 ...S $P(^IBE(357.5,FLD,2,SUB,0),"^",PIECE)=$S("LU"[WAY&(POS+AMOUNT<0):0,"RD"[WAY&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

MFLDS(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT) ;shifts the multiple choice fields in IBBLK falling within the rectangle defined by TOP,BOTTOM,LEFT,RIGHT by AMOUNT

 ;WAY="D" for down, "U" for up, "L" for left, "R" for right

 N SUB,NODE,IBX,IBY,FLD,PIECE,POS,VERT,SIZE,BLKSIZE

 S VERT=$S("UD"[WAY:1,1:0)

 S BLKSIZE=$S(VERT:IBBLK("H"),1:IBBLK("W"))

 ;shifts to the left or up are negative

 S:"UL"[WAY AMOUNT=AMOUNT*(-1)

 S FLD="" F  S FLD=$O(^IBE(357.93,"C",IBBLK,FLD)) Q:'FLD  D

 .S PIECE=$S(VERT:4,1:3)

 .S NODE=$G(^IBE(357.93,FLD,0)) Q:NODE=""

 .I $P(NODE,"^",2)]"" D

 ..S IBX=$P(NODE,"^",3),IBY=$P(NODE,"^",4),POS=$P(NODE,"^",PIECE) I $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D

 ...S SIZE=$S(VERT:1,1:$L($P(NODE,"^",2)))

 ...S $P(^IBE(357.93,FLD,0),"^",PIECE)=$S(("LU"[WAY)&(POS+AMOUNT<0):0,("RD"[WAY)&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

 .S SUB=0 F  S SUB=$O(^IBE(357.93,FLD,1,SUB)) Q:'SUB  D

 ..S NODE=$G(^IBE(357.93,FLD,1,SUB,0)) Q:NODE=""

 ..S PIECE=$S(VERT:3,1:2) S POS=$P(NODE,"^",PIECE),IBX=$P(NODE,"^",2),IBY=$P(NODE,"^",3) I $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D

 ...S SIZE=$S(VERT:1,1:$L($P(NODE,"^",1)))

 ...S $P(^IBE(357.93,FLD,1,SUB,0),"^",PIECE)=$S(("LU"[WAY)&(POS+AMOUNT<0):0,("RD"[WAY)&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

 ..S PIECE=$S(VERT:7,1:6) S POS=$P(NODE,"^",PIECE),IBX=$P(NODE,"^",6),IBY=$P(NODE,"^",7) I $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D

 ...S SIZE=$S(VERT:1,1:3)

 ...S $P(^IBE(357.93,FLD,1,SUB,0),"^",PIECE)=$S("LU"[WAY&(POS+AMOUNT<0):0,"RD"[WAY&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

HFLDS(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT) ;shifts the hand print fields in IBBLK falling within the rectangle defined by TOP,BOTTOM,LEFT,RIGHT by AMOUNT

 ;WAY="D" for down, "U" for up, "L" for left, "R" for right

 N SUB,NODE,IBX,IBY,FLD,PIECE,POS,VERT,SIZE,BLKSIZE

 S VERT=$S("UD"[WAY:1,1:0)

 S BLKSIZE=$S(VERT:IBBLK("H"),1:IBBLK("W"))

 ;shifts to the left or up are negative

 S:"UL"[WAY AMOUNT=AMOUNT*(-1)

 S FLD="" F  S FLD=$O(^IBE(359.94,"C",IBBLK,FLD)) Q:'FLD  D

 .S PIECE=$S(VERT:4,1:3)

 .S NODE=$G(^IBE(359.94,FLD,0)) Q:NODE=""

 .I $P(NODE,"^",2)]"" D

 ..S IBX=$P(NODE,"^",3),IBY=$P(NODE,"^",4),POS=$P(NODE,"^",PIECE) I $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D

 ...S SIZE=$S(VERT:1,1:$L($P(NODE,"^",2)))

 ...S $P(^IBE(359.94,FLD,0),"^",PIECE)=$S(("LU"[WAY)&(POS+AMOUNT<0):0,("RD"[WAY)&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

LINES(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT) ;shifts all of the lines in IBBLK falling within the range START->END by AMOUNT - if END="" range extends all the way out

 ;WAY="D" for down, "U" for up, "L" for left, "R" for right

 N SUB,NODE,POS,LINE,PIECE,VERT,IBX,IBY,SIZE,BLKSIZE

 S VERT=$S("UD"[WAY:1,1:0)

 S BLKSIZE=$S(VERT:IBBLK("H"),1:IBBLK("W"))

 ;shifts to the left or up are negative

 S:"UL"[WAY AMOUNT=AMOUNT*(-1)

 S LINE="" F  S LINE=$O(^IBE(357.7,"C",IBBLK,LINE)) Q:'LINE  D

 .S NODE=$G(^IBE(357.7,LINE,0)) Q:NODE=""

 .S PIECE=$S(VERT:3,1:2)

 .S POS=$P(NODE,"^",PIECE),IBY=$P(NODE,"^",3),IBX=$P(NODE,"^",2) I $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D

 .S SIZE=$S(((($P(NODE,"^",4)="V")&VERT)!(($P(NODE,"^",4)="H")&'VERT)):$P(NODE,"^",5),1:1)

 .S $P(^IBE(357.7,LINE,0),"^",PIECE)=$S("LU"[WAY&(POS+AMOUNT<0):0,"RD"[WAY&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

TXT(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT) ;shifts all of the text areas in IBBLK falling within the range START->END by AMOUNT - if END="" range extends all the way out

 ;WAY="D" for down, "U" for up, "L" for left, "R" for right

 N SUB,NODE,POS,TXT,PIECE,VERT,IBX,IBY,BLKSIZE,SIZE

 S VERT=$S("UD"[WAY:1,1:0)

 S BLKSIZE=$S(VERT:IBBLK("H"),1:IBBLK("W"))

 ;shifts to the left or up are negative

 S:"UL"[WAY AMOUNT=AMOUNT*(-1)

 S TXT="" F  S TXT=$O(^IBE(357.8,"C",IBBLK,TXT)) Q:'TXT  D

 .S NODE=$G(^IBE(357.8,TXT,0)) Q:NODE=""

 .S PIECE=$S(VERT:4,1:3)

 .S POS=$P(NODE,"^",PIECE),IBY=$P(NODE,"^",4),IBX=$P(NODE,"^",3) I $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D

 .S SIZE=$S(VERT:$P(NODE,"^",6),1:$P(NODE,"^",5))

 .S $P(^IBE(357.8,TXT,0),"^",PIECE)=$S("LU"[WAY&(POS+AMOUNT<0):0,"RD"[WAY&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

INRANGE(X,Y,TOP,BOTTOM,LEFT,RIGHT) ;

 ;determines if (X,Y) is in the rectangle defined by TOP,BOTTOM,LEFT,RIGHT - returns 1 if yes,0 if no

 I (X'<LEFT),((RIGHT="")!(X'>RIGHT)),(Y'<TOP),((BOTTOM="")!(Y'>BOTTOM)) Q 1

Q 0

BLOCKS(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT) ;shifts blocks whose top left-hand corner is within the rectangular region defined by TOP,BOTTOM,LEFT,RIGHT

 N SUB,NODE,POS,BLOCK,PIECE,VERT,IBX,IBY,BLKSIZE,FORMSIZE,NAME

 S VERT=$S("UD"[WAY:1,1:0)

 ;shifts to the left or up are negative

 S:"UL"[WAY AMOUNT=AMOUNT*(-1)

 S BLOCK="" F  S BLOCK=$O(^IBE(357.1,"C",IBFORM,BLOCK)) Q:'BLOCK  D

 .S NODE=$G(^IBE(357.1,BLOCK,0)) Q:NODE=""

 .S NAME=$P(NODE,"^")

 .S PIECE=$S(VERT:4,1:5)

 .S BLKSIZE=$S(VERT:$P(NODE,"^",7),1:$P(NODE,"^",6))

 .S FORMSIZE=$S(VERT:IBFORM("HT"),1:IBFORM("WIDTH"))

 .S POS=$P(NODE,"^",PIECE),IBY=$P(NODE,"^",4),IBX=$P(NODE,"^",5)

 .I $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D

 ..S $P(^IBE(357.1,BLOCK,0),"^",PIECE)=$S(("LU"[WAY)&(POS+AMOUNT<0):0,("DR"[WAY)&((POS+AMOUNT+BLKSIZE)>FORMSIZE):FORMSIZE-BLKSIZE,1:POS+AMOUNT)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF10A   7083     printed  Feb 19, 2025@00:17:02                                                                                                                                                                                                     Page 2

IBDF10A   ;ALB/CJM - ENCOUNTER FORM - (shifting data fields,lines,text areas,blocks);3/29/93

 +1       ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

FLDS(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT) ;shifts all of the data fields in IBBLK falling within the rectangle defined by TOP,BOTTOM,LEFT,RIGHT by AMOUNT

 +1       ;WAY="D" for down, "U" for up, "L" for left, "R" for right

 +2        NEW SUB,NODE,IBX,IBY,FLD,PIECE,POS,VERT,SIZE,BLKSIZE

 +3        SET VERT=$SELECT("UD"[WAY:1,1:0)

 +4        SET BLKSIZE=$SELECT(VERT:IBBLK("H"),1:IBBLK("W"))

 +5       ;shifts to the left or up are negative

 +6        if "UL"[WAY

               SET AMOUNT=AMOUNT*(-1)

 +7        SET FLD=""

FOR

               SET FLD=$ORDER(^IBE(357.5,"C",IBBLK,FLD))

               if 'FLD

                   QUIT

               Begin DoDot:1

 +8                SET PIECE=$SELECT(VERT:11,1:10)

 +9                SET NODE=$GET(^IBE(357.5,FLD,0))

                   if NODE=""

                       QUIT

 +10               SET IBX=$PIECE(NODE,"^",10)

                   SET IBY=$PIECE(NODE,"^",11)

                   SET POS=$PIECE(NODE,"^",PIECE)

                   IF $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)

                       Begin DoDot:2

 +11                       SET SIZE=$SELECT(VERT:$PIECE(NODE,"^",12),1:$SELECT($LENGTH($PIECE(NODE,"^",6))>$PIECE(NODE,"^",14):$LENGTH($PIECE(NODE,"^",6)),1:$PIECE(NODE,"^",14)))

 +12                       SET $PIECE(^IBE(357.5,FLD,0),"^",PIECE)=$SELECT(("LU"[WAY)&(POS+AMOUNT<0):0,("RD"[WAY)&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

                       End DoDot:2

 +13               SET SUB=0

FOR

                       SET SUB=$ORDER(^IBE(357.5,FLD,2,SUB))

                       if 'SUB

                           QUIT

                       Begin DoDot:2

 +14                       SET NODE=$GET(^IBE(357.5,FLD,2,SUB,0))

                           if NODE=""

                               QUIT

 +15                       SET PIECE=$SELECT(VERT:5,1:4)

                           SET POS=$PIECE(NODE,"^",PIECE)

                           SET IBX=$PIECE(NODE,"^",4)

                           SET IBY=$PIECE(NODE,"^",5)

                           IF $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)

                               Begin DoDot:3

 +16                               SET SIZE=$SELECT(VERT:1,1:$LENGTH($PIECE(NODE,"^",1)))

 +17                               SET $PIECE(^IBE(357.5,FLD,2,SUB,0),"^",PIECE)=$SELECT(("LU"[WAY)&(POS+AMOUNT<0):0,("RD"[WAY)&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

                               End DoDot:3

 +18                       SET PIECE=$SELECT(VERT:6,1:7)

                           SET POS=$PIECE(NODE,"^",PIECE)

                           SET IBX=$PIECE(NODE,"^",7)

                           SET IBY=$PIECE(NODE,"^",6)

                           IF $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)

                               Begin DoDot:3

 +19                               SET SIZE=$SELECT(VERT:1,1:$PIECE(NODE,"^",8))

 +20                               SET $PIECE(^IBE(357.5,FLD,2,SUB,0),"^",PIECE)=$SELECT("LU"[WAY&(POS+AMOUNT<0):0,"RD"[WAY&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +21       QUIT

MFLDS(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT) ;shifts the multiple choice fields in IBBLK falling within the rectangle defined by TOP,BOTTOM,LEFT,RIGHT by AMOUNT

 +1       ;WAY="D" for down, "U" for up, "L" for left, "R" for right

 +2        NEW SUB,NODE,IBX,IBY,FLD,PIECE,POS,VERT,SIZE,BLKSIZE

 +3        SET VERT=$SELECT("UD"[WAY:1,1:0)

 +4        SET BLKSIZE=$SELECT(VERT:IBBLK("H"),1:IBBLK("W"))

 +5       ;shifts to the left or up are negative

 +6        if "UL"[WAY

               SET AMOUNT=AMOUNT*(-1)

 +7        SET FLD=""

FOR

               SET FLD=$ORDER(^IBE(357.93,"C",IBBLK,FLD))

               if 'FLD

                   QUIT

               Begin DoDot:1

 +8                SET PIECE=$SELECT(VERT:4,1:3)

 +9                SET NODE=$GET(^IBE(357.93,FLD,0))

                   if NODE=""

                       QUIT

 +10               IF $PIECE(NODE,"^",2)]""

                       Begin DoDot:2

 +11                       SET IBX=$PIECE(NODE,"^",3)

                           SET IBY=$PIECE(NODE,"^",4)

                           SET POS=$PIECE(NODE,"^",PIECE)

                           IF $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)

                               Begin DoDot:3

 +12                               SET SIZE=$SELECT(VERT:1,1:$LENGTH($PIECE(NODE,"^",2)))

 +13                               SET $PIECE(^IBE(357.93,FLD,0),"^",PIECE)=$SELECT(("LU"[WAY)&(POS+AMOUNT<0):0,("RD"[WAY)&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

                               End DoDot:3

                       End DoDot:2

 +14               SET SUB=0

FOR

                       SET SUB=$ORDER(^IBE(357.93,FLD,1,SUB))

                       if 'SUB

                           QUIT

                       Begin DoDot:2

 +15                       SET NODE=$GET(^IBE(357.93,FLD,1,SUB,0))

                           if NODE=""

                               QUIT

 +16                       SET PIECE=$SELECT(VERT:3,1:2)

                           SET POS=$PIECE(NODE,"^",PIECE)

                           SET IBX=$PIECE(NODE,"^",2)

                           SET IBY=$PIECE(NODE,"^",3)

                           IF $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)

                               Begin DoDot:3

 +17                               SET SIZE=$SELECT(VERT:1,1:$LENGTH($PIECE(NODE,"^",1)))

 +18                               SET $PIECE(^IBE(357.93,FLD,1,SUB,0),"^",PIECE)=$SELECT(("LU"[WAY)&(POS+AMOUNT<0):0,("RD"[WAY)&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

                               End DoDot:3

 +19                       SET PIECE=$SELECT(VERT:7,1:6)

                           SET POS=$PIECE(NODE,"^",PIECE)

                           SET IBX=$PIECE(NODE,"^",6)

                           SET IBY=$PIECE(NODE,"^",7)

                           IF $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)

                               Begin DoDot:3

 +20                               SET SIZE=$SELECT(VERT:1,1:3)

 +21                               SET $PIECE(^IBE(357.93,FLD,1,SUB,0),"^",PIECE)=$SELECT("LU"[WAY&(POS+AMOUNT<0):0,"RD"[WAY&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +22       QUIT

 +23      ;

HFLDS(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT) ;shifts the hand print fields in IBBLK falling within the rectangle defined by TOP,BOTTOM,LEFT,RIGHT by AMOUNT

 +1       ;WAY="D" for down, "U" for up, "L" for left, "R" for right

 +2        NEW SUB,NODE,IBX,IBY,FLD,PIECE,POS,VERT,SIZE,BLKSIZE

 +3        SET VERT=$SELECT("UD"[WAY:1,1:0)

 +4        SET BLKSIZE=$SELECT(VERT:IBBLK("H"),1:IBBLK("W"))

 +5       ;shifts to the left or up are negative

 +6        if "UL"[WAY

               SET AMOUNT=AMOUNT*(-1)

 +7        SET FLD=""

FOR

               SET FLD=$ORDER(^IBE(359.94,"C",IBBLK,FLD))

               if 'FLD

                   QUIT

               Begin DoDot:1

 +8                SET PIECE=$SELECT(VERT:4,1:3)

 +9                SET NODE=$GET(^IBE(359.94,FLD,0))

                   if NODE=""

                       QUIT

 +10               IF $PIECE(NODE,"^",2)]""

                       Begin DoDot:2

 +11                       SET IBX=$PIECE(NODE,"^",3)

                           SET IBY=$PIECE(NODE,"^",4)

                           SET POS=$PIECE(NODE,"^",PIECE)

                           IF $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)

                               Begin DoDot:3

 +12                               SET SIZE=$SELECT(VERT:1,1:$LENGTH($PIECE(NODE,"^",2)))

 +13                               SET $PIECE(^IBE(359.94,FLD,0),"^",PIECE)=$SELECT(("LU"[WAY)&(POS+AMOUNT<0):0,("RD"[WAY)&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +14       QUIT

 +15      ;

LINES(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT) ;shifts all of the lines in IBBLK falling within the range START->END by AMOUNT - if END="" range extends all the way out

 +1       ;WAY="D" for down, "U" for up, "L" for left, "R" for right

 +2        NEW SUB,NODE,POS,LINE,PIECE,VERT,IBX,IBY,SIZE,BLKSIZE

 +3        SET VERT=$SELECT("UD"[WAY:1,1:0)

 +4        SET BLKSIZE=$SELECT(VERT:IBBLK("H"),1:IBBLK("W"))

 +5       ;shifts to the left or up are negative

 +6        if "UL"[WAY

               SET AMOUNT=AMOUNT*(-1)

 +7        SET LINE=""

FOR

               SET LINE=$ORDER(^IBE(357.7,"C",IBBLK,LINE))

               if 'LINE

                   QUIT

               Begin DoDot:1

 +8                SET NODE=$GET(^IBE(357.7,LINE,0))

                   if NODE=""

                       QUIT

 +9                SET PIECE=$SELECT(VERT:3,1:2)

 +10               SET POS=$PIECE(NODE,"^",PIECE)

                   SET IBY=$PIECE(NODE,"^",3)

                   SET IBX=$PIECE(NODE,"^",2)

                   IF $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)

                       Begin DoDot:2

                       End DoDot:2

 +11               SET SIZE=$SELECT(((($PIECE(NODE,"^",4)="V")&VERT)!(($PIECE(NODE,"^",4)="H")&'VERT)):$PIECE(NODE,"^",5),1:1)

 +12               SET $PIECE(^IBE(357.7,LINE,0),"^",PIECE)=$SELECT("LU"[WAY&(POS+AMOUNT<0):0,"RD"[WAY&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

               End DoDot:1

 +13       QUIT

TXT(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT) ;shifts all of the text areas in IBBLK falling within the range START->END by AMOUNT - if END="" range extends all the way out

 +1       ;WAY="D" for down, "U" for up, "L" for left, "R" for right

 +2        NEW SUB,NODE,POS,TXT,PIECE,VERT,IBX,IBY,BLKSIZE,SIZE

 +3        SET VERT=$SELECT("UD"[WAY:1,1:0)

 +4        SET BLKSIZE=$SELECT(VERT:IBBLK("H"),1:IBBLK("W"))

 +5       ;shifts to the left or up are negative

 +6        if "UL"[WAY

               SET AMOUNT=AMOUNT*(-1)

 +7        SET TXT=""

FOR

               SET TXT=$ORDER(^IBE(357.8,"C",IBBLK,TXT))

               if 'TXT

                   QUIT

               Begin DoDot:1

 +8                SET NODE=$GET(^IBE(357.8,TXT,0))

                   if NODE=""

                       QUIT

 +9                SET PIECE=$SELECT(VERT:4,1:3)

 +10               SET POS=$PIECE(NODE,"^",PIECE)

                   SET IBY=$PIECE(NODE,"^",4)

                   SET IBX=$PIECE(NODE,"^",3)

                   IF $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)

                       Begin DoDot:2

                       End DoDot:2

 +11               SET SIZE=$SELECT(VERT:$PIECE(NODE,"^",6),1:$PIECE(NODE,"^",5))

 +12               SET $PIECE(^IBE(357.8,TXT,0),"^",PIECE)=$SELECT("LU"[WAY&(POS+AMOUNT<0):0,"RD"[WAY&((POS+AMOUNT+SIZE)>BLKSIZE):BLKSIZE-SIZE,1:POS+AMOUNT)

               End DoDot:1

 +13       QUIT

 +14      ;

INRANGE(X,Y,TOP,BOTTOM,LEFT,RIGHT) ;

 +1       ;determines if (X,Y) is in the rectangle defined by TOP,BOTTOM,LEFT,RIGHT - returns 1 if yes,0 if no

 +2        IF (X'<LEFT)

               IF ((RIGHT="")!(X'>RIGHT))

                   IF (Y'<TOP)

                       IF ((BOTTOM="")!(Y'>BOTTOM))

                           QUIT 1

 +3        QUIT 0

BLOCKS(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT) ;shifts blocks whose top left-hand corner is within the rectangular region defined by TOP,BOTTOM,LEFT,RIGHT

 +1        NEW SUB,NODE,POS,BLOCK,PIECE,VERT,IBX,IBY,BLKSIZE,FORMSIZE,NAME

 +2        SET VERT=$SELECT("UD"[WAY:1,1:0)

 +3       ;shifts to the left or up are negative

 +4        if "UL"[WAY

               SET AMOUNT=AMOUNT*(-1)

 +5        SET BLOCK=""

FOR

               SET BLOCK=$ORDER(^IBE(357.1,"C",IBFORM,BLOCK))

               if 'BLOCK

                   QUIT

               Begin DoDot:1

 +6                SET NODE=$GET(^IBE(357.1,BLOCK,0))

                   if NODE=""

                       QUIT

 +7                SET NAME=$PIECE(NODE,"^")

 +8                SET PIECE=$SELECT(VERT:4,1:5)

 +9                SET BLKSIZE=$SELECT(VERT:$PIECE(NODE,"^",7),1:$PIECE(NODE,"^",6))

 +10               SET FORMSIZE=$SELECT(VERT:IBFORM("HT"),1:IBFORM("WIDTH"))

 +11               SET POS=$PIECE(NODE,"^",PIECE)

                   SET IBY=$PIECE(NODE,"^",4)

                   SET IBX=$PIECE(NODE,"^",5)

 +12               IF $$INRANGE(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)

                       Begin DoDot:2

 +13                       SET $PIECE(^IBE(357.1,BLOCK,0),"^",PIECE)=$SELECT(("LU"[WAY)&(POS+AMOUNT<0):0,("DR"[WAY)&((POS+AMOUNT+BLKSIZE)>FORMSIZE):FORMSIZE-BLKSIZE,1:POS+AMOUNT)

                       End DoDot:2

               End DoDot:1

 +14       QUIT

IBDF10A.m