source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF2F2.m@ 1586

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1IBDF2F2 ;ALB/AAS - PRINT VA LOGO AS ANCHORS ON ENCOUNTER FORMS ; 25-JUNE-97
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**3**;APR 24, 1997
3 ;
4ANCHORS ; -- print anchors,
5 ; escape &a positions cursor at specified vert and horiz decipoints
6 ; escape &f1y2X prints macro #1
7 ;
8 ; -- old anchors composed of two narrow rectangles
9 ; escape *c prints rectangle of specified vert and horiz decipoints
10 ; 0P is for complete fill.
11 ;
12 D MACRO
13 ;
14 ; -- top left corner (ANCHOR 1)
15 W !,$C(27),"&a184v4H",$C(27),"&f1y2X"
16 ;
17 ; -- top right (ANCHOR 3)
18 W !,$C(27),"&a184v5534H",$C(27),"&f1y2X"
19 ;
20 ; -- bottom left (ANCHOR 4)
21 W !,$C(27),"&a7615v4H",$C(27),"&f1y2X"
22 ;
23 ; -- scannable page
24 I $G(IBFORM("SCAN",PAGE)),'$G(IBDSAMP) W $C(27),"&a7576v3400H",$C(27),"&f1y2X"
25 ;
26 ;bottom right (ANCHOR 6)
27 W $C(27),"&a7615v5534H",$C(27),"&f1y2X"
28 Q
29 ;
30MACRO ; -- build macro for printing va logo
31 ; -- position cursor before printing macro
32 W $C(27),"&f1Y" ; define marco as #1
33 W !
34 W $C(27),"&f0X" ; start macro definition
35 D VALOGO
36 W $C(27),"&f1X" ; stop macro definition
37 W !
38 W $C(27),"&f1y10X" ; make macro permanent, still defined after reset
39 Q
40 ;
41VALOGO ; -- Raster Graphic print of VA LOGO
42 ; -- position curser before calling directly
43 W $C(27),"*t150R" ; raster graphics at (75,150,or 300) dots per inch
44 W $C(27),"*r0F" ; presentation mode orientation of logical page
45 W $C(27),"*r1A" ; sets the left graphics margin to current x
46 ; -- begin raster data
471 W $C(27),"*b5W",$C(3),$C(224),$C(15),$C(248),$C(0)
482 W $C(27),"*b5W",$C(7),$C(240),$C(15),$C(248),$C(0)
493 W $C(27),"*b5W",$C(15),$C(240),$C(31),$C(252),$C(0)
504 ;W $C(27),"*b5W",$C(15),$C(248),$C(31),$C(252),$C(0)
515 W $C(27),"*b5W",$C(15),$C(248),$C(31),$C(254),$C(0)
526 W $C(27),"*b5W",$C(31),$C(252),$C(63),$C(254),$C(0)
537 W $C(27),"*b5W",$C(31),$C(252),$C(63),$C(255),$C(0)
548 W $C(27),"*b5W",$C(32),$C(254),$C(112),$C(63),$C(0)
559 W $C(27),"*b5W",$C(32),$C(254),$C(112),$C(63),$C(128)
5610 W $C(27),"*b5W",$C(96),$C(126),$C(112),$C(31),$C(128)
5711 W $C(27),"*b5W",$C(112),$C(127),$C(224),$C(15),$C(192)
5812 W $C(27),"*b5W",$C(240),$C(127),$C(224),$C(15),$C(192)
5913 W $C(27),"*b5W",$C(248),$C(63),$C(193),$C(7),$C(224)
6014 W $C(27),"*b5W",$C(252),$C(63),$C(193),$C(7),$C(224)
6115 W $C(27),"*b5W",$C(252),$C(31),$C(195),$C(131),$C(240)
6216 W $C(27),"*b5W",$C(126),$C(15),$C(195),$C(131),$C(240)
6317 W $C(27),"*b5W",$C(126),$C(15),$C(131),$C(131),$C(240)
6418 W $C(27),"*b5W",$C(63),$C(7),$C(135),$C(193),$C(248)
6519 W $C(27),"*b5W",$C(63),$C(3),$C(135),$C(193),$C(248)
6620 W $C(27),"*b5W",$C(31),$C(131),$C(7),$C(224),$C(252)
6721 W $C(27),"*b5W",$C(31),$C(129),$C(15),$C(224),$C(252)
6822 W $C(27),"*b5W",$C(15),$C(193),$C(15),$C(240),$C(124)
6923 W $C(27),"*b5W",$C(15),$C(192),$C(12),$C(0),$C(120)
7024 W $C(27),"*b5W",$C(7),$C(224),$C(30),$C(0),$C(120)
7125 W $C(27),"*b5W",$C(7),$C(224),$C(30),$C(0),$C(56)
7226 W $C(27),"*b5W",$C(3),$C(240),$C(63),$C(0),$C(48)
7327 W $C(27),"*b5W",$C(3),$C(240),$C(63),$C(0),$C(16)
7428 W $C(27),"*b5W",$C(1),$C(255),$C(255),$C(255),$C(240)
7529 W $C(27),"*b5W",$C(1),$C(255),$C(255),$C(255),$C(224)
7630 W $C(27),"*b5W",$C(0),$C(255),$C(255),$C(255),$C(224)
7731 W $C(27),"*b5W",$C(0),$C(255),$C(239),$C(255),$C(192)
7832 ;W $C(27),"*b5W",$C(0),$C(127),$C(239),$C(255),$C(192)
7933 W $C(27),"*b5W",$C(0),$C(127),$C(199),$C(255),$C(128)
8034 W $C(27),"*b5W",$C(0),$C(63),$C(131),$C(255),$C(128)
81 W $C(27),"*rB" ; signifies the end of the raster graphic
82 Q
83 ;
84TESTM ; -- Test macro printing
85 S PAGE=1,IBFORM("SCAN",PAGE)=1,IBDSAMP=0
86 D ^%ZIS G:POP END
87 U IO
88 ;
89 ; -- sets top of page
90 W $C(27),"&l0E"
91 W !
92 D ANCHORS
93END D ^%ZISC
94 K PAGE,IBDFORM,IBDSAMP
95 Q
96 ;
97TESTD ; -- Test printing without macro
98 S PAGE=1,IBFORM("SCAN",PAGE)=1,IBDSAMP=0
99 D ^%ZIS G:POP END1
100 U IO
101 ;
102 ; -- sets top of page
103 W $C(27),"&l0E"
104 W !
105 D DIRECT
106END1 D ^%ZISC
107 K PAGE,IBFORM,IBDSAMP
108 Q
109DIRECT ; -- print logo direct without macros
110 ; -- top left corner (ANCHOR 1)
111 W !,$C(27),"&a184v4H",$C(27) D VALOGO
112 ;
113 ; -- top right (ANCHOR 3)
114 W !,$C(27),"&a184v5534H" D VALOGO
115 ;
116 W !!!,"PRINTING ANCHORS DIRECTLY, NO MACRO"
117 ;
118 ; -- bottom left (ANCHOR 4)
119 W !,$C(27),"&a7615v4H" D VALOGO
120 ;
121 ; -- scannable page
122 I $G(IBFORM("SCAN",PAGE)),'$G(IBDSAMP) W $C(27),"&a7576v3400H" D VALOGO
123 ;
124 ;bottom right (ANCHOR 6)
125 W $C(27),"&a7615v5534H" D VALOGO
126 Q
Note: See TracBrowser for help on using the repository browser.