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

Last change on this file since 1520 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.7 KB
RevLine 
[613]1IBDF10C ;ALB/CJM - ENCOUNTER FORM - (shift block contents - continued) ;APRIL 22,1993
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4MAX(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
13E ;
14 D D
15 D S
16 D T
17 D L
18 D M
19 D H
20 Q
21D ;
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 ;
38M ;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 ;
55H ;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 ;
65S ;
66 ;just let the user do what he wants - lists automatically resize themselves to fit the block
67 Q
68T ;
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
76L ;
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
84B ;
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
95COMPARE ;
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
Note: See TracBrowser for help on using the repository browser.