XQSUITE ;Luke/Sea - Window Suite driver ;2/14/95 10:32 [ 04/02/2003 8:29 AM ]
;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
;;8.0;KERNEL;;Jul 10, 1995
;
;Jump-start XQSUITE by asking which suite to run
S DIC=19,DIC(0)="AEQM" D ^DIC Q:Y<0 S (XQDIC,XQY)=+Y K DIC,XQUR,Y,^VA(200,DUZ,202.1)
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
;
;Enter with XQY=the IEN of the suite
;
EN ;Entry point for ^XQ1
S KWAPI=1
S U="^"
S XQWIN=$$NEXTNM^XGCLOAD("XQS")
D ^XQDATE
S ^XUTL("XQSUITE",$J,XQWIN,0)=%_U_%Y
D PREP^XG
S XQKWAPI=0 I XGWIN'["^$W" S XQKWAPI=1
D GET^XGCLOAD("XQSUITE",$NA(^TMP($J,XQWIN)))
I $L($P(^DIC(19,+XQY,0),U,2)) S ^TMP($J,XQWIN,"TITLE")=$P(^DIC(19,XQY,0),U,2)
;S XQPOP=$$NEXTNM^XGCLOAD("XQP")
D GET^XGCLOAD("XQPOP",$NA(^TMP($J,"XQPOP")))
;
S XQN=1000,XQJ=0 F XQI=1:1:$P(^DIC(19,XQY,10,0),U,4) D
.S XQJ=$O(^DIC(19,XQY,10,XQJ))
.Q:XQJ'=+XQJ
.S XQJY=^DIC(19,XQY,10,XQJ,0)
.I $L(XQJY,U)<3 F S XQJY=XQJY_U Q:$L(XQJY,U)=3
.S XQK=$P(XQJY,U,3) I XQK'>0 S XQK=XQN,XQN=XQN+1 ;Display order
.S ^XUTL(XQWIN,$J,XQY,+XQJY)=^DIC(19,+XQJY,0)
.S ^XUTL(XQWIN,$J,XQY,+XQJY,"W")=^DIC(19,+XQJY,"W")
.S XQM(XQK)=XQJY_U_^XUTL(XQWIN,$J,XQY,+XQJY,"W")
.Q
K XQI,XQJ,XQJYM,XQK
;
ICONS ;Build the generic (icon) windows for each option
S XQK=0,XQGB1="XQB1",XQGB2="XQB2",XQGL1="XQL1",XQGL2="XQL2",XQII="XQSI"
S XQP1=30,XQP2=",334",XQIP1=30,XQIP2=20
S XQPTH=$G(^XTV(8989.3,101)),XQNB=0,XQNI=0,XQLONG=0
;
S ^TMP($J,XQWIN,"FFACE")="Courier New"
S ^TMP($J,XQWIN,"NEXTG")="XQSI"_$O(XQM(0))
F XQI=1:1 Q:XQK="" D
.S XQK=$O(XQM(XQK)) Q:XQK=""
.S XQKY=+XQM(XQK)
.S XQSIN=XQII_XQK
.S XQB1=XQGB1_XQK,XQB2=XQGB2_XQK
.S XQL1=XQGL1_XQK,XQL2=XQGL2_XQK
.;
MAKE .D
..S XQNI=XQNI+1
..S XQIP1=((XQNI*120)-120)+32
..S ^TMP($J,XQWIN,"G",XQSIN,"POS")=XQIP1_","_XQIP2
..S ^TMP($J,XQWIN,"G",XQSIN,"SIZE")="32,32"
..S ^TMP($J,XQWIN,"G",XQSIN,"TYPE")=$S(XQKWAPI:"BUTTON",1:"GENERIC")
..I $O(XQM(XQK))'="" S ^TMP($J,XQWIN,"G",XQSIN,"NEXTG")="XQSI"_$O(XQM(XQK))
..E S ^TMP($J,XQWIN,"G",XQSIN,"NEXTG")="XQSI"_$O(XQM(0))
..I 'XQKWAPI D
...S XQICP=$P(XQM(XQK),U,4)
...S XQICP=$S(XQICP["\":XQICP,XQICP["[":XQICP,XQICP="":"",1:XQPTH_XQICP)
...I $L(XQICP) S ^TMP($J,XQWIN,"G",XQSIN,"DRAW",1)="BITMAP,0,0,F,"_XQICP
...E S ^TMP($J,XQWIN,"G",XQSIN,"BCOLOR")="400,800,51110"
...Q
..S ^TMP($J,XQWIN,"G",XQSIN,"EVENT",$S(XQKWAPI:"SELECT",1:"DBLCLICK"))="SEL^XQSUITE"
..S ^TMP($J,XQWIN,"G",XQSIN,"EVENT","FOCUS")="FOCUS^XQSUITE"
..;
..S XQTXT=$P(XQM(XQK),U,5) I '$L(XQTXT) S XQTXT="No Title"
..S XQTL=$L(XQTXT)
..I XQTL>12 S XQLONG=1,X=XQTXT D SPLIT^XQSUITE1 S XQTXT=Y1,XQTL=$L(XQTXT)
..;S ^TMP($J,XQWIN,"G",XQB1,"TYPE")="GENERIC"
L1 ..S ^TMP($J,XQWIN,"G",XQL1,"TYPE")="LABEL"
..S ^TMP($J,XQWIN,"G",XQL1,"BCOLOR")="65535,65535,65535"
..S ^TMP($J,XQWIN,"G",XQL1,"SIZE")=XQTL*8_",16"
..S P1=XQIP1-(((XQTL*8)-36)\2),P2=XQIP2+32
..S ^TMP($J,XQWIN,"G",XQL1,"POS")=P1_","_P2
..S ^TMP($J,XQWIN,"G",XQL1,"TFFACE")="Courier New"
..S ^TMP($J,XQWIN,"G",XQL1,"TFSIZE")=10
..;S ^TMP($J,XQWIN,"G",XQL1,"DRAW",1)="DRAWTEXT,0,0,"_XQTXT
..S ^TMP($J,XQWIN,"G",XQL1,"TITLE")=XQTXT
L2 ..I XQLONG S XQTXT=Y2,XQTL=$L(XQTXT),XQLONG=0 D
...S ^TMP($J,XQWIN,"G",XQL2,"TYPE")="LABEL"
...S ^TMP($J,XQWIN,"G",XQL2,"BCOLOR")="65535,65535,65535"
...S ^TMP($J,XQWIN,"G",XQL2,"SIZE")=XQTL*8_",16"
...S P1=XQIP1-(((XQTL*8)-36)\2),P2=XQIP2+32+16
...S ^TMP($J,XQWIN,"G",XQL2,"POS")=P1_","_P2
...S ^TMP($J,XQWIN,"G",XQL2,"TFFACE")="Courier New"
...S ^TMP($J,XQWIN,"G",XQL2,"TFSIZE")=10
...;S ^TMP($J,XQWIN,"G",XQL2,"DRAW",1)="DRAWTEXT,0,0,"_XQTXT
...S ^TMP($J,XQWIN,"G",XQL2,"TITLE")=XQTXT
...Q
..Q
.Q
KILL 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
;
D M^XG(XQWIN,$NA(^TMP($J,XQWIN)))
;
;Start up the XQSUI window
;
D ESTA^XG()
;
;Return here after suite exits
;
D K^XG(XQWIN)
;
OUT ;Finish it all up here
K ^XUTL(XQWIN,$J,XQY)
K ^TMP($J,XQWIN),^TMP($J,"XQP")
;D CLEAN^XG
K %,%Y,XQWIN
Q
;
SEL ;One of the icons was double-clicked
;N XQY,XQWIN
S XQI=@XGEVENT@("WINDOW")
S XQJ=@XGEVENT@("ELEMENT")
S XQK=$P(XQJ,",",2)
S XQY=+XQM($E(XQK,5,99))
;W !,XQI," ",XQJ," ",XQY
;
S XQOK=1
I $D(^DIC(19,XQY,25)),$L(^(25)) D G OUT ;Routine type
.S XQSUI=^DIC(19,XQY,25)
.S:XQSUI'[U XQSUI=U_XQSUI
.I XQSUI["[" D DO^%XUCI Q
.;W !,"ROUTINE=",XQSUI
.D @XQSUI
.Q
;
I $D(^DIC(19,XQY,24)),$L(^(24)) D G:XQOK OUT ;Pointer type
.;W !,"We have a pointer!"
.S XQSUI=^DIC(19,XQY,24)
.S XQSUI=$P($G(^XTV(8995,XQSUI,0)),U) I XQSUI="" S XQOK=0 Q
.;W !,XQSUI
.S XQWIN=$$NEXTNM^XGCLOAD("XQSUI")
.D GET^XGCLOAD(XQSUI,$NA(^TMP($J,XQWIN)))
.D M^XG(XQWIN,$NA(^TMP($J,XQWIN)))
.D SD^XG($PD,"FOCUS",XQWIN)
.;D ESTA^XG() ;Send it off to window land
.;
.;D K^XG(XQWIN) ;Return here after the ESTOP
.Q
Q
;
CLOSE ;Close the XQSUITE window and do an ESTOP
S XQWIN=@XGEVENT@("WINDOW")
K XQM
D ESTO^XG
Q
;
HLP ;Help Callback for XQHLPMEN menu
S XQMESS="Sorry, I'm still writing the help messages.",XQTITLE="Help!"
D POP^XQGP(XQMESS,XQTITLE)
K XQMESS,XQTITLE
Q
;
MAIL ;Hook into Mail
S XQMESS="Windowed MAIL is not available yet.",XQTITLE="Sorry!"
D POP^XQGP(XQMESS,XQTITLE)
K XQMESS,XQTITLE
Q
;
ALERT ;Hook into ALERT system
S XQMESS="Alerts are not yet available in windows."
S XQTITLE="Very Sorry!"
D POP^XQGP(XQMESS,XQTITLE)
K XQMESS,XQTITLE
Q
;
FOCUS ;Show Menu Text of button with FOCUS in XQSUIHTXT gadget
;N XQY,XQWIN
S XQWIN=@XGEVENT@("WINDOW")
S XQJ=@XGEVENT@("ELEMENT")
S XQK=$P(XQJ,",",2)
S XQN=$E(XQK,5,99)
S XQY=+XQM(XQN)
;W !,XQWIN," ",XQY," ",XQJ," ",XQK
;
S @XGWIN@(XQWIN,"G","XQSHTXT","TITLE")=$P(^DIC(19,XQY,0),U,2)
K XQJ,XQK,XQN
Q
XQSUITE ;Luke/Sea - Window Suite driver ;2/14/95 10:32 [ 04/02/2003 8:29 AM ]
+1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
+2 ;;8.0;KERNEL;;Jul 10, 1995
+3 ;
+4 ;Jump-start XQSUITE by asking which suite to run
+5 SET DIC=19
SET DIC(0)="AEQM"
DO ^DIC
IF Y<0
QUIT
SET (XQDIC,XQY)=+Y
KILL DIC,XQUR,Y,^VA(200,DUZ,202.1)
+6 IF $PIECE(^DIC(19,XQY,0),U,4)'="Z"
WRITE !!,"Sorry, '",$PIECE(^(0),U,2),"' is not a suite of windows."
KILL XQY,XQDIC
QUIT
+7 ;
+8 ;Enter with XQY=the IEN of the suite
+9 ;
EN ;Entry point for ^XQ1
+1 SET KWAPI=1
+2 SET U="^"
+3 SET XQWIN=$$NEXTNM^XGCLOAD("XQS")
+4 DO ^XQDATE
+5 SET ^XUTL("XQSUITE",$JOB,XQWIN,0)=%_U_%Y
+6 DO PREP^XG
+7 SET XQKWAPI=0
IF XGWIN'["^$W"
SET XQKWAPI=1
+8 DO GET^XGCLOAD("XQSUITE",$NAME(^TMP($JOB,XQWIN)))
+9 IF $LENGTH($PIECE(^DIC(19,+XQY,0),U,2))
SET ^TMP($JOB,XQWIN,"TITLE")=$PIECE(^DIC(19,XQY,0),U,2)
+10 ;S XQPOP=$$NEXTNM^XGCLOAD("XQP")
+11 DO GET^XGCLOAD("XQPOP",$NAME(^TMP($JOB,"XQPOP")))
+12 ;
+13 SET XQN=1000
SET XQJ=0
FOR XQI=1:1:$PIECE(^DIC(19,XQY,10,0),U,4)
Begin DoDot:1
+14 SET XQJ=$ORDER(^DIC(19,XQY,10,XQJ))
+15 IF XQJ'=+XQJ
QUIT
+16 SET XQJY=^DIC(19,XQY,10,XQJ,0)
+17 IF $LENGTH(XQJY,U)<3
FOR
SET XQJY=XQJY_U
IF $LENGTH(XQJY,U)=3
QUIT
+18 ;Display order
SET XQK=$PIECE(XQJY,U,3)
IF XQK'>0
SET XQK=XQN
SET XQN=XQN+1
+19 SET ^XUTL(XQWIN,$JOB,XQY,+XQJY)=^DIC(19,+XQJY,0)
+20 SET ^XUTL(XQWIN,$JOB,XQY,+XQJY,"W")=^DIC(19,+XQJY,"W")
+21 SET XQM(XQK)=XQJY_U_^XUTL(XQWIN,$JOB,XQY,+XQJY,"W")
+22 QUIT
End DoDot:1
+23 KILL XQI,XQJ,XQJYM,XQK
+24 ;
ICONS ;Build the generic (icon) windows for each option
+1 SET XQK=0
SET XQGB1="XQB1"
SET XQGB2="XQB2"
SET XQGL1="XQL1"
SET XQGL2="XQL2"
SET XQII="XQSI"
+2 SET XQP1=30
SET XQP2=",334"
SET XQIP1=30
SET XQIP2=20
+3 SET XQPTH=$GET(^XTV(8989.3,101))
SET XQNB=0
SET XQNI=0
SET XQLONG=0
+4 ;
+5 SET ^TMP($JOB,XQWIN,"FFACE")="Courier New"
+6 SET ^TMP($JOB,XQWIN,"NEXTG")="XQSI"_$ORDER(XQM(0))
+7 FOR XQI=1:1
IF XQK=""
QUIT
Begin DoDot:1
+8 SET XQK=$ORDER(XQM(XQK))
IF XQK=""
QUIT
+9 SET XQKY=+XQM(XQK)
+10 SET XQSIN=XQII_XQK
+11 SET XQB1=XQGB1_XQK
SET XQB2=XQGB2_XQK
+12 SET XQL1=XQGL1_XQK
SET XQL2=XQGL2_XQK
+13 ;
MAKE Begin DoDot:2
+1 SET XQNI=XQNI+1
+2 SET XQIP1=((XQNI*120)-120)+32
+3 SET ^TMP($JOB,XQWIN,"G",XQSIN,"POS")=XQIP1_","_XQIP2
+4 SET ^TMP($JOB,XQWIN,"G",XQSIN,"SIZE")="32,32"
+5 SET ^TMP($JOB,XQWIN,"G",XQSIN,"TYPE")=$SELECT(XQKWAPI:"BUTTON",1:"GENERIC")
+6 IF $ORDER(XQM(XQK))'=""
SET ^TMP($JOB,XQWIN,"G",XQSIN,"NEXTG")="XQSI"_$ORDER(XQM(XQK))
+7 IF '$TEST
SET ^TMP($JOB,XQWIN,"G",XQSIN,"NEXTG")="XQSI"_$ORDER(XQM(0))
+8 IF 'XQKWAPI
Begin DoDot:3
+9 SET XQICP=$PIECE(XQM(XQK),U,4)
+10 SET XQICP=$SELECT(XQICP["\":XQICP,XQICP["[":XQICP,XQICP="":"",1:XQPTH_XQICP)
+11 IF $LENGTH(XQICP)
SET ^TMP($JOB,XQWIN,"G",XQSIN,"DRAW",1)="BITMAP,0,0,F,"_XQICP
+12 IF '$TEST
SET ^TMP($JOB,XQWIN,"G",XQSIN,"BCOLOR")="400,800,51110"
+13 QUIT
End DoDot:3
+14 SET ^TMP($JOB,XQWIN,"G",XQSIN,"EVENT",$SELECT(XQKWAPI:"SELECT",1:"DBLCLICK"))="SEL^XQSUITE"
+15 SET ^TMP($JOB,XQWIN,"G",XQSIN,"EVENT","FOCUS")="FOCUS^XQSUITE"
+16 ;
+17 SET XQTXT=$PIECE(XQM(XQK),U,5)
IF '$LENGTH(XQTXT)
SET XQTXT="No Title"
+18 SET XQTL=$LENGTH(XQTXT)
+19 IF XQTL>12
SET XQLONG=1
SET X=XQTXT
DO SPLIT^XQSUITE1
SET XQTXT=Y1
SET XQTL=$LENGTH(XQTXT)
+20 ;S ^TMP($J,XQWIN,"G",XQB1,"TYPE")="GENERIC"
L1 SET ^TMP($JOB,XQWIN,"G",XQL1,"TYPE")="LABEL"
+1 SET ^TMP($JOB,XQWIN,"G",XQL1,"BCOLOR")="65535,65535,65535"
+2 SET ^TMP($JOB,XQWIN,"G",XQL1,"SIZE")=XQTL*8_",16"
+3 SET P1=XQIP1-(((XQTL*8)-36)\2)
SET P2=XQIP2+32
+4 SET ^TMP($JOB,XQWIN,"G",XQL1,"POS")=P1_","_P2
+5 SET ^TMP($JOB,XQWIN,"G",XQL1,"TFFACE")="Courier New"
+6 SET ^TMP($JOB,XQWIN,"G",XQL1,"TFSIZE")=10
+7 ;S ^TMP($J,XQWIN,"G",XQL1,"DRAW",1)="DRAWTEXT,0,0,"_XQTXT
+8 SET ^TMP($JOB,XQWIN,"G",XQL1,"TITLE")=XQTXT
L2 IF XQLONG
SET XQTXT=Y2
SET XQTL=$LENGTH(XQTXT)
SET XQLONG=0
Begin DoDot:3
+1 SET ^TMP($JOB,XQWIN,"G",XQL2,"TYPE")="LABEL"
+2 SET ^TMP($JOB,XQWIN,"G",XQL2,"BCOLOR")="65535,65535,65535"
+3 SET ^TMP($JOB,XQWIN,"G",XQL2,"SIZE")=XQTL*8_",16"
+4 SET P1=XQIP1-(((XQTL*8)-36)\2)
SET P2=XQIP2+32+16
+5 SET ^TMP($JOB,XQWIN,"G",XQL2,"POS")=P1_","_P2
+6 SET ^TMP($JOB,XQWIN,"G",XQL2,"TFFACE")="Courier New"
+7 SET ^TMP($JOB,XQWIN,"G",XQL2,"TFSIZE")=10
+8 ;S ^TMP($J,XQWIN,"G",XQL2,"DRAW",1)="DRAWTEXT,0,0,"_XQTXT
+9 SET ^TMP($JOB,XQWIN,"G",XQL2,"TITLE")=XQTXT
+10 QUIT
End DoDot:3
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
KILL KILL 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
+1 ;
+2 DO M^XG(XQWIN,$NAME(^TMP($JOB,XQWIN)))
+3 ;
+4 ;Start up the XQSUI window
+5 ;
+6 DO ESTA^XG()
+7 ;
+8 ;Return here after suite exits
+9 ;
+10 DO K^XG(XQWIN)
+11 ;
OUT ;Finish it all up here
+1 KILL ^XUTL(XQWIN,$JOB,XQY)
+2 KILL ^TMP($JOB,XQWIN),^TMP($JOB,"XQP")
+3 ;D CLEAN^XG
+4 KILL %,%Y,XQWIN
+5 QUIT
+6 ;
SEL ;One of the icons was double-clicked
+1 ;N XQY,XQWIN
+2 SET XQI=@XGEVENT@("WINDOW")
+3 SET XQJ=@XGEVENT@("ELEMENT")
+4 SET XQK=$PIECE(XQJ,",",2)
+5 SET XQY=+XQM($EXTRACT(XQK,5,99))
+6 ;W !,XQI," ",XQJ," ",XQY
+7 ;
+8 SET XQOK=1
+9 ;Routine type
IF $DATA(^DIC(19,XQY,25))
IF $LENGTH(^(25))
Begin DoDot:1
+10 SET XQSUI=^DIC(19,XQY,25)
+11 IF XQSUI'[U
SET XQSUI=U_XQSUI
+12 IF XQSUI["["
DO DO^%XUCI
QUIT
+13 ;W !,"ROUTINE=",XQSUI
+14 DO @XQSUI
+15 QUIT
End DoDot:1
GOTO OUT
+16 ;
+17 ;Pointer type
IF $DATA(^DIC(19,XQY,24))
IF $LENGTH(^(24))
Begin DoDot:1
+18 ;W !,"We have a pointer!"
+19 SET XQSUI=^DIC(19,XQY,24)
+20 SET XQSUI=$PIECE($GET(^XTV(8995,XQSUI,0)),U)
IF XQSUI=""
SET XQOK=0
QUIT
+21 ;W !,XQSUI
+22 SET XQWIN=$$NEXTNM^XGCLOAD("XQSUI")
+23 DO GET^XGCLOAD(XQSUI,$NAME(^TMP($JOB,XQWIN)))
+24 DO M^XG(XQWIN,$NAME(^TMP($JOB,XQWIN)))
+25 DO SD^XG($PDISPLAY,"FOCUS",XQWIN)
+26 ;D ESTA^XG() ;Send it off to window land
+27 ;
+28 ;D K^XG(XQWIN) ;Return here after the ESTOP
+29 QUIT
End DoDot:1
IF XQOK
GOTO OUT
+30 QUIT
+31 ;
CLOSE ;Close the XQSUITE window and do an ESTOP
+1 SET XQWIN=@XGEVENT@("WINDOW")
+2 KILL XQM
+3 DO ESTO^XG
+4 QUIT
+5 ;
HLP ;Help Callback for XQHLPMEN menu
+1 SET XQMESS="Sorry, I'm still writing the help messages."
SET XQTITLE="Help!"
+2 DO POP^XQGP(XQMESS,XQTITLE)
+3 KILL XQMESS,XQTITLE
+4 QUIT
+5 ;
MAIL ;Hook into Mail
+1 SET XQMESS="Windowed MAIL is not available yet."
SET XQTITLE="Sorry!"
+2 DO POP^XQGP(XQMESS,XQTITLE)
+3 KILL XQMESS,XQTITLE
+4 QUIT
+5 ;
ALERT ;Hook into ALERT system
+1 SET XQMESS="Alerts are not yet available in windows."
+2 SET XQTITLE="Very Sorry!"
+3 DO POP^XQGP(XQMESS,XQTITLE)
+4 KILL XQMESS,XQTITLE
+5 QUIT
+6 ;
FOCUS ;Show Menu Text of button with FOCUS in XQSUIHTXT gadget
+1 ;N XQY,XQWIN
+2 SET XQWIN=@XGEVENT@("WINDOW")
+3 SET XQJ=@XGEVENT@("ELEMENT")
+4 SET XQK=$PIECE(XQJ,",",2)
+5 SET XQN=$EXTRACT(XQK,5,99)
+6 SET XQY=+XQM(XQN)
+7 ;W !,XQWIN," ",XQY," ",XQJ," ",XQK
+8 ;
+9 SET @XGWIN@(XQWIN,"G","XQSHTXT","TITLE")=$PIECE(^DIC(19,XQY,0),U,2)
+10 KILL XQJ,XQK,XQN
+11 QUIT
