| [613] | 1 | IBDF9 ;ALB/CJM - ENCOUNTER FORM - BUILD FORM(display single form block for edit) ; 08-JAN-1993
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | INIT ;
|
|---|
| 5 | D IDXBLOCK^IBDFU4
|
|---|
| 6 | Q
|
|---|
| 7 | EXIT ;
|
|---|
| 8 | K @VALMAR
|
|---|
| 9 | Q
|
|---|
| 10 | HDR ;
|
|---|
| 11 | S VALMHDR(1)=$$PADRIGHT^IBDFU("",4)
|
|---|
| 12 | F I=1:1:16 S VALMHDR(1)=VALMHDR(1)_$J(I,10)
|
|---|
| 13 | Q
|
|---|
| 14 | RESIZE ;resize the block
|
|---|
| 15 | N IBW,IBH
|
|---|
| 16 | S VALMBCK="R"
|
|---|
| 17 | K DIR S DIR(0)="NA^1:"_IBFORM("WIDTH")_":0",DIR("A")="Move the RIGHT MARGIN of the block to which column?: ",DIR("B")=IBBLK("W") D ^DIR K DIR Q:$D(DIRUT) S IBW=X
|
|---|
| 18 | S DIR(0)="NA^1:"_IBFORM("HT")_":0",DIR("A")="Move the BOTTOM MARGIN of the block to which row?: ",DIR("B")=IBBLK("H") D ^DIR K DIR Q:$D(DIRUT) S IBH=X
|
|---|
| 19 | K DR,DIE,DA S DIE=357.1,DA=IBBLK,DR=".06////^S X=IBW;.07////^S X=IBH" D ^DIE K DIE,DR,DA
|
|---|
| 20 | S VALMBCK="R"
|
|---|
| 21 | D UNCMPBLK^IBDF19(IBBLK),IDXBLOCK^IBDFU4
|
|---|
| 22 | Q
|
|---|
| 23 | EDITBLK ;edit the name,brief description, header and outline
|
|---|
| 24 | ;automatically shifts contents and changes size of block if changes in header or outline call for that
|
|---|
| 25 | N HDR1,HDR2 ;flags set to indicate existance of hdr before and after editing
|
|---|
| 26 | N NODE,IBNAME,QUIT
|
|---|
| 27 | S QUIT=0,VALMBCK="R"
|
|---|
| 28 | D FULL^VALM1
|
|---|
| 29 | S NODE=$G(^IBE(357.1,IBBLK,0))
|
|---|
| 30 | S HDR1=$P(NODE,"^",11) S:HDR1'="" HDR1=1
|
|---|
| 31 | K DIR S DIR(0)="357.1,.01",DIR("B")=$P($G(^IBE(357.1,IBBLK,0)),"^") D ^DIR K DIR D Q:QUIT
|
|---|
| 32 | .I (Y=-1)!$D(DIRUT) S QUIT=1 Q
|
|---|
| 33 | .S IBNAME=Y
|
|---|
| 34 | .K DA,DR,DIE S DIE=357.1,DA=IBBLK,DR="[IBDF EDIT HEADER&OUTLINE]" D ^DIE K DIE,DR,DA
|
|---|
| 35 | S NODE=$G(^IBE(357.1,IBBLK,0))
|
|---|
| 36 | S HDR2=$P(NODE,"^",11) S HDR2=$S(HDR2="":0,1:1)
|
|---|
| 37 | ;shift contents and resize if there has been a change to existance of the header
|
|---|
| 38 | I HDR1'=HDR2 D
|
|---|
| 39 | .N TOP,BOTTOM,LEFT,RIGHT,WAY,AMOUNT
|
|---|
| 40 | .S TOP=0,BOTTOM=IBBLK("H"),LEFT=0,RIGHT=IBBLK("W"),AMOUNT=1
|
|---|
| 41 | .I HDR2 S WAY="D" D E^IBDF10 S $P(NODE,"^",7)=$P(NODE,"^",7)+1,^IBE(357.1,IBBLK,0)=NODE
|
|---|
| 42 | .I HDR1 S WAY="U" D E^IBDF10 S $P(NODE,"^",7)=$P(NODE,"^",7)-1,^IBE(357.1,IBBLK,0)=NODE
|
|---|
| 43 | D UNCMPBLK^IBDF19(IBBLK),IDXBLOCK^IBDFU4
|
|---|
| 44 | Q
|
|---|
