source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF10B.m@ 635

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

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1IBDF10B ;ALB/CJM - ENCOUNTER FORM - (shifting selection lists);3/29/93
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3LSTS(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT) ;shifts all of the selection lists in IBBLK falling within the range START->END by AMOUNT - if END="" range extends all the way out
4 ;WAY="D" for down, "U" for up, "L" for left, "R" for right
5 N SUB,NODE,POS,LIST,PIECE,VERT,IBX,IBY,COL
6 S VERT=$S("UD"[WAY:1,1:0)
7 ;shifts to the left or up are negative
8 S:"UL"[WAY AMOUNT=AMOUNT*(-1)
9 ;must make sure there is at least one column defined with the row and column specified
10 S LIST="" F S LIST=$O(^IBE(357.2,"C",IBBLK,LIST)) Q:'LIST D
11 .S COL=$O(^IBE(357.2,LIST,1,"B","")) I COL S SUB=$O(^IBE(357.2,LIST,1,"B",COL,0))
12 .S:'$G(SUB) SUB=$$ADDCOL(LIST) ;if there is no column then one must be added, otherwise positioning works through defaults
13 .Q:'SUB
14 .S NODE=$G(^IBE(357.2,LIST,1,SUB,0))
15 .I "DU"[WAY S POS=$P(NODE,"^",2) I POS="" S POS=$S(IBBLK("BOX")=1:1,1:0),POS=POS+$S(IBBLK("HDR")="":0,1:2) S $P(^IBE(357.2,LIST,1,SUB,0),"^",2)=POS
16 .I "RL"[WAY S POS=$P(NODE,"^",3) I POS="" S POS=0,$P(^IBE(357.2,LIST,1,SUB,0),"^",3)=POS
17 .;now loop through all of the columns, shifting the position of each
18 .S SUB=0 F S SUB=$O(^IBE(357.2,LIST,1,SUB)) Q:'SUB D
19 ..S NODE=$G(^IBE(357.2,LIST,1,SUB,0)) Q:NODE=""
20 ..S PIECE=$S(VERT:2,1:3),POS=$P(NODE,"^",PIECE),IBY=+$P(NODE,"^",2),IBX=+$P(NODE,"^",3) I POS=+POS,$$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) S $P(^IBE(357.2,LIST,1,SUB,0),"^",PIECE)=$S(POS+AMOUNT<0:0,1:POS+AMOUNT)
21 Q
22ADDCOL(LIST) ;adds a column to the selection list, which has none
23 S ^IBE(357.2,LIST,1,0)="^357.21I^1^1",^(1,0)="1^^^"
24 K DIK,DA S DIK="^IBE(357.2,"_LIST_",1,",DA(1)=LIST,DA=1 D IX1^DIK K DIK,DA
25 Q 1
Note: See TracBrowser for help on using the repository browser.