IBDF10C ;ALB/CJM - ENCOUNTER FORM - (shift block contents - continued) ;APRIL 22,1993
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
MAX(TYPE,WAY,MAX,TOP,BOTTOM,LEFT,RIGHT) ;returns the maximum allowable shift
;
N VERT,AREASIZE,IBY,IBX,SIZE,NODE
S VERT=$S("UD"[WAY:1,1:0)
S AREASIZE=$S(VERT:$S(TYPE="B":IBFORM("HT"),1:IBBLK("H")),1:$S(TYPE="B":IBFORM("WIDTH"),1:IBBLK("W")))
D @TYPE
I TYPE'="B",IBBLK("BOX")=1 S MAX=MAX-1
S:MAX<0 MAX=0
Q MAX
E ;
D D
D S
D T
D L
D M
D H
Q
D ;
N SUB,FLD
S FLD="" F S FLD=$O(^IBE(357.5,"C",IBBLK,FLD)) Q:'FLD D
.S NODE=$G(^IBE(357.5,FLD,0)) Q:NODE=""
.S IBY=$P(NODE,"^",11),IBX=$P(NODE,"^",10) I $$INRANGE^IBDF10A(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)))
..D COMPARE
.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 IBX=$P(NODE,"^",4),IBY=$P(NODE,"^",5) I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D
...S SIZE=$S(VERT:1,1:$L($P(NODE,"^",1)))
...D COMPARE
..S IBX=$P(NODE,"^",7),IBY=$P(NODE,"^",6) I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D
...S SIZE=$S(VERT:1,1:$P(NODE,"^",8))
...D COMPARE
Q
;
M ;shift multiple choice field
N SUB,FLD
S FLD="" F S FLD=$O(^IBE(357.93,"C",IBBLK,FLD)) Q:'FLD D
.S NODE=$G(^IBE(357.93,FLD,0)) Q:NODE=""
.S IBY=$P(NODE,"^",4),IBX=$P(NODE,"^",3) I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D
..S SIZE=$S(VERT:1,1:$L($P(NODE,"^",2)))
..D COMPARE
.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 IBX=$P(NODE,"^",2),IBY=$P(NODE,"^",3) I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D
...S SIZE=$S(VERT:1,1:$L($P(NODE,"^",1)))
...D COMPARE
..S IBX=$P(NODE,"^",6),IBY=$P(NODE,"^",7) I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D
...S SIZE=$S(VERT:1,1:3)
...D COMPARE
Q
;
H ;shift hand print fields
N SUB,FLD
S FLD="" F S FLD=$O(^IBE(359.94,"C",IBBLK,FLD)) Q:'FLD D
.S NODE=$G(^IBE(359.94,FLD,0)) Q:NODE=""
.S IBY=$P(NODE,"^",4),IBX=$P(NODE,"^",3) I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D
..I VERT S SIZE=2
..I 'VERT S SIZE=$L($P(NODE,"^",2))+1 S NODE=$G(^IBE(359.1,$P(NODE,"^",10),0)) S SIZE=SIZE+($P(NODE,"^",6)*$S(IBFORM("WIDTH")>96:4,1:3)) I $L($P(NODE,"^",11)) S SIZE=SIZE+(2*$L($P(NODE,"^",11)))
..D COMPARE
Q
;
S ;
;just let the user do what he wants - lists automatically resize themselves to fit the block
Q
T ;
N TXT
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 IBY=$P(NODE,"^",4),IBX=$P(NODE,"^",3) I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D
..S SIZE=$S(VERT:$P(NODE,"^",6),1:$P(NODE,"^",5))
..D COMPARE
Q
L ;
N LINE
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 IBY=$P(NODE,"^",3),IBX=$P(NODE,"^",2) I $$INRANGE^IBDF10A(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)
..D COMPARE
Q
B ;
N BLOCK
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 SIZE=$S(VERT:$P(NODE,"^",7),1:$P(NODE,"^",6)),IBX=$P(NODE,"^",5),IBY=$P(NODE,"^",4)
.I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D COMPARE
;..I WAY="R" S:(IBFORM("WIDTH")-(IBX+WIDTH))<MAX MAX=(IBFORM("WIDTH")-(IBX+WIDTH)) Q
;..I WAY="L" S:IBX<MAX MAX=IBX Q
;..I WAY="D" S:(IBFORM("HT")-(IBY+HT))<MAX MAX=(IBFORM("HT")-(IBY+HT)) Q
;..I WAY="U" S:IBY<MAX MAX=IBY Q
Q
COMPARE ;
I WAY="R" S:(AREASIZE-(IBX+SIZE))<MAX MAX=(AREASIZE-(IBX+SIZE)) Q
I WAY="L" S:IBX<MAX MAX=IBX Q
I WAY="D" S:(AREASIZE-(IBY+SIZE))<MAX MAX=(AREASIZE-(IBY+SIZE)) Q
I WAY="U" S:IBY<MAX MAX=IBY Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF10C 3915 printed Oct 16, 2024@18:51:24 Page 2
IBDF10C ;ALB/CJM - ENCOUNTER FORM - (shift block contents - continued) ;APRIL 22,1993
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
MAX(TYPE,WAY,MAX,TOP,BOTTOM,LEFT,RIGHT) ;returns the maximum allowable shift
+1 ;
+2 NEW VERT,AREASIZE,IBY,IBX,SIZE,NODE
+3 SET VERT=$SELECT("UD"[WAY:1,1:0)
+4 SET AREASIZE=$SELECT(VERT:$SELECT(TYPE="B":IBFORM("HT"),1:IBBLK("H")),1:$SELECT(TYPE="B":IBFORM("WIDTH"),1:IBBLK("W")))
+5 DO @TYPE
+6 IF TYPE'="B"
IF IBBLK("BOX")=1
SET MAX=MAX-1
+7 if MAX<0
SET MAX=0
+8 QUIT MAX
E ;
+1 DO D
+2 DO S
+3 DO T
+4 DO L
+5 DO M
+6 DO H
+7 QUIT
D ;
+1 NEW SUB,FLD
+2 SET FLD=""
FOR
SET FLD=$ORDER(^IBE(357.5,"C",IBBLK,FLD))
if 'FLD
QUIT
Begin DoDot:1
+3 SET NODE=$GET(^IBE(357.5,FLD,0))
if NODE=""
QUIT
+4 SET IBY=$PIECE(NODE,"^",11)
SET IBX=$PIECE(NODE,"^",10)
IF $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)
Begin DoDot:2
+5 SET SIZE=$SELECT(VERT:$PIECE(NODE,"^",12),1:$SELECT($LENGTH($PIECE(NODE,"^",6))>$PIECE(NODE,"^",14):$LENGTH($PIECE(NODE,"^",6)),1:$PIECE(NODE,"^",14)))
+6 DO COMPARE
End DoDot:2
+7 SET SUB=0
FOR
SET SUB=$ORDER(^IBE(357.5,FLD,2,SUB))
if 'SUB
QUIT
Begin DoDot:2
+8 SET NODE=$GET(^IBE(357.5,FLD,2,SUB,0))
if NODE=""
QUIT
+9 SET IBX=$PIECE(NODE,"^",4)
SET IBY=$PIECE(NODE,"^",5)
IF $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)
Begin DoDot:3
+10 SET SIZE=$SELECT(VERT:1,1:$LENGTH($PIECE(NODE,"^",1)))
+11 DO COMPARE
End DoDot:3
+12 SET IBX=$PIECE(NODE,"^",7)
SET IBY=$PIECE(NODE,"^",6)
IF $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)
Begin DoDot:3
+13 SET SIZE=$SELECT(VERT:1,1:$PIECE(NODE,"^",8))
+14 DO COMPARE
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
M ;shift multiple choice field
+1 NEW SUB,FLD
+2 SET FLD=""
FOR
SET FLD=$ORDER(^IBE(357.93,"C",IBBLK,FLD))
if 'FLD
QUIT
Begin DoDot:1
+3 SET NODE=$GET(^IBE(357.93,FLD,0))
if NODE=""
QUIT
+4 SET IBY=$PIECE(NODE,"^",4)
SET IBX=$PIECE(NODE,"^",3)
IF $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)
Begin DoDot:2
+5 SET SIZE=$SELECT(VERT:1,1:$LENGTH($PIECE(NODE,"^",2)))
+6 DO COMPARE
End DoDot:2
+7 SET SUB=0
FOR
SET SUB=$ORDER(^IBE(357.93,FLD,1,SUB))
if 'SUB
QUIT
Begin DoDot:2
+8 SET NODE=$GET(^IBE(357.93,FLD,1,SUB,0))
if NODE=""
QUIT
+9 SET IBX=$PIECE(NODE,"^",2)
SET IBY=$PIECE(NODE,"^",3)
IF $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)
Begin DoDot:3
+10 SET SIZE=$SELECT(VERT:1,1:$LENGTH($PIECE(NODE,"^",1)))
+11 DO COMPARE
End DoDot:3
+12 SET IBX=$PIECE(NODE,"^",6)
SET IBY=$PIECE(NODE,"^",7)
IF $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)
Begin DoDot:3
+13 SET SIZE=$SELECT(VERT:1,1:3)
+14 DO COMPARE
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
H ;shift hand print fields
+1 NEW SUB,FLD
+2 SET FLD=""
FOR
SET FLD=$ORDER(^IBE(359.94,"C",IBBLK,FLD))
if 'FLD
QUIT
Begin DoDot:1
+3 SET NODE=$GET(^IBE(359.94,FLD,0))
if NODE=""
QUIT
+4 SET IBY=$PIECE(NODE,"^",4)
SET IBX=$PIECE(NODE,"^",3)
IF $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)
Begin DoDot:2
+5 IF VERT
SET SIZE=2
+6 IF 'VERT
SET SIZE=$LENGTH($PIECE(NODE,"^",2))+1
SET NODE=$GET(^IBE(359.1,$PIECE(NODE,"^",10),0))
SET SIZE=SIZE+($PIECE(NODE,"^",6)*$SELECT(IBFORM("WIDTH")>96:4,1:3))
IF $LENGTH($PIECE(NODE,"^",11))
SET SIZE=SIZE+(2*$LENGTH($PIECE(NODE,"^",11)))
+7 DO COMPARE
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
S ;
+1 ;just let the user do what he wants - lists automatically resize themselves to fit the block
+2 QUIT
T ;
+1 NEW TXT
+2 SET TXT=""
FOR
SET TXT=$ORDER(^IBE(357.8,"C",IBBLK,TXT))
if 'TXT
QUIT
Begin DoDot:1
+3 SET NODE=$GET(^IBE(357.8,TXT,0))
if NODE=""
QUIT
+4 SET IBY=$PIECE(NODE,"^",4)
SET IBX=$PIECE(NODE,"^",3)
IF $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)
Begin DoDot:2
+5 SET SIZE=$SELECT(VERT:$PIECE(NODE,"^",6),1:$PIECE(NODE,"^",5))
+6 DO COMPARE
End DoDot:2
End DoDot:1
+7 QUIT
L ;
+1 NEW LINE
+2 SET LINE=""
FOR
SET LINE=$ORDER(^IBE(357.7,"C",IBBLK,LINE))
if 'LINE
QUIT
Begin DoDot:1
+3 SET NODE=$GET(^IBE(357.7,LINE,0))
if NODE=""
QUIT
+4 SET IBY=$PIECE(NODE,"^",3)
SET IBX=$PIECE(NODE,"^",2)
IF $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)
Begin DoDot:2
+5 SET SIZE=$SELECT(((($PIECE(NODE,"^",4)="V")&VERT)!(($PIECE(NODE,"^",4)="H")&'VERT)):$PIECE(NODE,"^",5),1:1)
+6 DO COMPARE
End DoDot:2
End DoDot:1
+7 QUIT
B ;
+1 NEW BLOCK
+2 SET BLOCK=""
FOR
SET BLOCK=$ORDER(^IBE(357.1,"C",IBFORM,BLOCK))
if 'BLOCK
QUIT
Begin DoDot:1
+3 SET NODE=$GET(^IBE(357.1,BLOCK,0))
if NODE=""
QUIT
+4 SET SIZE=$SELECT(VERT:$PIECE(NODE,"^",7),1:$PIECE(NODE,"^",6))
SET IBX=$PIECE(NODE,"^",5)
SET IBY=$PIECE(NODE,"^",4)
+5 IF $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)
DO COMPARE
End DoDot:1
+6 ;..I WAY="R" S:(IBFORM("WIDTH")-(IBX+WIDTH))<MAX MAX=(IBFORM("WIDTH")-(IBX+WIDTH)) Q
+7 ;..I WAY="L" S:IBX<MAX MAX=IBX Q
+8 ;..I WAY="D" S:(IBFORM("HT")-(IBY+HT))<MAX MAX=(IBFORM("HT")-(IBY+HT)) Q
+9 ;..I WAY="U" S:IBY<MAX MAX=IBY Q
+10 QUIT
COMPARE ;
+1 IF WAY="R"
if (AREASIZE-(IBX+SIZE))<MAX
SET MAX=(AREASIZE-(IBX+SIZE))
QUIT
+2 IF WAY="L"
if IBX<MAX
SET MAX=IBX
QUIT
+3 IF WAY="D"
if (AREASIZE-(IBY+SIZE))<MAX
SET MAX=(AREASIZE-(IBY+SIZE))
QUIT
+4 IF WAY="U"
if IBY<MAX
SET MAX=IBY
QUIT
+5 QUIT
