source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFUA.m@ 1078

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

initial load of WorldVistAEHR
File size: 3.0 KB
RevLine 
[613]1IBDFUA ;ALB/CJM - ENCOUNTER FORM (utilities - IBDFU continued) ;NOV 16,1992
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4PRNTVAR ;defines the screen and graphics variables needed for printing
5 ;
6 D GSET^%ZISS,KILL^%ZISS
7 S X="IOINHI;IOINORM;IOUON;IOUOFF"
8 D ENDR^%ZISS
9 S (IORVON,IORVOFF)=""
10 K X
11 Q
12 ;
13KPRNTVAR ;kills the variables defined by PRINTVAR
14 ; -- (actually, kills all screen paramters)
15 ;
16 Q:$D(VALMEVL) ;don't kill if listman, (needed for 1010T)
17 D GKILL^%ZISS,KILL^%ZISS
18 Q
19 ;
20GRAPHICS() ; returns1 if graphic mode available with characters needed
21 ;sets graphics characters to "|" and "_" if graphics mode not available
22 ;If not a raster device, then returns 0 no matter what
23 ;
24 N GRAPHICS S GRAPHICS=0
25 I IBDEVICE("RASTER"),($G(IOG0)'=""),($G(IOG1)'=""),($G(IOVL)'=""),($G(IOHL)'=""),($G(IOBLC)'=""),($G(IOBRC)'=""),($G(IOTLC)'=""),($G(IOTRC)'="") S GRAPHICS=1
26 S:IBDEVICE("PCL") GRAPHICS=1
27 S:'GRAPHICS (IOVL,IOBLC,IOBRC)="|",(IOHL,IOTRC,IOTLC)="_"
28 Q GRAPHICS
29 ;
30DEVICE(LISTMAN,IBDEVICE) ;sets various device parameters
31 ;LISTMAN=1 if display for the List Manager, 0 otherwise
32 ;returns IBDEVICE array - pass by reference
33 ;Also, the required Kernel screen and graphics parameters are defined.
34 ;
35 ;IBDEVICE array elements:
36 ; RASTER = 1 if IOXY defined and not a crt
37 ; CRT= 1 if crt
38 ; GRAPHICS=1 if graphic mode available with characters needed.
39 ; PCL=1 if the printer language is PCL, version 5 or higher.
40 ; SIMPLEX,DUPLEX_LONG,DUPLEX_SHORT are printer control statements for simplex, duplex long-edge binding, duplex short-edge binding - in an encounter form file until added to the TERMINAL TYPE file in future version of KERNEL
41 ;
42 S IBDEVICE("TCP")=0
43 ;
44 I LISTMAN D Q
45 .S IBDEVICE("LISTMAN")=1
46 .S IBDEVICE("CRT")=1
47 .S IBDEVICE("PCL")=0
48 .S IBDEVICE("GRAPHICS")=0
49 .S IBDEVICE("RASTER")=0
50 .D NOGRPHCS^IBDFU5
51 ;
52 ;not List Manager ->
53 ;
54 S (IBDEVICE("LISTMAN"),IBDEVICE("RASTER"),IBDEVICE("CRT"),IBDEVICE("PCL"))=0
55 I $E($G(IOST),1,2)="C-" S IBDEVICE("CRT")=1
56 I $G(IOXY)'="" S IBDEVICE("RASTER")=1
57 D PRNTVAR
58 S (IBDEVICE("SIMPLEX"),IBDEVICE("DUPLEX_LONG"),IBDEVICE("DUPLEX_SHORT"))=""
59 I 'IBDEVICE("CRT"),'LISTMAN,$G(IOST(0)) D
60 .N TERMINAL,TEMP
61 .S TERMINAL=$G(^IBE(357.94,+$O(^IBE(357.94,"B",IOST(0),0)),0))
62 .S IBDEVICE("TCP")=+$P(TERMINAL,"^",6)
63 .S IBDEVICE("RESET")=$P(TERMINAL,"^",7)
64 .S IBDEVICE("PCL")=$S($P(TERMINAL,"^",2)=1:1,1:0)
65 .I $P(TERMINAL,"^",3)]"" S TEMP="S IBDEVICE(""SIMPLEX"")="_$P(TERMINAL,"^",3) X TEMP
66 .;
67 .;do not define duplex mode if simplex not defined
68 .Q:IBDEVICE("SIMPLEX")=""
69 .I $P(TERMINAL,"^",4)]"" S TEMP="S IBDEVICE(""DUPLEX_LONG"")="_$P(TERMINAL,"^",4) X TEMP
70 .I $P(TERMINAL,"^",5)]"" S TEMP="S IBDEVICE(""DUPLEX_SHORT"")="_$P(TERMINAL,"^",5) X TEMP
71 ;
72 S IBDEVICE("GRAPHICS")=$$GRAPHICS
73 Q
74 ;
75KILL ;this can be used just before calling List Manager to save space in the symbol table
76 ;
77 ;K XQORKBD,VALMKEY,VALMDDF,VALMHDR,%,CTRLCOL,DIC,Y,X,POP,DX,DY,%I,D,ZTSK,DIC,D0,POP,SEL,DIR,DIE,DR,DA,DIK,DD,%DT,%H,IOP,COL,J
78 ;
79 K %,CTRLCOL,DIC,Y,X,POP,DX,DY,%I,D,ZTSK,DIC,D0,POP,SEL,DIR,DIE,DR,DA,DIK,DD,%DT,%H,IOP,COL,J
80 Q
Note: See TracBrowser for help on using the repository browser.