source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF9.m@ 619

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1IBDF9 ;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 ;
4INIT ;
5 D IDXBLOCK^IBDFU4
6 Q
7EXIT ;
8 K @VALMAR
9 Q
10HDR ;
11 S VALMHDR(1)=$$PADRIGHT^IBDFU("",4)
12 F I=1:1:16 S VALMHDR(1)=VALMHDR(1)_$J(I,10)
13 Q
14RESIZE ;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
23EDITBLK ;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
Note: See TracBrowser for help on using the repository browser.