| 1 | IBDF5A ;ALB/CJM - ENCOUNTER FORM ;NOV 16,1992
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
|---|
| 3 | IDXFORM(IBTOPLN,IBBOTLN) ;creates an array for the list processor
|
|---|
| 4 | ;containing the image of the form - or just rebuilds a portion of the
|
|---|
| 5 | ;array - if IBTOPLN,IBBOTLN defined they specify a range within which to
|
|---|
| 6 | ;update the array - otherwise, create it from scratch
|
|---|
| 7 | ;IBFORM should be passed by reference
|
|---|
| 8 | ;
|
|---|
| 9 | N IBBLK,BLKTOP
|
|---|
| 10 | W !,"... BUILDING THE FORM ..."
|
|---|
| 11 | S VALMSG="[Editing "_IBFORM("NAME")_"] ?? for more actions"
|
|---|
| 12 | I ('$D(IBTOPLN))!('$D(IBBOTLN)) D
|
|---|
| 13 | .K @VALMAR D KILL^VALM10()
|
|---|
| 14 | .S VALMCNT=IBFORM("HT")+1
|
|---|
| 15 | .W "."
|
|---|
| 16 | .D BLNKFORM(0,IBFORM("HT")-1,IBFORM("WIDTH"))
|
|---|
| 17 | .S I="",$P(I,"~",IBFORM("WIDTH")+1)="~"
|
|---|
| 18 | .S @VALMAR@(IBFORM("HT")+1,0)=" "_I
|
|---|
| 19 | .W "."
|
|---|
| 20 | E D
|
|---|
| 21 | .F LN=IBTOPLN+1:1:IBBOTLN+1 D KILL^VALM10(LN)
|
|---|
| 22 | .D BLNKFORM(IBTOPLN,IBBOTLN,IBFORM("WIDTH")) W "."
|
|---|
| 23 | .I IBTOPLN'>IBFORM("HT"),IBBOTLN>(IBFORM("HT")-1) S I="",$P(I,"~",IBFORM("WIDTH")+1)="~",@VALMAR@(IBFORM("HT")+1,0)=" "_I
|
|---|
| 24 | S IBBLK="" F S IBBLK=$O(^IBE(357.1,"C",IBFORM,IBBLK)) Q:'IBBLK D
|
|---|
| 25 | .I $D(IBTOPLN),$D(IBBOTLN) Q:'$$BETWEEN(IBBLK,IBTOPLN,IBBOTLN,.BLKTOP)
|
|---|
| 26 | .I '($D(IBTOPLN)&$D(IBBOTLN)) S BLKTOP=$P($G(^IBE(357.1,IBBLK,0)),"^",4) Q:BLKTOP=""
|
|---|
| 27 | .D DRWBLOCK^IBDF2A1(.IBBLK) W "."
|
|---|
| 28 | .D PGBNDRY($G(IBBLK("Y")),$G(IBBLK("H")),IBFORM("PAGE_HT"),$G(IBBLK("NAME")))
|
|---|
| 29 | ;
|
|---|
| 30 | ;************************************************************
|
|---|
| 31 | ;this is needed for Paper Keyboards anchors, but may change
|
|---|
| 32 | D ANCHORS
|
|---|
| 33 | ;************************************************************
|
|---|
| 34 | Q
|
|---|
| 35 | BETWEEN(BLOCK,TOP1,BOT1,BLKTOP) ;determines if the block=BLOCK falls between TOP1 and BOT!, also returns BLKTOP
|
|---|
| 36 | N TOP2,BOT2 S (TOP2,BOT2)=""
|
|---|
| 37 | D TOPNBOT^IBDFU5(BLOCK,.TOP2,.BOT2) S BLKTOP=TOP2
|
|---|
| 38 | I ((TOP2>BOT1)&(BOT2>BOT1))!((TOP2<TOP1)&(BOT2<TOP1)) Q 0
|
|---|
| 39 | Q 1
|
|---|
| 40 | BLNKFORM(TOP,BOT,W) ;
|
|---|
| 41 | ;creates an array of lines the length of the form with nothing but
|
|---|
| 42 | ;line numbers on the left
|
|---|
| 43 | N I
|
|---|
| 44 | F I=TOP+1:1:BOT+1 S @VALMAR@(I,0)=$S(((I>1)&(I#$S($G(IBFORM("PAGE_HT")):IBFORM("PAGE_HT"),1:1000)=1)):"NP >",1:$J((I)#1000,3,0)_" ")_$J("",W)_":" D CNTRL^VALM10(I,4,1,IORVON,IORVOFF)
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | ANCHORS ;blanks out the areas near the anchors
|
|---|
| 48 | N PAGE
|
|---|
| 49 | I IBFORM("SCAN") F PAGE=1:1:IBFORM("PAGES") D
|
|---|
| 50 | .D WHITEOUT(((PAGE-1)*IBFORM("PAGE_HT")+1),5,5)
|
|---|
| 51 | .D WHITEOUT(((PAGE-1)*IBFORM("PAGE_HT")+1),67,9)
|
|---|
| 52 | .D WHITEOUT(((PAGE-1)*IBFORM("PAGE_HT")+1),131,6)
|
|---|
| 53 | .D WHITEOUT((((PAGE)*IBFORM("PAGE_HT"))),5,5)
|
|---|
| 54 | .D WHITEOUT((((PAGE)*IBFORM("PAGE_HT"))),67,9)
|
|---|
| 55 | .D WHITEOUT((((PAGE)*IBFORM("PAGE_HT"))),131,6)
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | WHITEOUT(IBY,IBX,LEN) ;erases at (IBY,IBX) for LEN characters
|
|---|
| 59 | N CURLINE
|
|---|
| 60 | S CURLINE=$G(@VALMAR@(IBY,0))
|
|---|
| 61 | S CURLINE=$$SETSTR^VALM1(" ",CURLINE,IBX,LEN)
|
|---|
| 62 | D SET^VALM10(IBY,CURLINE)
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | PGBNDRY(ROW,HT,PGHT,NAME) ;checks the if the block=NAME starting at ROW and of hight HT overlaps a page boundry - if so a warning is displayed
|
|---|
| 66 | I (ROW\PGHT)<((ROW+HT-1)\PGHT) W !,"WARNING: The block = ",NAME," overlaps page boundries!" D PAUSE^IBDFU5
|
|---|
| 67 | Q
|
|---|
