| [613] | 1 | IBDF9C ;ALB/CJM - ENCOUNTER FORM - (edit header block) ;FEB 1,1993
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | EDITHDR ;edit the header block
|
|---|
| 5 | N HDRBLK,HDRFLD,TOP1,BOT1,TOP2,BOT2,HDRLINES,MAXLEN,QUIT,NEWBLOCK
|
|---|
| 6 | S VALMBCK="R",(TOP1,TOP2,BOT1,BOT2,QUIT,NEWBLOCK)=0
|
|---|
| 7 | D FULL^VALM1
|
|---|
| 8 | S HDRBLK=$$FINDBLK I 'HDRBLK S HDRBLK=$$MAKEBLK I 'HDRBLK Q
|
|---|
| 9 | D TOPNBOT^IBDFU5(HDRBLK,.TOP1,.BOT1)
|
|---|
| 10 | S HDRFLD=$$FINDFLD I 'HDRFLD S HDRFLD=$$MAKEFLD I 'HDRFLD Q
|
|---|
| 11 | D EDITFLD
|
|---|
| 12 | D:'QUIT EDITBLK,MOVEFLD
|
|---|
| 13 | I HDRBLK D TOPNBOT^IBDFU5(HDRBLK,.TOP2,.BOT2),UNCMPBLK^IBDF19(HDRBLK)
|
|---|
| 14 | D IDXFORM^IBDF5A($S(TOP1<TOP2:TOP1,1:TOP2),$S(BOT1>BOT2:BOT1,1:BOT2))
|
|---|
| 15 | S VALMBCK="R"
|
|---|
| 16 | Q
|
|---|
| 17 | FINDBLK() ;
|
|---|
| 18 | S HDRBLK="" F S HDRBLK=$O(^IBE(357.1,"C",IBFORM,HDRBLK)) Q:'HDRBLK Q:$P($G(^IBE(357.1,HDRBLK,0)),"^")="HEADER"
|
|---|
| 19 | Q HDRBLK
|
|---|
| 20 | MAKEBLK() ;
|
|---|
| 21 | S NEWBLOCK=1
|
|---|
| 22 | K DIC,DD,DO,DINUM S DIC="^IBE(357.1,",X="HEADER",DIC(0)="",DIC("DR")=".02////"_IBFORM
|
|---|
| 23 | D FILE^DICN K DIC,DIE
|
|---|
| 24 | Q $S(+Y<0:"",1:+Y)
|
|---|
| 25 | FINDFLD() ;
|
|---|
| 26 | S HDRFLD="" F S HDRFLD=$O(^IBE(357.5,"C",HDRBLK,HDRFLD)) Q:'HDRFLD Q:$P($G(^IBE(357.5,HDRFLD,0)),"^")="HEADER"
|
|---|
| 27 | Q HDRFLD
|
|---|
| 28 | MAKEFLD() ;
|
|---|
| 29 | K DIC,DD,DO,DINUM S DIC="^IBE(357.5,",X="HEADER",DIC(0)="",DIC("DR")=".02////"_HDRBLK
|
|---|
| 30 | D FILE^DICN K DIC,DIE
|
|---|
| 31 | Q $S(+Y<0:"",1:+Y)
|
|---|
| 32 | EDITFLD ;allows the user to edit the header lines
|
|---|
| 33 | N NODE,SUBFLD
|
|---|
| 34 | K DIE,DA S DIE=357.5,DA=HDRFLD,DR="[IBDF EDIT FORM HEADER]",DIE("NO^")="BACKOUTOK" D ^DIE K DIE,DR,DA
|
|---|
| 35 | ;find the number of lines and the maximum length
|
|---|
| 36 | S (HDRLINES,MAXLEN)=0
|
|---|
| 37 | S SUBFLD=0 F S SUBFLD=$O(^IBE(357.5,HDRFLD,2,SUBFLD)) Q:'SUBFLD S NODE=$G(^(SUBFLD,0)) I NODE'="" S HDRLINES=HDRLINES+1 S MAXLEN=$S(MAXLEN>$L($P(NODE,"^",1)):MAXLEN,1:$L($P(NODE,"^",1)))
|
|---|
| 38 | I 'MAXLEN D DLTBLK^IBDFU3(HDRBLK,IBFORM,357.1) S QUIT=1,HDRBLK=""
|
|---|
| 39 | Q
|
|---|
| 40 | EDITBLK ;allows the user to position the header block & draw a box around it
|
|---|
| 41 | N IBBOX,IBDELETE
|
|---|
| 42 | S IBBOX=0,IBDELETE=1
|
|---|
| 43 | D RE^VALM4
|
|---|
| 44 | K DIE,DA S DIE=357.1,DA=HDRBLK,DR="[IBDF EDIT HEADER BLOCK]",DIE("NO^")="BACKOUTOK" D ^DIE K DIE,DR,DA
|
|---|
| 45 | I IBDELETE,NEWBLOCK D DLTBLK^IBDFU3(HDRBLK,IBFORM,357.1)
|
|---|
| 46 | Q
|
|---|
| 47 | DFLTCOL() ;finds the column that would center the header block
|
|---|
| 48 | Q ((IBFORM("WIDTH")-(+$G(MAXLEN)+(+$G(IBBOX))))\2)+1
|
|---|
| 49 | MOVEFLD ;centers each header line in the block
|
|---|
| 50 | N START,SUBFLD,HDR,LINES
|
|---|
| 51 | S LINES=0
|
|---|
| 52 | S START=$S($P($G(^IBE(357.1,HDRBLK,0)),"^",10)=1:1,1:0)
|
|---|
| 53 | S SUBFLD=0
|
|---|
| 54 | F S SUBFLD=$O(^IBE(357.5,HDRFLD,2,SUBFLD)) Q:'SUBFLD S NODE=$G(^IBE(357.5,HDRFLD,2,SUBFLD,0)),HDR=$P(NODE,"^",1) D
|
|---|
| 55 | .I HDR'="" S $P(NODE,"^",4)=((MAXLEN-$L(HDR))\2)+START,$P(NODE,"^",5)=LINES+START,LINES=LINES+1 S ^IBE(357.5,HDRFLD,2,SUBFLD,0)=NODE
|
|---|
| 56 | Q
|
|---|
