source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF10C.m@ 1096

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