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)
Q
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)
Q
;
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)
Q
;
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)
Q
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)
Q
;
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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF10A 7083 printed Dec 13, 2024@02:50:36 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
