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))