IBDF5A ;ALB/CJM - ENCOUNTER FORM ;NOV 16,1992
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
IDXFORM(IBTOPLN,IBBOTLN) ;creates an array for the list processor
;containing the image of the form - or just rebuilds a portion of the
;array - if IBTOPLN,IBBOTLN defined they specify a range within which to
;update the array - otherwise, create it from scratch
;IBFORM should be passed by reference
;
N IBBLK,BLKTOP
W !,"... BUILDING THE FORM ..."
S VALMSG="[Editing "_IBFORM("NAME")_"] ?? for more actions"
I ('$D(IBTOPLN))!('$D(IBBOTLN)) D
.K @VALMAR D KILL^VALM10()
.S VALMCNT=IBFORM("HT")+1
.W "."
.D BLNKFORM(0,IBFORM("HT")-1,IBFORM("WIDTH"))
.S I="",$P(I,"~",IBFORM("WIDTH")+1)="~"
.S @VALMAR@(IBFORM("HT")+1,0)=" "_I
.W "."
E D
.F LN=IBTOPLN+1:1:IBBOTLN+1 D KILL^VALM10(LN)
.D BLNKFORM(IBTOPLN,IBBOTLN,IBFORM("WIDTH")) W "."
.I IBTOPLN'>IBFORM("HT"),IBBOTLN>(IBFORM("HT")-1) S I="",$P(I,"~",IBFORM("WIDTH")+1)="~",@VALMAR@(IBFORM("HT")+1,0)=" "_I
S IBBLK="" F S IBBLK=$O(^IBE(357.1,"C",IBFORM,IBBLK)) Q:'IBBLK D
.I $D(IBTOPLN),$D(IBBOTLN) Q:'$$BETWEEN(IBBLK,IBTOPLN,IBBOTLN,.BLKTOP)
.I '($D(IBTOPLN)&$D(IBBOTLN)) S BLKTOP=$P($G(^IBE(357.1,IBBLK,0)),"^",4) Q:BLKTOP=""
.D DRWBLOCK^IBDF2A1(.IBBLK) W "."
.D PGBNDRY($G(IBBLK("Y")),$G(IBBLK("H")),IBFORM("PAGE_HT"),$G(IBBLK("NAME")))
;
;************************************************************
;this is needed for Paper Keyboards anchors, but may change
D ANCHORS
;************************************************************
Q
BETWEEN(BLOCK,TOP1,BOT1,BLKTOP) ;determines if the block=BLOCK falls between TOP1 and BOT!, also returns BLKTOP
N TOP2,BOT2 S (TOP2,BOT2)=""
D TOPNBOT^IBDFU5(BLOCK,.TOP2,.BOT2) S BLKTOP=TOP2
I ((TOP2>BOT1)&(BOT2>BOT1))!((TOP2<TOP1)&(BOT2<TOP1)) Q 0
Q 1
BLNKFORM(TOP,BOT,W) ;
;creates an array of lines the length of the form with nothing but
;line numbers on the left
N I
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)
Q
;
ANCHORS ;blanks out the areas near the anchors
N PAGE
I IBFORM("SCAN") F PAGE=1:1:IBFORM("PAGES") D
.D WHITEOUT(((PAGE-1)*IBFORM("PAGE_HT")+1),5,5)
.D WHITEOUT(((PAGE-1)*IBFORM("PAGE_HT")+1),67,9)
.D WHITEOUT(((PAGE-1)*IBFORM("PAGE_HT")+1),131,6)
.D WHITEOUT((((PAGE)*IBFORM("PAGE_HT"))),5,5)
.D WHITEOUT((((PAGE)*IBFORM("PAGE_HT"))),67,9)
.D WHITEOUT((((PAGE)*IBFORM("PAGE_HT"))),131,6)
Q
;
WHITEOUT(IBY,IBX,LEN) ;erases at (IBY,IBX) for LEN characters
N CURLINE
S CURLINE=$G(@VALMAR@(IBY,0))
S CURLINE=$$SETSTR^VALM1(" ",CURLINE,IBX,LEN)
D SET^VALM10(IBY,CURLINE)
Q
;
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
I (ROW\PGHT)<((ROW+HT-1)\PGHT) W !,"WARNING: The block = ",NAME," overlaps page boundries!" D PAUSE^IBDFU5
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF5A 3001 printed Dec 13, 2024@02:51:30 Page 2
IBDF5A ;ALB/CJM - ENCOUNTER FORM ;NOV 16,1992
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
IDXFORM(IBTOPLN,IBBOTLN) ;creates an array for the list processor
+1 ;containing the image of the form - or just rebuilds a portion of the
+2 ;array - if IBTOPLN,IBBOTLN defined they specify a range within which to
+3 ;update the array - otherwise, create it from scratch
+4 ;IBFORM should be passed by reference
+5 ;
+6 NEW IBBLK,BLKTOP
+7 WRITE !,"... BUILDING THE FORM ..."
+8 SET VALMSG="[Editing "_IBFORM("NAME")_"] ?? for more actions"
+9 IF ('$DATA(IBTOPLN))!('$DATA(IBBOTLN))
Begin DoDot:1
+10 KILL @VALMAR
DO KILL^VALM10()
+11 SET VALMCNT=IBFORM("HT")+1
+12 WRITE "."
+13 DO BLNKFORM(0,IBFORM("HT")-1,IBFORM("WIDTH"))
+14 SET I=""
SET $PIECE(I,"~",IBFORM("WIDTH")+1)="~"
+15 SET @VALMAR@(IBFORM("HT")+1,0)=" "_I
+16 WRITE "."
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 FOR LN=IBTOPLN+1:1:IBBOTLN+1
DO KILL^VALM10(LN)
+19 DO BLNKFORM(IBTOPLN,IBBOTLN,IBFORM("WIDTH"))
WRITE "."
+20 IF IBTOPLN'>IBFORM("HT")
IF IBBOTLN>(IBFORM("HT")-1)
SET I=""
SET $PIECE(I,"~",IBFORM("WIDTH")+1)="~"
SET @VALMAR@(IBFORM("HT")+1,0)=" "_I
End DoDot:1
+21 SET IBBLK=""
FOR
SET IBBLK=$ORDER(^IBE(357.1,"C",IBFORM,IBBLK))
if 'IBBLK
QUIT
Begin DoDot:1
+22 IF $DATA(IBTOPLN)
IF $DATA(IBBOTLN)
if '$$BETWEEN(IBBLK,IBTOPLN,IBBOTLN,.BLKTOP)
QUIT
+23 IF '($DATA(IBTOPLN)&$DATA(IBBOTLN))
SET BLKTOP=$PIECE($GET(^IBE(357.1,IBBLK,0)),"^",4)
if BLKTOP=""
QUIT
+24 DO DRWBLOCK^IBDF2A1(.IBBLK)
WRITE "."
+25 DO PGBNDRY($GET(IBBLK("Y")),$GET(IBBLK("H")),IBFORM("PAGE_HT"),$GET(IBBLK("NAME")))
End DoDot:1
+26 ;
+27 ;************************************************************
+28 ;this is needed for Paper Keyboards anchors, but may change
+29 DO ANCHORS
+30 ;************************************************************
+31 QUIT
BETWEEN(BLOCK,TOP1,BOT1,BLKTOP) ;determines if the block=BLOCK falls between TOP1 and BOT!, also returns BLKTOP
+1 NEW TOP2,BOT2
SET (TOP2,BOT2)=""
+2 DO TOPNBOT^IBDFU5(BLOCK,.TOP2,.BOT2)
SET BLKTOP=TOP2
+3 IF ((TOP2>BOT1)&(BOT2>BOT1))!((TOP2<TOP1)&(BOT2<TOP1))
QUIT 0
+4 QUIT 1
BLNKFORM(TOP,BOT,W) ;
+1 ;creates an array of lines the length of the form with nothing but
+2 ;line numbers on the left
+3 NEW I
+4 FOR I=TOP+1:1:BOT+1
SET @VALMAR@(I,0)=$SELECT(((I>1)&(I#$SELECT($GET(IBFORM("PAGE_HT")):IBFORM("PAGE_HT"),1:1000)=1)):"NP >",1:$JUSTIFY((I)#1000,3,0)_" ")_$JUSTIFY("",W)_":"
DO CNTRL^VALM10(I,4,1,IORVON,IORVOFF)
+5 QUIT
+6 ;
ANCHORS ;blanks out the areas near the anchors
+1 NEW PAGE
+2 IF IBFORM("SCAN")
FOR PAGE=1:1:IBFORM("PAGES")
Begin DoDot:1
+3 DO WHITEOUT(((PAGE-1)*IBFORM("PAGE_HT")+1),5,5)
+4 DO WHITEOUT(((PAGE-1)*IBFORM("PAGE_HT")+1),67,9)
+5 DO WHITEOUT(((PAGE-1)*IBFORM("PAGE_HT")+1),131,6)
+6 DO WHITEOUT((((PAGE)*IBFORM("PAGE_HT"))),5,5)
+7 DO WHITEOUT((((PAGE)*IBFORM("PAGE_HT"))),67,9)
+8 DO WHITEOUT((((PAGE)*IBFORM("PAGE_HT"))),131,6)
End DoDot:1
+9 QUIT
+10 ;
WHITEOUT(IBY,IBX,LEN) ;erases at (IBY,IBX) for LEN characters
+1 NEW CURLINE
+2 SET CURLINE=$GET(@VALMAR@(IBY,0))
+3 SET CURLINE=$$SETSTR^VALM1(" ",CURLINE,IBX,LEN)
+4 DO SET^VALM10(IBY,CURLINE)
+5 QUIT
+6 ;
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
+1 IF (ROW\PGHT)<((ROW+HT-1)\PGHT)
WRITE !,"WARNING: The block = ",NAME," overlaps page boundries!"
DO PAUSE^IBDFU5
+2 QUIT
