source: FOIAVistA/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@ 1755

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

initial load of FOIAVistA 6/30/08 version

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