IBDF10B.m

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

IBDF10B   ;ALB/CJM - ENCOUNTER FORM - (shifting selection lists);3/29/93

 +1       ;;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

 +1       ;WAY="D" for down, "U" for up, "L" for left, "R" for right

 +2        NEW SUB,NODE,POS,LIST,PIECE,VERT,IBX,IBY,COL

 +3        SET VERT=$SELECT("UD"[WAY:1,1:0)

 +4       ;shifts to the left or up are negative

 +5        IF "UL"[WAY

               SET AMOUNT=AMOUNT*(-1)

 +6       ;must make sure there is at least one column defined with the row and column specified

 +7        SET LIST=""

           FOR 

               SET LIST=$ORDER(^IBE(357.2,"C",IBBLK,LIST))

               IF 'LIST

                   QUIT 

               Begin DoDot:1

 +8                SET COL=$ORDER(^IBE(357.2,LIST,1,"B",""))

                   IF COL

                       SET SUB=$ORDER(^IBE(357.2,LIST,1,"B",COL,0))

 +9       ;if there is no column then one must be added, otherwise positioning works through defaults

                   IF '$GET(SUB)

                       SET SUB=$$ADDCOL(LIST)

 +10               IF 'SUB

                       QUIT 

 +11               SET NODE=$GET(^IBE(357.2,LIST,1,SUB,0))

 +12               IF "DU"[WAY

                       SET POS=$PIECE(NODE,"^",2)

                       IF POS=""

                           SET POS=$SELECT(IBBLK("BOX")=1:1,1:0)

                           SET POS=POS+$SELECT(IBBLK("HDR")="":0,1:2)

                           SET $PIECE(^IBE(357.2,LIST,1,SUB,0),"^",2)=POS

 +13               IF "RL"[WAY

                       SET POS=$PIECE(NODE,"^",3)

                       IF POS=""

                           SET POS=0

                           SET $PIECE(^IBE(357.2,LIST,1,SUB,0),"^",3)=POS

 +14      ;now loop through all of the columns, shifting the position of each

 +15               SET SUB=0

                   FOR 

                       SET SUB=$ORDER(^IBE(357.2,LIST,1,SUB))

                       IF 'SUB

                           QUIT 

                       Begin DoDot:2

 +16                       SET NODE=$GET(^IBE(357.2,LIST,1,SUB,0))

                           IF NODE=""

                               QUIT 

 +17                       SET PIECE=$SELECT(VERT:2,1:3)

                           SET POS=$PIECE(NODE,"^",PIECE)

                           SET IBY=+$PIECE(NODE,"^",2)

                           SET IBX=+$PIECE(NODE,"^",3)

                           IF POS=+POS

                               IF $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT)

                                   SET $PIECE(^IBE(357.2,LIST,1,SUB,0),"^",PIECE)=$SELECT(POS+AMOUNT<0:0,1:POS+AMOUNT)

                       End DoDot:2

               End DoDot:1

 +18       QUIT 

ADDCOL(LIST) ;adds a column to the selection list, which has none

 +1        SET ^IBE(357.2,LIST,1,0)="^357.21I^1^1"

           SET ^(1,0)="1^^^"

 +2        KILL DIK,DA

           SET DIK="^IBE(357.2,"_LIST_",1,"

           SET DA(1)=LIST

           SET DA=1

           DO IX1^DIK

           KILL DIK,DA

 +3        QUIT 1