IBDF5.m

IBDF5 ;ALB/CJM - ENCOUNTER FORM (edit a form);NOV 16,1992

 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 ;displays the form for editing using the list processor

 ;

 ;these variables should always be defined while editing a form

 ;IBFORM - contains the form description

INIT ;

 ;

 Q:'$$FORMDSCR^IBDFU1C(.IBFORM)

 D IDXFORM^IBDF5A()

 Q

EXIT ;

 K @VALMAR

 Q

HDR ;the screen header, a ruler

 S VALMHDR(1)=$$PADRIGHT^IBDFU("",4) ;VALMHDR(2)=VALMHDR(2)_0

 F I=1:1:16 S VALMHDR(1)=VALMHDR(1)_$J(I,10)

 Q

DELETE  ;allows user to select a block for deletion

 N IBBLK,IBVALMBG,TOP,BOT

 S VALMBCK="R",IBVALMBG=$G(VALMBG)

 S VALMBG=IBVALMBG

 D FULL^VALM1

 S IBBLK=$$SLCTBLK^IBDFU8(IBFORM,IOSL)

 Q:'IBBLK

 Q:'$$RUSURE^IBDFU5($P($G(^IBE(357.1,IBBLK,0)),"^"))

 D TOPNBOT^IBDFU5(IBBLK,.TOP,.BOT)

 D DLTBLK^IBDFU3(IBBLK,IBFORM,357.1)

 S VALMBCK="R"

 D IDXFORM^IBDF5A(TOP,BOT)

 Q

 ;

MOVE ;allows the user to select a block and move it

 N IBBLK,NODE0,BLKWIDTH,BLKHT,STARTCOL,STARTROW,TOP1,BOT1,TOP2,BOT2

 S VALMBCK="R"

 ;D FULL^VALM1

 S IBBLK=$$SLCTBLK^IBDFU8(IBFORM,5)

 I IBBLK D

 .S NODE0=$G(^IBE(357.1,IBBLK,0))

 .S BLKWIDTH=+$P(NODE0,"^",6),BLKHT=+$P(NODE0,"^",7),STARTCOL=+$P(NODE0,"^",5),STARTROW=+$P(NODE0,"^",4)

 .S TOP1=STARTROW,BOT1=(TOP1+BLKHT)-1

 .I STARTROW!(IBFORM("HT")>BLKHT) K DIR S DIR(0)="NA^1:"_(IBFORM("HT")-BLKHT+1)_":0",DIR("A")="Move the TOP MARGIN of the block to which row?: ",DIR("B")=STARTROW+1 D ^DIR K DIR Q:$D(DIRUT)  S STARTROW=X-1

 .I STARTCOL!(IBFORM("WIDTH")>BLKWIDTH) K DIR S DIR(0)="NA^1:"_(IBFORM("WIDTH")-BLKWIDTH+1)_":0",DIR("A")="Move the LEFT MARGIN of the block to which column?: ",DIR("B")=STARTCOL+1 D ^DIR K DIR Q:$D(DIRUT)  S STARTCOL=X-1

 .K DIE,DA S DIE=357.1,DA=IBBLK,DR=".04////^S X=STARTROW;.05////^S X=STARTCOL" D ^DIE K DIE,DA,DR

 .S VALMBCK="R"

 .D TOPNBOT^IBDFU5(IBBLK,.TOP2,.BOT2) S TOP1=$S(TOP1<TOP2:TOP1,1:TOP2) S BOT1=$S(BOT1>BOT2:BOT1,1:BOT2)

 .D IDXFORM^IBDF5A(TOP1,BOT1)

 .S VALMBG=STARTROW-7 S:VALMBG<1 VALMBG=1

 Q

RESIZE ;allows user to select a block & re-size it

 N IBBLK,BLKWIDTH,BLKHT,STARTCOL,STARTROW,TOP1,TOP2,BOT1,BOT2

 S IBBLK=$$SLCTBLK^IBDFU8(IBFORM,5)

 I IBBLK D

 .D NOWSIZE S TOP1=STARTROW,BOT1=(TOP1+BLKHT)-1

 .D NEWSIZE

 .D TOPNBOT^IBDFU5(IBBLK,.TOP2,.BOT2) S TOP1=$S(TOP1<TOP2:TOP1,1:TOP2) S BOT1=$S(BOT1>BOT2:BOT1,1:BOT2)

 .D IDXFORM^IBDF5A(TOP1,BOT1)

 S VALMBCK="R"

 Q

NOWSIZE ;what size is the block, and where does it start? returns BLKWIDTH,BLKHT,STARTROW,STARTCOL

 N NODE0

 S NODE0=$G(^IBE(357.1,IBBLK,0))

 S BLKWIDTH=+$P(NODE0,"^",6),BLKHT=+$P(NODE0,"^",7),STARTCOL=+$P(NODE0,"^",5),STARTROW=+$P(NODE0,"^",4)

 Q

NEWSIZE ;allows user to change the size of a block

 K DIR S DIR(0)="NA^"_(STARTROW+1)_":"_(IBFORM("HT"))_":0",DIR("A")="Move the BOTTOM MARGIN of the block to which row?: ",DIR("B")=(STARTROW+BLKHT) D ^DIR K DIR Q:$D(DIRUT)  S BLKHT=(X-STARTROW)

 K DIR S DIR(0)="NA^"_(STARTCOL+1)_":"_IBFORM("WIDTH")_":0",DIR("A")="Move the RIGHT MARGIN of the block to which column?: ",DIR("B")=(STARTCOL+BLKWIDTH) D ^DIR K DIR Q:$D(DIRUT)  S BLKWIDTH=(X-STARTCOL)

 K DIE,DA S DIE=357.1,DA=IBBLK,DR=".06////^S X=BLKWIDTH;.07////^S X=BLKHT" D ^DIE K DIE,DA,DR

 D UNCMPBLK^IBDF19(IBBLK)

 Q

SHIFT ;allows the user to shift a group of blocks within a rectangular region on the form

 D SHIFT^IBDF10("B")

 D IDXFORM^IBDF5A()

 S VALMBCK="R"

 Q

IBDF5     ;ALB/CJM - ENCOUNTER FORM (edit a form);NOV 16,1992

 +1       ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 +2       ;displays the form for editing using the list processor

 +3       ;

 +4       ;these variables should always be defined while editing a form

 +5       ;IBFORM - contains the form description

INIT      ;

 +1       ;

 +2        IF '$$FORMDSCR^IBDFU1C(.IBFORM)

               QUIT 

 +3        DO IDXFORM^IBDF5A()

 +4        QUIT 

EXIT      ;

 +1        KILL @VALMAR

 +2        QUIT 

HDR       ;the screen header, a ruler

 +1       ;VALMHDR(2)=VALMHDR(2)_0

           SET VALMHDR(1)=$$PADRIGHT^IBDFU("",4)

 +2        FOR I=1:1:16

               SET VALMHDR(1)=VALMHDR(1)_$JUSTIFY(I,10)

 +3        QUIT 

DELETE    ;allows user to select a block for deletion

 +1        NEW IBBLK,IBVALMBG,TOP,BOT

 +2        SET VALMBCK="R"

           SET IBVALMBG=$GET(VALMBG)

 +3        SET VALMBG=IBVALMBG

 +4        DO FULL^VALM1

 +5        SET IBBLK=$$SLCTBLK^IBDFU8(IBFORM,IOSL)

 +6        IF 'IBBLK

               QUIT 

 +7        IF '$$RUSURE^IBDFU5($PIECE($GET(^IBE(357.1,IBBLK,0)),"^"))

               QUIT 

 +8        DO TOPNBOT^IBDFU5(IBBLK,.TOP,.BOT)

 +9        DO DLTBLK^IBDFU3(IBBLK,IBFORM,357.1)

 +10       SET VALMBCK="R"

 +11       DO IDXFORM^IBDF5A(TOP,BOT)

 +12       QUIT 

 +13      ;

MOVE      ;allows the user to select a block and move it

 +1        NEW IBBLK,NODE0,BLKWIDTH,BLKHT,STARTCOL,STARTROW,TOP1,BOT1,TOP2,BOT2

 +2        SET VALMBCK="R"

 +3       ;D FULL^VALM1

 +4        SET IBBLK=$$SLCTBLK^IBDFU8(IBFORM,5)

 +5        IF IBBLK

               Begin DoDot:1

 +6                SET NODE0=$GET(^IBE(357.1,IBBLK,0))

 +7                SET BLKWIDTH=+$PIECE(NODE0,"^",6)

                   SET BLKHT=+$PIECE(NODE0,"^",7)

                   SET STARTCOL=+$PIECE(NODE0,"^",5)

                   SET STARTROW=+$PIECE(NODE0,"^",4)

 +8                SET TOP1=STARTROW

                   SET BOT1=(TOP1+BLKHT)-1

 +9                IF STARTROW!(IBFORM("HT")>BLKHT)

                       KILL DIR

                       SET DIR(0)="NA^1:"_(IBFORM("HT")-BLKHT+1)_":0"

                       SET DIR("A")="Move the TOP MARGIN of the block to which row?: "

                       SET DIR("B")=STARTROW+1

                       DO ^DIR

                       KILL DIR

                       IF $DATA(DIRUT)

                           QUIT 

                       SET STARTROW=X-1

 +10               IF STARTCOL!(IBFORM("WIDTH")>BLKWIDTH)

                       KILL DIR

                       SET DIR(0)="NA^1:"_(IBFORM("WIDTH")-BLKWIDTH+1)_":0"

                       SET DIR("A")="Move the LEFT MARGIN of the block to which column?: "

                       SET DIR("B")=STARTCOL+1

                       DO ^DIR

                       KILL DIR

                       IF $DATA(DIRUT)

                           QUIT 

                       SET STARTCOL=X-1

 +11               KILL DIE,DA

                   SET DIE=357.1

                   SET DA=IBBLK

                   SET DR=".04////^S X=STARTROW;.05////^S X=STARTCOL"

                   DO ^DIE

                   KILL DIE,DA,DR

 +12               SET VALMBCK="R"

 +13               DO TOPNBOT^IBDFU5(IBBLK,.TOP2,.BOT2)

                   SET TOP1=$SELECT(TOP1<TOP2:TOP1,1:TOP2)

                   SET BOT1=$SELECT(BOT1>BOT2:BOT1,1:BOT2)

 +14               DO IDXFORM^IBDF5A(TOP1,BOT1)

 +15               SET VALMBG=STARTROW-7

                   IF VALMBG<1

                       SET VALMBG=1

               End DoDot:1

 +16       QUIT 

RESIZE    ;allows user to select a block & re-size it

 +1        NEW IBBLK,BLKWIDTH,BLKHT,STARTCOL,STARTROW,TOP1,TOP2,BOT1,BOT2

 +2        SET IBBLK=$$SLCTBLK^IBDFU8(IBFORM,5)

 +3        IF IBBLK

               Begin DoDot:1

 +4                DO NOWSIZE

                   SET TOP1=STARTROW

                   SET BOT1=(TOP1+BLKHT)-1

 +5                DO NEWSIZE

 +6                DO TOPNBOT^IBDFU5(IBBLK,.TOP2,.BOT2)

                   SET TOP1=$SELECT(TOP1<TOP2:TOP1,1:TOP2)

                   SET BOT1=$SELECT(BOT1>BOT2:BOT1,1:BOT2)

 +7                DO IDXFORM^IBDF5A(TOP1,BOT1)

               End DoDot:1

 +8        SET VALMBCK="R"

 +9        QUIT 

NOWSIZE   ;what size is the block, and where does it start? returns BLKWIDTH,BLKHT,STARTROW,STARTCOL

 +1        NEW NODE0

 +2        SET NODE0=$GET(^IBE(357.1,IBBLK,0))

 +3        SET BLKWIDTH=+$PIECE(NODE0,"^",6)

           SET BLKHT=+$PIECE(NODE0,"^",7)

           SET STARTCOL=+$PIECE(NODE0,"^",5)

           SET STARTROW=+$PIECE(NODE0,"^",4)

 +4        QUIT 

NEWSIZE   ;allows user to change the size of a block

 +1        KILL DIR

           SET DIR(0)="NA^"_(STARTROW+1)_":"_(IBFORM("HT"))_":0"

           SET DIR("A")="Move the BOTTOM MARGIN of the block to which row?: "

           SET DIR("B")=(STARTROW+BLKHT)

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               QUIT 

           SET BLKHT=(X-STARTROW)

 +2        KILL DIR

           SET DIR(0)="NA^"_(STARTCOL+1)_":"_IBFORM("WIDTH")_":0"

           SET DIR("A")="Move the RIGHT MARGIN of the block to which column?: "

           SET DIR("B")=(STARTCOL+BLKWIDTH)

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               QUIT 

           SET BLKWIDTH=(X-STARTCOL)

 +3        KILL DIE,DA

           SET DIE=357.1

           SET DA=IBBLK

           SET DR=".06////^S X=BLKWIDTH;.07////^S X=BLKHT"

           DO ^DIE

           KILL DIE,DA,DR

 +4        DO UNCMPBLK^IBDF19(IBBLK)

 +5        QUIT 

SHIFT     ;allows the user to shift a group of blocks within a rectangular region on the form

 +1        DO SHIFT^IBDF10("B")

 +2        DO IDXFORM^IBDF5A()

 +3        SET VALMBCK="R"

 +4        QUIT