source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQSUITE.m@ 623

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

initial load of WorldVistAEHR
File size: 6.4 KB
RevLine 
[613]1XQSUITE ;Luke/Sea - Window Suite driver ;2/14/95 10:32
2 ;;8.0;KERNEL;;Jul 10, 1995;Build 4
3 ;Modified from FOIA VISTA,
4 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
5 ;General Public License See attached copy of the License.
6 ;
7 ;This program is free software; you can redistribute it and/or modify
8 ;it under the terms of the GNU General Public License as published by
9 ;the Free Software Foundation; either version 2 of the License, or
10 ;(at your option) any later version.
11 ;
12 ;This program is distributed in the hope that it will be useful,
13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;GNU General Public License for more details.
16 ;
17 ;You should have received a copy of the GNU General Public License along
18 ;with this program; if not, write to the Free Software Foundation, Inc.,
19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20 ;
21 ;Jump-start XQSUITE by asking which suite to run
22 S DIC=19,DIC(0)="AEQM" D ^DIC Q:Y<0 S (XQDIC,XQY)=+Y K DIC,XQUR,Y,^VA(200,DUZ,202.1)
23 I $P(^DIC(19,XQY,0),U,4)'="Z" W !!,"Sorry, '",$P(^(0),U,2),"' is not a suite of windows." K XQY,XQDIC Q
24 ;
25 ;Enter with XQY=the IEN of the suite
26 ;
27EN ;Entry point for ^XQ1
28 S KWAPI=1
29 S U="^"
30 S XQWIN=$$NEXTNM^XGCLOAD("XQS")
31 D ^XQDATE
32 S ^XUTL("XQSUITE",$J,XQWIN,0)=%_U_%Y
33 D PREP^XG
34 S XQKWAPI=0 I XGWIN'["^$W" S XQKWAPI=1
35 D GET^XGCLOAD("XQSUITE",$NA(^TMP($J,XQWIN)))
36 I $L($P(^DIC(19,+XQY,0),U,2)) S ^TMP($J,XQWIN,"TITLE")=$P(^DIC(19,XQY,0),U,2)
37 ;S XQPOP=$$NEXTNM^XGCLOAD("XQP")
38 D GET^XGCLOAD("XQPOP",$NA(^TMP($J,"XQPOP")))
39 ;
40 S XQN=1000,XQJ=0 F XQI=1:1:$P(^DIC(19,XQY,10,0),U,4) D
41 .S XQJ=$O(^DIC(19,XQY,10,XQJ))
42 .Q:XQJ'=+XQJ
43 .S XQJY=^DIC(19,XQY,10,XQJ,0)
44 .I $L(XQJY,U)<3 F S XQJY=XQJY_U Q:$L(XQJY,U)=3
45 .S XQK=$P(XQJY,U,3) I XQK'>0 S XQK=XQN,XQN=XQN+1 ;Display order
46 .S ^XUTL(XQWIN,$J,XQY,+XQJY)=^DIC(19,+XQJY,0)
47 .S ^XUTL(XQWIN,$J,XQY,+XQJY,"W")=^DIC(19,+XQJY,"W")
48 .S XQM(XQK)=XQJY_U_^XUTL(XQWIN,$J,XQY,+XQJY,"W")
49 .Q
50 K XQI,XQJ,XQJYM,XQK
51 ;
52ICONS ;Build the generic (icon) windows for each option
53 S XQK=0,XQGB1="XQB1",XQGB2="XQB2",XQGL1="XQL1",XQGL2="XQL2",XQII="XQSI"
54 S XQP1=30,XQP2=",334",XQIP1=30,XQIP2=20
55 S XQPTH=$G(^XTV(8989.3,101)),XQNB=0,XQNI=0,XQLONG=0
56 ;
57 S ^TMP($J,XQWIN,"FFACE")="Courier New"
58 S ^TMP($J,XQWIN,"NEXTG")="XQSI"_$O(XQM(0))
59 F XQI=1:1 Q:XQK="" D
60 .S XQK=$O(XQM(XQK)) Q:XQK=""
61 .S XQKY=+XQM(XQK)
62 .S XQSIN=XQII_XQK
63 .S XQB1=XQGB1_XQK,XQB2=XQGB2_XQK
64 .S XQL1=XQGL1_XQK,XQL2=XQGL2_XQK
65 .;
66MAKE .D
67 ..S XQNI=XQNI+1
68 ..S XQIP1=((XQNI*120)-120)+32
69 ..S ^TMP($J,XQWIN,"G",XQSIN,"POS")=XQIP1_","_XQIP2
70 ..S ^TMP($J,XQWIN,"G",XQSIN,"SIZE")="32,32"
71 ..S ^TMP($J,XQWIN,"G",XQSIN,"TYPE")=$S(XQKWAPI:"BUTTON",1:"GENERIC")
72 ..I $O(XQM(XQK))'="" S ^TMP($J,XQWIN,"G",XQSIN,"NEXTG")="XQSI"_$O(XQM(XQK))
73 ..E S ^TMP($J,XQWIN,"G",XQSIN,"NEXTG")="XQSI"_$O(XQM(0))
74 ..I 'XQKWAPI D
75 ...S XQICP=$P(XQM(XQK),U,4)
76 ...S XQICP=$S(XQICP["\":XQICP,XQICP["[":XQICP,XQICP="":"",1:XQPTH_XQICP)
77 ...I $L(XQICP) S ^TMP($J,XQWIN,"G",XQSIN,"DRAW",1)="BITMAP,0,0,F,"_XQICP
78 ...E S ^TMP($J,XQWIN,"G",XQSIN,"BCOLOR")="400,800,51110"
79 ...Q
80 ..S ^TMP($J,XQWIN,"G",XQSIN,"EVENT",$S(XQKWAPI:"SELECT",1:"DBLCLICK"))="SEL^XQSUITE"
81 ..S ^TMP($J,XQWIN,"G",XQSIN,"EVENT","FOCUS")="FOCUS^XQSUITE"
82 ..;
83 ..S XQTXT=$P(XQM(XQK),U,5) I '$L(XQTXT) S XQTXT="No Title"
84 ..S XQTL=$L(XQTXT)
85 ..I XQTL>12 S XQLONG=1,X=XQTXT D SPLIT^XQSUITE1 S XQTXT=Y1,XQTL=$L(XQTXT)
86 ..;S ^TMP($J,XQWIN,"G",XQB1,"TYPE")="GENERIC"
87L1 ..S ^TMP($J,XQWIN,"G",XQL1,"TYPE")="LABEL"
88 ..S ^TMP($J,XQWIN,"G",XQL1,"BCOLOR")="65535,65535,65535"
89 ..S ^TMP($J,XQWIN,"G",XQL1,"SIZE")=XQTL*8_",16"
90 ..S P1=XQIP1-(((XQTL*8)-36)\2),P2=XQIP2+32
91 ..S ^TMP($J,XQWIN,"G",XQL1,"POS")=P1_","_P2
92 ..S ^TMP($J,XQWIN,"G",XQL1,"TFFACE")="Courier New"
93 ..S ^TMP($J,XQWIN,"G",XQL1,"TFSIZE")=10
94 ..;S ^TMP($J,XQWIN,"G",XQL1,"DRAW",1)="DRAWTEXT,0,0,"_XQTXT
95 ..S ^TMP($J,XQWIN,"G",XQL1,"TITLE")=XQTXT
96L2 ..I XQLONG S XQTXT=Y2,XQTL=$L(XQTXT),XQLONG=0 D
97 ...S ^TMP($J,XQWIN,"G",XQL2,"TYPE")="LABEL"
98 ...S ^TMP($J,XQWIN,"G",XQL2,"BCOLOR")="65535,65535,65535"
99 ...S ^TMP($J,XQWIN,"G",XQL2,"SIZE")=XQTL*8_",16"
100 ...S P1=XQIP1-(((XQTL*8)-36)\2),P2=XQIP2+32+16
101 ...S ^TMP($J,XQWIN,"G",XQL2,"POS")=P1_","_P2
102 ...S ^TMP($J,XQWIN,"G",XQL2,"TFFACE")="Courier New"
103 ...S ^TMP($J,XQWIN,"G",XQL2,"TFSIZE")=10
104 ...;S ^TMP($J,XQWIN,"G",XQL2,"DRAW",1)="DRAWTEXT,0,0,"_XQTXT
105 ...S ^TMP($J,XQWIN,"G",XQL2,"TITLE")=XQTXT
106 ...Q
107 ..Q
108 .Q
109KILL K X,XQB1,XQB2,XQGB1,XQGB2,XQGL1,XQGL2,XQI,XQICP,XQII,XQIP1,XQIP2,XQJ,XQJY,XQK,XQKY,XQL1,XQL2,XQLONG,XQNB,XQNI,XQP,XQP1,XQP2,XQPTH,XQTL,XQTXT,XQSUIB,XQSUIIN
110 ;
111 D M^XG(XQWIN,$NA(^TMP($J,XQWIN)))
112 ;
113 ;Start up the XQSUI window
114 ;
115 D ESTA^XG()
116 ;
117 ;Return here after suite exits
118 ;
119 D K^XG(XQWIN)
120 ;
121OUT ;Finish it all up here
122 K ^XUTL(XQWIN,$J,XQY)
123 K ^TMP($J,XQWIN),^TMP($J,"XQP")
124 ;D CLEAN^XG
125 K %,%Y,XQWIN
126 Q
127 ;
128SEL ;One of the icons was double-clicked
129 ;N XQY,XQWIN
130 S XQI=@XGEVENT@("WINDOW")
131 S XQJ=@XGEVENT@("ELEMENT")
132 S XQK=$P(XQJ,",",2)
133 S XQY=+XQM($E(XQK,5,99))
134 ;W !,XQI," ",XQJ," ",XQY
135 ;
136 S XQOK=1
137 I $D(^DIC(19,XQY,25)),$L(^(25)) D G OUT ;Routine type
138 .S XQSUI=^DIC(19,XQY,25)
139 .S:XQSUI'[U XQSUI=U_XQSUI
140 .I XQSUI["[" D DO^%XUCI Q
141 .;W !,"ROUTINE=",XQSUI
142 .D @XQSUI
143 .Q
144 ;
145 I $D(^DIC(19,XQY,24)),$L(^(24)) D G:XQOK OUT ;Pointer type
146 .;W !,"We have a pointer!"
147 .S XQSUI=^DIC(19,XQY,24)
148 .S XQSUI=$P($G(^XTV(8995,XQSUI,0)),U) I XQSUI="" S XQOK=0 Q
149 .;W !,XQSUI
150 .S XQWIN=$$NEXTNM^XGCLOAD("XQSUI")
151 .D GET^XGCLOAD(XQSUI,$NA(^TMP($J,XQWIN)))
152 .D M^XG(XQWIN,$NA(^TMP($J,XQWIN)))
153 .D SD^XG($P,"FOCUS",XQWIN)
154 .;D ESTA^XG() ;Send it off to window land
155 .;
156 .;D K^XG(XQWIN) ;Return here after the ESTOP
157 .Q
158 Q
159 ;
160CLOSE ;Close the XQSUITE window and do an ESTOP
161 S XQWIN=@XGEVENT@("WINDOW")
162 K XQM
163 D ESTO^XG
164 Q
165 ;
166HLP ;Help Callback for XQHLPMEN menu
167 S XQMESS="Sorry, I'm still writing the help messages.",XQTITLE="Help!"
168 D POP^XQGP(XQMESS,XQTITLE)
169 K XQMESS,XQTITLE
170 Q
171 ;
172MAIL ;Hook into Mail
173 S XQMESS="Windowed MAIL is not available yet.",XQTITLE="Sorry!"
174 D POP^XQGP(XQMESS,XQTITLE)
175 K XQMESS,XQTITLE
176 Q
177 ;
178ALERT ;Hook into ALERT system
179 S XQMESS="Alerts are not yet available in windows."
180 S XQTITLE="Very Sorry!"
181 D POP^XQGP(XQMESS,XQTITLE)
182 K XQMESS,XQTITLE
183 Q
184 ;
185FOCUS ;Show Menu Text of button with FOCUS in XQSUIHTXT gadget
186 ;N XQY,XQWIN
187 S XQWIN=@XGEVENT@("WINDOW")
188 S XQJ=@XGEVENT@("ELEMENT")
189 S XQK=$P(XQJ,",",2)
190 S XQN=$E(XQK,5,99)
191 S XQY=+XQM(XQN)
192 ;W !,XQWIN," ",XQY," ",XQJ," ",XQK
193 ;
194 S @XGWIN@(XQWIN,"G","XQSHTXT","TITLE")=$P(^DIC(19,XQY,0),U,2)
195 K XQJ,XQK,XQN
196 Q
Note: See TracBrowser for help on using the repository browser.