source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF5A.m@ 794

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

initial load of WorldVistAEHR

File size: 2.9 KB
RevLine 
[613]1IBDF5A ;ALB/CJM - ENCOUNTER FORM ;NOV 16,1992
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3IDXFORM(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
35BETWEEN(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
40BLNKFORM(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 ;
47ANCHORS ;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 ;
58WHITEOUT(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 ;
65PGBNDRY(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
Note: See TracBrowser for help on using the repository browser.