26 lines
1.7 KiB
Mathematica
26 lines
1.7 KiB
Mathematica
IBDF10B ;ALB/CJM - ENCOUNTER FORM - (shifting selection lists);3/29/93
|
|
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
|
LSTS(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
|
|
;WAY="D" for down, "U" for up, "L" for left, "R" for right
|
|
N SUB,NODE,POS,LIST,PIECE,VERT,IBX,IBY,COL
|
|
S VERT=$S("UD"[WAY:1,1:0)
|
|
;shifts to the left or up are negative
|
|
S:"UL"[WAY AMOUNT=AMOUNT*(-1)
|
|
;must make sure there is at least one column defined with the row and column specified
|
|
S LIST="" F S LIST=$O(^IBE(357.2,"C",IBBLK,LIST)) Q:'LIST D
|
|
.S COL=$O(^IBE(357.2,LIST,1,"B","")) I COL S SUB=$O(^IBE(357.2,LIST,1,"B",COL,0))
|
|
.S:'$G(SUB) SUB=$$ADDCOL(LIST) ;if there is no column then one must be added, otherwise positioning works through defaults
|
|
.Q:'SUB
|
|
.S NODE=$G(^IBE(357.2,LIST,1,SUB,0))
|
|
.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
|
|
.I "RL"[WAY S POS=$P(NODE,"^",3) I POS="" S POS=0,$P(^IBE(357.2,LIST,1,SUB,0),"^",3)=POS
|
|
.;now loop through all of the columns, shifting the position of each
|
|
.S SUB=0 F S SUB=$O(^IBE(357.2,LIST,1,SUB)) Q:'SUB D
|
|
..S NODE=$G(^IBE(357.2,LIST,1,SUB,0)) Q:NODE=""
|
|
..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)
|
|
Q
|
|
ADDCOL(LIST) ;adds a column to the selection list, which has none
|
|
S ^IBE(357.2,LIST,1,0)="^357.21I^1^1",^(1,0)="1^^^"
|
|
K DIK,DA S DIK="^IBE(357.2,"_LIST_",1,",DA(1)=LIST,DA=1 D IX1^DIK K DIK,DA
|
|
Q 1
|