| [613] | 1 | IBDF10C ;ALB/CJM - ENCOUNTER FORM - (shift block contents - continued) ;APRIL 22,1993 | 
|---|
|  | 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997 | 
|---|
|  | 3 | ; | 
|---|
|  | 4 | MAX(TYPE,WAY,MAX,TOP,BOTTOM,LEFT,RIGHT) ;returns the maximum allowable shift | 
|---|
|  | 5 | ; | 
|---|
|  | 6 | N VERT,AREASIZE,IBY,IBX,SIZE,NODE | 
|---|
|  | 7 | S VERT=$S("UD"[WAY:1,1:0) | 
|---|
|  | 8 | S AREASIZE=$S(VERT:$S(TYPE="B":IBFORM("HT"),1:IBBLK("H")),1:$S(TYPE="B":IBFORM("WIDTH"),1:IBBLK("W"))) | 
|---|
|  | 9 | D @TYPE | 
|---|
|  | 10 | I TYPE'="B",IBBLK("BOX")=1 S MAX=MAX-1 | 
|---|
|  | 11 | S:MAX<0 MAX=0 | 
|---|
|  | 12 | Q MAX | 
|---|
|  | 13 | E ; | 
|---|
|  | 14 | D D | 
|---|
|  | 15 | D S | 
|---|
|  | 16 | D T | 
|---|
|  | 17 | D L | 
|---|
|  | 18 | D M | 
|---|
|  | 19 | D H | 
|---|
|  | 20 | Q | 
|---|
|  | 21 | D ; | 
|---|
|  | 22 | N SUB,FLD | 
|---|
|  | 23 | S FLD="" F  S FLD=$O(^IBE(357.5,"C",IBBLK,FLD)) Q:'FLD  D | 
|---|
|  | 24 | .S NODE=$G(^IBE(357.5,FLD,0)) Q:NODE="" | 
|---|
|  | 25 | .S IBY=$P(NODE,"^",11),IBX=$P(NODE,"^",10) I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D | 
|---|
|  | 26 | ..S SIZE=$S(VERT:$P(NODE,"^",12),1:$S($L($P(NODE,"^",6))>$P(NODE,"^",14):$L($P(NODE,"^",6)),1:$P(NODE,"^",14))) | 
|---|
|  | 27 | ..D COMPARE | 
|---|
|  | 28 | .S SUB=0 F  S SUB=$O(^IBE(357.5,FLD,2,SUB)) Q:'SUB  D | 
|---|
|  | 29 | ..S NODE=$G(^IBE(357.5,FLD,2,SUB,0)) Q:NODE="" | 
|---|
|  | 30 | ..S IBX=$P(NODE,"^",4),IBY=$P(NODE,"^",5) I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D | 
|---|
|  | 31 | ...S SIZE=$S(VERT:1,1:$L($P(NODE,"^",1))) | 
|---|
|  | 32 | ...D COMPARE | 
|---|
|  | 33 | ..S IBX=$P(NODE,"^",7),IBY=$P(NODE,"^",6) I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D | 
|---|
|  | 34 | ...S SIZE=$S(VERT:1,1:$P(NODE,"^",8)) | 
|---|
|  | 35 | ...D COMPARE | 
|---|
|  | 36 | Q | 
|---|
|  | 37 | ; | 
|---|
|  | 38 | M ;shift multiple choice field | 
|---|
|  | 39 | N SUB,FLD | 
|---|
|  | 40 | S FLD="" F  S FLD=$O(^IBE(357.93,"C",IBBLK,FLD)) Q:'FLD  D | 
|---|
|  | 41 | .S NODE=$G(^IBE(357.93,FLD,0)) Q:NODE="" | 
|---|
|  | 42 | .S IBY=$P(NODE,"^",4),IBX=$P(NODE,"^",3) I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D | 
|---|
|  | 43 | ..S SIZE=$S(VERT:1,1:$L($P(NODE,"^",2))) | 
|---|
|  | 44 | ..D COMPARE | 
|---|
|  | 45 | .S SUB=0 F  S SUB=$O(^IBE(357.93,FLD,1,SUB)) Q:'SUB  D | 
|---|
|  | 46 | ..S NODE=$G(^IBE(357.93,FLD,1,SUB,0)) Q:NODE="" | 
|---|
|  | 47 | ..S IBX=$P(NODE,"^",2),IBY=$P(NODE,"^",3) I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D | 
|---|
|  | 48 | ...S SIZE=$S(VERT:1,1:$L($P(NODE,"^",1))) | 
|---|
|  | 49 | ...D COMPARE | 
|---|
|  | 50 | ..S IBX=$P(NODE,"^",6),IBY=$P(NODE,"^",7) I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D | 
|---|
|  | 51 | ...S SIZE=$S(VERT:1,1:3) | 
|---|
|  | 52 | ...D COMPARE | 
|---|
|  | 53 | Q | 
|---|
|  | 54 | ; | 
|---|
|  | 55 | H ;shift hand print fields | 
|---|
|  | 56 | N SUB,FLD | 
|---|
|  | 57 | S FLD="" F  S FLD=$O(^IBE(359.94,"C",IBBLK,FLD)) Q:'FLD  D | 
|---|
|  | 58 | .S NODE=$G(^IBE(359.94,FLD,0)) Q:NODE="" | 
|---|
|  | 59 | .S IBY=$P(NODE,"^",4),IBX=$P(NODE,"^",3) I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D | 
|---|
|  | 60 | ..I VERT S SIZE=2 | 
|---|
|  | 61 | ..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))) | 
|---|
|  | 62 | ..D COMPARE | 
|---|
|  | 63 | Q | 
|---|
|  | 64 | ; | 
|---|
|  | 65 | S ; | 
|---|
|  | 66 | ;just let the user do what he wants - lists automatically resize themselves to fit the block | 
|---|
|  | 67 | Q | 
|---|
|  | 68 | T ; | 
|---|
|  | 69 | N TXT | 
|---|
|  | 70 | S TXT="" F  S TXT=$O(^IBE(357.8,"C",IBBLK,TXT)) Q:'TXT  D | 
|---|
|  | 71 | .S NODE=$G(^IBE(357.8,TXT,0)) Q:NODE="" | 
|---|
|  | 72 | .S IBY=$P(NODE,"^",4),IBX=$P(NODE,"^",3) I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D | 
|---|
|  | 73 | ..S SIZE=$S(VERT:$P(NODE,"^",6),1:$P(NODE,"^",5)) | 
|---|
|  | 74 | ..D COMPARE | 
|---|
|  | 75 | Q | 
|---|
|  | 76 | L ; | 
|---|
|  | 77 | N LINE | 
|---|
|  | 78 | S LINE="" F  S LINE=$O(^IBE(357.7,"C",IBBLK,LINE)) Q:'LINE  D | 
|---|
|  | 79 | .S NODE=$G(^IBE(357.7,LINE,0)) Q:NODE="" | 
|---|
|  | 80 | .S IBY=$P(NODE,"^",3),IBX=$P(NODE,"^",2) I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D | 
|---|
|  | 81 | ..S SIZE=$S(((($P(NODE,"^",4)="V")&VERT)!(($P(NODE,"^",4)="H")&'VERT)):$P(NODE,"^",5),1:1) | 
|---|
|  | 82 | ..D COMPARE | 
|---|
|  | 83 | Q | 
|---|
|  | 84 | B ; | 
|---|
|  | 85 | N BLOCK | 
|---|
|  | 86 | S BLOCK="" F  S BLOCK=$O(^IBE(357.1,"C",IBFORM,BLOCK)) Q:'BLOCK  D | 
|---|
|  | 87 | .S NODE=$G(^IBE(357.1,BLOCK,0)) Q:NODE="" | 
|---|
|  | 88 | .S SIZE=$S(VERT:$P(NODE,"^",7),1:$P(NODE,"^",6)),IBX=$P(NODE,"^",5),IBY=$P(NODE,"^",4) | 
|---|
|  | 89 | .I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D COMPARE | 
|---|
|  | 90 | ;..I WAY="R" S:(IBFORM("WIDTH")-(IBX+WIDTH))<MAX MAX=(IBFORM("WIDTH")-(IBX+WIDTH)) Q | 
|---|
|  | 91 | ;..I WAY="L" S:IBX<MAX MAX=IBX Q | 
|---|
|  | 92 | ;..I WAY="D" S:(IBFORM("HT")-(IBY+HT))<MAX MAX=(IBFORM("HT")-(IBY+HT)) Q | 
|---|
|  | 93 | ;..I WAY="U" S:IBY<MAX MAX=IBY Q | 
|---|
|  | 94 | Q | 
|---|
|  | 95 | COMPARE ; | 
|---|
|  | 96 | I WAY="R" S:(AREASIZE-(IBX+SIZE))<MAX MAX=(AREASIZE-(IBX+SIZE)) Q | 
|---|
|  | 97 | I WAY="L" S:IBX<MAX MAX=IBX Q | 
|---|
|  | 98 | I WAY="D" S:(AREASIZE-(IBY+SIZE))<MAX MAX=(AREASIZE-(IBY+SIZE)) Q | 
|---|
|  | 99 | I WAY="U" S:IBY<MAX MAX=IBY Q | 
|---|
|  | 100 | Q | 
|---|