Cache for OpenVMS/ALPHA V7.x^INT^XG Routines and XAK-XAK1 (Omage)^~Format=Cache.S~ %RO on 16 Oct 2007 6:09 AM XAK^INT^1^60169,79033^0 XAK ; GENERATED FROM 'XAK' INPUT TEMPLATE(#2), FILE 16061;10/10/89 D DE G BEGIN DE S DIE="^DIZ(16061,",DIC=DIE,DP=16061,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$N(^DIZ(16061,DA,-1))<0 I $D(^(0)) S %Z=^(0) S %=$P(%Z,"^",1) S:%]"" DE(1)=% S %=$P(%Z,"^",2) S:%]"" DE(2)=% S %=$P(%Z,"^",3) S:%]"" DE(3)=% K %Z Q ; W W !?DL+DL-2,DLB_": " Q O D W W Y W:$X>45 !?9 I $L(Y)>19,'DV,(DV["F"!(DV["K")) G RW^DIED W:Y]"" "// " I 'DV,DV["I" S X="" W " (No Editing)" Q TR R X:DTIME E S (DTOUT,X)=U W *7 Q A K DQ(DQ) S DQ=DQ+1 B G @DQ RE G PR:$D(DE(DQ)) D W,TR N I X="" G A:DV'["R",X:'DV,X:D'>0,A RD G QS:X?."?" I X["^" D D G ^DIE17 I X="@" D D G Z^DIE2 I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W " "_X T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) S %=$P($P(";"_DU,";"_X_":",2),";"),Y=X I %]"" X:$D(DIC("S")) DIC("S") I W:'$D(DB(DQ)) " "_% G V F %=1:1 S Y=$P(DU,";",%),DG=$F(Y,":"_X) G X:Y="" S YS=Y,Y=$P(Y,":") I DG X:$D(DIC("S")) DIC("S") I Q:DG W:'$D(DB(DQ)) $E(YS,DG,999) S X=$P(YS,":") P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) I DV'["*" D ^DIC S X=+Y,DIC=DIE G X:X<0 G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z I +$P(DV,",",2),X[".",$P(DQ(DQ),U,5)'["$" S X=$S($P(X,"00")="":"",$E(X)[0:$E(X,2,$L(X)),1:X) S:$E($P(X,".",2),$L($P(X,".",2)))[0 X=$E(X,1,$L(X)-1) I $P(X,".",2)=""&(X[".") S X=+X V D @("X"_DQ) K YS Z K DIC("S"),DLAYGO I $D(X),X'=U S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A X W *7,"??" I $D(DB(DQ)) G Z^DIE17 S X="?BAD" QS S DZ=X D D,QQ^DIEQ G B D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q Y I '$D(DE(DQ)) D O G A:X="@",RD:X]"" S X=Y G N PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP R I DG["P",@("$D(^"_X_"0))") S X=+$P(^(0),U,2) G RP:'$D(^(Y,0)) S Y=$P(^(0),U),X=$P(^DD(X,.01,0),U,3),DG=$P(^(0),U,2) G R I DG["V",+Y,$D(@(U_$P(Y,";",2)_"0)")) S X=+$P(^(0),U,2) G RP:'$D(^(+Y,0)) S Y=$P(^(0),U) I $D(^DD(+X,.01,0)) S DG=$P(^(0),U,2),X=$P(^(0),U,3) G R X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=% RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17 I I DV'["I",DV'["#" G RD D E^DIE0 G RD:$D(X),PR Q BEGIN S DNM="XAK",DQ=1 S:$D(DTIME)[0 DTIME=999 S D0=DA,DIEZ=2,U="^" 1 S DW="0;1",DV="RV",DU="",DLB="NAME",DIFLD=.01 S DE(DW)="C1^XAK" G RE C1 G C1S:$D(DE(1))[0 K DB S X=DE(1),DIC=DIE K ^DIZ(16061,"B",$E(X,1,30),DA) C1S S X="" Q:DG(DQ)=X K DB S X=DG(DQ),DIC=DIE S ^DIZ(16061,"B",$E(X,1,30),DA)="" Q X1 Q 2 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW="0;2",DV="D",DU="",DLB="DATE",DIFLD=1 G RE X2 S %DT="EX" D ^%DT S X=Y K:Y<1 X Q ; 3 S DW="0;3",DV="RV",DU="",DLB="HUMAN",DIFLD=2 G RE X3 Q 4 S D=0 K DE(1) ;3 S Y="WP1^W^^0;1^Q",DG="1" D DIEN^DIWE K DE(1) G A ; 5 S D=0 K DE(1) ;4 S Y="WP2^W^^0;1^Q",DG="2" D DIEN^DIWE K DE(1) G A ; 6 S D=0 K DE(1) ;5 S DIFLD=5,DGO="^XAK1",DC="2^16061.05^C^",DV="16061.05MF",DW="0;1",DOW="CITY",DLB="Select "_DOW G RE:D I $D(DSC(16061.05))#2,$P(DSC(16061.05),"I $D(^UTILITY(",1)="" X DSC(16061.05) S D=$N(^(0)) G M6 S D=$S($D(^DIZ(16061,DA,"C",0)):$P(^(0),U,3,4),1:$N(^(0))) M6 I D>0 S DC=DC_D I $D(^DIZ(16061,DA,"C",+D,0)) S DE(6)=$P(^(0),U,1) G RE R6 D DE S D=1 G 6+1 ; 7 G 0^DIE17 XAK1^INT^1^60169,79033^0 XAK1 ; ;10/10/89 D DE G BEGIN DE S DIE="^DIZ(16061,D0,""C"",",DIC=DIE,DP=16061.05,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$N(^DIZ(16061,D0,"C",DA,-1))<0 I $D(^(0)) S %Z=^(0) S %=$P(%Z,"^",1) S:%]"" DE(1)=% K %Z Q ; W W !?DL+DL-2,DLB_": " Q O D W W Y W:$X>45 !?9 I $L(Y)>19,'DV,(DV["F"!(DV["K")) G RW^DIED W:Y]"" "// " I 'DV,DV["I" S X="" W " (No Editing)" Q TR R X:DTIME E S (DTOUT,X)=U W *7 Q A K DQ(DQ) S DQ=DQ+1 B G @DQ RE G PR:$D(DE(DQ)) D W,TR N I X="" G A:DV'["R",X:'DV,X:D'>0,A RD G QS:X?."?" I X["^" D D G ^DIE17 I X="@" D D G Z^DIE2 I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W " "_X T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) S %=$P($P(";"_DU,";"_X_":",2),";"),Y=X I %]"" X:$D(DIC("S")) DIC("S") I W:'$D(DB(DQ)) " "_% G V F %=1:1 S Y=$P(DU,";",%),DG=$F(Y,":"_X) G X:Y="" S YS=Y,Y=$P(Y,":") I DG X:$D(DIC("S")) DIC("S") I Q:DG W:'$D(DB(DQ)) $E(YS,DG,999) S X=$P(YS,":") P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) I DV'["*" D ^DIC S X=+Y,DIC=DIE G X:X<0 G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z I +$P(DV,",",2),X[".",$P(DQ(DQ),U,5)'["$" S X=$S($P(X,"00")="":"",$E(X)[0:$E(X,2,$L(X)),1:X) S:$E($P(X,".",2),$L($P(X,".",2)))[0 X=$E(X,1,$L(X)-1) I $P(X,".",2)=""&(X[".") S X=+X V D @("X"_DQ) K YS Z K DIC("S"),DLAYGO I $D(X),X'=U S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A X W *7,"??" I $D(DB(DQ)) G Z^DIE17 S X="?BAD" QS S DZ=X D D,QQ^DIEQ G B D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q Y I '$D(DE(DQ)) D O G A:X="@",RD:X]"" S X=Y G N PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP R I DG["P",@("$D(^"_X_"0))") S X=+$P(^(0),U,2) G RP:'$D(^(Y,0)) S Y=$P(^(0),U),X=$P(^DD(X,.01,0),U,3),DG=$P(^(0),U,2) G R I DG["V",+Y,$D(@(U_$P(Y,";",2)_"0)")) S X=+$P(^(0),U,2) G RP:'$D(^(+Y,0)) S Y=$P(^(0),U) I $D(^DD(+X,.01,0)) S DG=$P(^(0),U,2),X=$P(^(0),U,3) G R X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=% RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17 I I DV'["I",DV'["#" G RD D E^DIE0 G RD:$D(X),PR Q BEGIN S DNM="XAK1",DQ=1+D G B 1 S DW="0;1",DV="MF",DU="",DLB="CITY",DIFLD=.01 S DE(DW)="C1^XAK1" G RE:'D S DQ=2 G 2 C1 G C1S:$D(DE(1))[0 K DB S X=DE(1),DIC=DIE K ^DIZ(16061,DA(1),"C","B",$E(X,1,30),DA) C1S S X="" Q:DG(DQ)=X K DB S X=DG(DQ),DIC=DIE S ^DIZ(16061,DA(1),"C","B",$E(X,1,30),DA)="" Q X1 K:$L(X)>30!($L(X)<2) X I $D(X),X'?.ANP K X Q ; 2 G 1^DIE17 XG^INT^1^60169,79033^0 XG ;SFISC/VYD - GUI MWAPI or ANSI term K-WAPI driver ;10/03/94 11:57 ;;8.0T19;KERNEL;;Feb 22, 1995 PREP ;prepare GUI environment ;S XGWIN=$S($D(^$DI):"^$W",1:"^TMP(""XGW"",$J)") S XGWIN="^$W" ;*************************************************************** ;note: if PREP+1 errors out or doesn't work, ;comment it out and use PREP+2 ;*************************************************************** S:$D(KWAPI) XGWIN="^TMP(""XGW"",$J)" S XGDI=$S(XGWIN="^$W":"^$DI",1:"^TMP(""XGD"",$J)") S XGEVENT=$S(XGWIN="^$W":"^$E",1:"^TMP(""XGE"",$J,1000000)") D:XGWIN'="^$W" PREP^XGSETUP,KWAPI^XGSETUP Q ; ; S(P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11) ;K-WAPI equivalent of S ^$W(...)=... I XGWIN="^$W" D ;check if MWAPI is supported . I '$D(P4) S ^$W(P1,P2)=P3 Q . I '$D(P5) S ^$W(P1,P2,P3)=P4 Q . I '$D(P6) S ^$W(P1,P2,P3,P4)=P5 Q . I '$D(P7) S ^$W(P1,P2,P3,P4,P5)=P6 Q . I '$D(P8) S ^$W(P1,P2,P3,P4,P5,P6)=P7 Q . I '$D(P9) S ^$W(P1,P2,P3,P4,P5,P6,P7)=P8 Q . S ^$W(P1,P2,P3,P4,P5,P6,P7,P8)=P9 Q E D S^XGSET ;K-WAPI emulation Q ; ; M(P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11) ;K-WAPI equivalent of M ^$W(...)=... I XGWIN="^$W" D ;check if MWAPI is supported . I '$D(P2) M ^$W=@P1 Q . I '$D(P3) M ^$W(P1)=@P2 Q . I '$D(P4) M ^$W(P1,P2)=@P3 Q . I '$D(P5) M ^$W(P1,P2,P3)=@P4 Q . I '$D(P6) M ^$W(P1,P2,P3,P4)=@P5 Q . I '$D(P7) M ^$W(P1,P2,P3,P4,P5)=@P6 Q . I '$D(P8) M ^$W(P1,P2,P3,P4,P5,P6)=@P7 Q . I '$D(P9) M ^$W(P1,P2,P3,P4,P5,P6,P7)=@P8 Q . M ^$W(P1,P2,P3,P4,P5,P6,P7,P8)=@P9 Q E D M^XGMERG ;K-WAPI emulation Q ; ; K(P1,P2,P3,P4,P5,P6,P7,P8) ;K-WAPI equivalent of K ^$W(...) I XGWIN="^$W" D ;check if MWAPI is supported . I '$D(P1) K ^$W Q . I '$D(P2) K ^$W(P1) Q . I '$D(P3) K ^$W(P1,P2) Q . I '$D(P4) K ^$W(P1,P2,P3) Q . I '$D(P5) K ^$W(P1,P2,P3,P4) Q . I '$D(P6) K ^$W(P1,P2,P3,P4,P5) Q . I '$D(P7) K ^$W(P1,P2,P3,P4,P5,P6) Q . I '$D(P8) K ^$W(P1,P2,P3,P4,P5,P6,P7) Q . K ^$W(P1,P2,P3,P4,P5,P6,P7,P8) Q E D K^XGKILL ;K-WAPI emulation Q ; ; SD(P1,P2,P3) ;K-WAPI equivalent of S ^$DI(P1,P2)=P3 I XGWIN="^$W" S ^$DI(P1,P2)=P3 ;set into ^$DI if MWAPI is supported E D SD^XGSET ;K-WAPI emulation Q ; ; MD(P1,P2,P3) ;K-WAPI equivalent of M ^$DI(...)=... I XGWIN="^$W" D ;check if MWAPI is supported . I '$D(P2) M ^$DI=@P1 Q . I '$D(P3) M ^$DI(P1)=@P2 Q . M ^$DI(P1,P2)=@P3 Q E D MD^XGMERG ;K-WAPI emulation Q ; ; KD(P1,P2) ;K-WAPI equivalent of K ^$DI(...) I XGWIN="^$W" D ;check if MWAPI is supported . I '$D(P1) K ^$DI Q . I '$D(P2) K ^$DI(P1) Q . K ^$DI(P1,P2) Q E D KD^XGKILL ;K-WAPI emulation Q ; ; KE(P1) ;K-WAPI equivalent of K ^$E(P1) I XGWIN="^$W" K ^$E(P1) ;kill ^$E if MWAPI is supported E D KE^XGKILL ;K-WAPI emulation Q ; ; ESTART(XGTO) G ESTA1 ESTA(XGTO) ;K-WAPI equivalent of ESTART timeout ESTA1 I XGWIN="^$W" D ;check if MWAPI is supported . I '$D(XGTO) ESTART I 1 . E X "ESTART "_XGTO ;compensate for MSM's bug of timeouts in variable E D ESTA^XGEVNT ;K-WAPI emulation Q ; ; ESTOP ;K-WAPI equivalent of ESTOP ESTO ; I XGWIN="^$W" ESTOP ;if MWAPI is supported E D ESTO^XGEVNT1 ;K-WAPI emulation Q ; ; ETRIGGER(P1,P2,P3,P4,P5,P6,P7,P8) G ETR1 ETR(P1,P2,P3,P4,P5,P6,P7,P8) ;K-WAPI equivalent of ETR ^$W(...):... ETR1 I XGWIN="^$W" D ;check if MWAPI is supported . I '$D(P4) ETR ^$W(P1,P2,P3) Q . I '$D(P5) ETR ^$W(P1,P2,P3):@P4 Q . I '$D(P6) ETR ^$W(P1,P2,P3,P4,P5) Q . I '$D(P7) ETR ^$W(P1,P2,P3,P4,P5):@P6 Q . I '$D(P8) ETR ^$W(P1,P2,P3,P4,P5,P7) Q . ETR ^$W(P1,P2,P3,P4,P5,P6,P7):@P8 Q E D ETR^XGEVNT1 ;K-WAPI emulation Q ; ; WFONT(FONTFACE,FONTSIZE,FONTSTYL,UNITSPEC) ;K-WAPI equivalent of $WFONT N XGRESULT I XGWIN="^$W" D ;check if MWAPI is supported . S XGRESULT=$WFONT(FONTFACE,FONTSIZE,FONTSTYL,UNITSPEC) E S XGRESULT="20,8,8" ;K-WAPI emulation Q XGRESULT ; ; WTFIT(EXPR,NUMEXPR,FONTFACE,FONTSIZE,FONTSTYL,UNITSPEC) ;K-WAPI equiv $WTFIT N XGRESULT I XGWIN="^$W" D ;check if MWAPI is supported . S XGRESULT=$WTFIT(EXPR,NUMEXPR,FONTFACE,FONTSIZE,FONTSTYL,UNITSPEC) E ;K-WAPI emulation Q XGRESULT ; ; WTWIDTH(EXPR,FONTFACE,FONTSIZE,FONTSTYL,UNITSPEC) ;K-WAPI equiv $WTWIDTH N XGRESULT I XGWIN="^$W" D ;check if MWAPI is supported . S XGRESULT=$WTWIDTH(EXPR,FONTFACE,FONTSIZE,FONTSTYL,UNITSPEC) E S XGRESULT=$$WTWIDTH^XGWT ;K-WAPI emulation Q XGRESULT ; ; CLEAN ;clean up graphics environment I XGWIN="^$W" K XGWIN,XGDI,XGEVENT E D CLEAN^XGSETUP ;K-WAPI emulation Q XGC02^INT^1^60169,79033^0 XGC02 ;ISC-SF/JLI - SOME MWAPI FUNCTIONS ;1/24/95 14:35 ;;8.0T19;KERNEL;;Feb 22, 1995 ;; Q EVENT ; N XGSEQ S XGSEQ=$G(@XGEVENT@("SEQUENCE")) ;M ^TMP("$E",$J,XGSEQ)=@XGEVENT@ ; THIS DOESN'T WORK, ALTHOUGH IT SHOULD S ^TMP("$E",$J,XGSEQ,"WINDOW")=@XGEVENT@("WINDOW") S ^TMP("$E",$J,XGSEQ,"CLASS")=@XGEVENT@("CLASS") S ^TMP("$E",$J,XGSEQ,"TYPE")=@XGEVENT@("TYPE") I $D(@XGEVENT@("CHOICE")) S ^TMP("$E",$J,XGSEQ,"CHOICE")=@XGEVENT@("CHOICE") I $D(@XGEVENT@("ELEMENT")) S ^TMP("$E",$J,XGSEQ,"ELEMENT")=@XGEVENT@("ELEMENT") I $D(@XGEVENT@("SEQUENCE")) S ^TMP("$E",$J,XGSEQ,"SEQUENCE")=@XGEVENT@("SEQUENCE") I $D(@XGEVENT@("KEY")) S ^TMP("$E",$J,XGSEQ,"KEY")=@XGEVENT@("KEY") I $D(@XGEVENT@("OK")) S ^TMP("$E",$J,XGSEQ,"OK")=@XGEVENT@("OK") I $D(@XGEVENT@("PBUTTON")) S ^TMP("$E",$J,XGSEQ,"PBUTTON")=@XGEVENT@("PBUTTON") I $D(@XGEVENT@("PPOS")) S ^TMP("$E",$J,XGSEQ,"PPOS")=@XGEVENT@("PPOS") I $D(@XGEVENT@("PSTATE")) S ^TMP("$E",$J,XGSEQ,"PSTATE")=@XGEVENT@("PSTATE") I $D(@XGEVENT@("NEXTFOCUS")) S ^TMP("$E",$J,XGSEQ,"NEXTFOCUS")=@XGEVENT@("NEXTFOCUS") I $D(@XGEVENT@("PRIORFOCUS")) S ^TMP("$E",$J,XGSEQ,"PRIORFOCUS")=@XGEVENT@("PRIORFOCUS") Q ; WINDOW ; N XGSEQ,XWIN S XGSEQ=@XGEVENT@("SEQUENCE") S XWIN=@XGEVETN@("WINDOW") S I="" F S I=$O(@XGWIN@(XWIN,"G",I)) Q:I="" D . I @XGWIN@(XWIN,"G",I,"TYPE")="DOCUMENT" D . . S J=$$DLDOC($NA(@XGWIN@(XWIN,"G",I)),$NA(^TMP("$W",$J,XGSEQ,"G",I,"VALUE"))) . . D K^XG(XWIN,"G",I,"VALUE") M ^TMP("$W",$J,XGSEQ)=@XGWIN@(XWIN) S I="" F S I=$O(@XGWIN@(XWIN,"G",I)) Q:I="" D . I @XGWIN@(XWIN,"G",I,"TYPE")="DOCUMENT" D . . D ULDOC($NA(@XGWIN@(XWIN,"G",I)),$NA(^TMP("$W",$J,XGSEQ,"G",I,"VALUE"))) Q ; ; ---------------------------------------------------------- ; Function DLDOC -- returns number of lines (nodes) in the document ; ; Usage: ; S X=$$DLDOC^XGCUTILA(WINREF,ARREF,MAXLEN) ; ; Arguments: ; WINREF is the reference to the desired DOCUMENT gadget, not ; including the "VALUE" node, this will usually be obtained ; as $NA(@XGWIN@(win_name,"G",doc_name)) ; ARREF is the root for the array location in which the document ; text is to be returned. This is usually a global root, ; but could be a local variable. The contents of this ; root will be deleted prior to unloading the document. ; The document nodes will be a number, and zero subscript ; under the specified root value. ; MAXLEN is the maximum line length desired in a node. Text ; followed by a CR/LF will be taken as the final text on ; the current node. Otherwise characters will be wrapped ; at a length less than or equal to the MAXLEN specified ; such that text on the next node starts with an alphanumeric ; character if possible. If MAXLEN is not specified, the ; default will be 245. ; DLDOC(WINREF,ARREF,MAXLEN) ; N I,%,X,J,K,L,YFLG S YFLG=$S('$D(@WINREF@("YFLAG")):1,1:@WINREF@("YFLAG")) I ^%ZOSF("OS")["DSM"!(XGWIN'="^$W") D Q J . K ^TMP("DLDOC",$J) . I XGWIN="^$W" D . . S I="" F S I=$O(@WINREF@(I)) Q:I="" S:YFLG ^TMP("DLDOC",$J,I,0)=@WINREF@(I) S:'YFLG ^TMP("DLDOC",$J,I)=@WINREF@(I) . I XGWIN'="^$W" D . . S I="" F S I=$O(@WINREF@(I)) Q:I="" S:YFLAG ^TMP("DLDOC",$J,I,0)=@WINREF@(I,0) S:'YFLAG ^TMP("DLDOC",$J,I)=@WINREF@(I,0) . M @ARREF=^TMP("DLDOC",$J) . K ^TMP("DLDOC",$J) . S J=0,I="" F S I=$O(@ARREF@(I)) Q:I'>0 S J=J+1 S %=$C(13)_$C(10) K @ARREF S:'$D(MAXLEN) MAXLEN=245 S I=1,X="",J=0 F S J1=MAXLEN-$L(X)+J,J=J+1,K=$E(@WINREF@("VALUE"),J,J1),J=J1 D:K="" Q:K="" S X=X_K D . I X[% F Q:X'[% S:YFLG @ARREF@(I,0)=$P(X,%) S:'YFLG @ARREF@(I)=$P(X,%) S I=I+1,X=$P(X,%,2,200) . I X="" Q . I $L(X)0:%,1:"") S J=J+1,^TMP("UPLOAD",$J,J)=$L(@WINREF2@("VALUE")) Q . I K="" S @WINREF2@("VALUE")=@WINREF2@("VALUE")_%,J=1 Q . I $E(K,1)=" "!($E(K,1)=$C(9)),J=0 S @WINREF2@("VALUE")=@WINREF2@("VALUE")_% . I $E(K,$L(K))'=" " D . . S J=$O(@ARREF@(I)) . . I J>0 D . . . S J=$S($D(@ARREF@(J))#2:@ARREF@(J),1:@ARREF@(J,0)) . . . I J'="" D . . . . S J=$E(J) . . . . I J'=" "&(J'=$C(9)) D . . . . . S K=K_" " . S J=0 . S @WINREF2@("VALUE")=@WINREF2@("VALUE")_K S @WINREF@("VALUE")=$G(@WINREF@("VALUE"))_@WINREF2@("VALUE") S @WINREF@("YFLAG")=YFLG K @WINREF2 D WAIT^XGLWAIT(0) Q ; XGC1^INT^1^60169,79033^0 XGC1 ;ISC-SF.SEA/JLI - UTILITIES FOR GUI ;12/13/94 15:40 ;;8.0T19;KERNEL;;Feb 22, 1995 ;; SIZE ; Enter/Edit SIZE of current object -- need gadget name, root N PEVENT S PEVENT="RESIZE^JLI1" S Y=GENERIC(PEVENT) S @^TMP("XGCWEDIT",$J,@XGEVENT@("WINDOW"),"ROOT")@("G",GADNAM,"SIZE")=Y Q POSITN ; Q GENERIC ; S WINM=$$NEXTNM^XGCLOAD("W") D LOAD^XGCLOAD("XGCGENERIC",WINM) S ROOT=$NA(^TMP("XGCWEDIT",$J,WINM)) K @ROOT ; D BLDMAP(ROOT) D M^XG(WINM,ROOT) Q RELOC ; N XWIN,ELEM,ROOT,NODE,XGMOV,X,Y,X1,X2 S XWIN=@XGEVENT@("WINDOW"),ELEM=$P(@XGEVENT@("ELEMENT"),",",2) S X=@XGEVENT@("PPOS") S ROOT=$NA(@XGWIN@(XWIN,"G",ELEM,"DRAW")) S NODE=0 F Y=0:0 S Y=$O(@ROOT@(Y)) Q:Y'>0 S NODE=Y S Y=@ROOT@(NODE),X1=X-$P(Y,",",2) S X2=$P(X,",",2)-$P(Y,",",3) S XGMOV(1,"G",ELEM,"DRAW",NODE)=$P(Y,",")_","_(+X)_","_$P(X,",",2)_","_($P(Y,",",4)+X1)_","_($P(Y,",",5)+X2) D M^XG(XWIN,"XGMOV(1)") Q ; RESIZE ; N XWIN,ELEM,ROOT,NODE,XGMOV,X,Y,X1,X2 S XWIN=@XGEVENT@("WINDOW"),ELEM=$P(@XGEVENT@("ELEMENT"),",",2) S X=@XGEVENT@("PPOS") S ROOT=$NA(@XGWIN@(XWIN,"G",ELEM,"DRAW")) S NODE=0 F Y=0:0 S Y=$O(@ROOT@(Y)) Q:Y'>0 S NODE=Y Q:NODE'>0 S Y=@ROOT@(NODE) S XGMOV(1,"G",ELEM,"DRAW",NODE)=$P(Y,",",1,3)_","_(+X)_","_$P(X,",",2) D M^XG(XWIN,"XGMOV(1)") Q ; GOSIZE ; N XWIN S XWIN=@XGEVENT@("WINDOW") D S^XG(XWIN,"G","G1","EVENT","PDOWN","RESIZE^XGC1") Q GOPOS ; N XWIN S XWIN=@XGEVENT@("WINDOW") D S^XG(XWIN,"G","G1","EVENT","PDOWN","RELOC^XGC1") Q ; HELP ; N TXT S TXT(1)="To set POSITION, after selecting from the menu, move the cursor to the TOP LEFT CORNER, and then click the button. The Object will move to that location.",TXT(2)="" S TXT(3)="To set SIZE, after selecting from the menu, move the cursor to the desired location for the BOTTOM RIGHT CORNER, and then click the button. The object size will increase or decrease appropriately.",TXT(4)="" D MESG^XGCWUTL("TXT") Q XGCBIN^INT^1^60169,79033^0 XGCBIN ;ISC-SF.SEA/JLI - SAVE AND RESTORE BINARY OBJECTS ;11/30/94 12:50 ;;8.0T19;KERNEL;;Feb 22, 1995 ; TOFILE(ROOT,FILENAME) ; N CNT,X,X1,I FILNAM I $G(FILENAME)="" D . S DIR(0)="F^3:45",DIR("A")="Enter a Host File",DIR("?")="Enter a filename an d/or path to be used as the binary source file." . D ^DIR K DIR S FILENAME=Y I $D(DIRUT) S FILENAME="" Q:$G(FILENAME)="" I '$D(ZTQUEUED) D . S %ZIS="",%ZIS("HFSNAME")=FILENAME,%ZIS("HFSMODE")="R",IOP="HFS" . D ^%ZIS I 'POP D . . U IO D ^%ZISC U IO(0) . . S DIR(0)="Y",DIR("A")="OVERWRITE CURRENT FILE",DIR("B")="NO" . . S DIR("?",1)="A FILE WITH THE SPECIFIED FILENAME ALREADY EXISTS" . . S DIR("?")="DO YOU WANT TO WRITE OVER IT?" . . D ^DIR K DIR I 'Y S FILENAME="" I FILENAME="" G FILNAM S %ZIS="",%ZIS("HFSNAME")=FILENAME,%ZIS("HFSMODE")="W",IOP="HFS" D ^%ZIS Q:POP S CNT=0,X1="" U IO F S CNT=$O(@ROOT@(CNT)) Q:CNT'>0 D . S X1=$S($D(@ROOT@(CNT))=1:^(CNT),1:^(CNT,0)) . F I=1:2 Q:$E(X1,I)="" D . . S X=$A($E(X1,I))-64*16+($A($E(X1,I+1))-64) W $C(X) D ^%ZISC Q ; TOGLOB(ROOT,FILENAME) ; N X,CNT,X1,%ZIS I $G(FILENAME)="",'$D(ZTQUEUED) D . S DIR(0)="F^3:45",DIR("A")="Enter a Host File",DIR("?")="Enter a filename and/or path to be used as the binary source file." . D ^DIR K DIR S FILENAME=Y I $D(DIRUT) S FILENAME="" I $G(FILENAME)="" Q S %ZIS="",%ZIS("HFSNAME")=FILENAME,%ZIS("HFSMODE")="R",IOP="HFS" D ^%ZIS I POP W:'$D(ZTQUEUED) !!,"SPECIFIED FILE WAS NOT FOUND",!! Q S X="ERR^XGCBIN" S @^%ZOSF("TRAP") K @ROOT S CNT=0,X1="" U IO F R X#1:10 Q:'$T Q:X="" D . S X1=X1_$C($A(X)\16+64)_$C($A(X)#16+64) . I $L(X1)>219 D . . S CNT=CNT+1,@ROOT@(CNT,0)=X1,X1="" . . I '$D(ZTQUEUED),IO'=IO(0),'(CNT#50) U IO(0) W "." U IO END U IO D ^%ZISC I $L(X1) S CNT=CNT+1,@ROOT@(CNT,0)=X1 Q ; ERR ; G END ; BINOBJ(FILENAME) ; CREATE ENTRY IN BINARY OBJECT FILE ; S DIC(0)="AEQML",DIC=8995.9,DLAYGO=8995.9 D ^DIC Q:Y'>0 S DA=+Y S ^XTV(8995.9,DA,1,0)="^8995.91^" S FILENAME=$G(FILENAME) D TOGLOB("^XTV(8995.9,DA,1)",.FILENAME) F I=0:0 S I=$O(^XTV(8995.9,DA,1,I)) Q:$O(^XTV(8995.9,DA,1,+I))'>0 I I>0 D . S ^XTV(8995.9,DA,1,0)="^8995.91^"_I_U_I . S $P(^XTV(8995.9,DA,0),U,2)=FILENAME G BINOBJ ; RESTOBJ(OBJNAME,FILENAME) ; PUT BINARY OBJECT BACK INTO A FILE S X=$G(OBJNAME),DIC(0)=$S(X=""&'$D(ZTQUEUED):"AEQM",1:"M"),DIC=8995.9 D ^DIC Q:Y'>0 S DA=+Y S FILENAME=$S($G(FILENAME)="":$P(^XTV(8995.9,DA,0),U,2),1:FILENAME) D TOFILE("^XTV(8995.9,DA,1)",FILENAME) G RESTOBJ ; MAILBIN(FILENAME,XMY) ; Generate a mail message containing an encoded binary object. N I,XMSUB,XMTEXT S FILENAME=$G(FILENAME) D TOGLOB("^TMP($J)",.FILENAME) I $D(^TMP($J)) D . S ^TMP($J,.9,0)="**BIN "_FILENAME . S I=0 F S I=$O(^TMP($J,I)) Q:$O(^TMP($J,I))'>0 . S ^TMP($J,I+1,0)="**END "_FILENAME . I $D(ZTQUEUED),$D(XMY)'>1 S XMY(DUZ)="" . S XMSUB="ENCODED BINARY FILE: "_FILENAME . S XMTEXT="^TMP($J," . D ^XMD Q ; RESTMAIL(MESGNUM,FILENAME) ; N I,X S FILENAME=$G(FILENAME) K ^TMP($J) M ^TMP($J)=^XMB(3.9,MESGNUM,2) F I=0:0 S I=$O(^TMP($J,I)) Q:I'>0 I $E(^(I,0),1,6)="**BIN " S X=^(0) D . S:FILENAME="" FILENAME=$E(X,7,$L(X)) . F S I=$O(^TMP($J,I)) Q:I'>0 S X=^(I,0) Q:$E(X,1,6)="**END " D . . S ^TMP($J,"A",I,0)=X . I $E(^TMP($J,I,0),1,6)'="**END " Q . D TOFILE("^TMP($J,""A"")",FILENAME) K TMP($J) Q XGCCOMP^INT^1^60169,79033^0 XGCCOMP ;ISC-SF/JLI - COMPILE FROM WINDOW OBJECT FILE ;2/25/94 15:18 ;;8.0T19;KERNEL;;Feb 22, 1995 EN1 ; entry point to have user select the window for compiling ; and to select where the resulting MWAPI structure ; is stored. ; S XGCEDITR="" S XGCWIN=$$WINSLCT^XGCCOMP5() I XGCWIN>0 D . S XBASG=$$GETGLOB^XGCCOMP5() . D:XBASG'="" ENC G EXIT ; ; --------------------------------------------------------------- ; entry point which will use the location specified in the ; variable XBASG. If this value is undefined, it will use ; the EN1 entry point to select both parts ; EN3 ; G:'$D(XBASG) EN1 G:XBASG="" EN1 S XGCWIN=$$WINSLCT^XGCCOMP5() D:XGCWIN>0 ENC G EXIT ; ; ---------------------------------------------------------------- ; ; MAIN ; ; XGCWIN = internal entry number for desired window in Window ; Object file. ; XBASG = root of global to store compiled window in ; ; GET ATTRIBUTES FOR WINDOW AND EXPAND OTHER COMPONENTS ENC ; ; Q:XGCWIN'>0 S XGCEDITR="" Q:'$D(^XTV(8995,XGCWIN,0)) S XOTYP=+$P(^XTV(8995,XGCWIN,0),U,3) Q:$P($G(^XTV(8995.6,XOTYP,0)),U)'="WINDOW" ; K XW,XWNN S XBAS=$E(XBASG,1,$L(XBASG)-1)_")" K @XBAS S XDIC="^XTV(8995,"_XGCWIN_")" S XC=1 S XGCEDITR=1 S XW(XC)=XGCWIN ; The values of the XW array are the entries in ; the window object file either as the window, ; menus, or parent(s) of associated objects. ; The subscript indicates the order in which ; the references were encountered. Note that ; a given object may be referenced more than ; once as an associated object. ; S XNAME=$P(^XTV(8995,+XW(XC),0),U) S XOBJ=+XW(XC) D GETOBJ^XGCCOMP5(XOTYP,XBAS,XDIC) ; go through associated objects and simply ; note the parents. Only done for window. ; XW(XC) holds int entry number for parent S N=0 ; F S N=$O(@XDIC@(2,N)) Q:N'>0 D . S X=$P(@XDIC@(2,N,0),U,2) . S XC=XC+1 . S XW(XC)=X . S XWNN(XC)=N ; also need to know which associated object node ; ; I $D(@XBAS@("MENUBAR")) D ; menubar, as initially loaded is a . S X=@XBAS@("MENUBAR") ; pointer, change to a name and set . S @XBAS@("MENUBAR")=$$MNAM^XGCCOMP5($P(^XTV(8995,X,0),U)) . S XC=XC+1,XW(XC)=X ; the pointer up as an object to be included ; ; ; having completed processing of the ; Window type object, begin to walk ; through the other entries in the ; window object file related as menus ; or associated objects ; F XL=1:0 S XL=$O(XW(XL)) Q:XL'>0 D . I XW(XL)'>0 Q . D NEXT^XGCCOMP1(XBAS,XW(XL),+$G(XWNN(XL)),XGCWIN) Q ; ; ----------------------------------------------------------------- ; EXIT - clean up variables before leaving ; ; EXIT ; K DIC,D0,D1,%DT,NAME,N,N1,NX,NX1,NX2,X,X1,X2,X3,X31,X32,XBAS,XBAS1,XBASG,XC,XGCCOMPA K XDIC,XGCWIN,XL,XN,XNAME,XOBJ,XOT,XOTYP,XOTYPE,XV,XW,XWIN,XWN,XWNN,XWO,XWO1,Y,XGCEDITR Q ; ; ----------------------------------------------------------------- ; LOAD is the entry point used by XGCLOAD if the window needs to ; be compiled ; LOAD ; S XGCWIN=+XGCOBJ S XBASG="^XUTL(""XGC"","_XGCWIN_"," K ^XUTL("XGC",XGCWIN) D ENC I $D(^XUTL("XGC",XGCOBJ))=10 D . S X="N",%DT="TS" . D ^%DT . S ^XUTL("XGC",XGCOBJ)=Y Q XGCCOMP1^INT^1^60169,79033^0 XGCCOMP1 ;ISC-SF..SEA/JLI - CONTINUATION OF WINDOW COMPILATION ;2/14/94 05:22 ;;8.0T19;KERNEL;;Feb 22, 1995 ; ; ------------------------------------------------------------- ; NEXT - this module gets the data for the next window object ; referenced. If it is a gadget or timer, any values ; entered with the associated object entry referring to ; the window object are used to augment or overwrite those ; associated with the parent. NEXT(XBASG,XWO,XWO1,XWIN) ; N XOTYP,XNAME,XOTYPE,XDIC,XBAS S XOTYP=$P(^XTV(8995,+XWO,0),U,3) S XNAME=$P(^XTV(8995,+XWO,0),U) S XOTYPE=$P(^XTV(8995.6,+XOTYP,0),U,2) ; I XOTYPE="G"!(XOTYPE="T") D ; associated objects . S XDIC="^XTV(8995,"_XWIN_",2,"_XWO1_")" . S XNAME=$P(@XDIC@(0),U) . S XBAS=$NA(@XBASG@(XOTYPE,XNAME)) . I XOTYPE="G" D . . S @XBAS@("TYPE")=$P(^XTV(8995.6,+XOTYP,0),U) . D GETOBJ^XGCCOMP5(XOTYP,XBAS,"^XTV(8995,"_XWO_")") ; get parents attributes . ; . D GETASOC^XGCCOMP4(XOTYP,XBAS,XDIC) ; and now any for just this window ; I XOTYPE="M" D ; a Menu Object . S XNAME=$$MNAM^XGCCOMP5(XNAME) . S XBAS=$NA(@XBASG@("M",XNAME)) . S XDIC="^XTV(8995,"_(+XWO)_")" . D GETM^XGCCOMP3(XBAS,XDIC) Q ; ; ----------------------------------------------------------------- ; GETEVNT - go through and get any valid EVENTS and set up nodes ; with call backs ; ; XOTYP - type of object - pointer to the WINDOW OBJECT TYPE file ; XBAS - variable name for subscript indirection under which EVENT ; nodes are to be entered as a descendent ; XDIC - Global entry for subscript indirection under which event ; subscript are to be found ; ; EVENT data is stored in the MWAPI with "EVENT" nodes ; immediately desendent from the window name, for events ; related to the window itself, and descendent from ; associated object (gadgets and timers) names. The ; "EVENT" subscript is followed by a subscript indicating ; the type of event and the value is the call back to be ; used for processing the event. The call back is ; specifed as the argument of a DO command, and must ; include the routine name, and may include a tag and/or ; an argument list. ; ; ^$W("WIN","EVENT",evnt_typ) = call_back ; ; ^$W("WIN","G","GADNAM","EVENT",evnt_typ) = call_back ; ; ^$W("WIN","T:,"TIMRNM","EVENT",evnt_typ) = call_back ; ; Where 'evnt_typ' is one of a select set of keywords, and ; windows, gadgets and timers may respond only to a specific ; subset of the event types determined by the particular type ; of object (a few objects have NO valid events). ; ; 'call_back' indicates a DO argument in the form ^ROUTINE, ; TAG^ROUTINE, ^ROUTINE(ARG_LIST) or TAG^ROUTINE(ARG_LIST) ; in which processing related to the event is to take place. ; ; Menu items may also include the event SELECT. However, the ; format differs for events related to menus, is and is covered ; as part of processing of menus and menu items. ; ; ; Event related information in the Window Object file is stored ; in the event sub-file at node 1 of the file, and in the event ; sub-file at node 1 of the Associated Object sub-file. The ; WINDOW OBJECT EVENT file (8995.5) contains the list of valid ; events (evnt-typ, above), and the WINDOW OBJECT TYPE file ; (8995.6) contains a sub-file with valid event types for each ; of object types. Information on the call back is stored in ; the CALL BACK file (8995.8). ; ; ^XTV(8995,WINOBJ,1,n,0) = EVNT-TYP^CALL-BACK ; ; ^XTV(8995,WINOBJ,2,ASCOBJ,1,n,0) = EVNT-TYP^CALL-BACK ; ; Where 'EVNT-TYP' is a pointer to file 8995.5 ; ; 'CALL-BACK' is a pointer to file 8995.8 ; ; GETEVNT(XOTYP,XBAS,XDIC) ; N N,X1,X3 S N=0 ; F S N=$O(@XDIC@(1,N)) Q:N'>0 D . S X=@XDIC@(1,N,0) ; X=EVENT_TYPE^CALL_BACK . I $D(^XTV(8995.6,XOTYP,2,"B",+X)) D ; check it is valid for object . . S X1=$P(^XTV(8995.5,+X,0),U) ; name of EVENT TYPE . . S X3=$P(X,U,2) ; call back pointer . . I X3="" D Q ; if no call back specified . . . K @XBAS@("EVENT",X1) ; make sure we kill it . . ; . . S XGCCOMPA=$G(^XTV(8995.8,+X3,0)) ; entry in Call Back file . . I XGCCOMPA'="" D . . . S @XBAS@("EVENT",X1)=$P(XGCCOMPA,U,2,3) Q XGCCOMP2^INT^1^60169,79033^0 XGCCOMP2 ;ISC-SF..SEA/JLI - CONTINUATION OF WINDOW COMPILATION ;2/14/94 05:25 ;;8.0T19;KERNEL;;Feb 22, 1995 ; ; ------------------------------------------------------------- ; GETCHOIC - enter CHOICE entries for list boxes, etc. ; ; XOTYP - type of gadget ; XBAS - variable name for subscript indirection under which CHOICE ; nodes are to be entered as a descendent ; XDIC - Global entry for subscript indirection under which choice ; subscript are to be found ; XOBJ - Internal window entry number for gadget or parent of gadget ; ; ; CHOICE nodes in MWAPI are found descendent from the gadget ; for which the CHOICEs are availale (list boxes and ; radio buttons). ; ; ^$W("WIN","G","GNAM","CHOICE",subscrpt)=VALUE ; ; where 'subscrpt' is used to order the display of the choices ; and 'VALUE' is the value displayed for selection and, if ; selected, returned in the "VALUE" node. ; ; These choices are processed here. Choices are also found ; in Menu Objects, but those entries have a different ; format and are handled during the processing of menus ; ; ; In the Window Object file, choice data related to gadgets is ; found at node 4 for main entries and in the associated object ; subfile. It is also possible to enter some choice information ; in the ATTRIBUTE NAME subfile under associated objects. ; ; ^XTV(8995,WINOBJ,4,n,0) = SUBSCRIPT^VALUE ; ; ^XTV(8995,WINOBJ,2,ASCOBJ,4,n,0) = SUBSCRIPT^VALUE ; GETCHOIC(XOTYP,XBAS,XDIC) ; N I,XVAR,X,NX,NX1,NX2,XOBJ I '$P(^XTV(8995.6,XOTYP,0),U,4) Q ; only if CHOICE is valid ; I $$CHOICVAR(XBAS,XDIC) Q ; If CHOICE in VARIABLE and loaded ; if not CHOICE in VARIABLE ; check for fixed CHOICEs S I=0 F S I=$O(@XDIC@(4,I)) Q:I'>0 D . S NX=@XDIC@(4,I,0) . I NX'="" D . . S NX1=$P(NX,U) . . S NX2=$P(NX,U,2) . . ;S:NX1'=+NX1 NX1=""""_NX1_"""" . . I NX2="" D Q . . . K @XBAS@("CHOICE",NX1) . . S @XBAS@("CHOICE",NX1)=NX2 Q ; ; --------------------------------------------------------------- ; CHOICVAR - Check for whether CHOICE data is to be loaded from a ; user specified variable instead of a static set stored ; in the file. ; ; RETURNS: TRUE if CHOICE IN VARIABLE was specified ; ; CHOICVAR(XBAS,XDIC) ; ; ; We are in an associated object if $L(DIC,",")>2 ; In that case, we need to set up to obtain a value ; from the parent to determine the status of CHOICE ; IN VARIABLE, otherwise we just check the current object ; XOBJ is set up to look in the correct place ; S XOBJ=$S($L(XDIC,",")>2:"^XTV(8995,"_$P(@XDIC@(0),U,2)_")",1:XDIC) ; S XVAR="" ; Check for CHOICE in VARIABLE I $D(@XOBJ@(201)),$P(^(201),U,2) D . S XVAR=$P(@XOBJ@(201),U,3) . I $L(XDIC,",")>2 D ; we're looking at child in . . F I=0:0 S I=$O(@XDIC@(2,I)) Q:I'>0 D ; window . . . S X=$P($G(^XTV(8995.7,+@XDIC@(2,I,0),0)),U) ; see if CHOIC-VAR . . . I X="CHOIC-VAR" D ; ATTRIBUTE NAME is . . . . S X=$G(@XDIC@(2,I,1)) ; used, if so get the name . . . . I X="" Q . . . . I X'=XVAR D ; child has different CHOICE VAR . . . . . S XVAR=X ; set up to use values for child . . . . . K @XBAS@("CHOICE") ; delete any entries from parent . I XVAR'="" D . . S:$E(XVAR)'?1U XVAR=U_$E(XVAR,2,$L(XVAR)) ; . . S I="" . . F S I=$O(@XVAR@(I)) Q:I="" D . . . S NX1=I . . . S:NX1'=NX1 NX1=""""_NX1_"""" . . . S NX2=@XVAR@(I) . . . I NX2'="" D . . . . S @XBAS@("CHOICE",NX1)=NX2 Q XVAR'="" XGCCOMP3^INT^1^60169,79033^0 XGCCOMP3 ;ISC-SF..SEA/JLI - CONTINUATION OF WINDOW COMPILATION ;2/23/94 10:34 ;;8.0T19;KERNEL;;Feb 22, 1995 ; ; ----------------------------------------------------------------- ; GETDRAW - go through and get any DRAW commands and set up nodes ; ; XOTYP - type of gadget ; XBAS - variable name for subscript indirection under which DRAW ; nodes are to be entered as a descendent ; XDIC - Global entry for subscript indirection under which draw ; subscript are to be found ; ; In MWAPI drawing instructions are stored in nodes descendent ; from a DRAW node. The nodes are sequenced by numeric subscripts ; in the order in which the drawing instructions are to be ; performed. DRAW commands are only valid for GENERIC gadgets. ; ; ^$W("WIN","G","GADNAM","DRAW",n) = DRAW_INSTRUCTION ; ; where 'DRAW_INSTRUCTION' is a keyword for the type of ; instruction separated from the data elements for the ; instruction by a comma (comma is also used to separate any ; parts of the data elements from each other) ; ; In the WINDOW OBJECT file, DRAW data is stored at node 6 for ; window object entries, and at node 3 in the associated object ; subfile. ; ; ^XTV(8995,WINOBJ,6,n,0) = SUBSCRPT^TYPE^DATA ; ; ^XTV(8995,WINOBJ,2,ASCOBJ,3,n,0) = SUBSCRIPT^TYPE^DATA ; ; where SUBSCRIPT is a numeric value ; ; TYPE is a pointer to the WINDOW OBJECT DRAW TYPE file ; which contains all of the valid types which may ; be selected as well as pattern match information ; on the data elements required for each DRAW type. ; ; DATA is the data element sequence which is concatenated ; with the TYPE NAME and a comma to generate the ; DRAW_INSTRUCTION value for MWAPI ; GETDRAW(XOTYP,XBAS,XDIC) ; N N,X1,X3 I '$P(^XTV(8995.6,XOTYP,0),U,7) Q ; only if DRAW is valid ; S N1=$S($L(XDIC,",")>2:4,1:6) ; get right node for PARENT (6) ; or child (4) S N=0 ; F S N=$O(@XDIC@(N1,N)) Q:N'>0 D . S X=@XDIC@(N1,N,0) ; X=SUBSCRPT^TYPE_PTR^VALUE . S X1=+X ; subscript is a number . S X3=$P($G(^XTV(8995.4,+$P(X,U,2),0)),U) ; DRAW command name . I X3'="" D . . S X3=X3_","_$P(X,U,3) . . S @XBAS@("DRAW",X1)=X3 Q ; ; ------------------------------------------------------------- ; GETM - get menu entries, set up for submenus, handle callbacks ; ; GETM(XBAS,XDIC) ; ; S N=0 F S N=$O(@XDIC@(3,N)) Q:N'>0 D . S X=@XDIC@(3,N,0) . S NX1=$P(X,U) ; subscript for menu item . S NX2=$P(X,U,2) ; displayed menu text . S:NX1'=+NX1 NX1=""""_NX1_"""" . S @XBAS@("CHOICE",NX1)=NX2 . ; . ; . F N1=0:0 S N1=$O(@XDIC@(3,N,1,N1)) Q:N1'>0 D . . S Y=@XDIC@(3,N,1,N1,0) . . S Y1=$G(@XDIC@(3,N,1,N1,1)) . . S XBAS1=$NA(@XBAS@("CHOICE",NX1)) . . S XBAS1=$NA(@XBAS1@(Y)) . . S @XBAS1=Y1 . ; . ; . S X1=+$P(X,U,3) ; pointer to submenu, if one . I X1>0 D Q . . S X2=+$P($G(^XTV(8995,X1,0)),U,3) ; type pointer of submenu . . I $P($G(^XTV(8995.6,X2,0)),U,2)="M" D ; if really a menu . . . S X2=$P(^XTV(8995,X1,0),U) . . . S X2=$$MNAM^XGCCOMP5(X2) ; get name to store . . . S @XBAS@("CHOICE",NX1,"SUBMENU")=X2 ; in MWAPI . . . S XC=XC+1,XW(XC)=X1 ; put pointer to have it . . . ; expanded . ; . ; otherwise, setup call back . ; for menu selection . S XGCCOMPA=$G(^XTV(8995.8,+$P(X,U,4),0)) . I XGCCOMPA'="" D . . S @XBAS@("CHOICE",NX1,"EVENT","SELECT")=$P(XGCCOMPA,U,2,3) Q XGCCOMP4^INT^1^60169,79033^0 XGCCOMP4 ;ISC-SF..SEA/JLI - CONTINUATION OF WINDOW COMPILATION ;2/14/94 05:08 ;;8.0T19;KERNEL;;Feb 22, 1995 ; ; -------------------------------------------------------------------- ; GETATRIB move attributes for object from Window Object file into ; MWAPI structure. ; ; The values processed here are single value attributes for ; which the attribute name becomes subscript for the associated ; value. The specific attributes permitted for an object type ; (window, gadgets, timers, or menus) are immediately descendent ; from the object name in the MWAPI structure ; ; ^$W("WIN",attr_name) = attr_value ; ; ^$W("WIN","G","GADNAM",attr_name) = attr_value ; ; ^$W("WIN","T","TIMRNM",attr_name) = attr_value ; ; ^$W("WIN","M","MENUNM",attr_name) = attr_value ; ; The specific attributes in the WINDOW OBJECT file are stored ; at fields numbered above 100 and below 200 (all fields ; have a whole number part indicating the node number and a ; decimal fraction part indicating the piece position on that node). ; Currently field numbers used range between 100.01 and 107.12 ; ; The WINDOW OBJECT ATTRIBUTE file (8995.7) contains all of the ; valid attributes which may be selected (some attributes, such as ; ID, which are generated only by the windowing system are not ; included). Each entry in this file also contains information on ; the field number in for the data element in file 8995. ; ; The WINDOW OBJECT TYPE file (8995.6) contains a sub-field for ; each entry indicating (via a pointer to file 8995.7) the valid ; attributes for that object type. ; ; GETATRIB(XOTYP,XBAS,XDIC) ; N N,X,X1,X2,X3,X31,X32 S N=0 F S N=$O(^XTV(8995.6,XOTYP,1,N)) Q:N'>0 D ; check each valid attr . S X=^XTV(8995.6,XOTYP,1,N,0) ; pointed to for this . ; object type . S X=^XTV(8995.7,+X,0) ; entry in ATTRIB file . S X1=$P(X,U) ; attribute name . S X2=$P(X,U,2) ; field number in file 8995 . I '$D(^DD(8995,+X2,0)) Q . ; . I X1="CHOIC-VAR" Q ; attribute added to permit user to . ; enter CHOIC-VAR as an ATTRIBUTE NAME . ; but don't pass to MWAPI structure . ; . ; the following code determines . ; the node (X31) and piece (X32) . ; where the data is based on the . ; data for the field in ^DD . ; . S XV="" . S X3=$P(^DD(8995,+X2,0),U,4) . S X31=$P(X3,";") . S X32=$P(X3,";",2) . Q:X32'>0 . S:+X31'=X31 X31=""""_X31_"""" . S XV=$P($G(@XDIC@(X31)),U,X32) ; XV is the value . I XV'="" S @XBAS@(X1)=XV Q ; ; --------------------------------------------------------------- ; GETASOC - get data from associated objects sub-file for this ; entry ; GETASOC(XOTYP,XBASG,XDIC) ; N XOBJ ; D OVRRID(@XDIC@(0),XBAS) D GETEVNT^XGCCOMP1(XOTYP,XBAS,XDIC) ; D GETCHOIC^XGCCOMP2(XOTYP,XBAS,XDIC) D GETDRAW^XGCCOMP3(XOTYP,XBAS,XDIC) ; D ASOCATRB^XGCCOMP5(XOTYP,XBAS,XDIC) ; Q ; ; -------------------------------------------------------------- ; OVRRID - this segment overrides or removes entries for POS, ; SIZE and/or TITLE from the parent or supplies values ; which might have been ommitted. ; ; the following lines set a non-NULL value for the attribute, ; overiding any value that the parent had set ; UNLESS the value is ~. in which case, the node is deleted. ; OVRRID(X,XBAS) ; I $P(X,U,3)'="",$P(X,U,3)'="~" S @XBAS@("POS")=$P(X,U,3) I $P(X,U,3)="~" K @XBAS@("POS") ; I $P(X,U,4)'="",$P(X,U,4)'="~" S @XBAS@("SIZE")=$P(X,U,4) I $P(X,U,4)="~" K @XBAS@("SIZE") ; I $P(X,U,5)'="",$P(X,U,5)'="~" S @XBAS@("TITLE")=$P(X,U,5) I $P(X,U,5)="~" K @XBAS@("TITLE") Q XGCCOMP5^INT^1^60169,79033^0 XGCCOMP5 ;ISC-SF..SEA/JLI - COMPILATION OF WINDOWS CONTINUED ;2/15/94 09:15 ;;8.0T19;KERNEL;;Feb 22, 1995 ; ; ---------------------------------------------------------------- ; ASOCATRB - get entries from the ATTRIBUTE NAME subfile for this ; associated object. ; ; The ATTRIBUTE NAME subfile was created as a means to permit ; the user to either over-ride data from the parent or to add ; additional attributes for this instantiation for less commonly ; used attributes. The subfile entry is a text pointer to the ; WINDOW OBJECT ATTRIBUTE file (8995.7), so the text must match ; one of the attributes. In addition, the attributes are compared ; to those indicated in the WINDOW OBJECT TYPE file (8995.6) as ; valid for the current object type. The value for the attribute ; is stored on the 1 (one) node in the multiple. ; ; In addition to the single value attributes, the ATTRIBUTE NAME ; entry may begin with 'CHOICE,' or 'EVENT,' or 'DATA,' ; where the comma is followed by one or more additional subscripts ; separated by commas. During compilation into the MWAPI ; structure, each comma-delimited piece is used as a separate ; subscript. ; ASOCATRB(XOTYP,XBAS,XDIC) ; S N1=0 F S N1=$O(@XDIC@(2,N1)) Q:N1'>0 D . S X=@XDIC@(2,N1,0) . S X1=$G(@XDIC@(2,N1,1)) . S XBAS1=$E(XBAS,1,$L(XBAS)-1)_"," . F Q:X="" S XBAS1=XBAS1_""""_$P(X,",")_"""" D . . S X=$P(X,",",2,99) . . Q:X="" . . S XBAS1=XBAS1_"," . S @(XBAS1_")")=X1 Q ; --------------------------------------------------------------- ; MNAM - convert subscript names for MENU entries to all alpha- ; numeric by converting spaces to zero characters. This ; was consolidated here in case the mode of handling this ; is changed in the future. ; ; NAME is the character string to be converted ; MNAM(NAME) ; Q $TR(NAME," ","0") ; --------------------------------------------------------------- ; ; Select a window from the Window Object file WINSLCT() ; S DIC=8995,XGCEDITR=0 S DIC(0)="AEQM" S DIC("S")="I $P($G(^XTV(8995.6,+$P(^(0),U,3),0)),U)=""WINDOW""" D ^DIC K DIC Q +Y ; --------------------------------------------------------------- ; Determine global node to place window ; structure in before merging ; GETGLOB() ; S XBASG="" R !,"GLOBAL NODE FOR BUILDING: ",X:DTIME Q:'$T!(X="")!(X=U) XBASG S:$E(X)'=U X=U_X I X?1"^"1U.E D . S:$E(X,$L(X))=")" X=$E(X,1,$L(X)-1) . S:X?1"^"1U.8UN X=X_"(" . S:($E(X,$L(X))'="(")&($E(X,$L(X))'=",") X=X_"," . S XBASG=X Q XBASG ; ; ----------------------------------------------------------------- ; GETOBJ - move the attributes, etc for an object into ; the MWAPI format. This handles the WINDOW OBJECT ; entries other than Menu-type objects. It fills in ; for parents of associated objects as well as the ; primary window. ; GETOBJ(XOTYP,XBAS,XDIC) ; ; D GETATRIB^XGCCOMP4(XOTYP,XBAS,XDIC) ; get the basic attributes ; D GETEVNT^XGCCOMP1(XOTYP,XBAS,XDIC) ; and events ; D GETCHOIC^XGCCOMP2(XOTYP,XBAS,XDIC) ; choices ; D GETDRAW^XGCCOMP3(XOTYP,XBAS,XDIC) ; and drawing instructions ; Q XGCDIC^INT^1^60169,79033^0 XGCDIC ;ISC-SF.SEA/JLI - DIC LOOKUP UTILITY ;9/28/94 14:57 ;;8.0T19;KERNEL;;Feb 22, 1995 ;; EN(FILE,XGCARRAY,IEN,NEW,TITLE) ; S Y=$$ENM(.FILE,.XGCARRAY,$G(IEN),$G(NEW),$G(TITLE),1) S:Y'>0 Y=-1 I Y'=-1 D . S Y=$O(XGCARRAY("")) . S Y=XGCARRAY(Y) . K XGCARRAY . S XGCARRAY=Y . I Y>0,$D(^DIC(FILE,0,"GL")) S XGCARRAY(0)=@(^("GL")_(+Y)_",0)") Q Y ; ENM(FILE,XGCARRAY,IEN,NEW,TITLE,NVALS) ; N XGCDICS,FIRST,A,A1 I $D(DIC("S")) S XGCDICS=DIC("S") I '$D(IEN) S IEN="" S NVALS=$S('$D(NVALS):10000,NVALS'>0:10000,1:NVALS) S FIRST=$S($D(DIC("B")):DIC("B"),1:"") ENMX ; N XWIN,XGCRWIN S XWIN=$$NEXTNM^XGCLOAD("W") K ^TMP($J,"XX") S XGCRWIN=$S($D(XGCDIR):"XGCW DIR POINTER",1:"XGCW FILE/ENTRY SELECTION") D GET^XGCLOAD(XGCRWIN,$NA(^TMP($J,"XX",XWIN))) S ^TMP($J,"XX",XWIN,"G","LBOX1","SELECTMAX")=NVALS S ^TMP($J,"XX",XWIN,"TITLE")=$S($G(TITLE)'="":TITLE,1:"Selection Window") I NVALS=1 D . S ^TMP($J,"XX",XWIN,"G","LBOX1","EVENT","DBLCLICK")="DONE^XGCDIC" D M^XG(XWIN,$NA(^TMP($J,"XX",XWIN))) I $D(XGCDIR("A")) D LOADDIR^XGCDIR("XGCDIR(""A"")") ; K ^TMP($J,"XX") F I=1,2 D Q:FIRST="" . I FILE=0 D SETLIST1(.FIRST) I 1 . E D GETLIST(.FIRST,IEN) . D M^XG(XWIN,"G","LBOX1","CHOICE",$NA(^TMP("DILISTA",$J))) D LOADIT ; S ^TMP(XWIN,$J,"FILE")=FILE D SD^XG($PD,"FOCUS",XWIN_",TXT1") D . N XWIN . D ESTA^XG() D K^XG(XWIN) S Y=$G(Y,-1) S XGCARRAY=Y Q Y ; GETLIST(FIRST,IEN) ; N X1,X,ID,IDN I '$D(IEN) S IEN="" D LIST^DIC(FILE,IEN,"","",40,.FIRST,"","",$G(DIC("S"))) K ^TMP("DILISTA",$J),^TMP("DILISTB",$J) S IDN=0 F I=0:0 S I=$O(^TMP("DILIST",$J,1,I)) Q:I'>0 D . S N=^TMP("DILIST",$J,1,I),IEN=^TMP("DILIST",$J,2,I) . S ID="" F K=0:0 S K=$O(^TMP("DILIST",$J,"ID",I,K)) Q:K'>0 S X=^(K) D . . ;I $P($G(^DD(FILE,K,0)),U,2)["P" S X1=$P(^(0),U,3) D POINTR . . S ID=ID_$S(ID="":"",1:" ")_X . S ^TMP("DILISTA",$J,(N_U_IEN))=$E(N_$$SPAC^XGCRECV1(30),1,30)_ID ;,^TMP("DILISTB",$J,(N_U_IEN))=ID . I ID'="" S IDN=1 I 'IDN K ^TMP("DILISTB",$J) Q ; KEYUP ; N XWIN,KEY,ELEM,VAL,X1,X2,ARRAYZ,VAL1 S XWIN=@XGEVENT@("WINDOW") S VAL=@XGWIN@(XWIN,"G","TXT1","VALUE") SETVAL S X1=$$GET^XGLVAL("LBOX1","ARRAYZ") S VAL1="" I VAL'="" D . S X1=$NA(@XGWIN@(XWIN,"G","LBOX1","CHOICE")) . S X2=$O(@X1@("")) . D K^XG(XWIN,"G","LBOX1","CHOICE") . S VAL1=$E(VAL,1,$L(VAL)-1)_$C($A($E(VAL,$L(VAL)))-1)_"z" . D M^XG(XWIN,"G","LBOX1","CHOICE","ARRAYZ") . F I=1,2 D . . I FILE=0 D SETLIST1(VAL,50) I 1 . . E D GETLIST(VAL1) . . D M^XG(XWIN,"G","LBOX1","CHOICE",$NA(^TMP("DILISTA",$J))) . D M^XG(XWIN,"G","LBOX1","VALUE","ARRAYZ") . S X2=$O(@X1@(VAL)) S X2=$O(@XGWIN@(XWIN,"G","LBOX1","CHOICE",VAL1)) I $E(X2,1,$L(VAL))=VAL Q NOFIND ; N TEXT I $S(FILE=1:1,'$D(NEW):0,NEW=0:1,1:0) D Q . S TEXT(1)="THERE IS NO MATCH FOR THIS ENTRY!" . S TEXT=$$MESG1^XGLMSG("TEXT") S TEXT(1)="THERE IS NO MATCH TO THIS ENTRY CURRENTLY, DO YOU WANT TO ***ADD*** A NEW ENTRY?" Q:'$$MESG2^XGCWUTL("TEXT") I $D(NEW),NEW'="" S TEXT="S Y="_NEW X TEXT I 1 E S Y=$$ADD^XGCDIC1(FILE,VAL,.XGCARRAY) ;S Y=$$NEWOBJ^XGCWED2(VAL) I Y'=-1,NVALS=1 K XGCARRAY S XGCARRAY(1)=Y D ESTO^XG I Y'=-1 S VAL=$P(Y,U,2) G SETVAL ;D ESTO^XG Q ; DONE ; N ZARRAY,I,A,J K XGCARRAY S Y=$$GET^XGLVAL("LBOX1","ZARRAY") I Y>0 D . S A="",I=0 F S A=$O(ZARRAY(A)) Q:A="" D . . S J=$P(A,U,2)_U_$P(A,U),I=I+1 . . S XGCARRAY(I)=J D ESTO^XG Q ; N XWIN,ELEM,VAL S XWIN=@XGEVENT@("WINDOW"),ELEM=@XGEVENT@("ELEMENT") S VAL=$O(@XGWIN@(XWIN,"G",$P(ELEM,",",2),"VALUE","")) S Y=$P(VAL,U,2)_U_$P(VAL,U) Q INVALID ; S Y=-1 D ESTO^XG Q ; POINTR ; Q:X="" S X1=U_X1,X=$P($G(@(X1_X_",0)")),U) S X1=$P($G(@(X1_"0)")),U,2) I $P(^DD(X1,.01,0),U,2)["P" S X1=$P(^(0),U,2) G POINTR Q ; EN2(INARRAY,TITLE) ; N ZZARRAY S ZZARRAY=$$EN2M(.INARRAY,.ZZARRAY,$G(TITLE),1) Q $S(ZZARRAY'>0:-1,1:ZZARRAY(1)) ; EN2M(INARRAY,XGCARRAY,TITLE,NVALS) ; N FILE,VALUES,AREF S NVALS=$G(NVALS) I NVALS'>0 S NVALS=10000 M VALUES=INARRAY S AREF="VALUES" S FILE=0 D SETLIST G ENMX ; SELARR(INARRAY,TITLE) ; N ZZARRAY S ZZARRAY=$$SELARRM(INARRAY,.ZZARRAY,$G(TITLE),1) Q $S(ZZARRAY'>0:-1,1:ZZARRAY(1)) ; SELARRM(INARRAY,XGCARRAY,TITLE,NVALS) ; N FILE,AREF S NVALS=$G(NVALS) I NVALS'>0 S NVALS=10000 S AREF=INARRAY S FILE=0 D SETLIST G ENMX ; SETLIST ; N A K ^TMP("DILISTB",$J) S A="" F S A=$O(@AREF@(A)) Q:A="" S ^TMP("DILISTB",$J,(@AREF@(A)_U_A))=@AREF@(A) Q SETLIST1(START) ; N A,N K ^TMP("DILISTA",$J) S:'$D(START) START="" S:START'="" START=$E(START,1,$L(START)-1)_$C($A($E(START,$L(START)))-1)_"z" S A=START,N=0 F Q:N'<40 S A=$O(^TMP("DILISTB",$J,A)) Q:A="" D . S ^TMP("DILISTA",$J,A)=^TMP("DILISTB",$J,A) . S N=N+1 Q LOADIT ; K ^TMP($J,"XX"),^TMP($J,"XX1") S A="" F S A=$O(XGCARRAY(A)) Q:A="" S A1=XGCARRAY(A),A1=$P(A1,U,2)_U_$P(A1,U) S ^TMP($J,"XX",A1)="" I '$D(^TMP("DILISTA",$J,A1)) S ^TMP($J,"XX1",A1)=$P(A1,U) ; I $D(^TMP($J,"XX1")) D M^XG(XWIN,"G","LBOX1","CHOICE",$NA(^TMP($J,"XX1"))) K ^TMP($J,"XX1") I $D(^TMP($J,"XX")) D M^XG(XWIN,"G","LBOX1","VALUE",$NA(^TMP($J,"XX"))) K ^TMP($J,"XX") Q XGCDIC1^INT^1^60169,79033^0 XGCDIC1 ;ISC-SF.SEA/JLI - GENERIC ADD ENTRY TO FILE ;9/28/94 14:58 ;;8.0T19;KERNEL;;Feb 22, 1995 ;; Q ; CLOSE ; I $D(XGCWROOT) D . K @XGCWROOT D ESTO^XG Q ADD(FILE,NAME,YARRAY) ; N XWIN,XL,X,X1,A K YARRAY S XWIN=$$NEXTNM^XGCLOAD("W") K ^TMP($J,XWIN) D GET^XGCLOAD("XGCW ADD ENTRY (GENERIC)",$NA(^TMP($J,XWIN))) S ^TMP($J,XWIN,"TITLE")=^TMP($J,XWIN,"TITLE")_" - "_$O(^DD(FILE,0,"NM","")) S ^TMP($J,XWIN,"G","TXTX01","TITLE")=$O(^DD(FILE,0,"NM",""))_" "_$P(^DD(FILE,.01,0),U) I $D(NAME) S ^TMP($J,XWIN,"G","TXTX01","VALUE")=NAME S ^TMP($J,XWIN,"G","TXTX01","NEXTG")="OK",XL="TXTX01" S X1=40 F A=0:0 S A=$O(^DD(FILE,0,"ID",A)) Q:A'>0 D . S X="TXT"_A I X["." S X=$P(X,".")_"X"_$P(X,".",2) . S Y=$NA(^TMP($J,XWIN,"G",X)) . S X1=X1+60,@Y@("POS")="10,"_X1 . S @Y@("SIZE")="500,30" . S @Y@("TITLE")=$P(^DD(FILE,A,0),U) . S @Y@("TYPE")="TEXT" . S ^TMP($J,XWIN,"G",XL,"NEXTG")=X . S @Y@("NEXTG")="OK" . S XL=X D M^XG(XWIN,$NA(^TMP($J,XWIN))) D SD^XG($PD,"FOCUS",XWIN) D . N XWIN . D ESTART^XG() D K^XG(XWIN) Q Y ; ADDOK ; N XWIN,VAL,A,N,KEY S XWIN=@XGEVENT@("WINDOW") K ^TMP($J,"FDA") S KEY=1 S A="TXT" F S A=$O(@XGWIN@(XWIN,"G",A)) Q:$E(A,1,3)'="TXT" D . S VAL=@XGWIN@(XWIN,"G",A,"VALUE") . I VAL="" S KEY=0 Q . S N=$E(A,4,$L(A)) I N["X" S N=$P(N,"X")_"."_$P(N,"X",2) . S ^TMP($J,"FDA",FILE,"+1,",N)=VAL I 'KEY D Q . S TEXT(1)="There MUST be an entry for each field BEFORE the new entry can be added to the file." . S VAL=$$MESG1^XGLMSG("TEXT") K IENVAL,^TMP("DIERR",$J) D UPDATE^DIE("ES",$NA(^TMP($J,"FDA")),"IENVAL") I '$D(^TMP("DIERR",$J)) D D ESTO^XG . S Y=IENVAL(1)_U_@XGWIN@(XWIN,"G","TXTX01","VALUE")_U_1 S N=0 K ^TMP($J,"DIERR") F A=0:0 S A=$O(^TMP("DIERR",$J,A)) Q:A'>0 D . F Y=0:0 S Y=$O(^TMP("DIERR",$J,A,"TEXT",Y)) Q:Y'>0 D . . S N=N+1,^TMP($J,"DIERR",N)=^TMP("DIERR",$J,A,"TEXT",Y) . S N=N+1,^TMP($J,"DIERR",N)="" S N=$$MESG1^XGLMSG($NA(^TMP($J,"DIERR"))) Q ; ADDCAN ; S Y=-1 D ESTO^XG Q ; TEXTLIST(XGCLIST,NVALS) ; N XWIN,NEWLIST I '$D(NVALS) S NVALS=0 S XWIN=$$NEXTNM^XGCLOAD("W") D LOAD^XGCLOAD("XGCW TEXT LIST",XWIN) I $D(XGCLIST)>1 D . N A,NEWLIST . S A="" F S A=$O(XGCLIST(A)) Q:A="" S NEWLIST(XGCLIST(A))=XGCLIST(A) . D M^XG(XWIN,"G","LEBOX1","CHOICE","NEWLIST") D SD^XG($PD,"FOCUS",XWIN_",LEBOX1") D . N XWIN . D ESTA^XG() D K^XG(XWIN) Q $G(Y,-1) ; TLADD ; N VAL,XWIN,N,A S XWIN=@XGEVENT@("WINDOW") S VAL=$$GET^XGLVAL("LEBOX1") I VAL=""!(VAL=-1) Q I $D(@XGWIN@(XWIN,"G","LEBOX1","CHOICE",VAL)) D Q . D K^XG(XWIN,"G","LEBOX1","CHOICE",VAL) . D S^XG(XWIN,"G","LEBOX1","VALUE","") . D SD^XG($PD,"FOCUS",XWIN_",LEBOX1") I NVALS>0 D . S N=0,A="" F S A=$O(@XGWIN@(XWIN,"G","LEBOX1","CHOICE",A)) Q:A="" S N=N+1 . I N'0:-1,1:$$EN^XGCDIC(FILE,.YARRAY,$G(IEN),$G(NEW),$G(TITLE))) Q Y ; SETFILE(ELIGIBLE) ; N XFILE,Y I $S('$D(ELIGIBLE):1,$D(ELIGIBLE)>1:0,ELIGIBLE="":1,1:0) D . N DIC . S DIC("S")="I +Y'<2" . S Y=$$EN^XGCDIC(1) I $D(ELIGIBLE) D . I $D(ELIGIBLE)>1 D . . M XFILE=ELIGIBLE . . F Y=0:0 S Y=$O(XFILE(Y)) Q:Y'>0 I $D(^DIC(Y,0)) S XFILE(Y)=$P(^(0),U) . . S Y=$$EN2^XGCDIC(.XFILE) . I $D(ELIGIBLE)=1,ELIGIBLE'="" D . . S Y=ELIGIBLE . . S Y=Y_$S('$D(^DIC(Y,0)):"",1:U_$P(^(0),U)) I '$D(^DD(+Y)) S Y=-1 Q Y ; MOPEN(FILE,VALUES,IENS,NEW,TITLE,NVALS) ; N JFILE S NVALS=$S('$D(NVALS):1000,NVALS'>0:1000,1:NVALS) M JFILE=FILE S FILE=+$$SETFILE(.JFILE) S Y=$S(FILE'>0:-1,1:$$ENM^XGCDIC(FILE,.VALUES,$G(IEN),$G(NEW),$G(TITLE),NVALS)) S YARRAY=Y Q Y XGCDIC3^INT^1^60169,79033^0 XGCDIC3 ;ISC-SF.SEA/JLI - ATTRIBUTE EDITING [ 03/25/94 4:00 PM ] ;12/16/94 13:21 ;;8.0T19;KERNEL;;Feb 22, 1995 ;; ATTRIB(OBJTYP) ; D CLEAR Q ; CLEAR ; N I,X,X1,ATRBNM I $S('$D(OBJTYP):1,OBJTYP'>0:1,1:0) D Q . D K^XG(XEDWIN,"G","LBOX1","CHOICE") . D S^XG(XEDWIN,"G","TXT2","VALUE","") D S^XG(XEDWIN,"G","LBOX1","EVENT","SELECT","EDIT^XGCDIC3") SETWIN ; D RELOAD Q ; RELOAD ; D RELOAD^XGCDIC3A Q ; EDIT ; D EDIT^XGCDIC3A Q ; SETSIZE() ; N Y,CALLBK S Y=$G(@XGWIN@(XEDWIN,"G","CHK1","VALUE")) I Y!(XGWIN'="^$W") S Y=$$FRETXT() D Q Y . I Y'=-1 D . . I Y="@" D . . . K @CURROOT@(VAL) . . I Y'="@" D . . . S @CURROOT@(VAL)=Y . . S Y=1 S CALLBK="RESIZE^XGC1" S Y=$$SETDRW^XGCWEDIT(GADNAM,XEROOT,CALLBK) I Y'=-1 D . I Y="@" D . . K @CURROOT@("SIZE") . I Y'="@" D . . S @CURROOT@("SIZE")=$P(Y,",",3,4) . . S @CURROOT@("POS")=$P(Y,",",1,2) . S Y=1 Q Y=1 ; SETLOC() ; N Y,CALLBK S Y=$G(@XGWIN@(XEDWIN,"G","CHK1","VALUE")) I Y!(XGWIN'="^$W") S Y=$$FRETXT() D Q Y . I Y'=-1 D . . I (Y'="@")&(Y'="") D . . . S @CURROOT@(VAL)=Y . . S Y=1 S CALLBK="RELOC^XGC1" S Y=$$SETDRW^XGCWEDIT(GADNAM,XEROOT,CALLBK) I Y'=-1 D . I Y="@" D . . K @CURROOT@("POS") . I Y'="@" D . . S @CURROOT@("POS")=$P(Y,",",1,2) . . S @CURROOT@("SIZE")=$P(Y,",",3,4) . S Y=1 Q Y=1 Q ; FRETXT() ; N XWIN,XFROOT S XWIN=$$NEXTNM^XGCLOAD("W") S XFROOT=$NA(^TMP("XGCW TEXT EDIT",$J,XWIN)) D GET^XGCLOAD("XGCW TEXT EDIT",XFROOT) S @XFROOT@("G","TXT1","TITLE")="Enter "_VAL_" Value: " S @XFROOT@("G","TXT1","VALUE")=$G(@CURROOT@(VAL)) I $D(ATRBNM("CHARMAX")) S @XFROOT@("G","TXT1","CHARMAX")=ATRBNM("CHARMAX") S XGCURGAD="TXT1" D M^XG(XWIN,XFROOT) D SD^XG($PD,"FOCUS",XWIN_",TXT1") D . N XWIN . D ESTA^XG() D K^XG(XWIN) Q $G(Y,-1) ; GOTONE ; S Y=@XGWIN@(@XGEVENT@("WINDOW"),"G",XGCURGAD,"VALUE") D ESTO^XG Q Y ; RESTORE ; S Y=$S($D(@CURROOT@(VAL)):@CURROOT@(VAL),1:-1) D ESTO^XG Q Y ; YESNO() ; N XWIN S XWIN=$$NEXTNM^XGCLOAD("W") D GET^XGCLOAD("XGCW YES/NO WINDOW",$NA(^TMP($J,XWIN))) S ^TMP($J,XWIN,"G","RAD1","TITLE")="Select "_VAL_" Value:" D M^XG(XWIN,"^TMP($J,XWIN)") D SD^XG($PD,"FOCUS",XWIN) D . N XWIN . D ESTA^XG() D K^XG(XWIN) Q $G(Y,-1) ; YNVALUE ; S Y=@XGEVENT@("CHOICE") S Y=$S(Y=1:1,Y=2:0,1:-1) D ESTO^XG Q Q -1 EVENT(OBJTYP) ; S XEDWIN=XWIN D S^XG(XWIN,"G","LBOX1","EVENT","SELECT","EVENTED^XGCDIC4") D ERELOAD Q ; ERELOAD ; D ERELOAD^XGCDIC3A Q ; CHOICE(OBJTYP) ; N XTYPE S XEDWIN=XWIN S XTYPE="CHOICE" D S^XG(XEDWIN,"G","LBOX1","EVENT","SELECT","CHOICED^XGCDIC3") D CDRELOAD Q Q DRAW(OBJTYP) ; N XTYPE S XEDWIN=XWIN D S^XG(XEDWIN,"G","LBOX1","EVENT","SELECT","DRAWED^XGCDIC4") S XTYPE="DRAW" D CDRELOAD Q ; CDRELOAD ; D CDRELOAD^XGCDIC3A Q ; CHOICED ; Call back to process CHOICE ADD/Edit N Y D CHOICED1^XGCDIC4 I Y'=-1 D . N XTYPE . S XTYPE="CHOICE" . D CDRELOAD Q CHOICEOK ; D CHOICEOK^XGCDIC4 Q MENU(OBJTYP) ; N XTYPE S XTYPE="CHOICE" S XEDWIN=XWIN D S^XG(XWIN,"G","LBOX1","EVENT","SELECT","MENUED^XGCDIC4") D CDRELOAD ; XGCDIC3A^INT^1^60169,79033^0 XGCDIC3A ;ISC-SF.SEA/JLI - ATTRIBUTE EDITING CONTINUED ;2/10/95 09:11 ;;8.0T19;KERNEL;;Feb 22, 1995 ;; EDIT ; N XWIN,ELEM,VAL,X,X1,Y S XWIN=@XGEVENT@("WINDOW"),ELEM=@XGEVENT@("ELEMENT") S VAL=$O(@XGWIN@(XWIN,"G",$P(ELEM,",",2),"VALUE",0)) S X=0 I VAL'="" S X=1 D . S VAL=@XGWIN@(XWIN,"G",$P(ELEM,",",2),"CHOICE",VAL) I 'X S VAL=@XGWIN@(XWIN,"G",$P(ELEM,",",2),"VALUE") S VAL=$P(VAL," ") S X=+$O(^XTV(8995.7,"B",VAL,0)) S X1=$G(^XTV(8995.7,X,0)) Q:X1="" S ETYP=$P(X1,U,4) S CHKCOD=$P(X1,U,5) S H2ROOT="^XTV(8995.7,"_X_",1)" S Y=-1 I VAL="TYPE"&(CURROOT'=XEROOT) S ETYP="TYPE" D . N DIC S DIC("S")="I ""WINDOW,MENU,TIMER,COMPOSITE""'[$P(^(0),U)" . S Y=$$OPEN^XGCDIC2(8995.6) . I Y'=-1 S @CURROOT@(VAL)=$P(Y,U,2),Y=1 I ETYP="Y" D . S Y=$$YESNO^XGCDIC3() . I Y'=-1 D . . S @CURROOT@(VAL)=Y . . S Y=1 I ETYP="F"!(ETYP="N") D . S Y=$$FRETXT^XGCDIC3() . I Y'=-1,VAL="NEXTG"!(VAL="DEFBUTTON"),'$D(@XEROOT@("G",Y)) D . . N TEXT S TEXT(1)="This selection MUST be an existing GADGET name!" . . S TEXT=$$MESG1^XGLMSG("TEXT") . . S Y=-1 . I Y'=-1 D . . I Y="@" D . . . K @CURROOT@(VAL) . . I Y'="@" D . . . S @CURROOT@(VAL)=Y . . . I Y="",",FSIZE,FSTYLE,UNITS,"[","_VAL_"," K @CURROOT@(VAL) . . S Y=1 I ETYP="POS" D . S Y=$$SETLOC^XGCDIC3() I ETYP="SIZ" D . S Y=$$SETSIZE^XGCDIC3() I ETYP="CLR" D . S Y=$$SETCOLOR^XGCUTIL1($G(@CURROOT@(VAL))) . I Y'=-1 D . . S @CURROOT@(VAL)=Y . . S Y=1 I Y D RELOAD Q ; RELOAD ; K ^TMP($J,"ATRB") FLOOP ; I CURROOT'=XEROOT,$D(@CURROOT@("TYPE")) S OBJTYP=$O(^XTV(8995.6,"B",@CURROOT@("TYPE"),0)) F I=0:0 S I=$O(^XTV(8995.6,OBJTYP,1,I)) Q:I'>0 D . S AP=+^XTV(8995.6,OBJTYP,1,I,0) . S X=$G(^XTV(8995.7,AP,0)) . Q:X="" . S ATRBNM=$P(X,U) . I ATRBNM="CHOIC-VAR" K @CURROOT@(ATRBNM) Q . S ^TMP($J,"ATRB",I)=ATRBNM . S X1="",X=$P(X,U,2) . I $D(@CURROOT@(ATRBNM)) D . . S X1=$G(@CURROOT@(ATRBNM)) . . I ATRBNM="TYPE",X1'="",CURROOT=XEROOT D Q:X1="" . . . I X1="APPLICATION"!(X1="MTERM") Q . . . K @CURROOT@(ATRBNM) S X1="" . . I ATRBNM="MENUBAR" S X1=$$UNMENU^XGCWED1(X1) . . S ^TMP($J,"ATRB",I)=^TMP($J,"ATRB",I)_" "_$S(X1'="":X1,1:"<--null-->") S X1="" F S X1=$O(@CURROOT@(X1)) Q:X1="" D . I ",M,G,T,TYPE,CHOICE,DRAW,EVENT,"[(","_X1_",") D Q . . I CURROOT=XEROOT D . . . I ",M,G,T,TYPE,EVENT,"[(","_X1_",") Q . . . K @CURROOT@(X1) . S I=$O(^XTV(8995.7,"B",X1,0)) I I S I=$O(^XTV(8995.6,OBJTYP,1,"B",I,0)) . I 'I K @CURROOT@(X1) I $D(@CURROOT@("TYPE")),@CURROOT@("TYPE")'="TIMER" S ^TMP($J,"ATRB","TYPE")="TYPE "_@CURROOT@("TYPE") D K^XG(XEDWIN,"G","LBOX1","CHOICE") D M^XG(XEDWIN,"G","LBOX1","CHOICE",$NA(^TMP($J,"ATRB"))) D . N JK S JK=GADNAM I $P(^XTV(8995.6,OBJTYP,0),U)="MENU" S JK=$$UNMENU^XGCWED1(GADNAM) . D S^XG(XEDWIN,"G","TXT2","VALUE",JK) Q ; ERELOAD ; N XVAL F I=0:0 S I=$O(^XTV(8995.6,OBJTYP,2,I)) Q:I'>0 D . S X=+^XTV(8995.6,OBJTYP,2,I,0) . S X=$P(^XTV(8995.5,X,0),U) . S XVAL(X)=X ; S X="" F S X=$O(XVAL(X)) Q:X="" D . S I=$G(@CURROOT@("EVENT",X)) . I I'="" D . . S XVAL(X)=XVAL(X)_" "_I . . F J=0:0 S J=$O(^XTV(8995.8,J)) Q:J'>0 D . . . S Y=^XTV(8995.8,J,0) . . . I I=$P(Y,U,2,3) D . . . . S XVAL(X)=XVAL(X)_" ["_$P(Y,U)_"]" D K^XG(XEDWIN,"G","LBOX1","CHOICE") D M^XG(XEDWIN,"G","LBOX1","CHOICE","XVAL") Q CDRELOAD ; K XVAL,X,I S XVAL(1)="< -- add new -- >" S X="" F I=2:1 S X=$O(@CURROOT@(XTYPE,X)) Q:X="" D . S XVAL(I)=X_"^ "_@CURROOT@(XTYPE,X) . I $D(@CURROOT@(XTYPE,X,"SUBMENU")) D . . S J=I+.1,XVAL(J)=" Submenu: "_$$UNMENU^XGCWED1(@CURROOT@(XTYPE,X,"SUBMENU")) . I $D(@CURROOT@(XTYPE,X,"EVENT","SELECT")) D . . S J=I+.2,XVAL(J)=" Select Event: "_@CURROOT@(XTYPE,X,"EVENT","SELECT") D K^XG(XEDWIN,"G","LBOX1","CHOICE") D M^XG(XEDWIN,"G","LBOX1","CHOICE","XVAL") Q ; XGCDIC4^INT^1^60169,79033^0 XGCDIC4 ;ISC-SF.SEA/JLI - ATTRIBUTE EDITING CONTINUED [ 05/06/94 5:22 AM ] ;9/28/94 15:05 ;;8.0T19;KERNEL;;Feb 22, 1995 ;; CHOICED1 ; N XWIN,NEWCHOIC,VAL,VAL1,XTYPE S XWIN=@XGEVENT@("WINDOW") S VAL=$O(@XGWIN@(XWIN,"G","LBOX1","VALUE",0)) I VAL=1 D . S NEWCHOIC=1,VAL="",VAL1="" I VAL>1 D . S VAL=$P(@XGWIN@(XWIN,"G","LBOX1","CHOICE",VAL),U) . S VAL1=@CURROOT@("CHOICE",VAL) S XWIN=$$NEXTNM^XGCLOAD("W") D LOAD^XGCLOAD("XGCW CHOICE ADD/EDIT",XWIN) D S^XG(XWIN,"G","TXT1","VALUE",VAL) D S^XG(XWIN,"G","TXT2","VALUE",VAL1) D SD^XG($PD,"FOCUS",XWIN_",TXT1") D . N XWIN . D ESTA^XG() D K^XG(XWIN) S XTYPE="CHOICE" D CDRELOAD^XGCDIC3 Q CHOICEOK ; N XWIN,VAL,TXT,SUB S XWIN=@XGEVENT@("WINDOW") S SUB=@XGWIN@(XWIN,"G","TXT1","VALUE") I $D(@CURROOT@("CHOICE",SUB)),$D(NEWCHOIC) D . S TXT(1)=" This SUBSCRIPT is already in use, to add a new entry use a subscript which is not in use.",TXT(2)="" S VAL=@XGWIN@(XWIN,"G","TXT2","VALUE") I VAL="" D . S TXT(3)=" The VALUE for the choice must have a value (i.e., it can not be NULL.",TXT(4)="" I $D(TXT) D Q . D MESG^XGCWUTL("TXT") S @CURROOT@("CHOICE",SUB)=VAL S Y=SUB D ESTO^XG Q ; DRAWED ; N Y,VAL,VAL1,VAL2,XWIN,NEWDRAW S VAL=$O(@XGWIN@(XEDWIN,"G","LBOX1","VALUE",0)) S VAL=@XGWIN@(XEDWIN,"G","LBOX1","CHOICE",VAL) I VAL["add new" D . S VAL1="",VAL2="",VAL="" . S NEWDRAW=1 I VAL'="" D . S VAL=$P(VAL,U) . S VAL1=@CURROOT@("DRAW",VAL) . S VAL2=$P(VAL1,",",2,99),VAL1=$P(VAL1,",") S XWIN=$$NEXTNM^XGCLOAD("W") K ^TMP($J,"ED") D GET^XGCLOAD("XGCW DRAW COMMAND EDIT",$NA(^TMP($J,"ED",XWIN))) S ^TMP($J,"ED",XWIN,"G","TXT1","VALUE")=VAL D . N FILE . S FILE=8995.4 . D GETLIST^XGCDIC("") . M ^TMP($J,"ED",XWIN,"G","LBUT1","CHOICE")=^TMP("DILISTA",$J) S ^TMP($J,"ED",XWIN,"G","LBUT1","VALUE")=VAL1 S ^TMP($J,"ED",XWIN,"G","TXT2","VALUE")=VAL2 D M^XG(XWIN,$NA(^TMP($J,"ED",XWIN))) D SD^XG($PD,"FOCUS",XWIN_",TXT1") D . N XWIN . D ESTA^XG() D K^XG(XWIN) I Y'=-1 D . N XTYPE . S XTYPE="DRAW" . D CDRELOAD^XGCDIC3 Q ; DRAWOK ; D DRAWOK^XGCDIC4A Q ; MENUED ; N Y,VAL,VAL1,VAL2,VAL3,XWIN,NEWMENU,XVAL S VAL1=$O(@XGWIN@(XEDWIN,"G","LBOX1","VALUE",0)) S VAL1=VAL1\1 S VAL=@XGWIN@(XEDWIN,"G","LBOX1","CHOICE",VAL1) I VAL["add new" D . S VAL="",VAL1="",VAL2="",VAL3="",NEWMENU=1 I VAL'="" D . S VAL=$P(VAL,U) . S VAL1=$G(@CURROOT@("CHOICE",VAL)) . S VAL2=$$UNMENU^XGCWED1($G(@CURROOT@("CHOICE",VAL,"SUBMENU"))) . S VAL3=$G(@CURROOT@("CHOICE",VAL,"EVENT","SELECT")) S XVAL("C","TXT1","VALUE")=VAL,XVAL("C","TXT2","VALUE")=VAL1,XVAL("C","SUBMENU","VALUE")=VAL2,XVAL("C","CALBK","VALUE")=VAL3 S XWIN=$$NEXTNM^XGCLOAD("W") D LOAD^XGCLOAD("XGCW MENU ITEM ADD/EDIT",XWIN) D M^XG(XWIN,"G","XVAL(""C"")") D SD^XG($PD,"FOCUS",XWIN_",TXT1") D . N XWIN . D ESTA^XG() D K^XG(XWIN) I Y'=-1 D . N XTYPE S XTYPE="CHOICE" . D CDRELOAD^XGCDIC3 Q SUBMENU ; N VAL,DIC,XWIN,XEWIN S XEWIN=@XGEVENT@("WINDOW") I @XGWIN@(XEWIN,"G","RAD","VALUE")'=1 G SETCLBK S DIC("S")="I $P($G(^XTV(8995.6,+$P(^(0),U,3),0)),U)=""MENU""" S VAL=$$EN^XGCDIC(8995) I VAL>0 D . D S^XG(XEWIN,"G","SUBMENU","VALUE",$P(VAL,U,2)) Q ; MENUOK ; D MENUOK^XGCDIC4A Q ; SETCLBK ; N VAL,VAL1,I,Y S VAL=@XGWIN@(XEWIN,"G","CALBK","VALUE"),VAL1="" I VAL'="" D . I VAL'["^" S VAL=U_VAL . F I=0:0 S I=$O(^XTV(8995.8,I)) Q:I'>0 I $P(^(I,0),U,2,3)=VAL S VAL1=$P(^(0),U) Q S Y=$$CLBKEDIT^XGCDIC5(.VAL,.VAL1) Q:Y=-1 I Y="@" S Y="" D S^XG(XEWIN,"G","CALBK","VALUE",Y) Q ; EVENTED ; N XWIN,VAL,VAL1,Y S XWIN=@XGEVENT@("WINDOW"),EVNTNM=$O(@XGWIN@(XWIN,"G","LBOX1","VALUE","")),EVNTNM=$P(EVNTNM,U) S VAL="",VAL1=$G(@CURROOT@("EVENT",EVNTNM)) I VAL1'="" S:VAL1'[U VAL1=U_VAL1 D . F Y=0:0 S Y=$O(^XTV(8995.8,Y)) Q:Y'>0 I $P(^(Y,0),U,2,3)=VAL1 S VAL=$P(^(0),U) Q S Y=$$CLBKEDIT^XGCDIC5(.VAL,.VAL1) Q:Y=-1 I Y="@" K @CURROOT@("EVENT",EVNTNM) E S @CURROOT@("EVENT",EVNTNM)=Y D ERELOAD^XGCDIC3 Q DELOBJ ; D DELOBJ^XGCDIC5 Q ; CLONE D CLONE^XGCDIC5 Q EDITCB ; D EDITCB^XGCDIC5 Q VIEWCB ; D VIEWCB^XGCDIC5 Q XGCDIC4A^INT^1^60169,79033^0 XGCDIC4A ;ISC-SF.SEA/JLI - CONTINUATION OF ATTRIBUTE EDITING ; ;;8.0T19;KERNEL;;Feb 22, 1995 ;; DRAWOK ; N XWIN,VAL,VAL1,VAL2,TXT S XWIN=@XGEVENT@("WINDOW") S VAL=@XGWIN@(XWIN,"G","TXT1","VALUE") S VAL1=@XGWIN@(XWIN,"G","LBUT1","VALUE") I VAL1'="" S VAL1=@XGWIN@(XWIN,"G","LBUT1","CHOICE",VAL1) S VAL2=@XGWIN@(XWIN,"G","TXT2","VALUE") I VAL=""!(VAL1="")!(VAL2="") D . S TXT(1)=" There must be an entry for each part, the NUMERIC subscript, the DRAW COMMAND name, and the data to go with the DRAW command.",TXT(2)="" I VAL'="",+VAL'=VAL D . S TXT(3)=" The subscript for the draw command must be a number, which is used to determine the sequence in which the draw commands are performed.",TXT(4)="" I $D(TXT) D Q . D MESG^XGCWUTL("TXT") S VAL1=$P(VAL1," ")_","_VAL2 S @CURROOT@("DRAW",VAL)=VAL1 S Y=VAL D ESTO^XG ; MENUOK ; N XWIN,VAL,VAL1,TXT S XWIN=@XGEVENT@("WINDOW") S VAL=@XGWIN@(XWIN,"G","TXT1","VALUE") S VAL1=@XGWIN@(XWIN,"G","TXT2","VALUE") I VAL=""!(VAL1)="" D . S TXT(1)=" There must be AT LEAST a subscript and menu text supplied for the menu item.",TXT(2)="" I VAL'="",$D(NEWMENU),$D(@CURROOT@("CHOICE",VAL)) D . S TXT(3)=" This subscript currently exists. Choose a new subscript designation to add a new entry.",TXT(4)="" I $D(TXT) D Q . D MESG^XGCWUTL("TXT") S @CURROOT@("CHOICE",VAL)=VAL1 S VAL1=@XGWIN@(XWIN,"G","CALBK","VALUE") I VAL1'="" D . S @CURROOT@("CHOICE",VAL,"EVENT","SELECT")=VAL1 . K @CURROOT@("CHOICE",VAL,"SUBMENU") I VAL1="" D . K @CURROOT@("CHOICE",VAL,"EVENT") . S VAL1=@XGWIN@(XWIN,"G","SUBMENU","VALUE") . I VAL1'="" S @CURROOT@("CHOICE",VAL,"SUBMENU")=$$MNAM^XGCCOMP5(VAL1) . E K @CURROOT@("CHOICE",VAL,"SUBMENU") S Y=VAL D ESTO^XG XGCDIC5^INT^1^60169,79033^0 XGCDIC5 ;ISC-SF.SEA/JLI - ATTRIBUTE EDITING CONTINUED [ 03/25/94 4:00 PM ] ;2/9/95 14:25 ;;8.0T19;KERNEL;;Feb 22, 1995 ;; CLBKEDIT(VAL,VAL1) ; N XWIN,XVAL S:'$D(VAL) VAL="" S:'$D(VAL1) VAL1="" S XWIN=$$NEXTNM^XGCLOAD("W") D LOAD^XGCLOAD("XGCW CALLBACK EDIT",XWIN) S XVAL("G","TXTX01","VALUE")=VAL S XVAL("G","TXTX02","VALUE")=$P(VAL1,U) S XVAL("G","TXTX03","VALUE")=$P(VAL1,U,2,99) I $S('$D(DUZ(0)):1,DUZ(0)'="@":1,1:0) S XVAL("G","BUT4","ACTIVE")=0 D M^XG(XWIN,"G","XVAL(""G"")") D SD^XG($PD,"FOCUS",XWIN_",TXTX01") D . N XWIN . D ESTA^XG() D K^XG(XWIN) Q Y CALLBKOK ; N XWIN,X,X1,A1,A2,A3,XVAL,DA S XWIN=@XGEVENT@("WINDOW"),X1=0 S A1=@XGWIN@(XWIN,"G","TXTX01","VALUE") S A2=@XGWIN@(XWIN,"G","TXTX02","VALUE") S A3=@XGWIN@(XWIN,"G","TXTX03","VALUE") I A1'="",$O(^XTV(8995.8,"B",A1,0)) D . S DA=$O(^XTV(8995.8,"B",A1,0)),X=$P(^XTV(8995.8,DA,0),U,2,3) . I A3'="",X=(A2_U_A3) D Q . . S VAL=A1,VAL1=X,Y=X,X1=1 . I A3="" D Q . . S A2=$P(X,U),A3=$P(X,U,2),X1=-1 . I A2="",A3=$P(X,U,2) D Q . . S A2=$P(X,U,1),X1=-1 . D . . S X1=-1 N TXT S TXT(1)="Do you REALLY want to change the callback from "_X_" to "_A2_U_A3_" ??" . . Q:'$$MESG2^XGLMSG("TXT") . . N DIE,DR . . S DIE="^XTV(8995.8,",DR=$S(A2'="":".02///"_A2_";",1:"")_".03///"_A3_";" . . D ^DIE . . S VAL=A1,VAL1=A2_U_A3,Y=VAL1,X1=1 I X1=0,A3'="" D . S X=A2_U_A3 . F Y=0:0 S Y=$O(^XTV(8995.8,Y)) Q:Y'>0 I $P(^(Y,0),U,2,3)=X S AX=$P(^(0),U) Q . I Y>0 D . . S X1=AX,X1=-1 I X1=0,A1'="",A2'="",A3'="" D . S TXT(1)="Do you want to ADD A NEW CALLBACK entry?" . Q:'$$MESG2^XGLMSG("TXT") . N DIC,DLAYGO S DIC="^XTV(8995.8,",X=A1,DLAYGO=8995,DIC(0)="L",DIC("DR")=".02///"_A2_";.03///"_A3_";" D ^DIC . S VAL=A1,VAL2=A2_U_A3,Y=VAL2,X1=1 I X1=0,A3'="" D . N DIC,XGCVAL D . . I A2="" S XGCVAL=A3,DIC("S")="I $E($P(^(0),U,3),1,$L(XGCVAL))=XGCVAL" . . E S XGCVAL=A2_U_A3,DIC("S")="I $E($P(^(0),U,2,3),1,$L(XGCVAL))=XGCVAL" . S Y=$$OPEN^XGCDIC2(8995.8) . I Y>0 S A1=$P(Y,U,2),A2=$P(^XTV(8995.8,+Y,0),U,2),A3=$P(^(0),U,3),X1=-1 I X1=0,A1'="" D . N DIC,XGCVAL S DIC("S")="I $E($P(^(0),U),1,$L(XGCVAL))=XGCVAL",XGCVAL=A1 . S Y=$$OPEN^XGCDIC2(8995.8) . I Y>0 S A1=$P(Y,U,2),A2=$P(^XTV(8995.8,+Y,0),U,2),A3=$P(^(0),U,3),X1=-1 I X1>0 D ESTO^XG I X1<0 D . S XVAL("G","TXTX01","VALUE")=A1,XVAL("G","TXTX02","VALUE")=A2,XVAL("G","TXTX03","VALUE")=A3 . D M^XG(XWIN,"G",$NA(XVAL("G"))) Q DELOBJ ; N TXT Q:'$D(XEROOT) S TXT(1)="Do you REALLY want to DELETE the ENTIRE '"_GADNAM_"'?",TXT(2)="" Q:'$$MESG2^XGLMSG("TXT") I $P(^XTV(8995.6,OBJTYP,0),U)'="WINDOW" D Q . K @CURROOT . S XOBJTYP=1 D INIT^XGCWED1 S OBJTYP="" D CLEAR^XGCDIC3 ; K TXT S TXT(3)=" This will REMOVE the COMPLETE WINDOW ENTRY from the file immediately if you select yes.",TXT(4)="" Q:'$$MESG2^XGLMSG("TXT") S DIK="^XTV(8995," D ^DIK K @XEROOT G CLOSEIT^XGCWED2 ; CLONE ; Call back to select window entry from which to clone a new entry N XWIN,XGCTYP,VAL,Y,DIC S XWIN=@XGEVENT@("WINDOW") S XGCTYP=@XGWIN@(XWIN,"G","LBUT1","VALUE") I XGCTYP'="" D . S XGCTYP=$P(XGCTYP,U) . S DIC("S")="I $P($G(^XTV(8995.6,+$P(^(0),U,3),0)),U)=XGCTYP" S Y=$$EN^XGCDIC(8995) I Y'>0 Q S VAL=$P(Y,U,2) D S^XG(XWIN,"G","TXT2","VALUE",VAL) I XGCTYP="" D . S XGCTYP=$P($G(^XTV(8995.6,+$P(^XTV(8995,+Y,0),U,3),0)),U) . D S^XG(XWIN,"G","LBUT2","VALUE",XGCTYP) Q ; EDITCB ; N ROU S ROU=$$GET^XGLVAL("TXTX03") S ROU=$P(ROU,"(") Q:ROU="" D EDIT^XGCWROU(ROU) Q Q CBDEL ; N XWIN S Y="@",XWIN=@XGEVENT@("WINDOW"),VAL=$G(@XGWIN@(XWIN,"G","TXTX01","VALUE")),VAL1=$G(@XGWIN@(XWIN,"G","TXTX02","VALUE"))_U_$G(@XGWIN@(XWIN,"G","TXTX03","VALUE")) D ESTO^XG ; DELCHOIC ; S Y=$G(@XGWIN@(@XGEVENT@("WINDOW"),"G","TXT1","VALUE")) Q:Y="" K @CURROOT@("CHOICE",Y) S Y="@" D ESTO^XG D ESTO^XG ; DELMENU ; S Y=$G(@XGWIN@(@XGEVENT@("WINDOW"),"G","TXT1","VALUE")) Q:Y="" K @CURROOT@("CHOICE",Y) S Y="@" D ESTO^XG ; VIEWCB ; N ROU,XWIN S XWIN=@XGEVENT@("WINDOW") S ROU=@XGWIN@(XWIN,"G","TXTX03","VALUE") S ROU=$P(ROU,"(") Q:ROU="" D DISPLAY^XGCWROU(ROU) Q XGCDIR^INT^1^60169,79033^0 XGCDIR ;ISC-SF.SEA/JLI - READER INPUT FOR GUI ;9/28/94 15:07 ;;8.0T19;KERNEL;;Feb 22, 1995 ;; DIR(DIR,Y) ; I '$D(XGWIN) D ^DIR Q X I '$D(DIR(0)) Q -1 N XGCDIR,X,XGY M XGCDIR=DIR S XGY=$G(Y) D DODIR K Y M Y=XGY Q X DODIR ; N Y,DIR S X=-1 S XGC1=$P(XGCDIR(0),U) I XGC1["Y" G YESNO I XGC1["F" G FTEXT I XGC1["P" G POINTER I XGC1["N" G NUMBER I XGC1["L" G LIST I XGC1["S" G SET I XGC1["D" G DATE I XGC1["," D . S XFILE=+XGC1,XFLD=+$P(XGC1,",",2) . I XFILE'>0!(XFLD'>0) Q . D DD Q ; FTEXT ; I '$D(XGCDIR("A")) S XGCDIR("A")="The application expects you to enter or edit a free text value, but it hasn't given any guidance to provide you. Good luck, your mission is near impossible." D FTHELP^XGCDIR0D G GETTEXT NUMBER ; I '$D(XGCDIR("A")) S XGCDIR("A")="You have come to this point to enter a number value. Please type it in." D NUMHELP^XGCDIR0D G GETTEXT ; GETTEXT ; N XWIN,XWIN1 S:$D(@XGEVENT@("WINDOW")) XWIN1=@XGEVENT@("WINDOW") S XWIN=$$NEXTNM^XGCLOAD("W") D LOAD^XGCLOAD("XGCDIR FTEXT",XWIN) I $D(XGCDIR("B")) D S^XG(XWIN,"G","TXT1","VALUE",XGCDIR("B")) I '$D(XGCDIR("?")) D . S:$D(XGCDIR("?X")) XGCDIR("?")=XGCDIR("?X") . I $P(XGCDIR(0),U,3,99)'="" D . . S XGCDIR("?")=XGCDIR("?")_$C(13)_$C(10)_$C(13)_$C(10)_"And it must pass the following transform "_$C(13)_$C(10)_$P(XGCDIR(0),U,3,99) D LOADDIR("XGCDIR(""A"")") D SD^XG($PD,"FOCUS",XWIN_",TXT1") D . N XWIN . D ESTA^XG() D K^XG(XWIN) D:$D(XWIN1) SD^XG($PD,"FOCUS",XWIN1) Q Q DD ; ;N X1,X2,I,J,XY,XY1,XY2,XY3,DIC,DIE S X1=$G(^DD(XFILE,XFLD,0)) Q:X1="" S X2=$P(X1,U,2) Q:X2=""!X2 S:'$D(XGCDIR("A")) XGCDIR("A")=$P(X1,U) S XGCDIR("?")=$S($D(^DD(XFILE,XFLD,3)):^(3),1:"") D . F I=0:0 S I=$O(^DD(XFILE,XFLD,21,I)) Q:I'>0 S XGCDIR("?",I)=^(I,0) F I=1:1 S J=$E(X2,I) Q:J="" I "FDNKSP"[J S XGC1=J_$S(X2'["R":"O",1:"") Q Q:J="" S XGCDIR(0)=XGC1 S X3=$P(X1,U,5,99) S (XY,XY1,XY2,XY3)="" I J="F"!(J="K") S:X3]"$L(X)<" XY1=+$P(X3,"$L(X)<",2) S:X3]"$L(X)>" XY2=+$P(X3,"$L(X)>",2) S:XY1'=""!(XY2'="") XY=XY1_":"_XY2 I J="K" S J="F" I XY2="" S XY=":245" I J="P" S XY=+$P(X2,"P",2) D . N %,Y F %=" D ^DIC"," D IX^DIC"," D MIX^DIC1" S Y=$F(X3,%),%=$L(%)+1 Q:Y . Q:'Y . X $E(X3,1,Y-%) . I $D(DIC("S")) S X3=DIC("S") I J="N" S:X3["X<" XY1=+$P(X3,"X<",2) S:X3["X>" XY2=+$P(X3,"X>",2) S:X2]"," XY3=+$P(X2,",",2) S:(XY1_XY2_XY3)'="" XY=XY1_":"_XY2_":"_XY3 S XGCDIR(0)=XGC1_U_XY_U_$S(X3="":"",X3="Q":"",1:X3_" I $D(X)") S:$D(^DIC(XFILE,0,"GL")) (DIC,DIE)=^("GL") M XY0=XGCDIR ;K X1,X2,I,J,XY,XY1,XY2,XY3 G DODIR ; ENDPAG ; Q DATE ; I '$D(XGCDIR("A")) S XGCDIR("A")="Please enter a DATE." D DATEHELP^XGCDIR0D G GETTEXT ; LIST ; S:'$D(XGCDIR("A")) XGCDIR("A")="Please enter a list or range of numbers." S:'$D(XGCDIR("?")) XGCDIR("?X")="Your response must be a list or range, e.g., 1,3,5 or 2-4,8." G GETTEXT Q POINTER ; N DIC,NFILE,BASE,DIC0,IEN,I,JBASE,JREM,DDN1,DDN,XGCDIRY S NFILE=+$P(XGCDIR(0),U,2),IEN=",",DIC0=$P($P(XGCDIR(0),U,2),":",2) I NFILE'>0 D S NFILE=DDN . S BASE="",DDN=0 . S NFILE=U_$P($P(XGCDIR(0),U,2),":") . S JBASE=$P(NFILE,"(")_"(" . S JREM=$P(NFILE,JBASE,2) . I $D(@(JBASE_"0)")),$P(^(0),U,2)>0 S BASE=JBASE,DDN=+$P(^(0),U,2) . F I=1:1 Q:BASE'="" S X=$P(JREM,",",I) Q:X="" D . . S JBASE=JBASE_X_"," . . I $D(@(JBASE_"0)")),$P(^(0),U,2)>0 S BASE=JBASE,DDN=+$P(^(0),U,2) . Q:BASE="" S JREM=$P(NFILE,BASE,2) . F Q:JREM="" D . . S IEN=","_$P(JREM,",")_IEN . . S DDN1=$P(JREM,",",2),DDN1=$O(^DD(DDN,"GL",DDN1,0,0)),DDN=+$P(^DD(DDN,DDN1,0),U,2) . . S JREM=$P(JREM,",",3,99) Q:NFILE'>0 S:'$D(XGCDIR("?")) XGCDIR("?")="Select the desired entry from the list provided, or type the first couple of characters to get a better list." S X=$P(XGCDIR(0),U,3,99) I X'="",X'="Q" S DIC("S")=$P(XGCDIR(0),U,3,99) S X=$$OPEN^XGCDIC2(NFILE,.XGCDIRY,IEN,$S(DIC0["L":"",1:0)) M XGY=XGCDIRY Q ; SET ; N XARR,J,J1 S J=$P(XGCDIR(0),U,2) F Q:J="" S J1=$P(J,";"),J=$P(J,";",2,99),XARR($P(J1,":"))=$P(J1,":",2) S X=$$EN2^XGCDIC(.XARR) S XGY=$P(X,U),XGY(0)=$P(X,U,2),X=$P(X,U) Q YESNO ; N XWIN S XWIN=$$NEXTNM^XGCLOAD("W") D LOAD^XGCLOAD("XGCDIR YESNO",XWIN) I '$D(XGCDIR("?")) S XGCDIR("?")="Simply select the YES or NO button to indicate your choice." D LOADDIR("XGCDIR(""A"")") D SD^XG($PD,"FOCUS",XWIN) D . N XWIN . D ESTA^XG() D K^XG(XWIN) S XGY(0)=$S(Y=1:"YES",1:"NO"),XGY=Y,X=XGY(0) Q ; LOADDIR(ARG) ; N N S N=0 F Q:$O(@ARG@(N))'>0 S N=N+1 S N=N+1 S:($D(@ARG)#2) @ARG@(N)=@ARG D ULDOC^XGC02($NA(@XGWIN@(XWIN,"G","DOC1")),ARG,-1,1) K @ARG@(N) Q ; HELP ; N XWIN S XWIN=$$NEXTNM^XGCLOAD("W") I '$D(XGCDIR("?")) S XGCDIR("?")="Unfortunately, there is no specific help available at this time." D GET^XGCLOAD("XGCDIR HELP",$NA(^TMP($J,"HELP",XWIN))) I '$D(XGCDIR("??")) S ^TMP($J,"HELP",XWIN,"G","BUT2","VISIBLE")=0 D M^XG(XWIN,$NA(^TMP($J,"HELP",XWIN))) D LOADDIR("XGCDIR(""?"")") D LOADDIR("XGCDIR(""?E"")") D SD^XG($PD,"FOCUS",XWIN_",BUT1") D . N XWIN . D ESTA^XG() D K^XG(XWIN) Q HELP2 ; N XQH S XQH=$G(XGCDIR("??")) I XQH'="" D HELP^XGCHLP(XQH) Q ; GETVAL ; N ELEM,XWIN,OLDX S ELEM=$P(@XGEVENT@("ELEMENT"),",",2) S XWIN=@XGEVENT@("WINDOW") I ELEM="BUT3" S ELEM="TXT1" S Y=$$GET^XGLVAL(ELEM) S (OLDX,X)=Y I XGC1["D" D DATE^XGCDIR0D I XGC1["F" D FRETXT^XGCDIR0D I XGC1["N" D NUMBER^XGCDIR0D I XGC1["L" D LIST^XGCDIR0L I $D(X),$P(XGCDIR(0),U,3,99)'="" D . X $P(XGCDIR(0),U,3,99) I $D(X),X="",XGC1'["O" K X I '$D(X) D . D HELP . D S^XG(XWIN,"G","TXT1","VALUE","") . D SD^XG($PD,"FOCUS",XWIN_",TXT1") Q:'$D(X) M XGY=Y S X=OLDX D ESTO^XG Q ; CANCEL ; I $P(XGCDIR(0),U,1)'["O" D Q:'Y . S TXT(1)="WARNING --- WARNING --- WARNING" . S TXT(2)="" . S TXT(3)="This entry is *** REQUIRED ***" . S TXT(4)="" . S TXT(5)="Cancelling at this point may result in other entries being rejected or similar bad things." . S TXT(6)="" . S TXT(7)="Do you still want to CANCEL (Not Recommended)." . S Y=$$MESG2^XGLMSG("TXT") S Y=-1 D ESTO^XG Q FRETXT(NAME,CURRVAL) ; N XWIN,XFROOT,XGCURGAD S XWIN=$$NEXTNM^XGCLOAD("W") S XFROOT=$NA(^TMP("XGCW TEXT EDIT",$J,XWIN)) K @XFROOT D GET^XGCLOAD("XGCW TEXT EDIT",XFROOT) S @XFROOT@("G","TXT1","TITLE")=NAME_" Value:" S @XFROOT@("G","TXT1","VALUE")=$G(CURRVAL) ; SET CHARMAX IF NECESSARY D M^XG(XWIN,XFROOT) K @XFROOT S XGCURGAD="TXT1" D SD^XG($PD,"FOCUS",XWIN_",TXT1") D . N XWIN . D ESTA^XG() D K^XG(XWIN) Q $G(Y) Q XGCDIR0D^INT^1^60169,79033^0 XGCDIR0D ;ISC-SF.SEA/JLI - DATE PROCESSING FOR DIR ; [ 06/15/94 5:30 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 DATE ; Q:X="" N V,%DT,X1,X2,X3 D GETLIMS I X1="NOW"!(X1="DT") D . N X,Y . S X=$S(X1="DT":"T",1:X1) D ^%DT S X1=Y S V=X3 I V'="" D . S %DT=$S(V["T":"T",1:"")_$S(V["X":"X",1:"")_$S(V["S":"S",1:"")_$S(V["R":"R",1:"")_$S(V["F":"F",V["P":"P",1:"") D ^%DT I Y'>0 K X I $D(X),X1>0,Y'>X1 K X I $D(X),X2="NOW"!(X2="DT") D . N X,Y . S X=$S(X2="DT":"T",1:"NOW") D ^%DT S X2=Y I X2>0,Y'0,$L(X)0,$D(X),$L(X)>X2 K X Q ; FTHELP ; N X1,X2,X3,I D GETLIMS S I=1 I X1'>0,X2'>0 D Q . I '$D(XGCDIR("?")) S XGCDIR("?E",I)="This answer may be free text." S XGCDIR("?E",I)="",I=I+1 I X1>0 S XGCDIR("?E",I)="The text entered must be at least "_X1_$S(X2>0:" and at most "_X2,1:"")_" characters in length." Q S XGCDIR("?E",I)="The text entered must be at most "_X2_" characters in length." Q ; NUMBER ; N X1,X2,X3 Q:X="" I X'=+X S A(1)="The entry must be a number." K X D GETLIMS I X1'="",$D(X),XX2 K X S A(1)="Entry must be no larger than "_(+X2)_"." I X3'="",$D(X),X[".",$L($P(X,".",2))>X3 S A(1)="Entry must have no"_$S(X3>0:" more than "_(+X3),1:"")_" decimal digits." K X I '$D(X) D . N XGCDIR . S XGCDIR("?")=A(1) . D HELP^XGCDIR Q NUMHELP ; N X1,X2,X3,I S I="" D GETLIMS I X1'="" D . S X1=+X1 . S I="The entry must be a value greater than or equal to "_X1 I X2'="" D . S X2=+X2 . S I=I_$S(X1'="":" and",1:"The entry must be a value")_" less than or equal to "_X2 I X3'="" D . S X3=+X3 . S I=I_$S(I'="":" and with",1:"The entry must have")_" no"_$S(X3>0:" more than "_X3,1:"")_" decimal digits" I I="" S I="The entry must be a number" S XGCDIR("?E",1)="",XGCDIR("?E",2)=I_"." Q XGCDIR0L^INT^1^60169,79033^0 XGCDIR0L ;ISC-SF.SEA/JLI - PROCESSING FOR DIR CALL ; [ 06/20/94 9:00 AM ] ;;8.0T19;KERNEL;;Feb 22, 1995 LIST ; N X1,X2,X3,I,A,XOLD Q:X="" D GETLIMS^XGCDIR0D S ERR=0 I X1="" S X1=0 K ^TMP($J,"XGCDIR") S XOLD=X F Q:ERR Q:X="" D . S XA=$P(X,","),X=$P(X,",",2,255) . I XA?1.N S ^TMP($J,"XGCDIR",XA)="" D:XAX2&(X2'="")) LISTERR Q . I XA?1.N1"-"1.N D Q . . S XA1=+XA,XA2=+$P(XA,"-",2) . . I XA1>XA2 S A="In the parts of a range, the second value must not be less than the first value",ERR=1 Q . . F I=XA1:1:XA2 S ^TMP($J,"XGCDIR",I)="" I IX2&(X2'="")) D LISTERR Q . D LISTERR I 'ERR D Q . S I=0,Y(I)="" . F J=0:0 S J=$O(^TMP($J,"XGCDIR",J)) Q:J'>0 D . . I $L(Y(I))+$L(J)+1>245 S I=I+1,Y(I)="" . . S Y(I)=Y(I)_$S(Y(I)="":"",1:",")_J . S Y=Y(0),X=XOLD K Y(0),^TMP($J,"XGCDIR") N XGCDIR S XGCDIR("?")=A D HELP^XGCDIR K Y,X,^TMP($J,"XGCDIR") Q ; LISTERR ; N X1,X2,X3 D GETLIMS^XGCDIR0D S A="The values in the range must be integers with values of "_X1_" or above "_$S(X2>0:"up to a maximum of "_X2_" ",1:"")_"entered as individual values separated by commas, or a range separated by a hyphen.",ERR=1 Q XGCEDIT^INT^1^60169,79033^0 XGCEDIT ;ISC-SF..SEA/JLI-EDITOR FOR THE WINDOW OBJECT FILE ;12/15/94 11:13 ;;8.0T19;KERNEL;;Feb 22, 1995 ; ----------------------------------------------------------------- ; EN (or the top) is the main entry point for the WINDOW OBJECT EDITOR ; EN ; K DTOUT,DUOUT S XGCEDITR=1 S XGLEV=0 W !! S DIC="^XTV(8995," S DIC(0)="AEQML" S DLAYGO=8995 D ^DIC K DIC I Y'>0 G CALLBK^XGCEDIT2 D EDITIT(Y) G EN ; -------------------------------------------------------------------- ; EDITIT is a secondary entry point for editing the selected ; object or an object created during editing of the original ; object ; ; this is a recursive entry point with arg Y the value returned by ; a ^DIC look-up EDITIT(Y) ; N DA,XGDA,XGCNEW,XGY,XGTYP,XGNAM I Y'>0 Q ; just in case S (XGDA,DA)=+Y,XGLEV=$G(XGLEV)+1 S XGNAM=$P(Y,U,2),XGCNEW=$P(Y,U,3) ; 'XG ' entries are special I $E(XGNAM,1,3)="XG " I '$$XGENTRY^XGCEDIT2() Q ; D:XGCNEW NEWOBJ^XGCEDIT2 D:'XGCNEW OLDOBJ^XGCEDIT2 ; ; S DA=$$PRIMARY(XGDA) Q:DA'>0 ; edit main attributes for object ; G:$D(DTOUT) EXIT K DUOUT ; I $P(^XTV(8995.6,XGTYP,0),U,4) D CHOICE^XGCEDIT1(XGDA) ; may have choices ; ; I $P(^XTV(8995.6,XGTYP,0),U,5) D ASSOC^XGCEDIT1(XGDA) ; associated objects ; gadgets and timers) G:$D(DTOUT) EXIT K DUOUT ; ; I $P(^XTV(8995.6,XGTYP,0),U,7) D ; DRAW for GENERIC objects . S DA=XGDA,DIE="^XTV(8995,",DR="6;" . D ^DIE K DIE,DR ; G:$D(DTOUT) EXIT K DUOUT ; ; S XGTYPN=$P(^XTV(8995.6,XGTYP,0),U) I $S(XGTYPN="M TERM":0,XGTYPN="FRAME":0,XGTYPN="LABEL":0,XGTYPN="MENU":0,XGTYPN="SYMBOL":0,1:1) D . S DR="1;",DIE="^XTV(8995,",DA=XGDA . D ^DIE K DR,DIE ; ; I 'XGCNEW D CHKOLD^XGCEDIT2 ; if not new, check for any changes and ; update date/time last changed for ; window objects affected ; I $D(XGLEV),XGLEV>1 S XGLEV=XGLEV-1 Q ; quit for entry at EDITIT ; ; look up original file selection, ; to make sure gives expected entry ; S DIC(0)="M",DIC="^XTV(8995,",X="`"_XGDA D ^DIC K DIC Q ; ----------------------------------------------------------------- ; PRIMARY is used to edit the primary or single value attributes for ; the window object indicated by the internal entry ; number XGDA PRIMARY(XGDA) ; ; S DR=".01;5;" ; set up edit string with NAME, DESCRIPTION ... S XGTYP=$$TYPPNT^XGCEDIT2(DA) F I=0:0 S I=$O(^XTV(8995.6,XGTYP,1,I)) Q:I'>0 D . S J=+^XTV(8995.6,XGTYP,1,I,0) . S J1=J,J=$P($G(^XTV(8995.7,J,0)),U,2) . I J>0,$P(^XTV(8995.7,J1,0),U,3) S DR=DR_J_";" ; and add valid attributes S DR=DR_"7;" S JLIDR=DR ; ; ---------------------------------------------- ; if the attributes include MENUBAR (i.e., it's a window) ; save MENUBAR to be processed separately (this allows identification ; of a new OBJECT ENTRY and immediate editing of that if desired) ; S:DR["100.03;" XGDR=1,DR=$P(DR,"100.03;")_$P(DR,"100.03;",2) S DIE="^XTV(8995," D ^DIE K DR ; get all other single value attributes Q:'$D(DA) -1 ; the user deleted the entry I $D(XGDR),XGDR K XGDR D MENUBAR(DA) ; have a MENUBAR attribute to edit ; ----------------------------------------------- ; I $P(^XTV(8995.6,XGTYP,0),U,3) D MENUITEM^XGCEDIT1(XGDA) ; object may have menus Q XGDA ;---------------------------------------------------------------------- ; MENUBAR is used to edit the MENUBAR attribute for a WINDOW-type ; object ; DA is internal entry number in the WINDOW OBJECT file ; MENUBAR(DA) ; S XGOLD=$P($G(^XTV(8995,DA,100)),U,3) ; save current value S DIE="^XTV(8995,",XGDA=DA,DR="100.03;" D ^DIE K DIE ; and edit S XGCUR=$P($G(^XTV(8995,DA,100)),U,3) ; check for value now I XGCUR'="",XGCUR'=XGOLD D ; and if different . S XGOLD=0 ; check to see if . F I=0:0 S I=$O(^XTV(8995,XGCUR,3,I)) Q:I'>0 D . . S XGOLD=1 ; does have a menu item . . I $P(^XTV(8995,XGCUR,3,I,0),U,3)="" D . . . W !?10,$C(7),"WARNING -- ",$P(^XTV(8995,XGCUR,3,I,0),U,2)," option does not have a menu." . I XGOLD'>0 D ; the selected MENUBAR has no items, EDIT? . . D EDITNEW^XGCEDIT2(XGCUR,"Menu-type",XGNAM) Q ; EXIT ; I $S('$D(XGLEV):1,XGLEV'>1:1,1:0) K DTOUT,DUOUT,DLAYGO,XGLEV,XGCEDITR K DA,DIC,DIE,DR,I,J,X,XGCNEW,XGCUR,XGDA,XGDIC,XGDR,XGNAM,XGOLD,XGY,XGY1 K XGTYP,XGTYPN,Y,Y1,TYPE,NAME,%DT,DIK,XG Q XGCEDIT1^INT^1^60169,79033^0 XGCEDIT1 ;ISC-SF..SEA/JLI-FUNCTIONS RELATED TO GUI EDITOR ;11/16/94 10:13 ;;8.0T19;KERNEL;;Feb 22, 1995 Q ; ------------------------------------------------------------------ ; MENUITEM is used to edit the MENU ITEM nodes of a primary object. ; these are present in MENU-type options. ; ; Data on a node are stored as: ; ; ORDER_NUMBER^MENU_TEXT^SUBMENU^CALL_BACK ; .01 .02 .03 .04 ; ; A call back is asked for only if there is no SUBMENU entry ; ; A new Menu-type WINDOW OBJECT may be added for SUBMENU, if ; this is the case, then the user has the option of further ; defining that entry prior to continuing. ; MENUITEM(XGDA) ; F Q:$D(DTOUT) K DUOUT D Q:XGY1'>0 . S DA=XGDA . S DIC="^XTV(8995,DA(1),3," . S DIC(0)="AEQML",DA(1)=DA,DIC("P")=8995.03,XGDIC=DIC . D ^DIC K DIC S XGY1=Y Q:Y'>0 S DA=+Y D . . S XGOLD=$P(^XTV(8995,XGDA,3,DA,0),U,3) . . S DR=".01;.02;.03;",DIE=XGDIC . . D ^DIE K DIE Q:'$D(DA) . . S XGCUR=$P(^XTV(8995,XGDA,3,DA,0),U,3),XGY=XGCUR . . I XGCUR>0,XGCUR'=XGOLD D . . . S XGOLD=0 . . . F I=0:0 S I=$O(^XTV(8995,XGCUR,3,I)) Q:I'>0 S XGOLD=1 Q . . . I XGOLD'>0 D . . . . D EDITNEW^XGCEDIT2(XGCUR,"Menu-type",XGNAM) . . I XGY'>0 S DR=".04;",DIE=XGDIC D ^DIE K DIE,DR Q ; ---------------------------------------------------------------- ; CHOICE is used to edit the CHOICE nodes for listboxes, radio buttons, ; etc. ; CHOICE(XGDA) ; ; ; field 201.02 is CHOICE IN VARIABLE, which permits CHOICE entries to ; be taken from a user specified variable when the window is loaded ; IF 201.02 is YES or 1, the user is asked for a value for field 201.03 ; which contains the name of the variable. Otherwise the user is ; given field 4, the CHOICE multiple, to edit. ; S DR="201.02;S:X'=1 Y=""@4"";201.03;S Y=""@100"";@4;4;@100;" S DIE="^XTV(8995,",DA=XGDA D ^DIE K DR,DIE Q ; -------------------------------------------------------------------- ; ASSOC is used to edit the associated objects (gadgets and timers) ; related to the current object. These potentially multiple ; objects are identified by the subscript to be used for the ; entry in the window. These objects have to have a parent ; object of the desired type. Several distinct associated ; objects may inherit from the same parent, and attributes ; such as size, position, and title, as well as events, choices, ; or draw attributes may be entered or over-ridden. ; ASSOC(XGDA) ; F Q:$D(DTOUT) K DUOUT D Q:XGY1'>0 . S DA=XGDA . S DIC="^XTV(8995,XGDA,2," . S DIC(0)="AEQLM",DIC("P")=8995.02 . S DA(1)=DA . S DIC("A")="Select Associated Object SUBSCRIPT: " . D ^DIC K DIC S XGY1=+Y Q:Y'>0 D . . S DA=+Y . . S DIE="^XTV(8995,XGDA,2," . . S DR=".01 Associated Object SUBSCRIPT~;.02R;" ; .02 is parent . . S XGOLD=$P(^XTV(8995,DA(1),2,DA,0),U,2) ; save original parent pointer . . D ^DIE K DR,DIE Q:'$D(DA)!$D(DTOUT)!$D(DUOUT) Q:DA'>0 D Q:DA'>0 . . . S XGCUR=$P(^XTV(8995,XGDA,2,DA,0),U,2) ; and current parent pointer . . . I XGCUR'>0 S DIE="^XTV(8995,XGDA,2,",DR=".01///@" D ^DIE K DR,DIE S DA=-1 Q . . . I XGCUR>0,XGCUR'=XGOLD D ; new parent, is it defined? . . . . S XGOLD=0 . . . . F J=1,2,4,6,100:1:108 I $D(^XTV(8995,XGCUR,J)) S XGOLD=1 Q . . . . I XGOLD'>0 D . . . . . D EDITNEW^XGCEDIT2(XGCUR,"selected",XGNAM) ; new entry, edit if desired . . S DIE="^XTV(8995,XGDA,2," . . S DR="" D D ^DIE K DR,DIE . . . S J=$$TYPPNT^XGCEDIT2(XGCUR) . . . F Y=0:0 S Y=$O(^XTV(8995.6,J,1,Y)) Q:Y'>0 D . . . . S Y1=^XTV(8995.6,J,1,Y,0),Y1=$P(^XTV(8995.7,Y1,0),U) . . . . S:Y1="POS" DR=DR_".03;" ; ask POS, SIZE, . . . . S:Y1="SIZE" DR=DR_".04;" ; TITLE only if valid . . . . S:Y1="TITLE" DR=DR_".05;" . . . I $O(^XTV(8995.6,J,2,0))>0 S DR=DR_"1;" ; if valid events ask . . . I $P(^XTV(8995.6,J,0),U,7) S DR=DR_"3;" ; DRAW valid . . . I $P(^XTV(8995.6,J,0),U,4) S DR=DR_"4;" ; CHOICE valid . . . S DR=DR_"2;" ; add ATTRIBUTE NAME Q ; ; CHKDRAW ; N I,XPNT,XPNT1,XPNT2 ; I '$D(DIE) K X Q S XPNT=$P(@(DIE_DA_",0)"),U,2) I XPNT="" S XPNT=$G(DG("0;2")) S XPNT1=$G(^XTV(8995.4,+XPNT,0)) I XPNT1="" K X I $P(XPNT1,U,2)'="" D . S XPNT2="K:'("_$P(XPNT1,U,2)_") X" . X XPNT2 I '$D(X) D . W ! . F I=0:0 S I=$O(^XTV(8995.4,XPNT,2,I)) Q:I'>0 W !,^(I,0) . W ! XGCEDIT2^INT^1^60169,79033^0 XGCEDIT2 ;ISC-SF..SEA/JLI - CONTINUATION OF WINDOW OBJECT EDITOR ;11/28/94 10:13 ;;8.0T19;KERNEL;;Feb 22, 1995 CALLBK ; G:$D(DTOUT)!$D(DUOUT) EXIT^XGCEDIT W !!,$C(7),"Call Back Edit ------",!! F D Q:XGY1'>0 . S DIC="^XTV(8995.8," . S DIC(0)="AEQLM" . S DLAYGO=8995.8 . D ^DIC S XGY1=Y Q:Y'>0 . S DA=+Y,DIE=DIC,DR=".01;.02;.03;1;" . D ^DIE K DR,DIE,DIC G EXIT^XGCEDIT ; ; ------------------------------------------------------------------ ; NEWOBJ is used to give a newly created object the attributes which ; are present in the parent (if a parent is selected) ; NEWOBJ ; S DR=".02;S:X'="""" Y=""@2"";.03;@2" NEWOBJ1 S XGNOBJ=Y S DIE="^XTV(8995," D ^DIE K DIE,DR I $P(^XTV(8995,DA,0),U,2)'="" D . S X=$P(^XTV(8995,DA,0),U,1,2),XG=$P(X,U,2) . I XG=DA D G NEWOBJ . . S $P(^XTV(8995,DA,0),U,2)="" . . W !,$C(7),"THE PARENT MAY NOT BE THE SAME AS THE OBJECT -- SELECT ANOTHER PARENT",!,"OR SIMPLY ENTER THE TYPE OF OBJECT AND NO PARENT",!! . . S Y=XGNOBJ K XGNOBJ . M ^XTV(8995,DA)=^XTV(8995,XG) . S $P(^XTV(8995,DA,0),U,1,2)=X . S DIK="^XTV(8995," D IX1^DIK K DIK . I $S('$D(XGWIN):1,'$D(XGEVENT):1,'$D(@XGEVENT@("WINDOW")):1,1:0) D . . W !,"This OBJECT now has all of the properties of the parent.",! K ^XTV(8995,DA,5) ; REMOVE DESCRIPTION, SO THEY HAVE TO ADD ONE, OR IT DOESN'T HAVE ONE . S DR=$S($P(^XTV(8995,DA,0),U,3)="":".03;",1:"") . S DIE="^XTV(8995," . D:DR'="" ^DIE K DIE,DR S Y=XGNOBJ K XGNOBJ Q ;------------------------------------------------------------------ ; OLDOBJ is used to record the current state of a previously existing ; entry in the object file on selection of that entry for ; editing. This is compared to the state on exit to determine ; whether any change occurred, and if so, to permit date- ; stamping of windows potentially affected by the change ; OLDOBJ ; S:'$D(XGLEV) XGLEV=1 K ^TMP($J,"XGEDIT",XGLEV) M ^TMP($J,"XGEDIT",XGLEV)=^XTV(8995,DA) Q ; ------------------------------------------------------------------- ; CHKOLD is used on completion of editing a previously existing object ; file entry to determine whether a change occurred. If ; there was any detectable change, then windows which are ; using the object are date-time stamped to reflect the ; change in the window or associated object. ; CHKOLD ; S A="^TMP("_$J_",""XGEDIT"","_XGLEV_")" S B="^XTV(8995,DA)" S A1=$E(A,1,$L(A)-1)_"," S B1=$E(B,1,$L(B)-1)_"," S X=0 F Q:X S A=$Q(@A),B=$Q(@B) D Q:A="" . I $E(B,1,$L(B1))'=B1,$E(A,1,$L(A1))'=A1 S A="" Q . I $E(B,1,$L(B1))'=B1!($E(A,1,$L(A1))'=A1) S X=1 Q . I $E(B,$L(B1),$L(B))'=$E(A,$L(A1),$L(A)) S X=1 Q . I @A'=@B S X=1 Q . Q K A,B,A1,B1 Q:'X S %DT="TS",X="N" D ^%DT S X=Y K ^TMP($J,"XGEDIT",XGLEV) S N=1 S A="^TMP($J,""XGEDIT"",XGLEV)" S @A@(N)=DA F B=0:0 S B=$O(@A@(B)) Q:B'>0 S Y=@A@(B) D . I $P($G(^XTV(8995.6,+$P(^XTV(8995,Y,0),U,3),0)),U)="WINDOW" D Q . . S ^XTV(8995,Y,99)=X . F B1=0:0 S B1=$O(^XTV(8995,B1)) Q:B1'>0 I B1'=Y D . . I $P($G(^XTV(8995,B1,100)),U,3)=Y D Q . . .S N=N+1,@A@(N)=B1 . . S A2=0 . . F A1=0:0 D Q:A1'>0 . . . S A1=$O(^XTV(8995,B1,2,A1)) Q:A1'>0 . . . I $P($G(^XTV(8995,B1,2,A1,0)),U,2)=Y D S A1=0 . . . . S N=N+1,@A@(N)=B1,A2=1 . . Q:A2 . . F A1=0:0 D Q:A1'>0 . . . S A1=$O(^XTV(8995,B1,3,A1)) Q:A1'>0 . . . I $P(^XTV(8995,B1,3,A1,0),U,3)=Y D S A1=0 . . . . S N=N+1,@A@(N)=B1 K A,B,A1,B1,A2,N Q ED ; ---------------------------------------------------------------------- ; ; EDITNEW gives the user the opportunity to fill out the details for ; an object which has been created while editing the original ; object ; EDITNEW(DA,TYPE,NAME) ; S XGY=DA_U_$P(^XTV(8995,DA,0),U)_U_"1" S DIR("A",1)="The selected "_TYPE_" object does not have any detail" S DIR("A")=" Do you want to edit it now? " S DIR("B")="YES",DIR(0)="Y" D ^DIR K DIR I Y D . S Y=XGY D EDITIT^XGCEDIT(Y) . W !!,$C(7),"Back Editing ",NAME Q ; ------------------------------------------------------------------ ; TYPPNT returns the pointer for the object type of the WINDOW OBJECT ; entry with internal entry value XGDA ; TYPPNT(XGDA) ; Q $P(^XTV(8995,XGDA,0),U,3) ; ------------------------------------------------------------------- ; XGENTRY(A) ; DOES USER REALLY WANT TO EDIT AN 'XG ' TEMPLATE? S DIR(0)="Y" S DIR("A")="Do you REALLY want to edit a template object" S DIR("B")="NO" D ^DIR K DIR Q Y XGCEVNTS^INT^1^60169,79033^0 XGCEVNTS ;ISC-SF..SEA/JLI - GENERAL EVENTS FOR WINDOWING FUNCTIONS ;12:35 PM 5 Feb 1994 [ 03/25/94 4:00 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ;; Q ; CLOSE1 ; CLOSCUR ; N X D EVENT^XGC02 S XGW=@XGEVENT@("WINDOW") D K^XG(XGW) I $O(@XGWIN@(-99999))=XGW,$O(@XGWIN@(XGW))="" D ESTO^XG Q ; LEKEYDWN ; D EVENT^XGC02 N XGW,XGSEQ,XGELEM,KEY,XWREF,VAL,XGTYP,XWREF2 S XGW=@XGEVENT@("WINDOW"),XGSEQ=@XGEVENT@("SEQUENCE"),XGELEM=@XGEVENT@("ELEMENT"),KEY=$G(@XGEVENT@("KEY")) S XWREF=$NA(@XGWIN@(XGW,$P(XGELEM,","),$P(XGELEM,",",2),"VALUE")) ; ,VAL=@XWREF S:$L(KEY)=1 VAL=VAL_KEY I $L(KEY)>1 S VAL=$E(VAL,1,$L(VAL)-1) ;S @XWREF=VAL ;S ^TMP($J,XGCCHOIC,"LEKD")=@($NA(@XGWIN@(XGW,$P(XGELEM,","),$P(XGELEM,",",2),"VALUE"))) S XWREF1=$P(XWREF,",""VALUE""")_")" ;S XWREF2=""""_XGW_""","""_$P(XGELEM,",")_""","""_$P(XGELEM,",",2)_""",""VALUE""",XWREF=$S(XGWIN[")":$E(XGWIN,1,$L(XGWIN)-1)_",",1:XGWIN_"(")_XWREF2_")" ;S ^TMP($J,XGCCHOIC,"VALUE")=$S($D(@XWREF)#2:@XWREF,1:"NO VALUE NODE") Q LESELCT ; D EVENT^XGC02 N XGW,XGSEQ,XGELEM S XGW=@XGEVENT@("WINDOW"),XGSEQ=@XGEVENT@("SEQUENCE"),XGELEM=@XGEVENT@("ELEMENT") S ^TMP("XGC",XGW,XGSEQ,"LESEL")=@($NA(@XGWIN@(XGW,$P(XGELEM,","),$P(XGELEM,",",2),"VALUE"))) Q FKEYDWN ; D EVENT^XGC02 Q ; DUMMY ; Q XGCFLDS^INT^1^60169,79033^0 XGCFLDS ;ISC-SF.SEA/JLI - WINDOW FOR FIELD SELECTION ; [ 06/13/94 1:22 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 FLDLIST(FILE,FLDTYP,ARREF,SUBSCRA,OFFSET) ; N FLDNAM,FLDLOC,I,SUBSCR,J S:'$D(FLDTYP) FLDTYP=0 S SUBSCRA=$G(SUBSCRA),OFFSET=$G(OFFSET) S:$G(ARREF)="" ARREF=$NA(^TMP($J,"FLDLIST")) ;K @ARREF F I=0:0 S I=$O(^DD(FILE,I)) Q:I'>0 D . S FLDNAM=$P(^DD(FILE,I,0),U),FLDLOC=$P(^(0),U,4) . I +FLDTYP=0,$P(FLDLOC,";",2)'=0,$P(FLDLOC,";",2)'>0 Q . I SUBSCRA="" D I 1 . . S J=$P(I,".") . . S SUBSCR=$S($L($P(J,"."))>6:J,1:$E(" "_J,$L(J)+1,$L(J)+6)) . . I I["." S SUBSCR=SUBSCR_"."_$P(I,".",2) . E S SUBSCR=SUBSCRA_";"_I . S @ARREF@(SUBSCR)=OFFSET_$S($P(FLDLOC,";",2)=0:"+ ",1:" ")_FLDNAM Q ; XPAND(FILE,SUBSCR,FLDTYP,ARREF) ; N SUBSCR1,I,SUBSCRA,X,Y,YA,Y1 D . I $D(@XGEVENT@("WINDOW")) D Q . . S XWIN=@XGEVENT@("WINDOW") . . S XELEM=$P(@XGEVENT@("ELEMENT"),",",2) . . S YA=@XGWIN@(XWIN,"G",XELEM,"CHOICE",SUBSCR) . I $D(@ARREF@(SUBSCR)) D Q . . S YA=@ARREF@(SUBSCR) . S YA="" S SUBSCR1=SUBSCR F I=1:1 Q:$E(SUBSCR1)'=" " S SUBSCR1=$E(SUBSCR1,2,$L(SUBSCR1)) S SUBSCRA="" F I=1:1 S X=$P(SUBSCR1,";",I) Q:X="" D . S Y=^DD(FILE,+X,0) . S FILE=+$P(Y,U,2),SUBSCRA=SUBSCRA_" " D FLDLIST(FILE,FLDTYP,ARREF,SUBSCR,SUBSCRA) I YA'="" D . S Y1=$F(YA,"+")-1 . S @ARREF@(SUBSCR)=$E(YA,1,Y1-1)_"-"_$E(YA,Y1+1,$L(Y)) Q ; COLAPS(FILE,SUBSCR,ARREF) ; N XWIN,XELEM,YA,Y1 S:$G(ARREF)="" ARREF=$NA(^TMP($J,"FLDLIST")) I $D(@XGEVENT@("WINDOW")) D Q . S XWIN=@XGEVENT@("WINDOW") . S XELEM=$P(@XGEVENT@("ELEMENT"),",",2) . S YA=@XGWIN@(XWIN,"G",XELEM,"CHOICE",SUBSCR) . S Y1=SUBSCR F S Y1=$O(@XGWIN@(XWIN,"G",XELEM,"CHOICE",Y1)) Q:Y1="" Q:$E(Y1,1,$L(SUBSCR))'=SUBSCR D K^XG(XWIN,"G",XELEM,"CHOICE",Y1) . S Y1=$F(YA,"-")-1 . D S^XG(XWIN,"G",XELEM,"CHOICE",SUBSCR,($E(YA,1,Y1-1)_"+"_$E(YA,1,Y1+1))) I $D(@ARREF@(SUBSCR)) D Q . S YA=@ARREF@(SUBSCR) . S Y1=SUBSCR F S Y1=$O(@ARREF@(Y1)) Q:Y1="" Q:$E(Y1,1,$L(SUBSCR))'=SUBSCR K @ARREF@(Y1) . S Y1=$F(YA,"-")-1 . S @ARREF@(SUBSCR)=$E(YA,1,Y1-1)_"+"_$E(YA,Y1+1,$L(YA)) XGCHLP^INT^1^60169,79033^0 XGCHLP ;ISC-SF.SEA/JLI - HELP PROCESSOR FUNCTION ;12/15/94 11:56 ;;8.0T19;KERNEL;;Feb 22, 1995 ;; HLPRCSR ; N Y S Y=+$$OPEN^XGCDIC2(9.2) I Y>0 D . D HELP(Y) Q ; HELP(HLPFRAM) ; N HLPFRM,XGCHELP Q:'$D(HLPFRAM) S XGCHELP=0,HLPFRM=HLPFRAM I HLPFRM'=+HLPFRM S HLPFRM=$O(^DIC(9.2,"B",HLPFRM,0)) Q:HLPFRM'>0 D SHOHLP(HLPFRM) Q ; SHOHLP(HLPFRM) ; N XWIN K ^TMP($J,"XGCHLP") S XWIN=$$NEXTNM^XGCLOAD("HLP") D GET^XGCLOAD("XGCW HELP PROCESSOR",$NA(^TMP($J,"XGCHLP",XWIN))) S ^TMP($J,"XGCHLP",XWIN,"G","DOC1","TITLE")=$P(^DIC(9.2,HLPFRM,0),U,2) D M^XG(XWIN,$NA(^TMP($J,"XGCHLP",XWIN))) K ^TMP($J,"XGCHLP") D ULDOC^XGC02($NA(^$W(XWIN,"G","DOC1")),"^DIC(9.2,"_HLPFRM_",1)",1) D S^XG(XWIN,"VISIBLE",1) D SETKEYS(HLPFRM) D SD^XG($PD,"FOCUS",XWIN) D . N XWIN . D ESTA^XG() D K^XG(XWIN) Q ; SETKEYS(HLPFRM) ; N I,X,Y F I=0:0 S I=$O(^DIC(9.2,HLPFRM,2,I)) Q:I'>0 S Y=^(I,0),X(Y)=$P(Y,U) I '$D(^DIC(9.2,+$P(Y,U,2),0)) K X(Y) D M^XG(XWIN,"G","LBOX1","CHOICE","X") Q ; KEYWRD ; N XWIN,ELEM,VAL S XWIN=@XGEVENT@("WINDOW"),ELEM=@XGEVENT@("ELEMENT") S VAL=$O(@XGWIN@(XWIN,"G","LBOX1","VALUE","")) D SHOHLP($P(VAL,U,2)) Q:'XGCHELP G EXIT ; BACK ; S XGCHELP=0 D ESTO^XG Q ; EXIT S XGCHELP=1 D ESTO^XG Q ; CONT3 ; S LNMSPC=3 G CONTNTS ; CONT2 S LNMSPC=2 G CONTNTS ; CONT1 S LNMSPC=1 G CONTNTS ; CONT0 S LNMSPC=0 CONTNTS ; K ^TMP($J,"HLP") I '$D(LNMSPC) S LNMSPC=0 S CNMSPC=$E($G(XQY0),1,3) S LNMSPC=$S(LNMSPC'>$L(CNMSPC):LNMSPC,1:$L(CNMSPC)) S SCR=$S(LNMSPC=0!(LNMSPC>4):"I 1",1:"I $E($P(^(0),U),1,"_LNMSPC_")="""_$E(CNMSPC,1,LNMSPC)_"""") D LIST^DIC("9.2","","1","","","","","",SCR) S XDFLT="^TMP(""DILIST"",$J)" F I=0:0 S I=$O(@XDFLT@(1,I)) Q:I'>0 D . S NAM=@XDFLT@(1,I) . S IEN=@XDFLT@(2,I) . S TITLE=$G(@XDFLT@("ID",I,1)) . S ^TMP($J,"HLP",IEN)=$E(TITLE_" ["_NAM_"]"_$$SPAC^XGCRECV1(30),1,40) I '$D(^TMP($J,"HLP")) Q S Y=$$SELARR^XGCDIC($NA(^TMP($J,"HLP"))) K ^TMP($J,"HLP") Q:Y'>0 D HELP(+Y) Q XGCLIST^INT^1^60169,79033^0 XGCLIST ;ISC-SF/JLI - LIST WINDOW GLOBAL CONTENTS ;2/9/94 13:23 ;;8.0T19;KERNEL;;Feb 22, 1995 ;; EN ; K DIRUT I '$D(XGWIN) D PREP^XG D ^%ZIS Q:POP U IO S XGY=-999 F Q:$D(DIRUT) S XGY=$O(@XGWIN@(XGY)) Q:XGY="" D . S XGX=$Q(@XGWIN@(XGY)) I XGX'="" W !,XGX," = ",@XGX F S XGX=$Q(@XGX) Q:XGX="" W !,XGX," = ",@XGX I $Y'<(IOSL-3) D PAGE Q:$D(DIRUT) K DIRUT EVENT ; S XGY=-999 F Q:$D(DIRUT) S XGY=$O(@XGEVENT@(XGY)) Q:XGY="" D . S XGX=$Q(@XGEVENT@(XGY)) I XGX'="" W !,XGX," = ",@XGX F S XGX=$Q(@XGX) Q:XGX="" W !,XGX," = ",@XGX I $Y'<(IOSL-3) D PAGE Q:$D(DIRUT) K DIRUT DEVICE ; S XGY=-999 F Q:$D(DIRUT) S XGY=$O(@XGDI@(XGY)) Q:XGY="" D . S XGX=$Q(@XGDI@(XGY)) I XGX'="" W !,XGX," = ",@XGX F S XGX=$Q(@XGX) Q:XGX="" W !,XGX," = ",@XGX I $Y'<(IOSL-3) D PAGE Q:$D(DIRUT) K XGX,XGY,X,Y,DIRUT D ^%ZISC Q ; PAGE ; I IOST["C-" S DIR(0)="E" D ^DIR K DIR W @IOF Q XGCLOAD^INT^1^60169,79033^0 XGCLOAD ;ISC-SF/JLI,RWF - GENERIC LOAD, LOAD AND GO START UP ;10/13/94 12:39 ;;8.0T19;KERNEL;;Feb 22, 1995 ;; Q ; ; ERR ; S ^TMP("XGC","ERR",$J,"$EC")=$EC,^("$ER")=$ER F I=0:0 S I=$O(XGCWO(I)) Q:I'>0 D K^XG(("WIN"_I)) ;S XX="K ^$W(""WIN"_I_""")" X XX D ESTO^XG Q EXIT ; K XGCLOADW,XBASG,I,XX Q ; DEMO ; D PREP^XG K XGCDEMO N XGCWO DEMO1 I $D(XGCLOADW)>9 S XGCI="" F XGCOBJWN=$G(XGCOBJW)+1:1 S XGCI=$O(XGCLOADW(XGCI)) Q:XGCI="" S XGCWO(XGCOBJWN)=XGCLOADW(XGCI) I '($D(XGCLOADW)>9) K XGCLOADW F XGCOBJWN=$G(XGCOBJWN)+1:1 S XBASG="^TMP(""XGC"",$J,"_XGCOBJWN_"," S XGCLOADW=$E(XBASG,1,$L(XBASG)-1)_")" K @XGCLOADW D EN3^XGCCOMP Q:'$D(@XGCLOADW) S XGCLOADW(XGCOBJWN)=XGCLOADW,XGCWO(XGCOBJWN)=XGCLOADW G:($D(XGCWO)'>9) EXIT K XGCLOADW F XGCI=0:0 S XGCI=$O(XGCWO(XGCI)) Q:XGCI'>0 D M^XG(("WIN"_XGCI),XGCWO(XGCI)) D . N XGCWO . D ESTA^XG() F XGCI=0:0 S XGCI=$O(XGCWO(XGCI)) Q:XGCI'>0 D K^XG(("WIN"_XGCI)) F XGCI=0:0 S XGCI=$O(XGCWO(XGCI)) Q:XGCI'>0 D K^XG(("WIN"_XGCI)) Q LOAD(OBJNM,%W) ;Load window into ^$W ;OBJNM name in window object, %W work name in ^$W N IFN I $G(XGWIN)="" D PREP^XG S IFN=$$CHECK(OBJNM) I IFN'>0 D ^XGLMSG("E","UNKNOWN WINDOW NAME "_OBJNM,30) Q I $D(@XGEVENT@("WINDOW")) D Q . N XGCLOAD . D GET(OBJNM,$NA(XGCLOAD(%W))) . D M^XG(%W,$NA(XGCLOAD(%W))) . Q D M^XG(%W,$NA(^XUTL("XGC",IFN))) Q GET(OBJNM,DEST) ;Load window into temp. ;OBJNM name in window object file ;DEST Closed root of temp location N IFN I '$D(XGWIN) D PREP^XG S IFN=$$CHECK(OBJNM) I IFN'>0 D ^XGLMSG("E","UNKNOWN WINDOW NAME "_OBJNM,30) Q M @DEST=^XUTL("XGC",IFN) I $G(@XGEVENT@("WINDOW"))'="" D . N XWIN S XWIN=@XGEVENT@("WINDOW") . I $D(@XGWIN@(XWIN,"MODAL")) S @DEST@("MODAL")=@XGWIN@(XWIN,"MODAL") . I ^%ZOSF("OS")["DSM" S @DEST@("PARENT")=XWIN Q GO(OBJNM,XGCWNM) ;LOAD and GO S:'$D(XGCWNM)#2 XGCWNM="WNM" S XGCWNM=$$NEXTNM(XGCWNM) D LOAD(OBJNM,XGCWNM),SD^XG($PD,"FOCUS",XGCWNM) D D K^XG(XGCWNM) . N XGCWNM D ESTA^XG() Q NEXTNM(N) ;Build a unused name starting from N I $G(XGWIN)="" D PREP^XG S:'$D(N)#2 N="WNM" I '$D(@XGWIN@(N))#2 Q N F I=1:1:100 Q:'$D(@XGWIN@(N_I))#2 Q N_I CHECK(NAME) ;Lookup NAME in 8995 N %,%1,XGCWIN,XBASG S XGCWIN=$O(^XTV(8995,"B",NAME,0)) Q:XGCWIN="" -1 S %=$G(^XTV(8995,XGCWIN,99),1),%1=$G(^XUTL("XGC",XGCWIN),2) Q:%=%1 XGCWIN K ^XUTL("XGC",XGCWIN) S XBASG=$NA(^XUTL("XGC",XGCWIN)),XBASG=$E(XBASG,1,$L(XBASG)-1)_"," D ENC^XGCCOMP S ^XUTL("XGC",XGCWIN)=$G(^XTV(8995,XGCWIN,99)) Q XGCWIN XGCMENU^INT^1^60169,79033^0 XGCMENU ;ISC-SF.SEA/JLI - MENU STATUS CONTROLS ;3/23/94 10:00 ;;8.0T19;KERNEL;;Feb 22, 1995 Q ; ; CLEAR^XGCMENU(MENUSPEC,WIN) RESET STATUS FOR MENUSPEC AND ALL ; DEPENDENT SELECTIONS TO ACTIVE ; ; ON^XGCMENU(MENUSPEC,WIN) Sets ACTIVE to TRUE for the SPECIFIED ; selections only (the specified path and ; selections at the bottom level) ; ; OFF^XGCMENU(MENUSPEC,WIN) Sets ACTIVE to FALSE, inactivating the ; selection, for the specified selections ; at the last level (the specified path to ; the selections is NOT inactivated). ; ; ; USAGE: ; ; D CLEAR^XGCMENU(MENUSPEC,WIN) ; D ON^XGCMENU(MENUSPEC,WIN) ; D OFF^XGCMENU(MENUSPEC,WIN) ; ; ARGUMENTS: ; ; WIN - The Window name (usually the current window) on which the menus ; reside. This argument is OPTIONAL, and if not present, the ; current window which generated the call back is assumed (the ; argument is included to permit modification of the menu ; selection on a new window prior to an ESTART or a call back ; from the window). ; ; MENUSPEC- The sequence of menu items from that on the menubar to those ; (possibly plural) at the final level. The menu items at ; different levels are separated by the caret charcter ('^') ; and multiple menu items (at the final level only) are ; separated by semi-colons (';'). ; ; E.g., the following specification would be used to have ; the NAMES, LOCATION, and OTHER menu selections from the ; OPTION menu selection from the FILE selection on the menubar. ; ; S MENUSPEC="FILE^OPTIONS^NAMES;LOCATION;OTHER" ; ; (The call to CLEAR^XGCMENU would not specify the individual ; selections at the bottom level, but only the lowest level ; from which all dependent selections should be activated.) ; ; For the call to CLEAR^XGCMENU this value specifies the ; heirarchy of menus to reach the element to be cleared or ; reset to active, as a part of this all elements descendent ; from this element or selection will also be reset to active. ; ; The heirarchy starts at the specification on the menubar ; using the menu or display text for the selection, if the ; primary element to be cleared is descendent from this ; selection on the menu bar, a caret ('^') separator will ; be placed between the selection and the subsequent menu ; text. This process is repeated until the proper level ; from which all descendents are to be reset is reached. ; The value of MENUSPEC to clear the File entry on the ; menubar and all descendent selections would simply be ; "FILE", while "EDIT^OPTIONS" would reset the OPTIONS ; selection and all selections descendent from OPTIONS while ; not affecting any other selections available at the ; same level as OPTIONS (EDIT would also be reset to active ; so that OPTIONS could be reached). ; ; The comparison is NOT sensitive to case so upper case can ; be used even though the display text is in upper and lower ; case, also -- the & if present is ignored when the ; comparisons are made. ; CLEAR(MENUSPEC,WIN) ; ; N XMNU,XMNUSPC,A,X1,X2,X3 I '$D(WIN) S WIN=$G(@XGEVENT@("WINDOW")) I WIN="" Q S XMNU=$G(@XGWIN@(WIN,"MENUBAR")) I XMNU="" Q S XMNU(XMNU)=1 S XMNUSPC=MENUSPEC D SETX1 LOOP ; F S XMNU=$O(XMNU("")) Q:XMNU="" K XMNU(XMNU) D . S A="" . F S A=$O(@XGWIN@(WIN,"M",XMNU,"CHOICE",A)) Q:A="" D I X1'="" I $O(XMNU(""))'="" D SETX1 Q . . I X1'="" D . . . D SETX2 . . I X1=""!(X2=X1) D . . . S X1(1,"M",XMNU,"CHOICE",A,"ACTIVE")=1 . . . S X3=$G(@XGWIN@(WIN,"M",XMNU,"CHOICE",A,"SUBMENU")) . . . I X3'="" D . . . . S XMNU(X3)=$G(XMNU(X3),1) D M^XG(WIN,"X1(1)") Q ; SETX1 ; S X1=$P(XMNUSPC,U),XMNUSPC=$P(XMNUSPC,U,2,99) I X1'="" D . S X1=$$UP^XLFSTR(X1) Q SETX2 ; S X2=@XGWIN@(WIN,"M",XMNU,"CHOICE",A) S X2=$P(X2,"&")_$P(X2,"&",2,99) S X2=$P(X2," ...") S X2=$$UP^XLFSTR(X2) I X2="" S X2=$G(^TMP("XGMNU",$J,WIN,XMNU,A)) Q ; ; ON(MENUSPEC,WIN) ; ; N STATUS I '$D(WIN) S WIN=$G(@XGEVENT@("WINDOW")) I WIN="" Q S STATUS=1 D SETSTAT Q ; OFF(MENUSPEC,WIN) ; ; N STATUS I '$D(WIN) S WIN=$G(@XGEVENT@("WINDOW")) I WIN="" Q S STATUS=0 D SETSTAT Q ; SETSTAT ; ;N XMNU,XMNUSPC,A,X1,X2,X3,X0,I S XMNU=$G(@XGWIN@(WIN,"MENUBAR")) I XMNU="" Q S XMNU(XMNU)="" S XMNUSPC=MENUSPEC D SETX1 F S XMNU=$O(XMNU("")) Q:XMNU="" K XMNU(XMNU) D . S A="" . F S A=$O(@XGWIN@(WIN,"M",XMNU,"CHOICE",A)) Q:A="" D I XMNUSPC'="",$O(XMNU(""))'="" D SETX1 Q . . D SETX2 . . F I=1:1 S X0=$P(X1,";",I) Q:X0="" D . . . I X2=X0 D . . . . I STATUS!(XMNUSPC="") D . . . . . S X1(1,"M",XMNU,"CHOICE",A,"ACTIVE")=STATUS . . . . . I 'STATUS S ^TMP("XGMNU",$J,WIN,XMNU,A)=X2 . . . . I XMNUSPC'="" D . . . . . S X3=$G(@XGWIN@(WIN,"M",XMNU,"CHOICE",A,"SUBMENU")) . . . . . I X3'="" D . . . . . . S XMNU(X3)="" D M^XG(WIN,"X1(1)") Q XGCREAD^INT^1^60169,79033^0 XGCREAD ;ISC-SF.SEA/JLI - CONVERT READ STATEMENTS TO ROUTINE CALLS ;3/14/94 15:41 [ 05/13/94 3:46 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ;; REPLACE(TEXT) ; N T1,T2,Y,N,N1,N2,D,TA,TB,Y1,Y2,Y3 S T1=TEXT I T1'[" R "&(T1'[" R:")&(T1'[" READ ")&(T1'[" READ:") Q T1 S T2=$$MASK(T1) S Y="" TAG I $E(T2)'=" " D ; get TAG on first entry, all others should be space . S N=$L($P(T2," ")) . S Y=Y_$E(T1,1,N) . S T1=$E(T1,N+1,255) . S T2=$E(T2,N+1,255) ; DOTS F Q:$E(T2,2)'="." D . S Y=Y_" ." . S T1=$E(T1,3,255) . S T2=$E(T2,3,255) . F Q:$E(T2)'=" " D . . S T1=$E(T1,2,255) . . S T2=$E(T2,2,255) . S T1=" "_T1 . S T2=" "_T2 ; PARSE ; I $E(T2,2)'="R" D . S N=$L($P(T2," ",1,3)) . S Y=Y_$E(T1,1,N) . S T1=$E(T1,N+1,255) . S T2=$E(T2,N+1,255) WCMD I $E(T2,2)="R" D . S D=$S($E(T2,1,3)=" R:":" R:",$E(T2,1,6)=" READ:":" READ:",$E(T2,1,6)=" READ ":" READ ",1:" R ") . S Y2=" I 1 S" . S T1=$E(T1,$L(D)+1,255) . S T2=$E(T2,$L(D)+1,255) COND . S Y3="" I D[":" D . . S N=$L($P(T2," ")) . . S Y3=":"_$E(T1,1,N) . . S T1=$E(T1,N+2,255) . . S T2=$E(T2,N+2,255) ARG . S TB=$P(T2," ") . S TA=$E(T1,1,$L(TB)) . S T1=$E(T1,$L(TB)+1,255) . S T2=$E(T2,$L(TB)+1,255) . S Y1=$$CONVERT(TA,TB) . I Y1["_" D . . S Y2=" W"_Y3_" "_$P(Y1,"_",1,$L(Y1,"_")-1)_" I 1 S" . S Y1=$P(Y1,"_",$L(Y1,"_")) . S Y=Y_Y2_Y3_" "_$P(Y1,":")_"=$$VALUE^XR("_$P(Y1,":",2,99)_")" I T2'="" G PARSE Q Y ; MASK(T1) ; N T2,DQ,I,CNT,N,X S T2=T1 S DQ="""""" F Q:T2'[DQ D . S T2=$P(T2,DQ)_"XX"_$P(T2,DQ,2,99) ; S DQ="""" F Q:T2'[DQ D . S I="" . S $P(I,"X",$L($P(T2,DQ,2))+2)="X" . S T2=$P(T2,DQ)_I_$P(T2,DQ,3,99) ; F Q:T2'["(" D . S I=$L($P(T2,"("))+1 . S CNT=0 . S N=$L(T2) . F I=I:1 D Q:CNT=0 . . S X=$E(T2,I) . . S T2=$E(T2,1,I-1)_"X"_$E(T2,I+1,N) . . I X="(" S CNT=CNT+1 . . I X=")" S CNT=CNT-1 Q T2 ; CONVERT(TA,TB) ; N Y,T1,T2,N,N1,N2,N3 S Y="" S T1=TA S T2=TB F Q:T2'["#" D . S N1=$F(T2,"#") . S T1=$E(T1,1,N1-2)_"$C(3)"_$E(T1,N1,255) . S T2=$E(T2,1,N1-2)_"XXXXX"_$E(T2,N1,255) F Q:T2'["!" D . S N=$L($P(T2,"!")) . S T1=$E(T1,1,N)_"$C(1)_"_$E(T1,N+2,255) . S T2=$E(T2,1,N)_"XXXXXX"_$E(T2,N+2,255) ; F Q:T2'["?" D . S N1=$F(T2,"?") . S N2=$F($E(T2,N1,255)," ") . S N3=$F($E(T2,N1,255),",") . S N2=$S(N2=0:N3,N3=0:N2,N20 S N2=0 Q . . S N4=$E(T2,N1+$L(N3)) . . I N4'=","&(N4'=" ")&(N4'="") S N2=0 Q . . S T1=$E(T1,1,N1-2)_"$C("_N3_")"_$E(T1,N1+$L(N3),255) . . S T2=$E(T2,1,N1-2)_"XXX"_N3_"X"_$E(T2,N1+$L(N3),255) . I N2 Q . S T2=$E(T2,1,N1-2)_"X"_$E(T2,N1,255) INDIR F Q:T2'["@" D Q . S N1=$F(T2,"@") . S N2=$F($E(T2,N1,255)," ") . S N3=$F($E(T2,N1,255),",") . S N4=$F($E(T2,N1,255),"@") . S N2=$S(N2=0:N3,N3=0:N2,N20,$S(N2=0:1,N40 D G EXIT . K ^TMP($J,"MG1") S XGHED=$P(^XMB(3.9,XGVAL,0),U,1,3) ;S XGVAL=$$SELECT1^XGCRECV1() ;G:XGVAL'>0 EXIT D ASK1 Q ; PCFILE ; D ASK S XGSET=0 I '$D(^TMP($J,1)),'$D(^(3)),$D(^(2))=10,$D(^(4))=1 D . S XGHED=^TMP($J,4) . I XGHED'["XGSEND PC SET" Q . K DIR . S DIR(0)="Y" . S DIR("A")="Do you want to install the currently loaded data set" . D ^DIR . K DIR . S XGSET=Y,XGVAL=1 I 'XGSET D . S XGVAL=$$PCREAD^XGCVIEW1() . I XGVAL>0 D . . S XGHED=^TMP($J,4) I XGVAL'>0 G EXIT I '$D(IOSL) D HOME^%ZIS S XGV=$$SELECT1^XGCRECV1() ;G:XGVAL'>0 EXIT D ASK1 Q ; ASK K ^TMP($J,"MG1") S ERTY="INSTALL" S XGCEDITR="" S XGCNEW=0 S XGCVW="^TMP(""XGCVIEW"",$J)" K @XGCVW S XGCNT=4 Q ASK1 ; K DIR S DIR("A")="Are you SURE you want to install this message now" S DIR(0)="Y" D ^DIR Q:$D(DIRUT) I 'Y K CNT,I,X1,X3,DIC,DA,D0 Q ; S XGCPREP=1 D K XGCPREP D . K LEV,DA,DR,^TMP($J,"XGCAS2"),^("ERR") . S LEV=0,FILE=0,FILNUM=0,XGOVRWR=0,XGFRCENT=0,XGUPDAT=1 . S CNT=1 . S ^TMP($J,"ERR",CNT)=$P(XGHED,U)_" "_$P(XGHED,U,3)_" ("_XGVAL_")" . S CNT=CNT+1,^TMP($J,"ERR",CNT)=" " . D EN^XGCRECV2 K ^TMP($J,"MG1",XGVAL) I CNT>2 D . S XMTEXT="^TMP($J,""ERR""," . S XMSUB="Problems Installing MailGram Data" . S XMY(DUZ)="" . S XMDUZ=.5 . D ^XMD . K XMTEXT,XMSUB,XMY,XMDUZ K ^TMP($J,"XGCAS2"),^("ERR") K CNT,LEV,FILE,DA,DR,DIC,DIE,XGFRCENT,XGIJ,XGNOD,XGOVRWR,XGPC,XGIVAL,XGVAL,X,Y,A,D0,DLAYGO,FIELD,FILNUM,J,XGCI,NODE,P,XCNP,XMZ Q VIEWN ; K ^TMP($J,"F"),^("S"),DIRUT D GETLIST S:XGVAL'>0 XGVAL=1 D FILSEL I ERTY="INSTALL"!$D(DIRUT)!(Y=-1) Q D LISTENT I $D(DIRUT) Q Q ; GETLIST ; S NFILE=0 F I=0:0 S I=$O(^TMP($J,2,I)) Q:I'>0 D . I ^TMP($J,2,I,0)?1.NP1"^"1.NP D . . S X2=^TMP($J,2,I,0),J=I,I=$O(^TMP($J,2,I)) Q:I'>0 . . S XA=^TMP($J,2,I,0) D . . . S X1=$P(X2,U,2) . . . S X2=+X2 . . . I X1=.01,$D(^DIC(X2,0)) D . . . . S ^(X2)=$G(^TMP($J,"F",X2))+1 . . . . S XN=^TMP($J,"F",X2) . . . . S ^TMP($J,"F",X2,J)=XA . . . . I XN=1 D . . . . . S NFILE=NFILE+1 Q ; FILSEL ; S XGCNT=$$BLNKLIN^XGCRECV1(XGCVW,1,XGCNT),XGCNT=XGCNT+1,@XGCVW@(XGCNT)="The selected message contains data from "_NFILE_" file"_$S(NFILE>1:"s",1:""),XGCNT=$$BLNKLIN^XGCRECV1(XGCVW,2,XGCNT) K XGCX S A=0 F I=1:1 S A=$O(^TMP($J,"F",A)) Q:A'>0 D . S X2=A . S X1=^TMP($J,"F",A) . S XGCX(I)=A . S XGCNT=XGCNT+1,@XGCVW@(XGCNT)=I_". "_$P(^DIC(X2,0),U)_" file ("_X2_") with data for "_X1_" entr"_$S(X1>1:"ies",1:"y") S XGCNT=$$BLNKLIN^XGCRECV1(XGCVW,2,XGCNT) D WRITER^XGCWRITR(XGCVW) K @XGCVW S Y=-1 Q:ERTY="INSTALL" K DIRUT,DIR S DIR(0)="LO^1:"_(I-1) S DIR("A")="Indicate the file(s) for which you want to view data" D ^DIR K DIR Q:Y=-1!$D(DIRUT) ; K XGCY M XGCY=Y S XGI="" F S XGI=$O(XGCY(XGI)) Q:XGI="" D . F Q:XGCY="" D . . S XGJ=$P(XGCY,",") . . S XGCY=$P(XGCY,",",2,200) . . S ^TMP($J,"S",XGCX(XGJ))="" Q ; LISTENT ; F XGI=0:0 S XGI=$O(^TMP($J,"S",XGI)) Q:XGI="" D . S XGCNT=$$BLNKLIN^XGCRECV1(XGCVW,1,XGCNT)+1,@XGCVW@(XGCNT)=" "_$P(^DIC(XGI,0),U)_" ("_XGI_")",XGCNT=$$BLNKLIN^XGCRECV1(XGCVW,1,XGCNT) . D WRITER^XGCWRITR(XGCVW) K @XGCVW . S DIR("A")="Do you want to see a list of the "_^TMP($J,"F",XGI)_" entries for this file" . S DIR(0)="Y" . S DIR("B")="YES" . D ^DIR . K DIR . K XGCX . S XGJ=0 . F XGK=1:1 S XGJ=$O(^TMP($J,"F",XGI,XGJ)) Q:XGJ'>0 D . . S XGCX(XGK)=XGJ_U_^TMP($J,"F",XGI,XGJ) . I Y D . . S IY=$Y . . F XGJ=0:0 S XGJ=$O(XGCX(XGJ)) Q:XGJ'>0 D Q:XDONE . . . I IY>(IOSL-4) D MORE^XGCWRITR(XGCVW) Q:XDONE S IY=0 . . . S IY=IY+1,X=$P(XGCX(XGJ),U,2) . . . S DIC=XGI,DIC(0)="M" . . . D ^DIC . . . K DIC . . . S X=$S(Y>0:"... PRESENT IN FILE",1:"NEW") . . . S XGCNT=XGCNT+1,@XGCVW@(XGCNT)=$E($J(XGJ,3)_". "_$P(XGCX(XGJ),U,2)_$$SPAC^XGCRECV1(55),1,54)_X . S XGCNT=$$BLNKLIN^XGCRECV1(XGCVW,2,XGCNT) . D WRITER^XGCWRITR(XGCVW) K @XGCVW . S DIR(0)="LO^1:"_^TMP($J,"F",XGI) . S DIR("A")="Select Entry(s) to Display" . D ^DIR . K DIR . K DIRUT . K XGCY . M XGCY=Y . S XGJ="" . F S XGJ=$O(XGCY(XGJ)) Q:XGJ="" D . . S XGCY=XGCY(XGJ) . . F Q:XGCY="" D . . . S XGK=+XGCY . . . S XGCY=$P(XGCY,",",2,200) . . . S ^TMP($J,"S",XGI,+XGCX(XGK))=$P(XGCX(XGK),U,2) Q WAIT ; I IOST["C-" D . S DIR(0)="E" . D ^DIR . I $D(DIRUT) D . . S XDONE=1 . . K DIRUT W @IOF Q ; EXIT ; K A,C,CNT,D0,DA,DIC,DIE,DIR,DIRUT,DLAYGO,DR,ERTY,FIELD,FILE,FILNUM K I,J,K,LEV,LOC,N,NFILE,NODE,P,X,X1,X2,X3,XA,XCNP,XDONE,XGI K XGJ,XGK,XGSET,XGVAL,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,XN,XQMSG,Y,XG1,XG2,XGHED K XGDIC,XGFIL,XGFRCENT,XGII,XGIJ,XGIK,XGNOD,XGOLD,XGPC,XGUPDAT,XGCX1 K XGIVAL,XGX XGCRECV1^INT^1^60169,79033^0 XGCRECV1 ; ISC-SF.SEA/XGC - DATA SELECTION FOR DISPLAY/INSTALL ;11/16/94 10:23 ;;8.0T19;KERNEL;;Feb 22, 1995 Q SELECT() ; S:'$D(XGVAL) XGVAL=-1 I '$D(^TMP($J,"MG1")) D . K ^TMP($J,"F"),^("S") I '$D(^TMP($J,"F")) D . K DIC . S XGVAL=-1 . I '$D(^TMP($J,"MG1")) D . . D SEL1 . I $D(^TMP($J,"MG1")) D . . D SEL2 . . I XGVAL>0 D . . . K ^TMP($J,2) . . . M ^TMP($J,2)=^XMB(3.9,XGVAL,2) Q $$SELECT1() ; SELECT1() ; I XGVAL>0 D . D VIEWN^XGCRECV . S XGF=0 . F XGI=0:0 Q:XGF S XGI=$O(^TMP($J,"S",XGI)) Q:XGI'>0 D . . I $D(^TMP($J,"S",XGI))>9 S XGF=1 Q XGVAL ; SEL1 ; S XGCNT=$$BLNKLIN(XGCVW,1,XGCNT),XGCNT=XGCNT,@XGCVW@(XGCNT)="Searching for available selections..." D WRITER^XGCWRITR(XGCVW) K @XGCVW S X1="MODIFIED MAILGRAM DATA " S X=X1 F I=0:0 S X=$O(^XMB(3.9,"B",X)) Q:$E(X,1,$L(X1))'=X1 D . F J=0:0 S J=$O(^XMB(3.9,"B",X,J)) Q:J'>0 D . . I $D(^XMB(3.9,J,1,"C",DUZ)) D . . . S ^TMP($J,"MG1",J)=^XMB(3.9,J,0) F J=0:0 S J=$O(^TMP($J,"MG1",J)) Q:J'>0 D . F K=.9:0 S K=$O(^XMB(3.9,J,2,K)) Q:K'>0 D Q:$D(^TMP($J,"MG1",J,1)) . . I $L(^XMB(3.9,J,2,K,0),U)=2,+^(0)>0,$P(^(0),U,2)=0 D Q:$D(^TMP($J,"MG1",J,1)) . . . S X1=+^XMB(3.9,J,2,K,0) . . . S X=^XMB(3.9,J,2,K+1,0) . . . I X>0,$P(X,U,2)'="" D Q . . . . S ^TMP($J,"MG1",J,1)=X1_U_$P(X,U,2) . . I $P(^XMB(3.9,J,2,K,0),U,2)=.01 D . . . S X1=+^XMB(3.9,J,2,K,0) . . . S ^TMP($J,"MG1",J,1)=X1_U_^XMB(3.9,J,2,K+1,0) F J=0:0 S J=$O(^TMP($J,"MG1",J)) Q:J'>0 D . I $D(^TMP($J,"MG1",J,1)) D . . S DIC=+^TMP($J,"MG1",J,1) . . S X=$P(^TMP($J,"MG1",J,1),U,2) . . S DIC(0)="" . . D ^DIC . . I Y>0 D . . . I 'XGCNEW D . . . . S $P(^TMP($J,"MG1",J,1),U,3)=+Y . . . I XGCNEW D . . . . K ^TMP($J,"MG1",J) I '$D(^TMP($J,"MG1")) D Q . S XGCNT=$$BLNKLIN(XGCVW,3,XGCNT) . S XGCNT=XGCNT+1,@XGCVW@(XGCNT)="No Messages to Select From." . S XGCNT=$$BLNKLIN(XGCVW,2,XGCNT) Q ; SEL2 S XGCNT=$$BLNKLIN(XGCVW,1,XGCNT),XGCNT=XGCNT+1,@XGCVW@(XGCNT)="Select entry for "_ERTY_"ING: " S X1=$L("MODIFIED MAILGRAM")+2 S XDONE=0,J=0,XGVAL=0 F K=1:1 Q:XGVAL>0!XDONE S J=$O(^TMP($J,"MG1",J)) Q:J'>0 D . S K(K)=J . S XGCX1=$J(K,3)_". "_$E($P(^TMP($J,"MG1",J),U),X1,90) . S X=$P(^TMP($J,"MG1",J),U,3) . I $L(XGCX1)<55 D . . S XGCX1=$E(XGCX1_$$SPAC(55),1,55) . S XGCX1=XGCX1_$S('$P($G(^TMP($J,"MG1",J,1)),U,3):"NEW",1:" ")_" " . I X'=+X S XGCX1=XGCX1_X . I X=+X S XGCX1=XGCX1_$$WDATE(X) . S XGCNT=XGCNT+1,@XGCVW@(XGCNT)=XGCX1 . S N=K . I '(K#20) D . . D VAL Q:XDONE I XGVAL'>0 D . S N=K-1 . D VAL Q:XGVAL'>0!XDONE ; S XGDAT=$P(^TMP($J,"MG1",XGVAL),U,3) S DA=+$P($G(^TMP($J,"MG1",XGVAL,1)),U,3) I XGDAT=+XGDAT D . S XGDAT=$$WDATE(XGDAT) K N,K,J Q VAL ; S XDONE=0 D WRITER^XGCWRITR(XGCVW) K @XGCVW S DIR(0)="N"_$S(J'=""&($O(^TMP($J,"MG1",J))>0):"O",1:"")_"^1:"_N S DIR("A")="Select (1 to "_N_")" D ^DIR K DIR I $D(DIRUT) S XDONE=1 Q I (Y<1)!(Y>N) S XGVAL=-1 Q S XGVAL=K(Y) ;I '$D(^XMB(3.9,XGVAL,2,.91)) D ALSEA Q ; BLNKLIN(LOC,N,C) ; N I F I=1:1:N S C=C+1,@LOC@(C)=" " Q C WDATE(X) ; write FM date as mm/dd/yy hh:mm N % S %=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)_" " S X=$P(X,".",2)_"0000" S %=%_$E(X,1,2)_":"_$E(X,3,4) Q % ; WAIT ; I IOST["C-" D . S DIR(0)="E" . D ^DIR . I $D(DIRUT) D . . S XDONE=1 . . K DIRUT W @IOF Q ; SPAC(N) ; N X S $P(X," ",N)=" " Q X ; XGCRECV2^INT^1^60169,79033^0 XGCRECV2 ;ISC-SF..SEA/XGC - RESTORE DATA FROM MODIFIED MAILGRAM TRANSFER ;3/8/94 09:32 ;7/24/91 15:30 ; 01/31/89 ;;8.0T19;KERNEL;;Feb 22, 1995 EN ; F XGCI=.99:0 Q:(FILE=0&(FILNUM'=0)) S XGCI=$O(^TMP($J,2,XGCI)) Q:XGCI'>0 D MORE Q MORE ; I $D(^TMP($J,2,XGCI,0)) S X1=^(0) S XGCI=$O(^TMP($J,2,XGCI)) I XGCI>0,$D(^(XGCI,0)) S X2=^(0),XG1=+X1,XG2=+$P(X1,U,2) D:(XG1>0&(XG2>0)) SET1 D:(XG1=0&(XG2=0)) SETV D:(XG1>0&(XG2=0)) SPEC Q ; SETV S XGUPDAT=+X2,XGOVRWR=+$P(X2,U,2),XGFRCENT=0 Q ; SPEC ; S XGFRCENT=1,XGOLD=0,(FILNUM,FILE)=+X1,DIC=FILE,DLAYGO=FILE,XGFIL=+X2,X=$P(X2,U,2),DIC(0)="M" D ^DIC S (DA,D0)=+Y I Y>0 S ^TMP($J,"XGCAS2",FILE)=$P(X2,U,2),XGOLD=1,DIE=DIC I 'XGUPDAT S FILE=0 I Y'>0,XGFIL'=FILE S XGDIC=DIC,DIC=XGFIL,X=$P(X2,U,2),DIC(0)="M" D ^DIC I Y>0 S DIC=XGDIC,DA=+$O(@(DIC_"""B"","_(+Y)_",0)")),XGDIC=$O(^(DA)) S:XGDIC>0 DA=-1 I DA>0 S ^TMP($J,"XGCAS2",FILE)=$P(X2,U,2),XGOLD=1,DIE=DIC I 'XGUPDAT S FILE=0 I DA'>0 S FILE="" Q ; NEW ; I FILE'=FILNUM G NEWFIL I '$D(^DD(FILNUM,0,"UP")) D TOPFIL Q S A=$S('$D(^DD(FILNUM,.01,0)):0,$P(^(0),U,2)="W":2,1:1) I 'A S DA=-1 Q I A=2,FILE=FILNUM S DA=0 D F I=0:0 S I=$O(@(DIC_I_")")) Q:I'>0 S DA=I . N X . S X=$E(DIC,1,$L(DIC)-1)_")" . K @X I A=2,FILE=FILNUM S DA=DA+1,@(DIC_DA_",0)")=X2,@(DIC_"0)")="^^"_DA_U_DA Q S ^TMP($J,"XGCAS2",FILNUM)=X2,DIC(0)="ML",DIC("P")=$S($D(P):P,1:FILE),X=X2 I DIC["-1" S DA=-1,DIE=DIC Q S Y=-3 D:DIC'["-3" ^DIC S (DA,D0)=+Y S DIE=DIC Q ; NEWFIL ; I LEV>0,'$D(^DD(FILNUM,0,"UP")) D MOVEUP G NEW I '$D(^DD(FILNUM,0,"UP")) D TOPFIL Q I ^DD(FILNUM,0,"UP")=FILE D MOVDOWN G NEW I LEV>0 D MOVEUP G NEW Q ; ERROR, LEAVE FILE SAME, SO FILE'=FILNUM AND NOTHING IS ENTERED. ; TOPFIL ; This is a main file S DLAYGO=FILNUM ;I '$D(^TMP($J,"XGCAS2",FILNUM,X2)) Q:$D(^TMP($J,"XGCAS2",FILNUM)) S ^(FILNUM)="" K LEV,DA S LEV=0,DA=1,DIC=^DIC(FILNUM,0,"GL"),P=FILNUM,FILE=FILNUM,DIE=DIC ;I $D(^TMP($J,"XGCAS2",FILNUM,X2)) S (Y,DA,D0)=^(X2) Q I 'XGFRCENT S X=X2,DIC(0)="XML",DIC("P")=FILE D ^DIC S (DA,D0)=+Y Q:Y'>0 S ^TMP($J,"XGCAS2",FILNUM,X2)=DA,DIE=DIC,P=FILE S:('XGUPDAT&'$P(Y,U,3)) DA=-3 D Q . I DA'>0 Q . I $P(Y,U,3) Q . I '$D(XGCPREP) Q . I 'XGCPREP Q . S XGDA=DA,DIK=^DIC(FILE,0,"GL") . S XGVALNAM=$P(Y,U,2) . D ^DIK . K DIK . S DIC(0)="ML",DINUM=XGDA,DIC=^DIC(FILE,0,"GL") . S X=XGVALNAM . D FILE^DICN . S DA=XGDA S X=""""_X2_"""",DIC(0)="ML",DIC("P")=FILE D ^DIC S (DA,D0)=+Y I Y>0 S ^TMP($J,"XGCAS2",FILNUM,X2)=DA,DIE=DIC Q ; MOVDOWN ; Move Down to a subfile S LEV(LEV,"DIC")=DIC,LEV(LEV,"FILE")=FILE,LEV(LEV,"P")=FILE S DA(0)=DA F J=LEV+1:-1:1 S DA(J)=DA(J-1) S NODE=+$O(^DD(FILE,"SB",FILNUM,0)),NODE=$P(^DD(FILE,NODE,0),U,4),NODE=$P(NODE,";",1),DIC=DIC_DA_","_NODE_",",FILE=FILNUM,P=$P(^(0),U,2),LEV=LEV+1 Q ; MOVEUP ; S LEV=LEV-1 F J=0:1:LEV S DA(J)=DA(J+1) S DA=DA(0),DIC=LEV(LEV,"DIC"),FILE=LEV(LEV,"FILE"),DIC("P")=LEV(LEV,"P"),DIE=DIC K LEV(LEV) Q SET1 ; S FILNUM=+X1,FIELD=+$P(X1,U,2) I FIELD=.01 D NEW S ERTY=$S(DA=-3:"",DA'>0:"EN",FILE'=FILNUM:"FILE",1:"") D:ERTY'="" LOGERR Q I DA=-3 Q I DIC["-3" Q I FILE'=FILNUM,LEV>0 D MOVEUP G SET1 I FILE'=FILNUM S ERTY="FILE" D LOGERR Q I FILE=2,FIELD=63 Q I DA'>0 S ERTY="EN" D LOGERR Q I '$D(^DD(FILNUM,FIELD,0)) S ERTY="FLD" D LOGERR Q S XGIJ=$P(^DD(FILNUM,FIELD,0),U,4),XGPC=+$P(XGIJ,";",2) I $E(XGPC)=" " S ERTY="PC" D LOGERR Q S XGNOD=$P(XGIJ,";") S:+XGNOD'=XGNOD XGNOD=""""_XGNOD_"""" S XGIJ=$S($D(@(DIC_DA_","_XGNOD_")")):@("^("_XGNOD_")"),1:"") I XGPC=+XGPC S XGIVAL=$P(XGIJ,U,XGPC) I XGPC'=+XGPC S XGIVAL=$E(XGIJ,$P($E(XGPC,2,99),","),$P(XGPC,",",2)) D . F XGII=$L(XGIVAL):-1:1 S XGIK=$E(XGIVAL,XGII) Q:XGIK'=" "&($A(XGIK)>32) S XGIVAL=$E(XGIVAL,1,XGII-1) . K XGII,XGIK I XGIVAL'="",'XGOVRWR Q S DR=FIELD_"///"_X2 I DIE'["-1" D ^DIE S XGIJ=$S($D(@(DIC_DA_","_XGNOD_")")):@("^("_XGNOD_")"),1:"") I XGPC=+XGPC S XGIVAL=$P(XGIJ,U,XGPC) E S XGIVAL=$E(XGIJ,$P($E(XGPC,2,99),","),$P(XGPC,",",2)) I XGIVAL="" S ERTY="ED" D LOGERR Q ; LOGERR ; S CNT=CNT+1 I ERTY="EN" S ^TMP($J,"ERR",CNT)="NO COMPATIBLE FILE ENTRY, COULDN'T ADD DATA FOR IT." I ERTY="FILE" S ^TMP($J,"ERR",CNT)="NO COMPATIBLE FILE -- COULDN'T ADD DATA FOR NON-EXISTENT FILE." I ERTY="ED" S ^TMP($J,"ERR",CNT)="DATA WAS NOT ENTERED -- FOR SOME REASON DURING EDITING." I ERTY="PC" S ^TMP($J,"ERR",CNT)="FIELD DEFINITION INDICATES A COMPUTED FIELD - CAN'T ENTER DATA INTO IT." I ERTY="FLD" S ^TMP($J,"ERR",CNT)="NO DEFINITION IN FILE FOR THIS FIELD -- CAN'T ENTER DATA INTO NON-EXISTENT FIELD" S CNT=CNT+1,XGX=" File "_FILNUM_", field "_FIELD_$S($D(^DD(FILNUM,FIELD,0)):" ("_$P(^DD(FILNUM,FIELD,0),U)_")",1:"")_" data value= " I ($L(XGX)+$L(X2))<250 S ^TMP($J,"ERR",CNT)=XGX_X2 E S ^TMP($J,"ERR",CNT)=XGX,CNT=CNT+1,^(CNT)=X2 S CNT=CNT+1,^TMP($J,"ERR",CNT)=" " Q ; SERVER ; ; S XGVAL=XQMSG G EN XGCSEND^INT^1^60169,79033^0 XGCSEND ;JLI/SF-ISC.SEA - MOVE ALL DATA IN GUI RELATED FILES INTO MAIL MESSSAGE ;2/19/94 05:15 ;;8.0T19;KERNEL;;Feb 22, 1995 MAIL ; D ASK1 I $D(^TMP($J)) S XMTEXT="^TMP($J,",XMSUB="MODIFIED MAILGRAM DATA for WINDOW OBJECT and related files" D ^XMD EXIT ; K %DT,DFN,DIC,DICBAS,DICN,DICNXT,DIR,DIRUT,DR,DS,FIELDN,FILEN,FN,I,IX K IM,J,JMAX,JX,JXDIC,JXF,JXFL,JXX,JXXL,K,LEV,LOW,NODE,NODEPC,OLDDIC K OLDF,OLDIX,OUTRAN,OUTTRAN,PIECE,POINT,POP,X,X1,X2,XGCA,XGCA1,XGCI K XGCJ,XGDAT,XGNAM,XGSND,XGTYP,XMSUB,XMTEXT,Y,XGOVRWR,XGUPDAT K ^TMP($J) Q ; PCFILE ; D ^%ZIS Q:POP D ASK1 D PCWRITE G EXIT ; ; ASK1 ; K XGSND,DIRUT S XGTYP=8995,XGNAM="WINDOW OBJECT" D GET1 I $D(DIRUT) K DIRUT G EXIT S XGTYP=8995.8,XGNAM="CALL BACK" D GET1 I $D(DIRUT) K DIRUT G EXIT G:'$D(XGSND) EXIT S DIR(0)="Y",DIR("A",1)="Do you want to send the basic files which should be stable as well?",DIR("A",2)="Usually, you would not need to, but if they have been altered then you should",DIR("A",3)=" ",DIR("A")="Send other GUI files" S DIR("B")="NO" D ^DIR K DIR I Y S XGSND(8995.4,1)="**",XGSND(8995.5,1)="**",XGSND(8995.6,1)="**",XGSND(8995.7,1)="**" S DIR(0)="Y",DIR("A")="If an entry already exists do you want any further updating to occur?",DIR("B")="YES" D ^DIR S XGUPDAT=Y K DIR S XGOVRWR=0 I XGUPDAT S DIR(0)="Y",DIR("A")=" If a value already exists for field, do you want it replaced with your data?" D ^DIR S XGOVRWR=Y K DIR K ^TMP($J) S IX=1,^TMP($J,IX)="0^0",IX=IX+1,^(IX)=XGUPDAT_U_XGOVRWR W ! F FILEN=8995.8,8995.4,8995.5,8995.7,8995.6,8995 I $D(XGSND(FILEN,1)) D GETDAT Q GETDAT K DS,DR S DS(FILEN)="" F S FN=$O(DS("")) Q:FN="" K DS(FN) S X1=$O(^DD(FN,.001)) D I X1>0 S DR(FN)=X1 I X2>X1 S DR(FN)=X1_":"_X2_";" . F I=.001:0 S I=$O(^DD(FN,I)) Q:I'>0 S X2=I . F I=0:0 S I=$O(^DD(FN,"SB",I)) Q:I'>0 S DS(I)="" S DR=DR(FILEN) K DR(FILEN) LOOP ; I XGSND(FILEN,1)="**" F DFN=0:0 S DIC=^DIC(FILEN,0,"GL") S DFN=$O(@(DIC_DFN_")")) Q:DFN'>0 D LOOP1 I XGSND(FILEN,1)'="**" F XGCI=0:0 S XGCI=$O(XGSND(FILEN,XGCI)) Q:XGCI'>0 S XGCA1=XGSND(FILEN,XGCI),XGCA=$E(XGCA1,1,$L(XGCA1)-1)_$C($A($E(XGCA1,$L(XGCA1)))-1)_"z" D . F S DIC=^DIC(FILEN,0,"GL"),XGCA=$O(@(DIC_"""B"","""_XGCA_""")")) Q:XGCA="" Q:$E(XGCA,1,$L(XGCA1))'=XGCA1 S DFN=$O(^(XGCA,0)),Y=0 D I 'Y D LOOP1 . . F XGCJ=0:0 S XGCJ=$O(XGSND(FILEN,XGCI,XGCJ)) Q:XGCJ'>0 S X=XGSND(FILEN,XGCI,XGCJ) I $E(XGCA,1,$L(X))=X S Y=1 Q Q LOOP1 S DICNXT="",DICBAS="",LEV=0 S DIC=DIC_(+DFN)_"," ;K DIC S DIC=FILEN,DIC(0)="AEQM" D ^DIC K DIC(0) Q:Y'>0 S DFN=+Y,DIC=DIC_(+Y)_",",ENTNAM=$P(Y,U,2) ;S OLDIX=IX,X=$O(^DD(FILEN,0,"SP",0)) I X>0 S FIELDN=X D MOVEIT^XGCSEND1 S ^TMP($J,OLDIX+1)=FILEN_U_0,^(OLDIX+2)=FILEN_U_^(OLDIX+2) ;I IX=OLDIX K JXFL S FIELDN=.01 D MOVEIT^XGCSEND1 I $D(JXFL),JXFL>0 D ;. S ENTNAM=JX,IX=OLDIX,OLDF=FILEN,OLDDIC=DIC,DIC=JXDIC,FILEN=JXXL,FIELDN=JXFL D MOVEIT^XGCSEND1 S FILEN=OLDF,DIC=OLDDIC,^TMP($J,OLDIX+1)=FILEN_U_0,^(OLDIX+2)=JXXL_U_^(OLDIX+2) ; HUH?? K OLDIX,JXFL,JXXL,OLDF,JXDIC,OLDDIC D MOVE^XGCSEND1 Q GET1 ; W !! S DIR("A",2)=" Enter ** to move all entries",DIR("A",1)="Indicate a namespace of 2 or more characters of "_XGNAM_" to be moved",DIR("A",3)=" " F I=1:1 Q:$D(DIRUT) S DIR(0)="FO^2:15",DIR("A")=$S(I>1:"Another ",1:"")_"Namespace" D ^DIR K DIR K:X="" DIRUT Q:X="" S XGSND(XGTYP,I)=X Q:X="**" D . I X'?1U1UN.UNP W !!,"Enter an UPPERCASE LETTER followed by an UPPERCASE LETTER OR NUMBER",!,"and other characters" K XGSND(XGTYP,I) S I=I-1 Q . F J=1:1 S DIR(0)="FO^"_($L(XGSND(XGTYP,I))+1)_":20",DIR("A")="Enter Part of "_XGSND(XGTYP,I)_" namespace to omit (if any)" D ^DIR K DIR K:X="" DIRUT Q:X=""!$D(DIRUT) D . . I $E(X,1,$L(XGSND(XGTYP,I)))'=XGSND(XGTYP,I)!($E(X,$L(XGSND(XGTYP,I))+1,$L(X))'?1.UN) W $C(7)," ??" S J=J-1 Q . . S XGSND(XGTYP,I,J)=X Q ; PCWRITE ; S X="N",%DT="T" D ^%DT S XGDAT=Y U IO W !,"***D^",Y F I=0:0 S I=$O(^TMP($J,I)) Q:I'>0 W !,$S('(I#2):U,1:"")_U_^(I) W !,"***^***" D ^%ZISC Q ; XGCSEND1^INT^1^60169,79033^0 XGCSEND1 ;JLI/SF-ISC.SEA - MOVE ALL DATA IN GUI RELATED FILES INTO MAIL MESSSAGE (CONTINUATION) ;1/25/94 16:40 ;6/13/88 1:55 PM ;;8.0T19;KERNEL;;Feb 22, 1995 Q ; MOVE ; Move File and field numbers, then data into ^TMP S J=0 F I=1:1 S FIELDN=$P(DR,";",I) Q:FIELDN="" I FIELDN>0 D MOVE1 Q ; MOVE1 ; Move a single field number and data into ^TMP I FIELDN[":" G MOVEALL S FIELDN=+FIELDN D MOVEIT Q ; MOVEALL ; S J=FIELDN-.00000000001,JMAX=+$P(FIELDN,":",2) S:JMAX=0 JMAX=+FIELDN F K=0:0 S J=$O(^DD(FILEN,J)) Q:J'>0!(J>JMAX) S FIELDN=J D MOVEIT Q ; MOVEIT I DFN'>0 W !,FILEN," ",FIELDN Q:'$D(^DD(FILEN,FIELDN,0)) S NODEPC=$P(^(0),U,4),POINT=$P(^(0),U,2)["P",OUTTRAN=$P(^(0),U,2)["O",NODE=$P(NODEPC,";",1),PIECE=$P(NODEPC,";",2) I NODE=" "&(PIECE=" ") Q S:+NODE'=NODE NODE=""""_NODE_"""" I DFN'>0 W !,FILEN_";"_FIELDN," ",NODEPC," ",OUTRAN I PIECE>0 S DICN=DIC_NODE_")" Q:'$D(@DICN) S JX=$P(@DICN,U,PIECE) Q:JX="" D XPAND Q:JX="" S IX=IX+1,^TMP($J,IX)=FILEN_"^"_FIELDN,IX=IX+1,^(IX)=JX Q I $E(PIECE)="E" S DICN=DIC_NODE_")" Q:'$D(@DICN) S JX=$E(@DICN,+$E(PIECE,2,99),+$P(PIECE,",",2)) Q:JX="" S IX=IX+1,^TMP($J,IX)=FILEN_"^"_FIELDN,IX=IX+1,^(IX)=JX Q I PIECE=0 D LOWER Q Q ; XPAND ; I $P(^DD(FILEN,FIELDN,0),U,2)["N" S JX=+JX ; Make sure leading/trailing zeroes disappear from numeric data I POINT S JXX=FILEN,JXF=FIELDN D POINTR S JXFL=$O(^DD(JXX,0,"SP",0)),JXXL=JXX,JXDIC=$P(POINT,"0)") I OUTTRAN,$D(^DD(FILEN,FIELDN,2)) S Y=JX X ^(2) S JX=Y Q ; LOWER ; Drop down to a subfile S LOW=+$P(^DD(FILEN,FIELDN,0),U,2) Q:LOW'>0 I '$D(DR(LOW)) Q:'$D(^DD(LOW,.01,0)) Q:$P(^(0),U,2)'="W" S DR(LOW)=".01;" ; No fields for this subfile, unless its a word-processing field, then set it up. S LEV=LEV+1,LEV(LEV,"FILEN")=FILEN,LEV(LEV,"DRPIECE")=I,LEV(LEV,"DR")=DR,FILEN=+$P(^DD(FILEN,FIELDN,0),U,2),DR=DR(FILEN),LEV(LEV,"DIC")=DIC,LEV(LEV,"DICNXT")=DICNXT,LEV(LEV,"DICBAS")=DICBAS,LEV(LEV,"J")=J,LEV(LEV,"JMAX")=JMAX S DICBAS=DIC_NODE_"," S DICNXT=0 F IM=0:0 S DICNXT=$O(@(DICBAS_DICNXT_")")) Q:DICNXT'>0 S DIC=DICBAS_DICNXT_"," D MOVE S FILEN=LEV(LEV,"FILEN"),I=LEV(LEV,"DRPIECE"),DR=LEV(LEV,"DR"),DICBAS=LEV(LEV,"DICBAS"),DICNXT=LEV(LEV,"DICNXT"),DIC=LEV(LEV,"DIC"),J=LEV(LEV,"J"),JMAX=LEV(LEV,"JMAX") K LEV(LEV) S LEV=LEV-1 Q ; POINTR ; Field is a pointer, set to actual value instead of pointer value S POINT="^"_$P(^DD(JXX,JXF,0),"^",3)_JX_",0)",JXX=+$P($P(^DD(JXX,JXF,0),"^",2),"P",2),JX="" Q:'($D(@POINT)#2) S JX=$P(@POINT,"^",1) Q:$P(^DD(JXX,.01,0),U,2)'["P" S JXF=.01 G POINTR ; XGCUNCO1^INT^1^60169,79033^0 XGCUNCO1 ;ISC-SF..SEA/JLI - CONTINUTATION OF UNCOMPILER ;2/19/94 04:50 ;;8.0T19;KERNEL;;Feb 22, 1995 ; ; and what window entry to create EN2 ; W ! K DIC S DIC("A")="Entry name to save the window under: " S DIC(0)="AEQML" ; EN2A ; S DIC=8995 S DLAYGO=8995 S XGCEDITR=1 S DIC("DR")=".03///WINDOW;" D ^DIC G:Y'>0 EXIT^XGCUNCOM S DA=+Y S XGDA=DA S XGENTNAM=X I '$P(Y,U,3) D G:DA'>0 EN2 ; entry selected already exists . ; . I '$D(XGSILENT) D Q:DA'>0 . . S DIR("A")="Do you REALLY want to replace the current "_$P(Y,U,2) . . S DIR(0)="Y" . . S DIR("B")="NO" . . D ^DIR . . K DIR . . S:'Y DA=-1 ; nope, go get another name . ; . K ^TMP("XGCUNCO1",$J) . M ^TMP("XGCUNCO1",$J)=^XTV(8995,+DA,5) . S DIK="^XTV(8995," ; we're going to use an existing name . S XGDA=DA ; so make sure that nothing gets left . D ^DIK ; over from the past... . K DIK ; delete current entry . ; . K DIC("A") . S DIC(0)="ML" . S X=XGENTNAM . S DINUM=DA . D FILE^DICN ; and re-create with same name and location . M ^XTV(8995,+DA,5)=^TMP("XGCUNCO1",$J) . K ^TMP("XGCUNCO1",$J) ; ; set current date/time for window ENT1 S X="N" S %DT="TS" D ^%DT K %DT S ^XTV(8995,DA,99)=Y ; as window time stamp ; ; S DLAYGO=8995 K ^TMP("XGCUNCOM",$J) S XROOT=XGLOB S XGTYP="M" S XGNE=0 S XGTYP="" F S XGTYP=$O(@XROOT@(XGTYP)) Q:XGTYP="" D . D CHKTYP^XGCUNCO1(XROOT,XGDA,XGTYP) ; S DA=XGDA S DIK="^XTV(8995," D IX1^DIK ; Make sure cross-refs get set ; ; --------------------------------------------------------- ; list out any problems S I="" F S I=$O(^TMP("XGCUNCOM",$J,I)) Q:I="" D . S J="" F S J=$O(^TMP("XGCUNCOM",$J,I,J)) Q:J="" S X=^(J) D . . I J="EVENT" D Q . . . W !,"In object ",I," invalid/unrecognized EVENT: ",X . . W !,"In object ",I," invalid/unrecognized ATTRIBUTE: ",J . . W !?5,"Value was: ",X Q ; CHKTYP(XROOT,XGDA,XGTYP) ; N XGCI I XGTYP="EVENT" D WINEVNT(XROOT,XGDA) Q ; events for window ; I XGTYP="G"!(XGTYP="M")!(XGTYP="T") D Q . D GADGET^XGCUNCO2(XROOT,XGDA,XGTYP) ; these are attributes for window S XGCVAL=@XROOT@(XGTYP) ; value for attribute S XGCI=+$O(^XTV(8995.7,"B",XGTYP,0)) S XGCJ=+$O(^XTV(8995.6,"B","WINDOW",0)) ; I XGCI'>0!($O(^XTV(8995.6,XGCJ,1,"B",XGCI,0))'>0) D ; invalid attribute . S ^TMP("XGCUNCOM",$J,"WINDOW",XGTYP)=XGCVAL . S XGCI=0 ; I XGCI>0 D . I $P(^XTV(8995.7,XGCI,0),U,3) D ; user specified attribute . . I $P(^XTV(8995.7,XGCI,0),U,2)>0 D Q . . . S DIE="^XTV(8995," . . . S DA=XGDA . . . S DR=$P(^XTV(8995.7,XGCI,0),U,2) . . . S DR=DR_"///"_$S(DR=100.03:$$MENUNM^XGCUNCO2(XGCVAL),1:XGCVAL)_";" . . . D ^DIE . . . K DIE,DR . . S ^DIC(0)="ML" . . S DIC="^XTV(8995,XGDA,7," . . S DIC("P")=8995.07 . . S X=XGCTY . . S DIC("DR")="1.01///"_XGCVAL_";" . . S DA(0)=XGDA . . S D0=XGDA . . D ^DIC . . K DIC Q ; WINEVNT(XROOT,XGDA) ; N XGEVNTNM,DA,XGCMM,DIC,X,Y,DIE,DR S DA(1)=XGDA S XGEVNTNM="" F S XGEVNTNM=$O(@XROOT@("EVENT",XGEVNTNM)) Q:XGEVNTNM="" D . I '$$VALEVNT("WINDOW",XGEVNTNM) D Q ; don't process if not valid . . S ^TMP("XGCUNCOM",$J,"WINDOW","EVENT")=XGEVNTNM . S XGEVNROU=@XROOT@("EVENT",XGEVNTNM) ; TAG^ROUTINE for callback . S XGCMM=$$EVENT^XGCUNCO2("WINDOW",XGEVNTNM,XGEVNROU) ; get call back name . Q:XGCMM="" . S:'$D(^XTV(8995,XGDA,1,0)) ^(0)="^8995.01P" . S DIC="^XTV(8995,DA(1),1," . S DIC(0)="ML" . S X=XGEVNTNM . D ^DIC . I Y>0 D . . S DA=+Y . . S DIE=DIC . . S DR=".02///"_XGCNNM_";" . . D ^DIE . . K DIC,DIE,DR Q ; ; --------------------------------------------------------------- ; VALEVNT - returns TRUE if event is valid for object type ; returns FALSE if event is not valid ; VALEVNT(OBJTYP,EVNTNAM) ; S I=+$O(^XTV(8995.5,"B",EVNTNAM,0)) ; I=ien for event in event file S J=+$O(^XTV(8995.6,"B",OBJTYP,0)) S I=$O(^XTV(8995.6,J,2,"B",I,0)) ; look up valid event for window Q I>0 ; ; ----------------------------------------------------------------- ; VALATRIB - returns TRUE if attribute is valid for object type ; VALATRIB(OBJTYP,ATTRIB) ; S I=+$O(^XTV(8995.7,"B",ATTRIB)) S J=+$O(^XTV(8995.6,"B",OBJTYP)) S I=$O(^XTV(8995.6,J,1,"B",I,0)) Q I>0 XGCUNCO2^INT^1^60169,79033^0 XGCUNCO2 ;ISC-SF..SEA/JLI - CONTINUATION OF UNCOMPILER ;11/16/94 10:25 ;;8.0T19;KERNEL;;Feb 22, 1995 ; ; ----------------------------------------------------------------- ; EVENT -- returns call back name from CALL BACK file ; EVENT(GADNAM,XGEVNTNM,XGEVNROU) ; N DIC,DIE,DA S:XGEVNROU'[U XGEVNROU=U_XGEVNROU S XGNE=XGNE+1 S XGCNNM="" F I=0:0 S I=$O(^XTV(8995.8,I)) Q:I'>0 D Q:XGCNNM'="" . I $P(^XTV(8995.8,I,0),U,2,3)=XGEVNROU D . . S XGCNNM=$P(^XTV(8995.8,I,0),U) ; S XGCN=+I I XGCN'>0 D ; no current entry in call back file . ; . I '$D(XGSILENT) D . . W !!?5,$C(7),"An EVENT with no equivalent entry in the CALL BACK file has been" . . W !,"encountered. This event is a ",XGEVNTNM," event in ",GADNAM . . W !,"using a call back to ",XGEVNROU . . W !,"Please enter the desired name for this new CALL BACK",! . . S DIC(0)="AEQML" . I $D(XGSILENT) D . . S X=XGENTNAM_" "_GADNAM_" "_XGEVNTNM . . S DIC(0)="L" . S DIC("DR")=$S($P(XGEVNROU,U)'="":".02///"_$P(XGEVNROU,U)_";",1:"")_".03///"_$P(XGEVNROU,U,2)_";" . S DIC=8995.8 . S DLAYGO=8995.8 . D ^DIC . S DLAYGO=8995 . I Y>0,$P(Y,U,3) D . . S DA=+Y . . S XGCNNM=$P(Y,U,2) Q XGCNNM ; GADGET(XROOT,XGDA,XGTYP) ; N A S XGDGT="" F S XGDGT=$O(@XROOT@(XGTYP,XGDGT)) Q:XGDGT="" D . S XGLOB2=$NA(@XROOT@(XGTYP,XGDGT)) . S X=XGDGT . S DIC(0)="L" . S DA(1)=XGDA D . . S C=0 . . S XGDTYP="" . . S XGDTYP=$S(XGTYP="T":"TIMER",XGTYP="G":@XGLOB2@("TYPE"),1:"") . . I XGDTYP'="" D . . . S A="XG " . . . F S A=$O(^XTV(8995,"B",A)) Q:A="" Q:$E(A,1,3)'="XG " D Q:C=XGDTYP . . . . S B=$O(^XTV(8995,"B",A,0)) . . . . I B>0 D . . . . . S C=$P($G(^XTV(8995,B,0)),U,3) . . . . . S C=$P($G(^XTV(8995.6,+C,0)),U) . . I XGTYP="G"!(XGTYP="T") D Q:Y'>0 . . . S DIC("P")=8995.02 . . . S DIC("DR")=".02///"_A_";" . . . S DIC="^XTV(8995,DA(1),2," . . . D ^DIC . . . S (XGDAA,DA,D1)=+Y . . I C=XGDTYP D . . . S DIE=DIC . . . S DR=".02///"_A_";" . . . S:$G(@XGLOB2@("POS"))'="" DR=DR_".03///"_^("POS")_";" . . . S:$G(@XGLOB2@("SIZE"))'="" DR=DR_".04///"_^("SIZE")_";" . . . S:$G(@XGLOB2@("TITLE"))'="" DR=DR_".05///"_^("TITLE")_";" . . . D ^DIE K DR,DIE,DIC . . S XGSS="" . . F S XGSS=$O(@XGLOB2@(XGSS)) Q:XGSS="" D . . . I ",TYPE,POS,SIZE,TITLE,"[(","_XGSS_",") Q . . . S XGX=$NA(@XGLOB2@(XGSS)) . . . S XGY="" . . . D GADSUBS(.XGY,XGSS,XGX) . . . I XGTYP="G"!(XGTYP="T") D SETASOC . . . ; . . . ; . . . I XGTYP="M" D SETMENU Q SETASOC ; S X="" F S X=$O(XGY(X)) Q:X="" S XGOLDX=X D S X=XGOLDX . I $S($P(X,",")'="EVENT":1,$L(X,",")>2:1,1:0) D Q . . S DIC="^XTV(8995,DA(2),2,DA(1),2," . . S DIC("P")=8995.022 . . S DA(1)=XGDAA . . S DA(2)=XGDA . . S DIC(0)="L" . . D ^DIC . . I Y>0 D . . . S (XGDAAA,D2,DA)=+Y . . . S DIE=DIC . . . S DR="1///"_XGY(X)_";" . . . D ^DIE . . . K DR,DIE,DA . S XGEVNTNM=$P(X,",",2) . I '$$VALEVNT^XGCUNCO1(XGDTYP,XGEVNTNM) D Q . . S ^TMP("XGCUNCOM",$J,XGDGT,"EVENT")=XGEVNTNM . S XGEVNROU=XGY(X) . S X=XGEVNTNM . S DIC="^XTV(8995,DA(2),2,DA(1),1," . S DIC("P")=8995.21 . S DA(1)=XGDAA . S DA(2)=XGDA . S DIC(0)="L" . D ^DIC . I Y>0 D . . S (XGDAAA,DA)=+Y . . S DIE=DIC . . S XGCNNM=$$EVENT^XGCUNCO2(XGDGT,XGEVNTNM,XGEVNROU) ; get name of callback . . S DR=".02///"_XGCNNM_";" . . D ^DIE . . K DIC,DIE,DR,DA Q SETMENU ; S DIC="^XTV(8995," S X=$$MENUNM(XGDGT) S DIC(0)="ML" D ^DIC S (XGDAM,DA)=+Y Q:Y'>0 I $P(Y,U,3) D . S DIE=DIC . S DR=".03///MENU" . D ^DIE . K DR,DIC,DIE S X="" F S X=$O(XGY(X)) Q:X="" S XGOLDX=X D S X=XGOLDX . ;W !,"X=",X," XGY(X)=",XGY(X) . I X["SUBMENU" D . . I '$D(^XTV(8995,"B",$$MENUNM(XGY(X)))) D . . . S X=$$MENUNM(XGY(X)) . . . S DIC="^XTV(8995," . . . S DIC(0)="L" . . . D ^DIC . . . S DA=+Y . . . S DR=".03///MENU;" . . . S DIE=DIC . . . D ^DIE . . . K DIC,DIE,DR . . . S X=XGOLDX . S X=$P(X,",",2) . S DIC="^XTV(8995,DA(1),3," . S DA(1)=XGDAM . S DIC(0)="L" . S DIC("P")=8995.03 . D ^DIC . Q:Y'>0 . S (XGDAMA,DA)=+Y . S X=XGOLDX . I $P(X,",",3)="" D Q . . S DR=".02///"_XGY(X)_";" . . S DIE=DIC . . D ^DIE . . K DIC,DIE,DR . I $P(X,",",3)="SUBMENU" D Q . . S DR=".03///"_$$MENUNM(XGY(X))_";" . . S DIE=DIC . . D ^DIE . . K DIC,DIE,DR . I $P(X,",",3)="EVENT" D Q . . S XGEVNROU=XGY(X) . . S XGEVNTNM="SELECT" . . S XGCNNM=$$EVENT(XGDGT,XGEVNTNM,XGEVNROU) . . S DIE="^XTV(8995,DA(1),3," . . S DA(1)=XGDAM . . S DA=XGDAMA . . S DR=".04///"_XGCNNM_";" . . D ^DIE . . K DIC,DIE,DR . I $P(X,",",3)'="" D . . S X=$P(X,",",3,99) . . S DIC="^XTV(8995,DA(2),3,DA(1),1," . . S DIC("P")=8995.031 . . S DA(2)=XGDAM . . S DA(1)=XGDAMA . . S DIC(0)="ML" . . D ^DIC . . Q:Y'>0 . . Q:XGY(XGOLDX)="" . . S DA=+Y . . S DIE=DIC . . S DR="1.01///"_XGY(XGOLDX)_";" . . D ^DIE . . K DIC,DIE,DR Q MENUNM(NAME) ; Remove fill zeros from menu name F Q:NAME'["0" S NAME=$P(NAME,"0")_" "_$P(NAME,"0",2,99) Q NAME ; GADSUBS(XGY,XGSS,XGXA) ;LOOP ENTRY POINT K XGY I $D(@XGXA)#2 D . I XGSS'="DRAW" D ; DRAW shouldn't have a value . . S XGY(XGSS)=@XGXA S X=XGXA S X1=$E(XGXA,1,$L(XGXA)-1) ; F S X=$Q(@X) Q:X=""!(X'[X1) D ; now get any subsequent subscripts . S X2=$P(X,X1,2) . F Q:X2'["""" S X2=$P(X2,"""")_$P(X2,"""",2,99) . S XGSS1=XGSS_X2 . S:$E(XGSS1,$L(XGSS1))=")" XGSS1=$E(XGSS1,1,$L(XGSS1)-1) . S XGY(XGSS1)=@X Q XGCUNCOM^INT^1^60169,79033^0 XGCUNCOM ;ISC-SF/JLI-UNCOMPILE MWAPI INTO OBJECT FILE ;2/19/94 04:32 ;;8.0T19;KERNEL;;Feb 22, 1995 ; ------------------------------------------------------------------- ; XGCUNCOM - this routine is used to move the information contained ; within an MWAPI compatible global structure for a window ; and create an entry for the window in the WINDOW OBJECT ; file (8995). ; ; The routine is used in an interactive mode. ; The user specifies the global node containing the window ; structure, and the desired name for the window in the ; Window Object file. If an EVENT node involves a ; routine specification which is not present in the CALL ; BACK file (8995.8), the user is asked to name the call ; back entry. ; ; Unidentified attribute or event type names, as well as ; attributes or event types which are not valid for the ; type of object with which they are used are noted and ; listed for the user. These nodes are NOT incorporated ; into the WINDOW OBJECT file entry. ; ; Some attribute names, especially if the structure was ; derived directly from an MWAPI ssvn, are not included ; in the WINDOW OBJECT file. Examples of these are the ; ID attribute or implementation specific attributes or ; events. ; ; -------------------------------------------------------------------- ; ; Entry is at EN1 or from the top of the routine. ; ; The text and prompt resulting from the code shown here is currently ; displayed. At the current time, however, the actual response is ; not used. ; ; Activation of the ability to create new entries in the WINDOW ; OBJECT file for the various associated gadgets will not be difficult. ; However, it may be more desirable to remove this option, and provide ; the user with the ability to move any specific associated object into ; a window object entry independent of the uncompiler. ; ; EN1 ; S DIR(0)="Y" S DIR("A")=$P($T(TEXTA),";",3) F I=1:1 D Q:X="" . S X=$T(TEXTA+I) . S X=$P(X,";",3) . I X'="" D . . S DIR("A",I)=X D ^DIR K DIR S XGCNEST=+Y ; TEXTA ;;Do you want associated gadgets NESTED WITHIN the window object ;;You may save an MWAPI global into the XGC WINDOW OBJECT file. While doing ;;this, you may save the attributes, events, etc. associated with the gadgets ;;in the window either nested within the window object, or each gadget may be ;;entered as an individual WINDOW OBJECT. In the latter case, the gadget may ;;be re-used more readily in other windows, etc. ;; ; ;;; terminates loading ; ; ------------------------------------------------------------------- ; get the global node to be used W !! S DIR(0)="FA^2:20" S DIR("A")="UNCOMPILE GLOBAL: ^" D ^DIR K DIR G:$D(DIRUT)!(X="") EXIT S X=U_X S:$E(X,$L(X))="," X=$E(X,1,($L(X)-1)) S:$E(X,$L(X))'=")" X=X_")" I $D(@X)'>9 W !,"There are NO descendants from that global",! G EN1 S XGLOB=X ; ; ------------------------------------------------------------------ ; and what window entry to create D EN2^XGCUNCO1 ; EXIT ; K A,ATTRIB,B,C,D0,D1,D2,DA,DIC,DIE,DINUM,DIR,DIRUT,DLAYGO,DR,EVNTNAM,GADNAM,I,J,OBJTYP,X,X1,XGCDIC,XGCI,XGCJ,XGCN,XGCNEST,XGCNNM,XGCVAL,XGTYP,XGCEDITR K XGDA,XGDAA,XGDAAA,XGDAM,XGDAMA,XGDGT,XGDTYP,XGENTNAM,XGEVNROU,XGEVNTNM,XGI,XGLOB,XGLOB1,XGLOB2,XGN,XGN1,XGNE,XGOLDX,XGROOT,XGSS,XGSS1,XGV,XGX,XGXA,XGY,Y Q ; SILENT(WINNAME,XGLOB) ; N XGSILENT S XGSILENT=1 S X=WINNAME S XGCNEST=1 K DIC S DIC(0)="L" D EN2A^XGCUNCO1 D EXIT Q XGCUTIL^INT^1^60169,79033^0 XGCUTIL ;ISC-SF/JLI - UTILITIES FOR MWAPI GUI ;2/17/94 13:21 [ 03/25/94 4:00 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 Q CHKATRIB ; CHECK VALIDITY OF ATTRIBUTE FOR OBJECT TYPE, COMPLETE ATTRIBUTE NAME IF UNIQUE AND VALID, GIVE HELP OTHERWISE ; N XGC1,XGC2,D1,D2,A1,A2 S A2=$L(DIC,","),A1=$P(DIC,",",1,A2-2)_")" S A2=$S(A2=4:3,1:2) I A2=3 S D1=$S($D(DA(1)):DA(1),1:DA) I A2=2 S D2=$S($D(DA(2)):DA(2),1:DA(1)),D1=$S($D(DA(2)):DA(1),1:DA) S XGC1=$P($G(@A1@(0)),U,A2) G:XGC1'>0 BADATRIB I A2=2 G:'$D(^XTV(8995,XGC1,0)) BADATRIB S XGC1=$P(^(0),U,3) G:XGC1'>0 BADATRIB G:'$D(^XTV(8995.6,XGC1,0)) BADATRIB Q:$E(X)="Z" I X[",","EVENT,CHOICE,DRAW"[$P(X,",") Q F XGC2=0:0 S XGC2=$O(^XTV(8995.6,XGC1,1,XGC2)) Q:XGC2'>0 I $D(^XTV(8995.7,+^(XGC2,0),0)) S XGC1($P(^(0),U))="" G:$O(XGC1(""))="" BADATRIB K XGC2 S XGC2=0 S:$D(XGC1(X)) XGC2(1)=X,XGC2=1 S XGC1=X F S XGC1=$O(XGC1(XGC1)) Q:XGC1="" Q:X'=$E(XGC1,1,$L(X)) S XGC2=XGC2+1,XGC2(XGC2)=XGC1 I XGC2=0 W !!,?10,"Valid ATTRIBUTES for this object are:",! D G BADATRIB . N I . S XGC1="" F I=1:1 S XGC1=$O(XGC1(XGC1)) Q:XGC1="" W:'((I-1)#4) ! W ?(I-1#4*20),XGC1 . W ! D G:X="" BADATRIB . I XGC2=1 W:$L(X)<$L(XGC2(1)) $E(XGC2(1),$L(X)+1,$L(XGC2(1))) S X=XGC2(1) Q . W !!,?10,"Select from:",! . F XGC1=1:1:XGC2 W !,?12,$J(XGC1,2),". ",XGC2(XGC1) . W !!,?10,"Choose from 1-",XGC2,": " R XGC1:DTIME S:'$T!(XGC1<1)!(XGC1>XGC2) X="" S:X'="" X=XGC2(+XGC1) Q BADATRIB ; S X="" Q ; TEST ; Sets up screen used to check that the item selected for a menubar attribute is in fact a menu object. The NAKED GLOBAL REFERENCE is to the zero node of the object being selected as a menubar attribute. S DIC("S")="I $P($G(^XTV(8995.6,+$P(^(0),U,3),0)),U)=""MENU""" Q ; EVENT ; Sets up a screen used to check that the EVENT TYPE being selected (internal value of +Y) is a valid EVENT TYPE for the current Window Object type. Used for file 8995, field 1 (multiple), field .01 within the multiple (file 8995.01) S DIC("S")="I $D(^XTV(8995.6,+$P(^XTV(8995,D0,0),U,3),2,""B"",+Y))" Q ; CLOSE G CLOSE^XGCDIC1 D K^XG(@XGEVENT@("WINDOW")) I $O(@XGWIN@(""))="" D ESTO^XG Q ; CLOSCHLD ; D K^XG(@XGWIN@(@EVENT@("WINDOW"))) Q XGCUTIL1^INT^1^60169,79033^0 XGCUTIL1 ;ISC-SF..SEA/JLI - UTILITY FUNCTIONS FOR WINDOWING ;12/16/94 13:19 ;;8.0T19;KERNEL;;Feb 22, 1995 ;; Q SETCOLOR(COLOR) ; UTILITY TO ESTABLISH COLORS N XWIN,X S Y=$G(@XGWIN@(XEDWIN,"G","CHK1","VALUE")) I Y!(XGWIN'="^$W") S Y=$$FRETXT^XGCDIC3() D Q Y . I Y'=-1 D . . I (Y'="@")&(Y'="") D . . . S @CURROOT@(VAL)=Y . . ;S Y=1 S XWIN=$$NEXTNM^XGCLOAD("W") D LOAD^XGCLOAD("XGCW COLOR WINDOW",XWIN) I $D(COLOR),COLOR'="" D . S X(1,"G","SCB1","DRAW",2)="FCOLOR,"_$P(COLOR,",")_",0,0" . S X(1,"G","SCB2","DRAW",2)="FCOLOR,0,"_$P(COLOR,",",2)_",0" . S X(1,"G","SCB3","DRAW",2)="FCOLOR,0,0,"_$P(COLOR,",",3) . S X(1,"G","SCB5","BCOLOR")=COLOR . D M^XG(XWIN,"X(1)") D SD^XG($PD,"FOCUS",XWIN) D . N XWIN . D ESTA^XG() D K^XG(XWIN) Q Y Q ; OKCOLOR ; N XWIN S XWIN=@XGEVENT@("WINDOW") S Y=@XGWIN@(XWIN,"G","SCB5","BCOLOR") D ESTO^XG Q ; CANCOLOR ; S Y=-1 D ESTO^XG Q ; CLOSCOLR ; N TEXT,Y1 S TEXT(1)="Do you want to SAVE the current color before exiting?" S Y1=$$MESG3^XGCWUTL("TEXT") I Y1=-1 Q ; CANCEL QUITTING I Y1=1 G OKCOLOR G CANCOLOR ; SCPDRAG ; SCSELCT ; D EVENT^XGC02 PDOWN ; N XGELEM,XGCW,XGPPOS,XGCINT,XGC1,XGC2,XGC,XGCDEV,XGCOLN S XGCW=@XGEVENT@("WINDOW"),XGELEM=@XGEVENT@("ELEMENT"),XGPPOS=@XGEVENT@("PPOS") S XGCDEV=$P(XGELEM,",",2),XGCOLN=$E(XGCDEV,4) S XGPPOS=$P(XGPPOS,",",2),XGINT=65535/150*(150-XGPPOS)+.5\1,XGC1="0,0,0",$P(XGC1,",",XGCOLN)=XGINT S XGC2=@XGWIN@(XGCW,"G","SCB5","BCOLOR"),$P(XGC2,",",XGCOLN)=XGINT K @XGWIN@(XGCW,"G",XGCDEV,"DRAW") K @XGWIN@(XGCW,"G","SCB5","BCOLOR") S XGC(XGCDEV,"BCOLOR")="65535,65535,65535",XGC(XGCDEV,"DRAW",1)="BOX,0,0,25,150",XGC(XGCDEV,"DRAW",2)="FCOLOR,"_XGC1,XGC(XGCDEV,"DRAW",3)="FILLPAT,SOLID",XGC(XGCDEV,"DRAW",4)="BOX,0,"_XGPPOS_",25,150" S XGC("SCB5","BCOLOR")=XGC2 M @XGWIN@(XGCW,"G")=XGC Q Q ;D LEKEYDWN^XGCEVNTS N X,XGELEM,XGX,XGPOS S XGELEM=@XGEVENT@("ELEMENT"),XGW=@XGEVENT@("WINDOW"),XGPOS=@XGEVENT@("PPOS") S X1=XGWIN_"("""_XGW_""","""_$P(XGELEM,",")_""","""_$P(XGELEM,",",2) K @(X1_"""DRAW"")") ;S X=@(X1_"""VALUE"")") S XGX="0,0,0",X=65535*((150-$P(XGPOS,",",2))/150) S:XGELEM["1" XGX=X_",0,0" S:XGELEM["2" XGX="0,"_XGX_",0" S:XGELEM["3" XGX="0,0,"_XGX S:XGELEM["4" XGX=X_","_X_","_X S $P(XGX,",",$P($P(XGELEM,",",2),"SC",2))=X S @(X1_"""BCOLOR"")") Q XGCUTILA^INT^1^60169,79033^0 XGCUTILA ;ISC-SF.SEA/JLI - UTILITIES FOR GUI ; ;;8.0T19;KERNEL;;Feb 22, 1995 ;; DLDOC(WINREF,ARRREF,MAXLEN) ; N I,%,X,J,K S %=$C(13)_$C(10) K @ARRREF S:'$D(MAXLEN) MAXLEN=245 S I=1,X="" F J=1:1 S K=$E(@WINREF@("VALUE"),J) Q:K="" S X=X_K I $L(X)'0 D Q . K ^TMP($J,"MG1") VIEWL S XGVAL=$$SELECT1^XGCRECV1() I XGVAL'>0 G MAIL D VIEWA Q ; PCFILE ; D VIEW1 S XGSET=0 I '$D(^TMP($J,1)),'$D(^(3)),$D(^(2))=10,$D(^(4))=1 D . S XGHED=^TMP($J,4) . I XGHED'["XGSEND PC SET" Q . K DIR . S DIR(0)="Y" . S DIR("A")="Do you want to VIEW the currently loaded data set" . D ^DIR . K DIR . S XGSET=Y,XGVAL=1 I 'XGSET D . S XGVAL=$$PCREAD^XGCVIEW1() . I XGVAL>0 D . . S XGHED=^TMP($J,4) I XGVAL'>0 G EXIT PCL S XGVAL=$$SELECT1^XGCRECV1() I XGVAL'>0 G PCFILE S DA=-1,XGF1=0 D VIEWA Q Q ; VIEW1 ; S XGCVW="^TMP(""XGCVIEW"",$J)" K @XGCVW S @XGCVW@(1)=" " S @XGCVW@(2)="View Window Object Related Data..." S @XGCVW@(3)=" Data are presented as file number, field name, data" S @XGCVW@(4)=" " S XGCNT=4 K ^TMP($J,"MG1") S XGCNEW=0 ; XGCNEW=1,DIR(0)="Y",DIR("A")="Do You Want to see only Entries Which are NOT in the file?",DIR("B")="YES" D ^DIR K DIR I 'Y S XGCNEW=0 S ERTY="VIEW" S XGCEDITR="" Q VIEWA ; S XGF=0 F XGI=0:0 Q:XGF S XGI=$O(^TMP($J,"S",XGI)) Q:XGI'>0 D . I $D(^TMP($J,"S",XGI))>9 S XGF=1 G:'XGF EXIT ; S DIR(0)="Y" S DIR("A")="Do you want to see ONLY DIFFERENCES" S DIR("A",1)="If an entry is already present in the file," S DIR("B")="NO" D ^DIR K DIR S XGCDIF=Y K DIRUT ; S %ZIS="Q" D ^%ZIS G:POP LOOP^XGCVIEW1 I $D(IO("Q")) D G LOOP^XGCVIEW1 . K IO("Q") . S ZTRTN="DQVIEW^XGCRECV" . S ZTIO=ION . S ZTSAVE("XGCNEW")="" . S ZTSAVE("XGCDIF")="" . S ZTSAVE("DA")="" . S ZTSAVE("^TMP($J,")="" . S ZTSAVE("XGVAL")="" . S ZTSAVE("XGDAT")="" . S ZTDESC="PRINT MODIFIED MAILGRAM DATA" . D ^%ZTLOAD DQVIEW D DQVIEW1^XGCVIEW1 ; EXIT ; K %ZIS,D0,D1,D2,D3,D4,DA,DDTYP,DFN,DFNLEV,DIC,DICFIL,DIR,DIRUT,ERTY,FDA K FIELD,FIL,FILEN,FILJ,FNAME,ICNT,J,LEV,LEV1,LOC,PIECE,POP,X,X1,X2 K XDONE,XFNAME,XGCA,XGCDA,XGCDIF,XGCI,XGCNEW,XGCNT,XGCVW,XGDAT,XGF K XGF1,XGI,XGJ,XGTAB,XGTAB1,XGVAL,XLEV,XMIS,Y,ZTDESC,ZTIO,ZTRTN K ZTSAVE Q XGCVIEW1^INT^1^60169,79033^0 XGCVIEW1 ;ISC-SF.SEA/JLI - DISPLAY DATA FROM MODIFIED MAIL GRAM (CONTINUATION) ;3/8/94 09:20 ;;8.0T19;KERNEL;;Feb 22, 1995 DQVIEW1 ; S XDONE=0,LEV=0,FIL=0,FILEN=0 S DFN=DA,DA(0)=DA,D0=DA S XDONE=0,XGTAB=0,XGCNT=0 S XGCVW="^TMP(""XGCVIEW"",$J)" U IO S XGCNT=XGCNT+1 S @XGCVW@(XGCNT)=" " S XGCNT=XGCNT+1 S @XGCVW@(XGCNT)="MODIFIED MAILGRAM FOR WINDOW OBJECT RELATED FILES dated: "_XGDAT S XGCI=.8 D SET1 F XGI=0:0 S XGI=$O(^TMP($J,"S",XGI)) Q:XGI'>0 D . F XGJ=0:0 S XGJ=$O(^TMP($J,"S",XGI,XGJ)) Q:XGJ'>0 D . . S XGF1=0 . . S XGCI=XGJ-1 . . D SET1 D:'XDONE WAIT D ^%ZISC Q ; PCREAD() ; S XGVAL=-1 K ^TMP($J) S %ZIS("A")="Device from which to read WINDOWS OBJECT DATA: " D ^%ZIS Q:POP XGVAL S ICNT=0 U IO S XGVAL=$$PCREAD1() I XGVAL>0!(IO(0)=IO) D . S ^TMP($J,4)="XGSEND PC SET: "_IO_"^^"_XGDAT D ^%ZISC Q XGVAL ; PCREAD1() ; LOOP ; R X:30 Q:'$T XGVAL I X?1"***^***" Q XGVAL I X'?1"***D^".E G LOOP S XGDAT=$P(X,U,2) LOOPX1 ; R X:30 Q:'$T XGVAL W:IO(0)=IO ! I X="***^***" D Q XGVAL . S XGVAL=1 .; F R X:5 Q:'$T I X'?1"^".N.1"."1.N1"^".N.1"."1.N G LOOPX1 S ICNT=ICNT+1 S ^TMP($J,2,ICNT,0)=$E(X,2,255) R X:30 Q:'$T XGVAL I X'?1"^^".E S ICNT=ICNT-1 G LOOPX1 S ICNT=ICNT+1 S ^TMP($J,2,ICNT,0)=$E(X,3,255) G LOOPX1 ; SET1 ; S XGF=0 F J=0:0 Q:XGCI'>0!XGF1!XDONE D . S XGCI=$O(^TMP($J,2,XGCI)) Q:XGCI'>0 . S J=XGCI . I $D(^TMP($J,2,XGCI,0)) D . . S X1=^TMP($J,2,XGCI,0) . . S XGCI=$O(^TMP($J,2,XGCI)) . . S J=XGCI . . I XGCI>0 D . . . I $D(^TMP($J,2,XGCI,0)) D . . . . S X2=^TMP($J,2,XGCI,0) . . . . S FIL=+X1 . . . . S FIELD=+$P(X1,U,2) D Q:XGF1 . . . . . S XGF1=$S('XGF:0,FIELD'=.01:0,'$D(^DIC(FIL,0)):0,1:1),XGF=1 . . . . D VIEWB Q ; VIEWB ; I FIL=0,FIELD=0 W !,"*** file entry IS ",$S($P(X2,U)=0:"NOT ",1:""),"to be updated if it already exists.",! I +$P(X2,U) W !,"*** data which already exists WILL ",$S(+$P(X2,U,2)=0:"NOT ",1:""),"be overwritten by incoming data." Q:(FIL=0&(FIELD=0)) I FIL>0,FIELD=0 W !,"*** SPECIFIER lookup entry in file ",FIL,", is ",$P(X2,U,2)," in file ",+X2,! Q S XGTAB1=XGTAB+(2*(FIELD>.01)) I '$D(^DD(FIL,FIELD,0)) D:$Y>(IOSL-3) WAIT Q:XDONE W:FIELD=.01 ! W !?XGTAB1,FIL," **** UNDEFINED FIELD NUMBER ",FIELD," **** = ",X2 Q I FILEN'=FIL D NEW I FILEN'=FIL Q S XGCDA=DA,X=X2 I FIELD=.01,FIL'=2 S DIC=DICFIL,DIC(0)="X" D ^DIC K DIC S DA=+Y,X1=$P(Y,U,2),@("D"_LEV)=DA,XFNAME(LEV)=$P(^DD(FIL,FIELD,0),U),XLEV(LEV)=X2,XMIS(LEV)=0,FIL(LEV)=FIL S:$D(^DIC(FILEN,0)) DFN=DA,DA(0)=DA,D0=DA S XGTAB1=XGTAB+(2*(FIELD>.01)) S DDTYP=$P(^DD(FIL,FIELD,0),U,2) S X=X2 D:DDTYP["D" DATE S X2=X,FNAME=$P(^(0),U,1) I DFN'>0 D:$Y>(IOSL-3) WAIT Q:XDONE W:FIELD=.01 ! W !?XGTAB1,FIL," ",FNAME," = ",X2 Q S:DA'>0 X1="" I DA>0 S LOC=$P(^DD(FIL,FIELD,0),U,4),PIECE=$P(LOC,";",2),LOC=$P(LOC,";") S:+LOC'=LOC LOC=""""_LOC_"""" S X1="" I $D(@(DICFIL_DA_","_LOC_")")) S X1=$P(@(DICFIL_DA_","_LOC_")"),U,PIECE) I DDTYP["D",X1'="" S X=X1 D DATE S X1=X I DDTYP["P",DDTYP'["O",X1>0 S X1=$P(@("^"_$P(^DD(FIL,FIELD,0),U,3)_(+X1)_",0)"),U) I X1'="",DDTYP["O",$D(^DD(FIL,FIELD,2)) S Y=X1,D0=DA X ^DD(FIL,FIELD,2) S X1=Y S XGTAB1=XGTAB+(2*(FIELD>.01)) I X1=X2 Q:XGCDIF D:$Y>(IOSL-4) WAIT Q:XDONE W:FIELD=.01 ! W !?XGTAB1,FIL," ",FNAME,!?XGTAB1," BOTH: ",X1 Q D:$Y>(IOSL-4) WAIT Q:XDONE D . W:FIELD=.01 ! . I XGCDIF,'XMIS(LEV) S XMIS(LEV)=1 W ! F LEV1=0:1:$S(FIELD=.01:LEV-1,1:LEV) W !?(LEV1*5),FIL(LEV1)," ",XFNAME(LEV1)," = ",XLEV(LEV1) S:FIELD=.01 DFN=-1 . W !?XGTAB1,FIL," ",FNAME,!?XGTAB1," ******** ","CURRENT",": ",X1,!?(XGTAB1+10),"IMPORTED: ",X2 Q ; NEW I FILEN=FIL D:$D(^DIC(FILEN,0)) TOP Q:FIL=FILEN I $D(^DD(FIL,0,"UP")),^("UP")=FILEN D SUBFIL Q I LEV>0 D UPSUB Q:LEV=0&(FIL=FILEN) G NEW D TOP Q SUBFIL S FILJ=+^DD(FIL,0,"UP"),X=$O(^DD(FILJ,"SB",FIL,0)),X=$P($P(^DD(FILJ,X,0),U,4),";") S:+X'=X X=""""_X_"""" S DICFIL(LEV)=DICFIL,FIL(LEV)=FILEN,DFNLEV(LEV)=DFN,FDA(LEV)=DA F XGCA=LEV:-1:0 S DA(XGCA+1)=DA(XGCA) S LEV=LEV+1,DICFIL=DICFIL_DA_","_X_",",FILEN=FIL,DIC=DICFIL,DIC(0)="X",X=X2 D ^DIC S X1=$P(Y,U,2),DA=+Y,@("D"_LEV)=DA,XGTAB=XGTAB+5 Q UPSUB ; K DICFIL(LEV),FIL(LEV),DFNLEV(LEV),XLEV(LEV),XMIS(LEV),@("D"_LEV),FDA(LEV) S LEV=LEV-1,DA=FDA(LEV),DICFIL=DICFIL(LEV),FILEN=FIL(LEV),DFN=DFNLEV(LEV) F XGCA=0:1:LEV S DA(XGCA)=DA(XGCA+1),XGTAB=XGTAB-5 K DA(XGCA+1) Q TOP S DICFIL=^DIC(FIL,0,"GL"),FILEN=FIL,XGTAB=0 K DA,D0,D1,D2,D3,D4 S DA=-1 W:'XGCDIF ! W:XGCDIF&'$D(ZTQUEUED) "." ; DATE S X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) Q ; WAIT S X="" I 1 R:IOST["C-" !?10,"Return to continue, '^' to exit...",X:DTIME S:'$T!(X[U) XDONE=1 W @IOF Q XGCWDOC^INT^1^60169,79033^0 XGCWDOC ;ISC-SF.SEA/JLI - EDIT DOCUMENT ;12/13/94 15:42 ;;8.0T19;KERNEL;;Feb 22, 1995 EDITDOC(DOCARRAY) ; N XWIN S XWIN=$$NEXTNM^XGCLOAD("W") D LOAD^XGCLOAD("XGCW DOC EDIT",XWIN) S XGCDOC(XWIN)=DOCARRAY D ULDOC^XGC02($NA(@XGWIN@(XWIN,"G","DOC1")),XGCDOC(XWIN)) Q ; CANCEL ; N XWIN S XWIN=@XGEVENT@("WINDOW") D K^XG(XWIN) K XGCDOC(XWIN) I '$D(^$W) D ESTO^XG Q ; SAVE ; N XWIN,Y S XWIN=@XGEVENT@("WINDOW") S Y=$$DLDOC^XGC02($NA(@XGWIN@(XWIN,"G","DOC1")),XGCDOC(XWIN)) D K^XG(XWIN) K XGCDOC(XWIN) I '$D(^$W) D ESTO^XG Q XGCWED1^INT^1^60169,79033^0 XGCWED1 ;ISC-SF.SEA/JLI - SELECTION OF ITEM TO EDIT ; [ 05/06/94 4:38 AM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ;; OBJECTS ; S XWIN=$$NEXTNM^XGCLOAD("W") D LOAD^XGCLOAD("XGCW EDITING WINDOW",XWIN) S XEDWIN=XWIN D INIT D SD^XG("$PD","FOCUS",XWIN) D . N XWIN . D ESTART^XG() D K^XG(XWIN) Q ; INIT ; N XVAL S:'$D(XOBJTYP) XOBJTYP="" D K^XG(XEDWIN,"G","LBOX2","CHOICE") S XVAL("C",1)="<< WINDOW >>" S XVAL("C",2)="+ GADGETS" S XVAL("C",3)="+ MENUS" S XVAL("C",4)="+ TIMER" S XVAL("C",6)=" EDIT CALLBACKS" S XVAL("C",7)=" EDIT MENU OBJECTS" S XOBJ=$G(^XTV(8995.6,+XOBJTYP,0)) I $P($G(^XTV(8995.6,+XOBJTYP,0)),U)="WINDOW" D I 1 . D S^XG(XEDWIN,"G","TXT2","VALUE","WINDOW") E D . F XVAL=1:1:4 K XVAL("C",XVAL) D M^XG(XEDWIN,"G","LBOX2","CHOICE",$NA(XVAL("C"))) D S^XG(XEDWIN,"G","LBOX2","ACTIVE",1) S OBJTYP=XOBJTYP S CTYPE=$P(XOBJ,U,2) S CNAME="" S XGTYPSEL=11 D SETCUR Q SETCUR ; Entry with OBJTYP pointer to object type, XGTYPSEL subscript of selected entry for editing N XVAL I $S('$D(OBJTYP):1,OBJTYP="":1,1:0) D ATTRIB^XGCDIC3("") Q S XVAL("C",11)="ATTRIBUTES" ;S XVAL("C",12)="EVENTS" I $O(^XTV(8995.6,OBJTYP,2,0))>0 S XVAL("C",12)="EVENTS" ;,"ACTIVE")=0 S XOBJ=^XTV(8995.6,OBJTYP,0) ;S XVAL("C",13)="CHOICES" I $P(XOBJ,U,4) S XVAL("C",13)="CHOICES" ;,"ACTIVE")=0 ;S XVAL("C",14)="DRAW" I $P(XOBJ,U,7) S XVAL("C",14)="DRAW" ;,"ACTIVE")=0 ;S XVAL("C",15)="MENU ITEMS" I $P(XOBJ,U,3) D . S XVAL("C",15)="MENU ITEMS" ;,"ACTIVE")=0 . K XVAL("C",12) ; don't need to show events alone, are part of items I $S('$D(XGTYPSEL):1,XGTYPSEL<11:1,XGTYPSEL>15:1,1:0) D . S XGTYPSEL=11 I '$D(XVAL("C",XGTYPSEL)) S XGTYPSEL=11 S XVAL("C",XGTYPSEL)="<< "_XVAL("C",XGTYPSEL)_" >>" D K^XG(XEDWIN,"G","LBOX3","CHOICE") D M^XG(XEDWIN,"G","LBOX3","CHOICE",$NA(XVAL("C"))) S XGTAG=$P("ATTRIB^EVENT^CHOICE^DRAW^MENU",U,XGTYPSEL-10) D @(XGTAG_"^XGCDIC3("_OBJTYP_")") Q D K^XG(XEDWIN,"G","LBOX3","CHOICE") D M^XG(XEDWIN,"G","LBOX3","CHOICE",$NA(XVAL("C"))) Q EDITCB ; N Y,VAL S Y=$$CLBKEDIT^XGCDIC5(.VAL) I Y="@" D . N DA,DIK S DA=$O(^XTV(8995.8,"B",VAL,0)) Q:DA'>0 . N TEXT S TEXT(1)="Do you REALLY want to delete the "_VAL_" entry from the Call Back File??" Q:'$$MESG2^XGLMSG("TEXT") . S DIK="^XTV(8995.8," D ^DIK Q SETINIT ; OBJSELCT ; Call back from 'Object for Editing' list box N XWIN,ELEM,VAL,XVAL,X,Y,J S XWIN=@XGEVENT@("WINDOW"),ELEM=$P(@XGEVENT@("ELEMENT"),",",2) S VAL=$O(@XGWIN@(XWIN,"G",ELEM,"VALUE",0)) I VAL=6 G EDITCB ; I VAL=7 G MENUOBJ^XGCWED3 ; K XVAL COPY M XVAL("C")=@XGWIN@(XWIN,"G",ELEM,"CHOICE") REMOV S X="" F S X=$O(XVAL("C",X)) Q:X="" D . S Y=XVAL("C",X) I Y["<< " D . . S XVAL("C",X)=$S(X[".":" ",1:"")_$P($P(Y,"<< ",2)," >>") S XLET=$P("^G^M^T",U,VAL) S OBJTYP="" WIN I VAL=1 D . S XVAL("C",VAL)="<< WINDOW >>" . S OBJTYP=1 . S CURROOT=XEROOT . S GADNAM="WINDOW" OTHER E I VAL'["." D . S Y=XVAL("C",VAL) XPAND . I Y["+ " D . . S XVAL("C",VAL)=$P(Y,"+ ",2) . . S XVAL("C",VAL+.01)=" --add new--" . . S X="" F J=.02:.01 S X=$O(@XEROOT@(XLET,X)) Q:X="" D . . . S XVAL("C",VAL+J)=" "_X COLAPS . I Y'["+" D . . S XVAL("C",VAL)="+ "_Y . . S X=VAL F S X=$O(XVAL("C",X)) Q:X="" Q:$E(X,1,$L(VAL))'=VAL D . . . K XVAL("C",X) ITEM I VAL["." D NEW . I $P(VAL,".",2)="01" D Q:Y=-1 ; add new entry . . I $P(VAL,".")=2!($P(VAL,".")=4) D . . . S Y=$$NEWGADGT() . . I $P(VAL,".")=3 S Y=$$NEWMENU() . . I Y'=-1 D . . . S J(1)=VAL F J=VAL:0 S J=$O(XVAL("C",J)) Q:J'[$P(VAL,"01") S J(1)=J . . . S VAL=J(1)+.01,XVAL("C",VAL)=Y . I XVAL("C",VAL)[" " S XVAL("C",VAL)=$P(XVAL("C",VAL)," ",2) . S GADNAM=XVAL("C",VAL) . S CURROOT=$NA(@XEROOT@(XLET,$S(XLET'="M":XVAL("C",VAL),1:$$MNAM^XGCCOMP5(XVAL("C",VAL))))) . S OBJTYP=$S(XLET="M":"MENU",XLET="T":"TIMER",1:@CURROOT@("TYPE")) . S OBJTYP=$O(^XTV(8995.6,"B",OBJTYP,0)) . S XVAL("C",VAL)=" << "_XVAL("C",VAL)_" >>" F J=3:0 S J=$O(XVAL("C",J)) Q:J'>0 Q:J'<4 S XVAL("C",J)=$$UNMENU(XVAL("C",J)) D K^XG(XWIN,"G",ELEM,"CHOICE") D M^XG(XWIN,"G",ELEM,"CHOICE",$NA(XVAL("C"))) D SETCUR Q TYPSELCT ; Call back from 'Edit:' list box N XWIN,ELEM S XWIN=@XGEVENT@("WINDOW"),ELEM=$P(@XGEVENT@("ELEMENT"),",",2) S XGTYPSEL=$O(@XGWIN@(XWIN,"G",ELEM,"VALUE",0)) D SETCUR Q ; NEWGADGT() ; N Y,XWIN,X S XWIN=$$NEXTNM^XGCLOAD("W") D LOAD^XGCLOAD("XGCW NEW GADGET/TIMER",XWIN) I XLET="G" D . N FILE . S FILE=8995.6 . D GETLIST^XGCDIC("") . F X="WINDOW","MENU","TIMER","COMPOSITE" S Y=$O(^TMP("DILISTA",$J,X)) K ^(Y) . D M^XG(XWIN,"G","LBUT1","CHOICE",$NA(^TMP("DILISTA",$J))) I XLET="T" D . N XVAL . S XVAL("C","VALUE")="TIMER" . S XVAL("C","CHOICE","TIMER")="TIMER" . D M^XG(XWIN,"G","LBUT1","XVAL(""C"")") D SD^XG($PD,"FOCUS",XWIN_",TXT1") D . N XWIN . D ESTA^XG() D K^XG(XWIN) Q $G(Y,-1) NEWGADOK ; N XWIN,TXT,VAL,TYP S XWIN=@XGEVENT@("WINDOW") S VAL=@XGWIN@(XWIN,"G","TXT1","VALUE") I $S(VAL="":1,VAL'?1U.UN:1,1:0) D . S TXT(1)=" You MUST specify a subscript of a LETTER followed by other LETTERS and/or NUMBERS to be used for this component.",TXT(2)="" S TYP=@XGWIN@(XWIN,"G","LBUT1","VALUE") I TYP="" D . S TXT(3)=" The TYPE of the gadget must be specified by selecting one of the choices." I $D(TXT) D Q . D MESG^XGCWUTL("TXT") S TYP=$P(TYP,U) S @XEROOT@(XLET,VAL,"TYPE")=TYP S:XLET'="T" @XEROOT@(XLET,VAL,"POS")="10,10" S Y=VAL D ESTO^XG Q NEWMENU() ; N VAL,Y S VAL="Menu Object Name" S Y=$$FRETXT^XGCDIC3() I Y'=-1 D . S Y=$$MNAM^XGCCOMP5(Y) . S @XEROOT@("M",Y)="" Q Y ; UNMENU(NAME) ; F Q:NAME'["0" S NAME=$P(NAME,"0")_" "_$P(NAME,"0",2,99) Q NAME XGCWED2^INT^1^60169,79033^0 XGCWED2 ;ISC-SF.SEA/JLI - ADD NEW ENTRIES ; [ 05/06/94 4:01 AM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ;; Q NEWOBJ(NAME) ; N XWIN,I S XWIN=$$NEXTNM^XGCLOAD("W") ;S @XGSTOR@("PARENT")=$G(@XGEVENT@("WINDOW")) D LOAD^XGCLOAD("XGCW ADD NEW OBJECT",XWIN) I $D(NAME) D . D S^XG(XWIN,"G","TXT1","VALUE",NAME) ;D LOADLIST(XWIN,"LBUT1","8995.6") S I="WINDOW^"_$O(^XTV(8995.6,"B","WINDOW",0)) D S^XG(XWIN,"G","LBUT1","CHOICE",I,"WINDOW") D S^XG(XWIN,"G","LBUT1","VALUE",I) S FILE=8995 K ^TMP(XWIN,$J,"FILE") D SD^XG($PD,"FOCUS",XWIN_",TXT1") D D K^XG(XWIN) . N XWIN . D ESTA^XG() Q $G(Y,-1) ; CANEWOBJ ; S Y=-1 D ESTO^XG Q ; Q ; LOADLIST(WIN,GAD,FILE) ; K ^TMP(XWIN,$J,"FILE") D GETLIST^XGCDIC() D M^XG(WIN,"G",GAD,"CHOICE",$NA(^TMP("DILISTA",$J))) Q ; OKNEWOBJ ; N XWIN,VAL,XERR,X1,TEXT S XWIN=@XGEVENT@("WINDOW") S VAL=@XGWIN@(XWIN,"G","TXT1","VALUE") S OK=0 S DR="" CHKIT I VAL'="" D . S X1=$O(^XTV(8995,"B",VAL,0)) . I X1>0 D Q . . S TEXT(1)="An entry in the WINDOW OBJECT file already is using this name. Enter a different name if you want to make a new entry." . . D MESG^XGCWUTL("TEXT") . S OK=$$CHKPARNT() . I OK D Q . . S DR=".02///"_@XGWIN@(XWIN,"G","TXT2","VALUE")_";" . I OK'>0 D . . I $G(@XGWIN@(XWIN,"G","LBUT1","VALUE"))="" D Q . . . S TEXT(1)="To create a new entry in the WINDOW OBJECT file there must be a UNIQUE NAME and either a VALID PARENT or TYPE OF OBJECT specified, so the object type is known." . . . D MESG^XGCWUTL("TEXT") . . S OK=1 . . S DR=".03///"_$P(@XGWIN@(XWIN,"G","LBUT1","VALUE"),U)_";" I 'OK Q ADDONE K DIC S DIC(0)="L",X=VAL,DLAYGO=8995,DIC=8995,DIC("DR")=DR K DR D ^DIC S DA=+Y D NEWOBJ1^XGCEDIT2 D ESTO^XG Q ; CHKPARNT() ; N OK,VAL,VAL1,TEXT S VAL=@XGWIN@(XWIN,"G","TXT2","VALUE") S OK=0 I VAL'="" D . S VAL1=+$O(^XTV(8995,"B",VAL,0)) . I $P($G(^XTV(8995,+VAL1,0)),U,3)>0 S OK=1 Q . S TEXT(1)="The Object '"_$P(VAL,U)_"' does NOT have an OBJECT TYPE specified, and therefore can not be used as the parent for this new object." . D MESG^XGCWUTL("TEXT") Q OK ; ASOCOBJ ; S IEN1=","_IEN S FILE=8995.02 S Y=$$EN^XGCDIC(FILE,.YARRAY,IEN1) I Y'>0 Q S OBJNAME=$P(Y,U,2) S IEN1=(+Y)_","_IEN S CURROOT=$NA(@OBJROOT@("G",OBJNAME)) S OBJTYP=$P(^XTV(8995,+IEN,2,+IEN1,0),U,2) S OBJTYP=$P(^XTV(8995,+OBJTYP,0),U,3) D ENT1^XGCWEDIT Q ; SAVEIT ; I '$D(@XEROOT) Q S DA=+IEN S XGDA=DA S D0=DA S XGENTNAM=$P(^XTV(8995,DA,0),U) S XGLOB=XEROOT K ^TMP("XGCUNCO1",$J) M ^TMP("XGCUNCO1",$J)=^XTV(8995,+DA,5) S DIK="^XTV(8995," D ^DIK K DIK S DIC(0)="ML" S DLAYGO=8995 S X=XGENTNAM S DIC("DR")=".03///WINDOW;" S DIC="^XTV(8995," S DINUM=DA D FILE^DICN K DIC M ^XTV(8995,+DA,5)=^TMP("XGCUNCO1",$J) K ^TMP("XGCUNCO1",$J) D ENT1^XGCUNCO1 K DIC Q ASKSAVE() ; N TEXT S TEXT(1)="Do you want to SAVE the OBJECT before exiting?" Q $$MESG3^XGCWUTL("TEXT") EXIT ; N Y S Y=1 I $D(XEROOT),$D(@XEROOT) D . S Y=$$ASKSAVE() I Y=-1 Q I Y=1 D SAVEIT S XGCEXIT=1 K @XEROOT G CLOSE ; CLOSEIT ; N I I $D(@XEROOT) S I=$$ASKSAVE() Q:I=-1 I I D SAVEIT S XGCEXIT=0 D NEWIT^XGCWEDIT S XOBJTYP="" D INIT^XGCWED1 D CLEAR^XGLMENU("FILE") Q CLOSE D ESTO^XG Q ; NEWFILE ; New File has been selected for editing S FILE=@XGWIN@(@XGEVENT@("WINDOW"),"G",$P(@XGEVENT@("ELEMENT"),",",2),"VALUE") S:FILE["^" FILE=+$P(FILE,"^",2) S:FILE[";" FILE=+$P(FILE,";",2) S XFILE=FILE Q XGCWED3^INT^1^60169,79033^0 XGCWED3 ;ISC-SF.SEA/JLI - EDIT MENU OBJECTS ;9/14/94 09:46 ;;8.0T19;KERNEL;;Feb 22, 1995 ;; MENUOBJ ; N DA,XEROOT,XEDWIN,DIC,CURROOT,GADNAM,XWIN,XLET,OBJTYP,XGTYPSEL,IEN S DIC("S")="I $P($G(^XTV(8995.6,+$P(^(0),U,3),0)),U)=""MENU""" S DA=$$OPEN^XGCDIC2(8995,"","","$$NEWMENU^XGCWED3(VAL)") Q:DA'>0 S XEROOT="^TMP(""XGWEM"",$J)" K @XEROOT D LOADMENU(+DA,XEROOT) S XWIN=$$NEXTNM^XGCLOAD("W"),XEDWIN=XWIN D LOAD^XGCLOAD("XGCW MENU EDIT",XWIN) S GADNAM=$P(DA,U,2),XLET="M",OBJTYP=$O(^XTV(8995.6,"B","MENU",0)),CURROOT=$NA(@XEROOT@("M",$$MNAM^XGCCOMP5(GADNAM))),XGTYPSEL=11,IEN=+DA_"," D SETCUR^XGCWED1 D SD^XG($PD,"FOCUS",XWIN) D . N XWIN . D ESTA^XG() D K^XG(XWIN) K @XEROOT Q ; NEWMENU(NAME) ; N XWIN,I S XWIN=$$NEXTNM^XGCLOAD("W") ;S @XGSTOR@("PARENT")=$G(@XGEVENT@("WINDOW")) D LOAD^XGCLOAD("XGCW ADD NEW OBJECT",XWIN) I $D(NAME) D . D S^XG(XWIN,"G","TXT1","VALUE",NAME) ;D LOADLIST(XWIN,"LBUT1","8995.6") S I="MENU^"_$O(^XTV(8995.6,"B","MENU",0)) D S^XG(XWIN,"G","LBUT1","CHOICE",I,"MENU") D S^XG(XWIN,"G","LBUT1","VALUE",I) S FILE=8995 K ^TMP(XWIN,$J,"FILE") D SD^XG($PD,"FOCUS",XWIN_",TXT1") D D K^XG(XWIN) . N XWIN . D ESTA^XG() Q $G(Y,-1) ; LOADMENU(DA,XEROOT) ; N XW,XWNN,X,X1,X2,XBAS,XBASG,XC,XDIC,XGCCOMPA,XGCWIN,XL,XNAME,XOTYP,XOBJ,XV,N,N1,NX1,NX2 S XGCWIN=+DA S XBASG=$E(XEROOT,1,$L(XEROOT)-1)_"," S XOTYP=+$P(^XTV(8995,XGCWIN,0),U,3) K XW,XWNN S XBAS=$E(XBASG,1,$L(XBASG)-1)_")" K @XBAS S XDIC="^XTV(8995,"_XGCWIN_")" S XC=1 S XGCEDITR=1 S XW(XC)=XGCWIN ; The values of the XW array are the entries in S XNAME=$P(^XTV(8995,+XW(XC),0),U) S XOBJ=+XW(XC) F XL=0:0 S XL=$O(XW(XL)) Q:XL'>0 D . I XW(XL)'>0 Q . D NEXT^XGCCOMP1(XBAS,XW(XL),+$G(XWNN(XL)),XGCWIN) Q SAVEIT ; I '$D(@XEROOT) Q S DA=+IEN S XGDA=DA S D0=DA S XGENTNAM=$P(^XTV(8995,DA,0),U) S XGLOB=XEROOT K ^TMP("XGCUNCO1",$J) M ^TMP("XGCUNCO1",$J)=^XTV(8995,+DA,5) S DIK="^XTV(8995," D ^DIK K DIK S DIC(0)="ML" S DLAYGO=8995 S X=XGENTNAM S DIC("DR")=".03///MENU;" S DIC="^XTV(8995," S DINUM=DA D FILE^DICN K DIC M ^XTV(8995,+DA,5)=^TMP("XGCUNCO1",$J) K ^TMP("XGCUNCO1",$J) D ENT1^XGCUNCO1 K DIC D ESTO^XG Q ; MENUDEL ; N TEXT S TEXT(1)="Do you REALLY want to DELETE the complete "_GADNAM_" menu object entry from the Window Object File?" Q:'$$MESG2^XGLMSG("TEXT") S DA=+IEN S DIK="^XTV(8995," D ^DIK D ESTO^XG Q ; XGCWEDIT^INT^1^60169,79033^0 XGCWEDIT ;ISC-SF.SEA/JLI - FRONT END OF GUI EDITOR FOR WINDOW OBJECTS ;3/20/94 05:54 [ 05/06/94 5:41 AM ] ;;8.0T19;KERNEL;;Feb 22, 1995 MAIN ; N XGCEXIT,XEROOT,FILE,XFILE,XWIN,XEDWIN I '$D(XGWIN) D PREP^XG S XEROOT="^TMP(""XGWE"",$J)" S (FILE,XFILE)=8995 S XWIN=$$NEXTNM^XGCLOAD("W"),XEDWIN=XWIN D NEWIT S @XGCWREF@(XWIN,"PARENT")="" ; Mark as top window D LOAD^XGCLOAD("XGCW EDITING WINDOW",XWIN) ; load primary window, but before starting it I XGWIN'="^$W" D . D S^XG(XWIN,"G","CHK1","VALUE",1) . D S^XG(XWIN,"G","CHK1","ACTIVE",0) D SD^XG($PD,"FOCUS",XWIN) D . N XTYPE,XWIN . S XTYPE="OPEN" . D GETONE ; PUT UP OPEN SELECTION WINDOW . I DA'>0 D INIT^XGCWED1 D SD^XG($PD,"FOCUS",XWIN) D . N XWIN . D ESTA^XG() ; and start the real work D K^XG(XWIN) K @XEROOT Q ; NEWIT ; K OBJTYP,XOBJTYP,DIC,^TMP("XGWE",$J),XGCEXIT S OBJTYP="",XOBJTYP="" S XGCEDITR="" S XGCWROOT="^TMP(""XGCW"",$J,"_"$S($D(@XGEVENT@(""WINDOW"")):@XGEVENT@(""WINDOW""),1:XEDWIN))" S XGCWREF=$NA(^TMP("XGCW",$J)) I $D(@XGWIN@(XEDWIN)) D . D S^XG(XEDWIN,"G","TXT1","VALUE","") . D K^XG(XEDWIN,"G","LBOX2","CHOICE") . D K^XG(XEDWIN,"G","LBOX3","CHOICE") Q NEW ; N XTYPE S XTYPE="NEW" G GETONE ; OPEN ; N XTYPE,XWIN S XWIN=@XGEVENT@("WINDOW") S XTYPE="OPEN" G GETONE ; GETONE ; N ZARRAY,Y S ZARRAY="" ; This array will hold Y, Y(0) returned for selection I XTYPE="OPEN" D . N XTYPE,DIC,I S DIC("S")="I $P($G(^XTV(8995.6,+$P(^(0),U,3),0)),U)=""WINDOW""" . I $D(^DISV(DUZ,"XGCW ED")),$D(^XTV(8995,+^("XGCW ED"),0)) S I=$P(^(0),U),I=$E(I,1,$L(I)-1)_$C($A($E(I,$L(I)))-1)_"z",DIC("B")=I . S Y=$$OPEN^XGCDIC2(XFILE,.ZARRAY,"","$$NEWOBJ^XGCWED2(VAL)") . I Y>0,XFILE=8995 D . . S DA=+Y . . I '$P(Y,U,3) D . . . N YVAL . . . S YVAL=Y I $E($P(Y,U,2),1,3)="XG " K XTYPE S XTYPE(1)="Do you REALLY want to edit an XG object template??" S Y=-1 Q:'$$MESG2^XGLMSG("XTYPE") . . . S Y=YVAL,DA=+YVAL D OLDOBJ^XGCEDIT2 I XTYPE="NEW" D . N XTYPE . S Y=$$NEWOBJ^XGCWED2() S DA=+Y I Y'>0 Q S WINNAM=$P(Y,U,2) D S^XG(XEDWIN,"G","TXT1","VALUE",WINNAM) S ^DISV(DUZ,"XGCW ED")=+Y GOTONE S DA=+Y S IEN=DA_"," S OBJTYP=$P(^XTV(8995,DA,0),U,3) S OBJROOT="^TMP(""XGWE"",$J)" K @OBJROOT S CURROOT=XEROOT S OJBTYP=$P(^XTV(8995,DA,0),U,3) S @XGCWROOT@("DA")=DA S @XGCWROOT@("FILE")=XFILE S @XGCWROOT@("NAME")=$P(Y,U,2) D OFF^XGCMENU("FILE^NEW;OPEN") D SETUP(XEROOT) D SETMENU D SHOCUR ENT1 S GADNAM=$P(Y,U,2) S XOBJTYP=OBJTYP S XFILE=8995 D CLEAR^XGCMENU("FILE") D INIT^XGCWED1 Q I $D(XGCEXIT),XGCEXIT G CLOSE^XGCWED2 I $D(XGCEXIT) D NEWIT Q ; SETMENU ; N I,J,X I XFILE=8995.8 D Q . D OFF^XGCMENU("EDIT") D CLEAR^XGCMENU("EDIT") S XOBJTYP=OBJTYP ;$P(^XTV(8995,DA,0),U,3) S XOBJ=$G(^XTV(8995.6,XOBJTYP,0)) S X="" F I=3,4,5,7 I $P(XOBJ,U,I)'=1 D . S J=$P(",,MENU ITEMS,CHOICES,ASSOC OBJECTS,,DRAW CMNDS",",",I) . S X=X_";"_J I $O(^XTV(8995.6,XOBJTYP,2,0))'>0 S X=X_";"_EVENTS I X'="" D . S X="EDIT^"_X . D OFF^XGCMENU(X) Q SHOCUR ; Q K XX S XX(1,"G","TXT2","VALUE")=$P(Y,U,2) S XX(1,"G","TXT2","ACTIVE")=1 D M^XG(@XGEVENT@("WINDOW"),$NA(XX(1))) Q ; SETUP(XEROOT) ; set up MWAPI structure for current data N XW,XWNN,X,X1,X2,XBAS,XBASG,XC,XDIC,XGCCOMPA,XGCWIN,XL,XNAME,XOTYP,XOBJ,XV,N,N1,NX1,NX2 S XGCWIN=+DA S XBASG=$E(XEROOT,1,$L(XEROOT)-1)_"," D ENC^XGCCOMP Q ; SETDRW(GADNAM,FROM,CALLBK) ; N XWIN,TO,SETDRW S XWIN=$$NEXTNM^XGCLOAD("W") D LOAD^XGCLOAD("XGCW POS/SIZE EDIT",XWIN) S TO="SETDRW(1)" I CURROOT'=XEROOT D . S @TO@("POS")=$G(@FROM@("POS"),"0,0") . S @TO@("SIZE")=$G(@FROM@("SIZE"),"640,480") S @TO@("G","G1","EVENT","PDOWN")=CALLBK D BLDDRAW(GADNAM,FROM,TO) D M^XG(XWIN,TO) D SD^XG($PD,"FOCUS",XWIN) D . N XWIN . D ESTA^XG() D K^XG(XWIN) Q $G(SETDRW,-1) ; BLDDRAW(GADNAM,FROM,TO) ; N A,X1,XA,XB,N I '$D(@FROM) Q S @TO@("G","G1","DRAW",1)="FILLPAT,SOLID" S @TO@("G","G1","DRAW",2)="FCOLOR,65535,65535,65535" S N=2 S A="" F S A=$O(@FROM@("G",A)) Q:A="" D . I A=GADNAM Q . S XA=$G(@FROM@("G",A,"POS"),"10,10") . S XB=$G(@FROM@("G",A,"SIZE"),"30,30") . S N=N+1 . S @TO@("G","G1","DRAW",N)="BOX,"_(+XA)_","_$P(XA,",",2)_","_(XA+XB)_","_($P(XA,",",2)+$P(XB,",",2)) S N=N+1 S @TO@("G","G1","DRAW",N)="FILLPAT,SOLID" S N=N+1 S @TO@("G","G1","DRAW",N)="FCOLOR,65535,0,0" S N=N+1 I XEROOT'=CURROOT D . S XA=$G(@FROM@("G",GADNAM,"POS"),"10,10") . S XB=$G(@FROM@("G",GADNAM,"SIZE"),"30,30") I XEROOT=CURROOT D . S XA=$G(@FROM@("POS"),"10,10") . S XB=$G(@FROM@("SIZE"),"100,100") S @TO@("G","G1","DRAW",N)="BOX,"_(+XA)_","_$P(XA,",",2)_","_(XA+XB)_","_($P(XA,",",2)+$P(XB,",",2)) Q ; SAVEDRW ; N I,XWIN S XWIN=$NA(@XGWIN@(@XGEVENT@("WINDOW"),"G","G1","DRAW")) F I=0:0 S I=$O(@XWIN@(I)) Q:I="" Q:$O(@XWIN@(I))="" S SETDRW=-1 I I'="" D . S I=@XWIN@(I) . S SETDRW=$P(I,",",2)_","_$P(I,",",3)_","_($P(I,",",4)-$P(I,",",2))_","_($P(I,",",5)-$P(I,",",3)) G CLOSDRW Q ; QUITDRW ; S SETDRW=-1 G CLOSDRW Q DELDRW ; S SETDRW="@" G CLOSDRW ; CLOSDRW ; D ESTO^XG Q XGCWR^INT^1^60169,79033^0 XGCWR ;ISC-SF.SEA/JLI - CONVERT WRITE STATEMENTS TO ROUTINE CALLS ;9/14/94 09:46 ;;8.0T19;KERNEL;;Feb 22, 1995 REPLACE(TEXT) ; N T1,T2,Y,N,N1,N2,D,TA,TB S T1=TEXT I T1'[" W "&(T1'[" W:")&(T1'[" WRITE ")&(T1'[" WRITE:") Q T1 S T2=$$MASK(T1) S Y="" TAG I $E(T2)'=" " D ; get TAG on first entry, all others should be space . S N=$L($P(T2," ")) . S Y=Y_$E(T1,1,N) . S T1=$E(T1,N+1,255) . S T2=$E(T2,N+1,255) ; DOTS F Q:$E(T2,2)'="." D . S Y=Y_" ." . S T1=$E(T1,3,255) . S T2=$E(T2,3,255) . F Q:$E(T2)'=" " D . . S T1=$E(T1,2,255) . . S T2=$E(T2,2,255) . S T1=" "_T1 . S T2=" "_T2 ; PARSE ; I $E(T2,2)'="W" D . S N=$L($P(T2," ",1,3)) . S Y=Y_$E(T1,1,N) . S T1=$E(T1,N+1,255) . S T2=$E(T2,N+1,255) WCMD I $E(T2,2)="W" D . S D=$S($E(T2,1,3)=" W:":" W:",$E(T2,1,7)=" WRITE:":" WRITE:",$E(T2,1,7)=" WRITE ":" WRITE ",1:" W ") . S Y=Y_" D" . S T1=$E(T1,$L(D)+1,255) . S T2=$E(T2,$L(D)+1,255) COND . I D[":" D . . S N=$L($P(T2," ")) . . S Y=Y_":"_$E(T1,1,N) . . S T1=$E(T1,N+2,255) . . S T2=$E(T2,N+2,255) ARG . S TB=$P(T2," ") . S TA=$E(T1,1,$L(TB)) . S T1=$E(T1,$L(TB)+1,255) . S T2=$E(T2,$L(TB)+1,255) . S Y=Y_" ^XW("_$$CONVERT(TA,TB)_")" I T2'="" G PARSE Q Y ; MASK(T1) ; N T2,DQ,I,CNT,N,X S T2=T1 S DQ="""""" F Q:T2'[DQ D . S T2=$P(T2,DQ)_"XX"_$P(T2,DQ,2,99) ; S DQ="""" F Q:T2'[DQ D . S I="" . S $P(I,"X",$L($P(T2,DQ,2))+2)="X" . S T2=$P(T2,DQ)_I_$P(T2,DQ,3,99) ; F Q:T2'["(" D . S I=$L($P(T2,"("))+1 . S CNT=0 . S N=$L(T2) . F I=I:1 D Q:CNT=0 Q:I>$L(T1) . . S X=$E(T2,I) . . S T2=$E(T2,1,I-1)_"X"_$E(T2,I+1,N) . . I X="(" S CNT=CNT+1 . . I X=")" S CNT=CNT-1 Q T2 ; CONVERT(TA,TB) ; N Y,T1,T2,N,N1,N2,N3 S Y="" S T1=TA S T2=TB F Q:T2'["#" D . S N1=$F(T2,"#") . S T1=$E(T1,1,N1-2)_"$C(3)"_$E(T1,N1,255) . S T2=$E(T2,1,N1-2)_"XXXXX"_$E(T2,N1,255) F Q:T2'["!" D . S N=$L($P(T2,"!")) . S T1=$E(T1,1,N)_"$C(1)_"_$E(T1,N+2,255) . S T2=$E(T2,1,N)_"XXXXXX"_$E(T2,N+2,255) ; F Q:T2'["?" D . S N1=$F(T2,"?") . S N2=$F($E(T2,N1,255)," ") . S N3=$F($E(T2,N1,255),",") . S N2=$S(N2=0:N3,N3=0:N2,N20 S N2=0 Q . . S N4=$E(T2,N1+$L(N3)) . . I N4'=","&(N4'=" ")&(N4'="") S N2=0 Q . . S T1=$E(T1,1,N1-2)_"$C("_N3_")"_$E(T1,N1+$L(N3),255) . . S T2=$E(T2,1,N1-2)_"XXX"_N3_"X"_$E(T2,N1+$L(N3),255) . I N2 Q . S T2=$E(T2,1,N1-2)_"X"_$E(T2,N1,255) INDIR F Q:T2'["@" D Q . S N1=$F(T2,"@") . S N2=$F($E(T2,N1,255)," ") . S N3=$F($E(T2,N1,255),",") . S N4=$F($E(T2,N1,255),"@") . S N2=$S(N2=0:N3,N3=0:N2,N20,$S(N2=0:1,N40 S C=I S XTMES=1,XTDV1=0 D WRT^XTER1 D:C>0 MESSG S C=0 K XTMES,^TMP($J,"XTER") G XTERR^XTER Q PRNT S C=0,%ZIS="MQ" K ^TMP($J,"XTER") D ^%ZIS I POP S IOP="HOME" D ^%ZIS K IOP,%ZIS G WRT^XTER1 K %ZIS I $D(IO("Q")) K IO("Q") S ZTRTN="DQPRNT^XTER1A",ZTIO=ION,ZTSAVE("%XTZDAT")="",ZTSAVE("%XTZNUM")="",ZTDESC="XTER1A-PRINT OF ERROR" D ^%ZTLOAD K ZTRTN,ZTIO,ZTSAVE,ZTSK S IOP="HOME" D ^%ZIS S XTX="" G XTERR^XTER ; DQPRNT S XTPRNT=1,XDONE=0 D WRT^XTER1 U IO D:C>0 WRITER K ^TMP($J,"XTER") S C=0 K XTPRNT D ^%ZISC I $D(ZTQUEUED) Q S IOP="HOME" D ^%ZIS K IOP G XTERR^XTER WRITER(LOC) ; N X,X1 S X=LOC I X["$J" S X=$P(X,"$J")_($J)_$P(X,"$J",2) S X1=$E(X,1,$L(X)-1) F S X=$Q(@X) Q:X=""!($E(X,1,$L(X1))'=X1) W:((IOSL-$Y)'>4)&$G(XTPRNT) @IOF S %1=@X D .I $E(%1,1,6)="|PAGE|" W @IOF S %1=$E(%1,7,$L(%1)) Q:%1="" .I $E(%1,1,4)="@IOF" W @IOF S %1=$E(%1,5,$L(%1)) Q:%1="" .W !,%1 K %,%1 Q MESSG S XMY(DUZ)="",XMDUZ=.5 I '$D(ZTQUEUED) K XMY,XMDUZ S XMTEXT="^TMP($J,""XTER"",",XMSUB="ERROR - "_$E(%XTZE,1,40) F Q:XMSUB'[U S XMSUB=$P(XMSUB,U)_"~U~"_$P(XMSUB,U,2,99) D ^XMD K XMY,XMTEXT,XMSUB Q ; MORE(LOC) ; N X S XDONE=0,XTX="" Q:$G(XTMES) D WRITER(LOC) K @LOC S C=0 I '$D(ZTQUEUED),'$G(XTPRNT),$D(IOST)#2,IOST["C-" D . S DIR(0)="FO^0:50" . S DIR("A")=" Enter '^' to quit listing, to continue..." . D ^DIR K DIR . S:$D(DTOUT) X="^" . S XTX=X K DTOUT,DIRUT,DUOUT I $D(XTX),$E(XTX)="^" S XDONE=1 Q W @IOF Q ; XGCWROU^INT^1^60169,79033^0 XGCWROU ;ISC-SF.SEA/JLI - ROUTINE DISPLAY AND EDITOR ;11/16/94 10:27 ;;8.0T19;KERNEL;;Feb 22, 1995 DISPLAY(ROUTINE) ; N XRWIN S XRWIN="XGCW DOC DISPLAY" G SHOROU EDIT(ROUTINE) ; N XRWIN S XRWIN="XGCW ROUTINE EDIT" G SHOROU SHOROU ; N XWIN,I,X,X1 K ^TMP($J,"ROU") K ^TMP($J,"DOC") F I=1:1 S X1="+"_I_"^"_ROUTINE X "S X=$T("_X1_")" Q:X="" S ^TMP($J,"ROU",I,0)=X S XWIN=$$NEXTNM^XGCLOAD("W") D GET^XGCLOAD(XRWIN,$NA(^TMP($J,"DOC",XWIN))) S ^TMP($J,"DOC",XWIN,"TITLE")=$P($S(ROUTINE["^":$P(ROUTINE,U,2),1:ROUTINE),"(") D M^XG(XWIN,$NA(^TMP($J,"DOC",XWIN))) S NPAG=$$LOADPAGS($NA(^TMP($J,"ROU")),$NA(^TMP($J,"WROU"))) S CURPAG=1 I NPAG>1 D S^XG(XWIN,"G","BUT6","VISIBLE",1) D SD^XG($PD,"FOCUS",XWIN_",DOC1") D . N XWIN . D ESTA^XG() D K^XG(XWIN) Q ; EXIT ; N XWIN,I S XWIN=@XGEVENT@("WINDOW") S Y=0 S I=0,A="DOC" F Q:I S A=$O(@XGWIN@(XWIN,"G",A)) Q:$E(A,1,3)'="DOC" D . I @XGWIN@(XWIN,"G",A,"CHANGED") S I=1 I I D Q:Y=-1 . N TXT . S TXT(1)="Do you want to save the routine before EXITING?" . S Y=$$MESG3^XGLMSG("TXT") I Y D SAVE D ESTO^XG ; SAVEAS ; N TXT,Y,X S Y=$$FRETXT^XGCDIR("ROUTINE NAME",ROUTINE) I Y'?1A.7AN D Q . S TXT(1)="INVALID ROUTINE NAME MUST BE 1 ALPHA FOLLOWED BY 1 TO 7 ALPHANUMERIC CHARACTERS." . S TXT=$$MESG1^XGLMSG("TXT") S TXT="+1^"_Y X "S X=$T("_TXT_")" I X'="" D Q:TXT'>0 . S TXT(1)="The routine "_Y_" is already present." . S TXT(2)="" . S TXT(3)=" Do You REALLY want to replace it with the current routine?" . S TXT=$$MESG3^XGLMSG("TXT") S ROUTINE=Y D SAVE D ESTO^XG SAVE ; N XWIN,X S XWIN=@XGEVENT@("WINDOW") S X=ROUTINE K ^TMP($J,"ROUA") S Y=$$SAVEPAGS(XWIN,$NA(^TMP($J,"ROUA"))) S DIE="^TMP($J,""ROUA"",",XCN=0 X ^%ZOSF("SAVE") Q ; LOADPAGS(LOADFROM,LOADTO) ; N I,J,N,NPAG,X,CNT K @LOADTO S CNT=0,I=0,J=0,NPAG=1 F S I=$O(@LOADFROM@(I)) Q:I'>0 S X=$S(($D(^(I))#2):^(I),1:^(I,0)) D . S J=J+1 . S @LOADTO@(NPAG,J,0)=X . S CNT=CNT+$L(X)+2 . I CNT>2500 D . . S @LOADTO@(NPAG,J+1,0)="[**** CONTINUED ON NEXT FRAME (SELECT 'NEXT' TO VIEW IT ****]" . . S NPAG=NPAG+1 . . S J=0 . . S CNT=0 I NPAG>1 D . M @LOADTO@("DOC")=@XGWIN@(XWIN,"G","DOC1") . F N=1:1:NPAG S NAME="DOC"_N D . . M @LOADTO@(NAME)=@LOADTO@("DOC") . . S @LOADTO@(NAME,"TITLE")="FRAME "_N_" OF "_NPAG . . D M^XG(XWIN,"G",NAME,$NA(@LOADTO@(NAME))) F N=1:1:NPAG D . S NAME="DOC"_N . D ULDOC^XGC02($NA(@XGWIN@(XWIN,"G",NAME)),$NA(@LOADTO@(N)),-1) Q NPAG ; SAVEPAGS(XWIN,LOADTO) ; N CNT,N,NAME,LOADTEMP,X,NL S LOADTEMP="^TMP(""SAVEPAGS"",$J,XWIN)" K @LOADTEMP K @LOADTO S CNT=0 F N=1:1:NPAG S NAME="DOC"_N D . S NL=$$DLDOC^XGC02($NA(@XGWIN@(XWIN,"G",NAME)),$NA(@LOADTEMP@(N)),255) . F NL=0:0 S NL=$O(@LOADTEMP@(N,NL)) Q:NL'>0 D . . S X=@LOADTEMP@(N,NL,0) . . I $E(X,1,4)="[***" K @LOADTEMP@(N,NL,0) Q ; REMOVE NEXT PAGE TEXT . . S CNT=CNT+1 . . S @LOADTO@(CNT,0)=X K @LOADTEMP Q CNT NEXT ; N XWIN S XWIN=@XGEVENT@("WINDOW") S CURPAG=CURPAG+1 D SD^XG($PD,"FOCUS",(XWIN_",DOC"_CURPAG)) I CURPAG=NPAG D . D S^XG(XWIN,"G","BUT6","VISIBLE",0) I CURPAG=2 D . D S^XG(XWIN,"G","BUT5","VISIBLE",1) Q ; BACK ; N XWIN S XWIN=@XGEVENT@("WINDOW") S CURPAG=CURPAG-1 D SD^XG($PD,"FOCUS",(XWIN_",DOC"_CURPAG)) I CURPAG=(NPAG-1) D . D S^XG(XWIN,"G","BUT6","VISIBLE",1) I CURPAG=1 D . D S^XG(XWIN,"G","BUT5","VISIBLE",0) Q XGCWSSVN^INT^1^60169,79033^0 XGCWSSVN ;ISC-SF.SEA/JLI - VIEW SSVN WHILE IN WINDOWS ;12/13/94 15:42 ;;8.0T19;KERNEL;;Feb 22, 1995 ;; ENTRY ; N XWIN S XWIN=$$NEXTNM^XGCLOAD("W") D LOAD^XGCLOAD("XGCW SSVN LIST",XWIN) S XVAL("G","LBUT1","CHOICE",1)="^$WINDOW" S XVAL("G","LBUT1","CHOICE",2)="^$DISPLAY" S XVAL("G","LBUT1","VALUE")=1 D SETWINS D SD^XG($PD,"FOCUS",XWIN_",LBUT2") D . N XWIN . D ESTA^XG() D K^XG(XWIN) Q ; SETSSVN ; Callback to set a new SSVN selection (Window/Display) N XWIN,XVAL,Y S XWIN=@XGEVENT@("WINDOW") S Y=@XGWIN@(XWIN,"G","LBUT1","VALUE") I Y=1 D Q . D SETWINS I Y'=1 D . S XVAL("G","LBUT2","ACTIVE")=0 . S XVAL("G","LBUT3","ACTIVE")=0 . D M^XG(XWIN,"G",$NA(XVAL("G"))) Q ; SETWINS ; N I,N,XVAL S XVAL("G","LBUT2","ACTIVE")=1 S XVAL("G","LBUT3","ACTIVE")=0 S I="",N=0 F S I=$O(@XGWIN@(I)) Q:I="" D . S N=N+1,N(1)=$G(@XGWIN@(I,"TITLE"),"<-- no title -->") . S XVAL("G","LBUT2","CHOICE",N)=I_" "_N(1) D M^XG(XWIN,"G",$NA(XVAL("G"))) Q ; PICKWIN ; N XWIN,I,J,XVAL,VAL,N S XWIN=@XGEVENT@("WINDOW") D K^XG(XWIN,"G","LBUT3","CHOICE") S VAL=@XGWIN@(XWIN,"G","LBUT2","VALUE"),VAL=$P(@XGWIN@(XWIN,"G","LBUT2","CHOICE",VAL)," ") S XVAL("G","LBUT3","CHOICE",1)="Complete Window",XVAL("G","LBUT3","CHOICE",2)="Window Portion Only" S N=2 F I="G","T","M" D . S J="" F S J=$O(@XGWIN@(VAL,I,J)) Q:J="" D . . S N=N+1,XVAL("G","LBUT3","CHOICE",N)=$S(I="G":"Gadget ",I="M":"Menu ",1:"Timer ")_J_" ["_$G(@XGWIN@(VAL,I,J,"TITLE"),"<-- no title -->")_"] "_$G(@XGWIN@(VAL,I,J,"TYPE")) S XVAL("G","LBUT3","ACTIVE")=1 S XVAL("G","LBUT3","VALUE")=1 D M^XG(XWIN,"G",$NA(XVAL("G"))) Q ; SSVN ; N XWIN,XVAL,VAL,XROOT,XTYP,XR1,N S XWIN=@XGEVENT@("WINDOW") D K^XG(XWIN,"G","DOC1","VALUE") I @XGWIN@(XWIN,"G","LBUT1","VALUE")=2 D I 1 . S XROOT="^$DISPLAY("""")",XR1="^$DI(",XTYP="" E D . S VAL=@XGWIN@(XWIN,"G","LBUT2","VALUE"),VAL=@XGWIN@(XWIN,"G","LBUT2","CHOICE",VAL),VAL=$P(VAL," ") . S XROOT=$S(XGWIN="^$W":$NA(^$WINDOW(VAL)),1:$NA(@XGWIN@(VAL))) . S VAL=@XGWIN@(XWIN,"G","LBUT3","VALUE") . S VAL=@XGWIN@(XWIN,"G","LBUT3","CHOICE",VAL) . S XTYP=$E(VAL,1),VAL=$P(VAL," ",2) . I XTYP'="C"&(XTYP'="W") D . . S XROOT=$NA(@XROOT@(XTYP,VAL)) . S XR1=$E(XROOT,1,$L(XROOT)-1)_"," S XVAL="^TMP($J,""SSVN"")" K @XVAL S N=0 I XROOT'["^$DI",$D(@XROOT)#2 S N=N+1,@XVAL@(N)=XROOT_" = "_@XROOT F S XROOT=$Q(@XROOT) Q:XROOT'[XR1 D . I XTYP="W" S A=$P($P(XROOT,XR1,2),",") I A="""M"""!(A="""T""")!(A="""G""") Q . S N=N+1,@XVAL@(N)=XROOT_" = "_@XROOT S WINROOT=$NA(@XGWIN@(XWIN,"G","DOC1")) D ULDOC^XGC02(WINROOT,XVAL,-1) K @XVAL Q ; DISSVN ; XGCWUTL^INT^1^60169,79033^0 XGCWUTL ;ISC-SF.SEA/JLI - UTILITY CALLS [ 03/25/94 4:00 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 Q MESG(ARREF,WRAPFLG) ; N WINNAM,Y S WINNAM="XGCW GUI MESG 1B" D DOMESG Q MESG1(ARREF,WRAPFLG) ; D MESG(ARREF,$G(WRAPFLG,1)) Q 1 ; MESG2(ARREF,WRAPFLG) ; N WINNAM,Y S WINNAM="XGCW GUI MESG 2B" D DOMESG Q Y ; MESG3(ARREF,WRAPFLG) ; N WINNAM,Y S WINNAM="XGCW GUI MESG 3B" D DOMESG Q Y ; DOMESG ; N XWIN S XWIN=$$NEXTNM^XGCLOAD("XGW") D LOAD^XGCLOAD(WINNAM,XWIN) D ULDOC^XGC02($NA(@XGWIN@(XWIN,"G","DOC1")),ARREF,$G(WRAPFLG,1)) D SD^XG($PD,"FOCUS",XWIN) D . N XWIN . D ESTA^XG() D K^XG(XWIN) Q ; YES ; S Y=1 D ESTO^XG Q ; NO ; S Y=0 D ESTO^XG Q ; CANCEL ; S Y=-1 D ESTO^XG Q XGCWUTL1^INT^1^60169,79033^0 XGCWUTL1 ;ISC-SF.SEA/JLI - CONTINUTATION OF GUI EDITOR ; [ 03/25/94 4:00 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ;; Q VIEW ; S XEROOT=$NA(^TMP("XGWE",$J)) D SHOVIEW(XEROOT) Q ; SHOVIEW(XEROOT) ; N TXT,XFROOT,XWIN,X1,A I '$D(@XEROOT) D Q . S TXT(1)="NO OBJECT INFORMATION TO VIEW AT THIS TIME." . D MESG^XGCWUTL("TXT") S XFROOT="^TMP(""XGWF"","_$J_")" K @XFROOT X "M "_XFROOT_"="_XEROOT S X1=$E(XFROOT,1,$L(XFROOT)-1)_"," S A=XFROOT F S A=$Q(@A) Q:A'[X1 I A[",""EVENT""," K @A S @XFROOT@("MODAL")="APPLICATION" S @XFROOT@("EVENT","PDOWN")="CLOSE^XGCDIC1" S @XFROOT@("EVENT","CLOSE")="CLOSE^XGCDIC1" S XWIN=$$NEXTNM^XGCLOAD("W") D M^XG(XWIN,XFROOT) D SD^XG($PD,"FOCUS",XWIN) D . N XWIN . D ESTA^XG() D K^XG(XWIN) Q XGCXOBJ^INT^1^60169,79033^0 XGCXOBJ ;ISC-SF/JLI - IDENTIFY OBJECTS WHICH POINT TO A GIVEN OBJECT ;2/19/94 04:45 ;;8.0T19;KERNEL;;Feb 22, 1995 ;; EN ; W ! S XGCEDITR=1,DIC="^XTV(8995,",DIC(0)="AEQM",DIC("A")="Show references to OBJECT: " D ^DIC K DIC G:Y'>0 CBACKS S DA=+Y,XGNAM=$P(Y,U,2),XGLEN=$L(XGNAM)+4 S XGFND=0 F I=0:0 S I=$O(^XTV(8995,I)) Q:I'>0 I I'=DA S X=$P(^(I,0),U) D . I $P(^XTV(8995,I,0),U,2)=DA W ! W:'XGFND !?4,XGNAM W ?XGLEN," is PARENT of ",X S XGFND=1 . I $D(^XTV(8995,I,100)),$P(^XTV(8995,I,100),U,3)=DA W ! W:'XGFND !?4,XGNAM W ?XGLEN," is entered as MENUBAR for ",X S XGFND=1 . F J=0:0 S J=$O(^XTV(8995,I,2,J)) Q:J'>0 I +$P(^(J,0),U,2)=DA W ! W:'XGFND !?4,XGNAM W ?XGLEN," is entered as ASSOCIATED OBJECT for ",X S XGFND=1 . F J=0:0 S J=$O(^XTV(8995,I,3,J)) Q:J'>0 I $P(^(J,0),U,3)=DA W ! W:'XGFND !?4,XGNAM W ?XGLEN," is entered as SUB-MENU to ",X S XGFND=1 I 'XGFND W !!?4,XGNAM," IS NOT REFERENCED" G EN ; EXIT K DA,DIC,I,J,X,Y,XGCEDITR Q CBACKS ; W ! S DIC="^XTV(8995.8,",DIC(0)="AEQM",DIC("A")="Show reference to CALL BACK: " D ^DIC K DIC G:Y'>0 EXIT S DA=+Y,XGNAM=$P(Y,U,2),XGLEN=$L(XGNAM) S XGFND=0 F I=0:0 S I=$O(^XTV(8995,I)) Q:I'>0 S X=$P(^(I,0),U) D . F J=0:0 S J=$O(^XTV(8995,I,1,J)) Q:J'>0 I $P(^(J,0),U,2)=DA W ! W:'XGFND !,XGNAM W ?XGLEN," is a callback to ",$P(^XTV(8995.5,+^(0),0),U)," event for ",X S XGFND=1 . F J=0:0 S J=$O(^XTV(8995,I,2,J)) Q:J'>0 S X1=$P(^(J,0),U) F K=0:0 S K=$O(^XTV(8995,I,2,J,1,K)) Q:K'>0 I $P(^(K,0),U,2)=DA S X3=^(0) D . . W ! W:'XGFND !,XGNAM W ?XGLEN," is a callback to ",$P(^XTV(8995.5,+X3,0),U)," event for the ",X1,!?(XGLEN+5)," associated object for ",X S XGFND=1 . F J=0:0 S J=$O(^XTV(8995,I,3,J)) Q:J'>0 I $P(^(J,0),U,3)="",$P(^(0),U,4)=DA W ! W:'XGFND !,XGNAM W ?XGLEN," is a callback to SELECT of ",$P(^(0),U,2)," entry of ",X S XGFND=1 G CBACKS XGDEBUG^INT^1^60169,79033^0 XGDEBUG ;SFISC/VYD - Used to aid in troubleshooting emulation mode ;02/13/95 16:20 ;;8.0T19;KERNEL;;Feb 22, 1995 N %,XGJOB,XGWIN ASK R !,"Enter $J of process to troubleshoot: ",XGJOB Q:"^"[XGJOB I '$D(^TMP("XGW",XGJOB)) W !,XGJOB," doesn't exist!" G ASK ASK1 R !!,"Enter window name (^TMP(""XGS"",$J,windowname): ",XGWIN Q:"^"[XGWIN I XGWIN="?" S %="" F S %=$O(^TMP("XGS",XGJOB,%)) Q:%="" W !,% G:XGWIN="?" ASK1 I '$D(^TMP("XGW",XGJOB,XGWIN)) W !,XGWIN," doesn't exist!" G ASK1 S %="" F S %=$O(^TMP("XGS",XGJOB,XGWIN,%)) Q:%="" D . I %'="COORDS" W !,^(%,0) . E W !,"Coords: ",^(%) G ASK1 XGEVNT^INT^1^60169,79033^0 XGEVNT ;SFISC/VYD - KWAPI event handler ;02/14/95 11:00 ;;8.0T19;KERNEL;;Feb 22, 1995 ; ESTA ;main event handling loop N X,% S C="," I ^%ZOSF("OS")["DSM" N $ETRAP S $ETRAP="" S X="ESTOP^XGEVNT1",@^%ZOSF("TRAP") S $P(XGESEQ,U)=XGESEQ+1 ;increment event stack counter S $P(XGEVENT,C,3)=+XGESEQ_")" ;change event root ; D WAIT^XGUTIL2(0) ;clear the WAIT indicator ; ;-------------------- gadget processing loop F D ;an error is expected to break the loop . S XGFLAG("JUMP")=0 ;reset gadget jump (activated by "^") . S XGFLAG("ABORT")=0 ;reset ABORT flag that ends gadget's processing . K XGFLAG("KEEP FOCUS") . ; . D NXTELMNT ;get next element to process . D FCSEVNTS ;do change, unfocus and focus events . ; . D ;process next element . . I $D(XGFLAG("WINDOW CLOSE")) D CLOSE^XGWCTRL Q . . I $D(XGFLAG("WINDOW SELECT")) D ^XGWINSEL Q . . I $D(XGFLAG("WINDOW MOVE")) D MOVE^XGWCTRL Q . . I $D(XGFLAG("WINDOW RESIZE")) D RESIZE^XGWCTRL Q . . I XGFLAG("JUMP") D UARROW^XGJUMP Q . . I $L(XGMENU) D MENUS Q . . I $L($P(XGNEWFCS,C,2)) D GADGET Q . . D IDLE^XGEVNT1 Q ;could not find anything . ; . U:^%ZOSF("OS")["VAX DSM" IO(0):FLUSH ;update screen immediately Q ; ; FCSEVNTS ;focus/unfocus/change event processor N XGW1,XGG1 ;window, gadget ; I XGOLDFCS'=XGNEWFCS,$L(XGOLDFCS) D I 1 . S XGW1=$P(XGOLDFCS,C) . S XGG1=$P(XGOLDFCS,C,2) . I $G(^TMP("XGW",$J,XGW1,"G",XGG1,"EVENT","CHANGE","ENABLE")) D E^XGEVNT1(XGW1,"G",XGG1,"","CHANGE") I 1 . E I $G(^TMP("XGW",$J,XGW1,"G",XGG1,"EVENT","UNFOCUS","ENABLE")) D E^XGEVNT1(XGW1,"G",XGG1,"","UNFOCUS") I 1 ; S XGOLDFCS=^TMP("XGD",$J,$PD,"FOCUS") S ^TMP("XGD",$J,$PD,"FOCUS")=XGNEWFCS ; I ^TMP("XGD",$J,$PD,"FOCUS")'=XGOLDFCS D I 1 . S XGW1=$P(^TMP("XGD",$J,$PD,"FOCUS"),C) . S XGG1=$P(^TMP("XGD",$J,$PD,"FOCUS"),C,2) . I $G(^TMP("XGW",$J,XGW1,"G",XGG1,"EVENT","FOCUS","ENABLE")) D E^XGEVNT1(XGW1,"G",XGG1,"","FOCUS") I 1 ; S XGOLDFCS=^TMP("XGD",$J,$PD,"FOCUS") Q ; ; MENUS ; process menus ; come here if user selected a menu bar or a submenu F Q:XGMENU="" D . S XGM=$P(XGMENU,U) ;S XGM=last menu that user selected . I ^TMP("XGW",$J,XGW,"M",XGM,"ACTIVE"),^("VISIBLE")!($G(^TMP("XGW",$J,XGW,"MENUBAR"))=XGM) D . . K XGTRACE . . S XGID=XGW_U_"M"_U_XGM . . S XGFLAG("PAINT")=21 . . S XGFLAG("KEEP FOCUS")=1 ;set flag to return focus to prev window+gadget . . D @$S($G(^TMP("XGW",$J,XGW,"MENUBAR"))=XGM:"MBARS^XGM1",1:"MENUS^XGM2") ;service either a menu bar or a popup menu Q ; ; NXTELMNT ;get next element to process ;XGTRACE trace of all gadgets that I visited in search of ACTIVE ; gadget. If I try to add a gadget to XGTRACE that's already ; there, than I'm in an infinite loop. Then I'll try to rest ; on the MENUBAR N %,XGSTOP D . I $D(XGFLAG("WINDOW CLOSE")) Q . I $D(XGFLAG("WINDOW SELECT")) Q . I $D(XGFLAG("WINDOW MOVE")) Q . I $D(XGFLAG("WINDOW RESIZE")) Q . I XGFLAG("JUMP") Q . I $L(XGMENU) Q . I ^TMP("XGD",$J,$PD,"FOCUS")="" D Q:^TMP("XGD",$J,$PD,"FOCUS")="" . . S %="" . . F S %=$O(XGSCRN("ORDER",%),-1) Q:%=0!(^TMP("XGW",$J,XGSCRN("ORDER",%),"ACTIVE")) . . S:%>0 ^TMP("XGD",$J,$PD,"FOCUS")=XGSCRN("ORDER",%) . ; . I ^TMP("XGD",$J,$PD,"FOCUS")'=XGOLDFCS D ;callback changed FOCUS . . D:$P(^TMP("XGD",$J,$PD,"FOCUS"),C)'=$P(XGOLDFCS,C) SETUP^XGWIN1($P(^("FOCUS"),C)) . . S XGNEWFCS=^TMP("XGD",$J,$PD,"FOCUS") . . S XGNEXTG=$P(XGNEWFCS,C,2) . ; . S %=$O(XGSCRN("ORDER",""),-1),%=XGSCRN("ORDER",%) . I $P(^TMP("XGD",$J,$PD,"FOCUS"),C)'=%,%'=$C(1) D SETUP^XGWIN1(^("FOCUS")) . S:$P(^TMP("XGD",$J,$PD,"FOCUS"),C,2)="" XGNEXTG=^TMP("XGW",$J,$P(^("FOCUS"),C),"YXGNEXTG") . S (XGW,XGNEWFCS)=$P(^TMP("XGD",$J,$PD,"FOCUS"),C) . K XGTRACE . S XGSTOP="" . F D Q:$L(XGSTOP) . . I ^TMP("XGW",$J,XGW,"G",XGNEXTG,"VISIBLE"),$G(^("ACTIVE")) S XGSTOP="FOUND NEXT" . . E I '$D(XGTRACE(XGNEXTG)) D I 1 ;if gadget hasn't been visited . . . S XGTRACE(XGNEXTG)="" ;record gadget as "visited" . . . S XGG=XGNEXTG ;to get correct YXGNEXTG gadget . . . D @($S(XGRT="PF4":"PF4^XGJUMP",1:"TAB^XGJUMP")) ;get next . . E S XGSTOP="NONE FOUND" ;couldn't find a gadget to rest on . S:XGSTOP="FOUND NEXT" $P(XGNEWFCS,C,2)=XGNEXTG Q ; ; GADGET ;service gadget S XGW=$P(^TMP("XGD",$J,$PD,"FOCUS"),C),XGG=$P(^("FOCUS"),C,2) S XGGTYP=^TMP("XGW",$J,XGW,"G",XGG,"TYPE") S XGID=XGW_U_"G"_U_XGG S XGFLAG("ABORT")=0 ;reset ABORT flag that ends gadget's processing S XGFLAG("PAINT")=21 ;window visible, in focus, gadget visible D . I XGGTYP="BUTTON" K XGTRACE S XGMENU="" D SERVICE^XGGB Q . I XGGTYP="CHECK" K XGTRACE S XGMENU="" D SERVICE^XGGC Q . I XGGTYP="DOCUMENT" K XGTRACE S XGMENU="" D SERVICE^XGGD Q . I XGGTYP="LIST" K XGTRACE S XGMENU="" D SERVICE^XGGL Q . I XGGTYP="LISTBUTTON" K XGTRACE S XGMENU="" D SERVICE^XGGLB Q . I XGGTYP="LISTENTRY" K XGTRACE S XGMENU="" D SERVICE^XGGLE Q . I XGGTYP="LONGLIST" K XGTRACE S XGMENU="" D SERVICE^XGGL Q . I XGGTYP="RADIO" K XGTRACE S XGMENU="" D SERVICE^XGGR Q . I XGGTYP="TEXT" K XGTRACE S XGMENU="" D SERVICE^XGGT Q Q XGEVNT1^INT^1^60169,79033^0 XGEVNT1 ;SFISC/VYD - KWAPI event handler ;02/13/95 14:44 ;;8.0T19;KERNEL;;Feb 22, 1995 ; COMPLETE(XGW1,XGELTYP,XGELMNT,XGC1) ;complete missing event attribs for all events ;window, element type (G/M/T), element (gadget/menu/timer) N % D . I $G(XGELTYP)="" D Q . . S %="" . . F S %=$O(^TMP("XGW",$J,XGW1,"EVENT",%)) Q:%="" S:'$D(^(%,"ENABLE")) ^("ENABLE")=1 . I $G(XGC1)="" D Q . . S %="" . . F S %=$O(^TMP("XGW",$J,XGW1,XGELTYP,XGELMNT,"EVENT",%)) Q:%="" S:'$D(^(%,"ENABLE")) ^("ENABLE")=1 . S %="" . F S %=$O(^TMP("XGW",$J,XGW1,XGELTYP,XGELMNT,"CHOICE",XGC1,"EVENT",%)) Q:%="" S:'$D(^(%,"ENABLE")) ^("ENABLE")=1 Q ; ; COMPLET2(XGW1,XGELTYP,XGELMNT,XGC1,XGEVNT) ;complete missing event attribs for one event ;window, element type (G/M/T), element (gadget/menu/timer), event D . I $G(XGELTYP)="" S:'$D(^TMP("XGW",$J,XGW1,"EVENT",XGEVNT,"ENABLE")) ^("ENABLE")=1 Q . I $G(XGC1)="" S:'$D(^TMP("XGW",$J,XGW1,XGELTYP,XGELMNT,"EVENT",XGEVNT,"ENABLE")) ^("ENABLE")=1 Q . S:'$D(^TMP("XGW",$J,XGW1,XGELTYP,XGELMNT,"CHOICE",XGC1,"EVENT",XGEVNT,"ENABLE")) ^("ENABLE")=1 Q Q ; ; IDLE ;nothing to do N % F Q:XGFLAG("ABORT") D . S %=$$READ^XGKB(4) . S:%="^^^^" XGFLAG("ABORT")=1 Q ; ; ESTO ; S C="," S $P(XGESEQ,U)=XGESEQ-1 ;decrement event stack counter K @XGEVENT D WAIT^XGUTIL2(0) ;clear the WAIT indicator ;if poping out of the outermost level and on DSM, disable pack I $P(XGESEQ,U)=1000000,^%ZOSF("OS")["DSM" U $I:NOPACK ZTRAP "K-WAPI ESTOP" ;purposefully cause an error Q ; ; ESTOP ;K-WAPI equivalent of MWAPI ESTOP I $ZE'["K-WAPI ESTOP" D . S X=IOM X ^%ZOSF("RM") . ;D CLEAN^XG . W !,"**** "_$S($ZE["CANCEL":"CANCEL",1:"Hey! An error!")_" ****" . ZQ Q ; ; ETR ;event trigger S XGERR="ETRIGGER" I '$D(P4) D I 1 ;window event . S XGERR=XGERR_"-WINDOW" . I $D(^TMP("XGW",$J,P1,"EVENT",P3)) D E(P1,"","","",P3) I 1 . E ZTRAP "M?3, triggered nonexisting window event" E D . S XGERR=XGERR_"-GADGET/TIMER/MENU CHOICE" . D HUH^XGUTIL2(XGERR) Q ; ; E(XGW1,XGELTYPE,XGELMNT,XGC1,XGETYPE) ;application callback processor ;all callback entry points are entered into here N XGGTYP,XGC,% I XGETYPE'="KEYDOWN",XGETYPE'="TIMER",$G(XGELMNT)'="~XGWM" D WAIT^XGUTIL2(1) ;paint WAIT indicator S XGGTYP=$S('$L(XGELTYPE):^TMP("XGW",$J,XGW1,"TYPE"),1:$G(^TMP("XGW",$J,XGW1,XGELTYPE,XGELMNT,"TYPE"),"MENU")) S:$L($G(XGC1)) @XGEVENT@("CHOICE")=XGC1 S @XGEVENT@("CLASS")="WINDOW" S:$L($G(XGELTYPE)) @XGEVENT@("ELEMENT")=XGELTYPE_C_XGELMNT D:"CHANGE UNFOCUS"[XGETYPE . S @XGEVENT@("NEXTFOCUS")=XGNEWFCS . S @XGEVENT@("OK")="" S:XGETYPE="FOCUS" @XGEVENT@("PRIORFOCUS")=XGOLDFCS S $P(XGESEQ,U,2)=$P(XGESEQ,U,2)+1 S @XGEVENT@("SEQUENCE")=$P(XGESEQ,U,2) S @XGEVENT@("TYPE")=XGETYPE S @XGEVENT@("WINDOW")=XGW1 U:^%ZOSF("OS")["VAX DSM" IO(0):FLUSH ;update screen immediately ; I $G(XGELTYPE)="M" D I 1 ;if doing an event for a menu choice . I XGELMNT="~XGWM" D I 1 ;if processing window control menu . . S %=^TMP("XGW",$J,XGW1,XGELTYPE,XGELMNT,"CHOICE",XGC1,"EVENT",XGETYPE) . . K ^TMP("XGW",$J,XGW1,XGELTYPE,XGELMNT) . . D @% . E D:^TMP("XGW",$J,XGW1,XGELTYPE,XGELMNT,"CHOICE",XGC1,"EVENT",XGETYPE,"ENABLE") @^TMP("XGW",$J,XGW1,XGELTYPE,XGELMNT,"CHOICE",XGC1,"EVENT",XGETYPE) ; E I $G(XGELTYPE)="G"!($G(XGELTYPE)="T") D I 1 ;if doing an event for a gadget or a timer . D:^TMP("XGW",$J,XGW1,XGELTYPE,XGELMNT,"EVENT",XGETYPE,"ENABLE") @^TMP("XGW",$J,XGW1,XGELTYPE,XGELMNT,"EVENT",XGETYPE) ; E D ;doing an event for a window . D:^TMP("XGW",$J,XGW1,"EVENT",XGETYPE,"ENABLE") @^TMP("XGW",$J,XGW1,"EVENT",XGETYPE) ; S C="," K @XGEVENT S XGFLAG("PAINT")=21 ;window visible, in focus, gadget visible D WAIT^XGUTIL2(0) ;clear the WAIT indicator U:^%ZOSF("OS")["VAX DSM" IO(0):FLUSH ;update screen immediately Q XGF^INT^1^60169,79033^0 XGF ;SFISC/VYD - Graphics Functions ;11/06/2002 11:10 ;;8.0;KERNEL;**269**;Jul 10, 1995 PREP ;prepair graphics environment D PREP^XGSETUP Q ; ; IOXY(R,C) ;cursor positioning R:row, C:col D ADJRC W $$IOXY^XGS(R,C) S $Y=R,$X=C Q ; ; SAY(R,C,S,A) ;coordinate output instead of WRITE D ADJRC S:C+$L(S)>IOM S=$E(S,1,IOM-C) ;truncate if longer than screen I $L($G(A)) S A=$$UP^XLFSTR(A) D SAY^XGS(R,C,S,$S($$ATRSYNTX(A):A,1:"")) I 1 E D SAY^XGS(R,C,S) Q ; ; SAYU(R,C,S,A) ;coordinate output w/ underline instead of WRITE D ADJRC I $L($G(A)) S A=$$UP^XLFSTR(A) D SAYU^XGS(R,C,S,$S($$ATRSYNTX(A):A,1:"")) I 1 E D SAYU^XGS(R,C,S) Q ; ; ADJRC ;adjust row and column R and C are assumed to exist S R=$S($G(R)="":$Y,1:R),C=$S($G(C)="":$X,1:C) ;use current coords if none are passed S:"+-"[$E(R) R=$Y+$S(R="+":1,R="-":-1,1:R) ;increment/decrement S:"+-"[$E(C) C=$X+$S(C="+":1,C="-":-1,1:C) S R=$S(R<0:0,1:R\1),C=$S(C<0:0,1:C\1) ;make sure only pos int Q ; ; SETA(XGATR) ;set screen attribute(s) regardless of previous state ;XGATR=1 char when converted to binary represents all new attr N XGOLDX,XGOLDY S XGOLDX=$X,XGOLDY=$Y ;save $X $Y W $$SET^XGSA(XGATR) S $X=XGOLDX,$Y=XGOLDY ;restore $X $Y Q ; ; CHGA(XGATR) ;change screen attribute(s) w/ respect to previous state ;XGNEWATR=string of attr to change eg. "B0U1" or "E1" N XGOLDX,XGOLDY,XGSYNTX,XGACODE,% S XGATR=$$UP^XLFSTR(XGATR) ;make sure all attr codes are in upper case D:$$ATRSYNTX(XGATR) . S XGOLDX=$X,XGOLDY=$Y ;save $X $Y . W $$CHG^XGSA(XGATR) . S $X=XGOLDX,$Y=XGOLDY ;restore $X $Y Q ; ; ATRSYNTX(XGATR) ;check attribute code syntax ;proper attr is 1 or more (char from {BIRGUE} concat w/ 1 or 0) N XGSYNTX,% S XGSYNTX=$S($L(XGATR)&($L(XGATR)#2=0):1,1:0) ;even # of chars F %=1:2:$L(XGATR) S:"B1B0I1I0R1R0G1G0U1U0E1"'[$E(XGATR,%,%+1) XGSYNTX=0 Q XGSYNTX ; ; RESTORE(S) ;restore screen region TOP,LEFT,BOTTOM,RIGHT,SAVE ROOT D RESTORE^XGSW(S) Q K @S ; ; SAVE(T,L,B,R,S) ;save screen region TOP,LEFT,BOTTOM,RIGHT,SAVE ROOT D SAVE^XGSW(T,L,B,R,S) Q ; ; WIN(T,L,B,R,S) ;put up a window TOP,LEFT,BOTTOM,RIGHT[,SAVE ROOT] ;window style is not yet implemented I $L($G(S)) D WIN^XGSW(T,L,B,R,S) I 1 E D WIN^XGSW(T,L,B,R) Q ; ; FRAME(T,L,B,R) ;put a frame without clearing the inside TOP,LEFT,BOTTOM,RIGHT D FRAME^XGSBOX(T,L,B,R) Q ; ; CLEAR(T,L,B,R) ;clear screen portion TOP,LEFT,BOTTOM,RIGHT D CLEAR^XGSBOX(T,L,B,R) Q ; ; CLEAN ;clean up and destroy graphics environment D CLEAN^XGSETUP Q ; ; INITKB(XGTRM) ;initialize keyboard ;turn escape processing on, turn on passed terminators (if any) D INIT^XGKB($G(XGTRM)) Q ; ; READ(XGCHARS,XGTO) ;read the keyboard ;XGCHARS:number of chars to read, XGTO:timeout Q $$READ^XGKB($G(XGCHARS),$G(XGTO)) ; ; RESETKB ;reset keyboard(escape processing off, terminators off) D EXIT^XGKB Q XGFDEMO^INT^1^60169,79033^0 XGFDEMO ;SFISC/VYD - demonstrate graphics functions ;12/30/93 10:22 ;;8.0;KERNEL;;Jul 03, 1995 N NT,NL,NB,NR ;top,left,bottom,right for narrative window N MT,ML,MB,MR ;top,left,bottom,right for menu window N OLDCHOIC,NEWCHOIC,TAG,STOP,CHOICE D PREP^XGF ;prepare environment for graphics functions D GRID D WELCOME D MENU S STOP=0 F S %=$$CHOOSE() D Q:STOP .S TAG=$$UP^XLFSTR($TR($TR(CHOICE(%),"&","")," ","")) .D @(TAG_"^XGFDEMO1") ;do the menu choice D CLEAN^XGF K ^TMP($J) Q ; CHOOSE() ;choose a choice from the menu ;;Use or ;;or press a hot key of a choice ;; ;;Press to select. N I,S,STOP D CLEAR^XGF(NT+1,NL+1,NB-1,NR-1) F I=1:1:4 S S=$P($T(CHOOSE+I),";;",2) D SAY^XGF(NT+I,NL+1,S) I '$D(OLDCHOIC) S OLDCHOIC=2 S:'$D(NEWCHOIC) NEWCHOIC=1 S STOP=0 F D Q:STOP .I NEWCHOIC'=OLDCHOIC D ;another choice was selected ..D SAYU^XGF(MT+OLDCHOIC,ML+1,CHOICE(OLDCHOIC),"E1") ..D SAYU^XGF(MT+NEWCHOIC,ML+1,CHOICE(NEWCHOIC),"R1") ..D SAY^XGF(IOSL-1,2,CHOICE(NEWCHOIC,1)_$J("",80)) ..S OLDCHOIC=NEWCHOIC .S KEY=$$READ^XGF(1) .I XGRT="CR" S STOP=1 .E I $L(KEY),$D(CHOICE("HK",$$UP^XLFSTR(KEY))) S NEWCHOIC=CHOICE("HK",$$UP^XLFSTR(KEY)) .E I XGRT="UP" S NEWCHOIC=$S($D(CHOICE(OLDCHOIC-1)):OLDCHOIC-1,1:$O(CHOICE("A"),-1)) .E I XGRT="DOWN" S NEWCHOIC=$S($D(CHOICE(OLDCHOIC+1)):OLDCHOIC+1,1:$O(CHOICE(""))) Q NEWCHOIC ; MENU ;main menu ;;&Cursor;Cursor positioning ;;&Attributes;Output text in different video attributes ;;&Windows;Open overlapping pop-up windows and restore screen when closed ;;&Keyboard;Experiment with the low level keyboard reader ;;E&xit;Stop the demo N I F I=1:1 D Q:CHOICE(I)["E&xit" .S CHOICE(I)=$P($T(MENU+I),";",3) .S CHOICE(I)=CHOICE(I)_$J("",11-$L(CHOICE(I))) .S CHOICE(I,1)=$P($T(MENU+I),";",4) .S CHOICE("HK",$$UP^XLFSTR($E($P(CHOICE(I),"&",2))))=I ;hot key x-ref S MT=2,ML=2,MB=MT+I+1,MR=ML+11 D WIN^XGF(MT,ML,MB,MR,$NA(^TMP($J,"MENU"))) S $Y=MT F %=1:1:I D SAYU^XGF("+",ML+1,CHOICE(%)) Q ; GRID ;draw a grid N %,I ; X scale accross the top S %="" F I=0:1:IOM-1 S %=%_$S((I#10)=0:I/10,(I#5)=0:"+",1:"-") D SAY^XGF(0,0,%) ; Y scale along the left F I=1:1:IOSL-1 S %=$S((I#10)=0:I/10,(I#5)=0:"+",1:"|") D SAY^XGF(I,0,%) ; grid of dots S %="" F I=5:5:IOM-1 S %=%_" ." F I=5:5:IOSL D SAY^XGF(I,1,%) Q WELCOME ;displays welcome text ;;The purpose of this demo is to ;;exercise different components of ;;the low level graphics functions S NB=IOSL-3,NR=IOM-1,NT=NB-6,NL=NR-33 D SAVE^XGF(NT,NL,NB,NR,$NA(^TMP($J,"NARRATIVE"))) D CLEAR^XGF(NT,NL,NB,NR),CHGA^XGF("R1"),FRAME^XGF(NT,NL,NB,NR),CHGA^XGF("R0") D SAY^XGF(NT+1,NL+11,"W E L C O M E","U1B1") F I=1:1:3 S S=$P($T(WELCOME+I),";;",2) D SAY^XGF(NT+I+1,NL+1,S) D SAY^XGF(NB-1,NL+8,"RETURN","R1"),SAY^XGF("","+"," to continue") F S %=$$READ^XGF(1) Q:XGRT="CR" Q XGFDEMO1^INT^1^60169,79033^0 XGFDEMO1 ;SFISC/VYD - graphics demo (cont.); ;01/27/95 15:16 ;;8.0;KERNEL;;Jul 03, 1995 CURSOR ;cursor positioning ;;This demonstrates cursor positioning using ;; IOXY^XGF(row,col) ;; ;;Watch as the cursor makes its way around ;;the window. ;; ;;When you'll get tired of this, press any ;;key to stop. N T,L,B,R,DELAY,STOP,K S T=2,L=15,B=14,R=65,DELAY=1 D WIN^XGF(T,L,B,R,$NA(^TMP($J,"WIN"))) F %=1:1:8 D SAY^XGF(T+%+1,L+4,$P($T(CURSOR+%),";;",2)) W IOCUON S STOP=0 F D Q:STOP .F %=L:3:R-1 Q:STOP D IOXY^XGF(T,%) S K=$$READ^XGF(1,DELAY) S STOP='$D(DTOUT) .F %=T:1:B-1 Q:STOP D IOXY^XGF(%,R) S K=$$READ^XGF(1,DELAY) S STOP='$D(DTOUT) .F %=R:-3:L+1 Q:STOP D IOXY^XGF(B,%) S K=$$READ^XGF(1,DELAY) S STOP='$D(DTOUT) .F %=B:-1:T+1 Q:STOP D IOXY^XGF(%,L) S K=$$READ^XGF(1,DELAY) S STOP='$D(DTOUT) W IOCUOFF D RESTORE^XGF($NA(^TMP($J,"WIN"))) Q ; ATTRIBUT ; N T,L,B,R,K S T=1,L=12,B=23,R=68 D WIN^XGF(T,L,B,R,$NA(^TMP($J,"WIN"))) D SAY^XGF(T+1,L+2,"By now you've probably seen this table somewhere") D SAY^XGF(B-2,L+2,"...but now you have easy control of video attributes") D SAY^XGF("+",L+10,"Press any key to return to the menu") D SAY^XGF(T+3,L+5,"NORMAL ","E1") D SAY^XGF("+",L+5,"INTENSITY ","I1") D SAY^XGF("+",L+5,"REVERSE ","R1") D SAY^XGF("+",L+5,"REVERSE,INTENSITY ","R1I1") D SAY^XGF("+",L+5,"UNDERLINE ","U1") D SAY^XGF("+",L+5,"UNDERLINE,INTENSITY ","U1I1") D SAY^XGF("+",L+5,"UNDERLINE,REVERSE ","U1R1") D SAY^XGF("+",L+5,"UNDERLINE,REVERSE,INTENSITY ","U1R1I1") D CHGA^XGF("B1") ;turn blink on D SAY^XGF("+",L+5,"BLINK") D SAY^XGF("+",L+5,"BLINK,INTENSITY ","I1") D SAY^XGF("+",L+5,"BLINK,REVERSE ","R1") D SAY^XGF("+",L+5,"BLINK,REVERSE,INTENSITY ","R1I1") D SAY^XGF("+",L+5,"BLINK,UNDERLINE ","U1") D SAY^XGF("+",L+5,"BLINK,UNDERLINE,INTENSITY ","U1I1") D SAY^XGF("+",L+5,"BLINK,UNDERLINE,REVERSE ","U1R1") D SAY^XGF("+",L+5,"BLINK,UNDERLINE,REVERSE,INTENSITY","U1R1I1") D CHGA^XGF("B0") ;turn blink off S K=$$READ^XGF(1,0) D RESTORE^XGF($NA(^TMP($J,"WIN"))) Q ; KEYBOARD ; ;;Type some text and try different things: ;; - exceed the limit (15 characters) ;; - let timeout elapse (10 seconds) ;; - try terminators (function keys, arrow keys, keypad, etc.) ;; ;;To stop, type in "^" and press before time runs out. ;; ;; ;; Enter: [ ] ;; ;;Last Pass String Typed Terminator Limit Reached Timeout ;;--------- --------------- ---------- ------------- ------- N T,L,B,R,K S T=5,L=5,B=20,R=75 D WIN^XGF(T,L,B,R,$NA(^TMP($J,"WIN"))) F %=1:1:12 D SAY^XGF(T+%+1,L+4,$P($T(KEYBOARD+%),";;",2)) W IOCUON X ^%ZOSF("EON") F %=1:1 D Q:S="^"&('$D(DTOUT)) .D SAY^XGF(T+10,L+15,"_______________"),IOXY^XGF(T+10,L+15) .S S=$$READ^XGF(15,10) .D SAY^XGF(T+14,L+13,$J("",55)) ;clear output line for new results .D SAY^XGF(T+14,L+8,%) ; display the pass # .D SAY^XGF("",L+15,S) ; string typed .D SAY^XGF("",L+35,$S($L(XGRT):XGRT,1:"none")) ;read terminator .D SAY^XGF("",L+50,$S($L(S)=15:"Yes",1:"No")) ; length exceed status .D SAY^XGF("",L+61,$S($D(DTOUT):"Yes",1:"No")) ;timeout status W IOCUOFF X ^%ZOSF("EOFF") D RESTORE^XGF($NA(^TMP($J,"WIN"))) Q ; WINDOWS ; D WIN^XGF(0,0,12,39,$NA(^TMP($J,"W1"))) D SAY^XGF(2,2,"This is a medium sized window") D CHGA^XGF("U1") D SAY^XGF(3,2,"coords are:0,0,12,39 "_(13*40)_" cells") D CHGA^XGF("I1") H 1 D WIN^XGF(0,40,23,79,$NA(^TMP($J,"W2"))) D CHGA^XGF("B1") D SAY^XGF(4,41,"This is window is half the screen") D CHGA^XGF("R1") D SAY^XGF(6,41,"coords are:0,40,23,79 "_(24*40)_" cells") D CHGA^XGF("B0") H 1 D WIN^XGF(15,5,20,30,$NA(^TMP($J,"W3"))) D CHGA^XGF("E1") D SAY^XGF(17,6,"This is a small window") D SAY^XGF(18,6,"coords are:15,5,20,30") D SAY^XGF(19,6,(6*26)_" cells") H 1 D WIN^XGF(5,20,22,60,$NA(^TMP($J,"W4"))) D SAY^XGF(7,22,"This is 4th window") D SAY^XGF(9,22,"coords are:5,20,16,60 "_(12*41)_" cells") H 1 D WIN^XGF(3,50,21,77,$NA(^TMP($J,"W5"))) D SAY^XGF(5,52,"This is 5th window") D SAY^XGF(7,52,"coords are:3,50,21,77") D SAY^XGF(9,52,(19*28)_" cells") H 1 D WIN^XGF(10,15,17,65,$NA(^TMP($J,"W6"))) D SAY^XGF(12,23,"Please don't touch the keyboard.","R1") D SAY^XGF(14,23,"All windows will close in 5 seconds.") H 5 F %="W6","W5","W4","W3","W2","W1" H 1 D RESTORE^XGF($NA(^TMP($J,%))) Q ; EXIT ;exit out of the demo program ;;"Application type" code for this ;;demo is in XGFDEMO, XGFDEMO1 ;;routines. ;; ;;....wait until Kernel 8 is out! N I,S D CLEAR^XGF(NT+1,NL+1,NB-1,NR-1) F I=1:1:5 S S=$P($T(EXIT+I),";;",2) D SAY^XGF(NT+I,NL+1,S) S STOP=1 D IOXY^XGF(21,0) Q XGG^INT^1^60169,79033^0 XGG ;SFISC/VYD - COMMON GADGET FUNCTIONS ;11/23/94 13:31 [ 02/12/95 7:24 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ; PAINT(XGW1,XGG1) ;paint a gadget S XGGTYP=^TMP("XGW",$J,XGW1,"G",XGG1,"TYPE") D . I XGGTYP="BUTTON" D PAINT^XGGB(XGW1,XGG1) Q . I XGGTYP="CHECK" D PAINT^XGGC(XGW1,XGG1) Q . I XGGTYP="DOCUMENT" D PAINT^XGGD(XGW1,XGG1) Q . I XGGTYP="FRAME" D PAINT^XGGF(XGW1,XGG1) Q . I XGGTYP="LABEL" D PAINT^XGGLBL(XGW1,XGG1) Q . I XGGTYP="LIST" D PAINT^XGGL2(XGW1,XGG1) Q . I XGGTYP="LISTBUTTON" D PAINT^XGGLB(XGW1,XGG1) Q . I XGGTYP="LISTENTRY" D PAINT^XGGLE(XGW1,XGG1) Q . I XGGTYP="LONGLIST" D PAINT^XGGL2(XGW1,XGG1) Q . I XGGTYP="RADIO" D PAINT^XGGR(XGW1,XGG1) Q . I XGGTYP="SCROLL" D PAINT^XGGSC(XGW1,XGG1) Q . I XGGTYP="SYMBOL" D PAINT^XGGSY(XGW1,XGG1) Q . I XGGTYP="TEXT" D PAINT^XGGT(XGW1,XGG1) Q Q ; ; ERASE(XGW1,XGG1) ;erase a gadget N XGGTYP ;gadget type S XGGTYP=^TMP("XGW",$J,XGW1,"G",XGG1,"TYPE") D . I XGGTYP="BUTTON" D ERASE^XGGB(XGW1,XGG1) Q . I XGGTYP="CHECK" D ERASE^XGGC(XGW1,XGG1) Q . I XGGTYP="DOCUMENT" D ERASE^XGGD(XGW1,XGG1) Q . I XGGTYP="FRAME" D ERASE^XGGF(XGW1,XGG1) Q . I XGGTYP="LABEL" D ERASE^XGGLBL(XGW1,XGG1) Q . I XGGTYP="LIST" D ERASE^XGGL2(XGW1,XGG1) Q . I XGGTYP="LISTBUTTON" D ERASE^XGGLB(XGW1,XGG1) Q . I XGGTYP="LISTENTRY" D ERASE^XGGLE(XGW1,XGG1) Q . I XGGTYP="LONGLIST" D ERASE^XGGL2(XGW1,XGG1) Q . I XGGTYP="RADIO" D ERASE^XGGR(XGW1,XGG1) Q . I XGGTYP="SCROLL" D ERASE^XGGSC(XGW1,XGG1) Q . I XGGTYP="SYMBOL" D ERASE^XGGSY(XGW1,XGG1) Q . I XGGTYP="TEXT" D ERASE^XGGT(XGW1,XGG1) Q Q ; ; COMPLETE(XGW1,XGG1) ;supply common missing attribs for a gadget in a ;window. Common attributes are the ones that are applicable to most ;gadgets. Attributes specific to each gadget are handled in gadget ;spcific manner. Inapplicable attribs are removed there N XGTRACE D COMPLET2(XGW1,XGG1) Q ; ; COMPLET2(XGW1,XGG1) ; N %,T,L,B,R N XGUNITS,X,Y N XGGTYP ;gadget type N XGW S XGGTYP=^TMP("XGW",$J,XGW1,"G",XGG1,"TYPE") S:'$D(^TMP("XGW",$J,XGW1,"G",XGG1,"ACTIVE")) ^("ACTIVE")=1 S:'$D(^TMP("XGW",$J,XGW1,"G",XGG1,"CANCEL")) ^("CANCEL")=0 S ^TMP("XGW",$J,XGW1,"G",XGG1,"CHANGED")=0 D:$D(^TMP("XGW",$J,XGW1,"G",XGG1,"EVENT")) COMPLETE^XGEVNT1(XGW1,"G",XGG1) S ^TMP("XGW",$J,XGW1,"G",XGG1,"ID")=XGW1_U_"G"_U_XGG1 S:'$D(^TMP("XGW",$J,XGW1,"G",XGG1,"UNITS")) ^("G",XGG1,"UNITS")=^TMP("XGW",$J,XGW1,"UNITS") S:'$D(^TMP("XGW",$J,XGW1,"G",XGG1,"VISIBLE")) ^("VISIBLE")=1 ; ;------------------- SIZE ;I $P($G(^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE")),C,1)=""!($P($G(^("SIZE")),C,2)="") D D:$G(^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE"))'?1.N1","1.N.E . S X=$P($G(^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE")),C,1) . S Y=$P($G(^("SIZE")),C,2) ;r ^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE") . S XGUNITS=$P($G(^("SIZE")),C,3) ;r ^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE") . S:XGUNITS="" XGUNITS=^TMP("XGW",$J,XGW1,"G",XGG1,"UNITS") . ; . S %="BUTTON:10,1,CHECK:3,1,DOCUMENT:10,10,LABEL:10,1,LIST:10,10," . S %=%_"LISTBUTTON:10,10,LISTENTRY:10,10,LONLIST:10,10,RADIO:10,10," . S %=%_"SYMBOL:1,1,TEXT:10,1," . S:X="" X=$P($P(%,XGGTYP_":",2),C,1)/XGUFCTR(XGUNITS,"X") ;HORIZONTAL . S:Y="" Y=$P($P(%,XGGTYP_":",2),C,2)/XGUFCTR(XGUNITS,"Y") ;VERTICAL . ; . S $P(^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE"),C,1,2)=X_C_Y ;store size ; ;------------------- YXGNEXTG and YXGPREVG links S %=$G(^TMP("XGW",$J,XGW1,"G",XGG1,"NEXTG")) I $L(%),$D(^TMP("XGW",$J,XGW1,"G",%)) D I 1 .S %=^TMP("XGW",$J,XGW1,"G",XGG1,"NEXTG") .S XGTRACE(%)="" .S ^TMP("XGW",$J,XGW1,"G",%,"YXGPREVG")=XGG1 E D .S %=$O(^TMP("XGW",$J,XGW1,"G",XGG1)) ;link to the next .S:%="" %=$O(^TMP("XGW",$J,XGW1,"G","")) ;loop back to first .S:'$D(XGTRACE(%)) ^TMP("XGW",$J,XGW1,"G",%,"YXGPREVG")=XGG1 ;bckwrd link S ^TMP("XGW",$J,XGW1,"G",XGG1,"YXGNEXTG")=% ; ;------------------- YXGCOORDS=TOP^LEFT^BOTTOM^RIGHT in CHAR units ;relative to the position of the window S T=$$CHAR^XGUTIL2(XGW1,XGG1,"POS",2)+1 S:$D(^TMP("XGW",$J,XGW1,"MENUBAR")) T=T+1 ;adjust for MENUBAR S L=$$CHAR^XGUTIL2(XGW1,XGG1,"POS",1)+1 S B=T+$$CHAR^XGUTIL2(XGW1,XGG1,"SIZE",2)-1 S R=L+$$CHAR^XGUTIL2(XGW1,XGG1,"SIZE",1)-1 S:^TMP("XGW",$J,XGW1,"G",XGG1,"TYPE")="BUTTON" T=$J(T+((B-T+1)/2),0,0) S:T>B B=T ;adjust if top falls bellow bottom ;S:^TMP("XGW",$J,XGW1,"G",XGG1,"TYPE")="BUTTON" T=T+((B-T+1)\2) S ^TMP("XGW",$J,XGW1,"G",XGG1,"YXGCOORDS")=T_U_L_U_B_U_R ; S XGW=XGW1 D . I XGGTYP="BUTTON" D COMPLETE^XGGB(XGG1) Q . I XGGTYP="CHECK" D COMPLETE^XGGC(XGG1) Q . I XGGTYP="DOCUMENT" D COMPLETE^XGGD(XGG1) Q . I XGGTYP="FRAME" D COMPLETE^XGGF(XGG1) Q . I XGGTYP="LABEL" D COMPLETE^XGGLBL(XGG1) Q . I XGGTYP="LIST" D COMPLETE^XGGL4(XGG1) Q . I XGGTYP="LISTBUTTON" D COMPLETE^XGGLB(XGG1) Q . I XGGTYP="LISTENTRY" D COMPLETE^XGGLE(XGG1) Q . I XGGTYP="LONGLIST" D COMPLETE^XGGLL(XGG1) Q . I XGGTYP="RADIO" D COMPLETE^XGGR(XGG1) Q . I XGGTYP="SYMBOL" D COMPLETE^XGGSY(XGG1) Q . I XGGTYP="TEXT" D COMPLETE^XGGT(XGG1) Q Q ; ; XGOTHER(XGW1,XGELTYP,XGELMNT) ;complete choices and set YXGOTHER if approp ;window,element type (G/M), element (gadget name or menu name) N XGC,XGCMATCH,XGGTYP ;choice, choice to match, gadget/element type N XGCTOP ;top choice (same as TOPSHOW) N XGATR ;contains name of attribute to scan (CHOICE or VALUE) ; ;YXGOTHER structure for the LIST, LISTENTRY, LONGLIST, LISTBUTTON ;Piece # Meaning ; 1 total # of choices in the list ; 2 # of the choice at the top of the list (diff from subscript) ; 3 last position of the elevator in the scroll bar ; 4 elevator indicator (either "+" or T type) ; 5 CHOICE subscript of the last choice that the cursor was on ; 6 same as TOPSHOW (TOPSHOW is N/A for LISTBUTTON) ; ;YXGOTHER structure for the LIST, LISTENTRY, LONGLIST, LISTBUTTON ;Piece # Meaning ; 1 total # of lines ; 2 # of the line at the top of the docbox (diff from subscript) ; 3 last position of the elevator in the scroll bar ; 4 elevator indicator (either "+" or T type) ; 5 subscript of the last line that the cursor was on ; 6 subscript of the line at the top of docbox (same as TOPSHOW) ; ;YXGOTHER structure for the RADIO button set gadget ;Piece # Meaning ; 1 total # of choices in the set ; 2 cursor position ; S XGGTYP=$G(^TMP("XGW",$J,XGW1,XGELTYP,XGELMNT,"TYPE"),"MENU") S XGATR=$S(XGGTYP="DOCUMENT":"VALUE",1:"CHOICE") S $P(^TMP("XGW",$J,XGW1,XGELTYP,XGELMNT,"YXGOTHER"),XG255,1,2)=0_XG255_0 ;initialize ;set up choice/line to match S:$D(^TMP("XGW",$J,XGW1,"G",XGELMNT,"TOPSHOW")) XGCTOP=^("TOPSHOW") S:'$D(XGCTOP) XGCTOP=$P(^TMP("XGW",$J,XGW1,XGELTYP,XGELMNT,"YXGOTHER"),XG255,6) S:'$L(XGCTOP) XGCTOP=$O(^TMP("XGW",$J,XGW1,"G",XGELMNT,XGATR,"")) S XGCMATCH=$S(XGGTYP="DOCUMENT":XGCTOP,XGGTYP["LIST":XGCTOP,XGGTYP="RADIO":^TMP("XGW",$J,XGW1,"G",XGELMNT,"VALUE"),1:"") S XGC="",X=0 F S XGC=$O(^TMP("XGW",$J,XGW1,XGELTYP,XGELMNT,XGATR,XGC)) Q:XGC="" D . S X=X+1 ;increment choice/line counter . S:XGC=XGCMATCH $P(^TMP("XGW",$J,XGW1,XGELTYP,XGELMNT,"YXGOTHER"),XG255,2)=X . I XGGTYP'="DOCUMENT",'$D(^TMP("XGW",$J,XGW1,XGELTYP,XGELMNT,"CHOICE",XGC,"ACTIVE")) S ^("ACTIVE")=1 . D:$D(^TMP("XGW",$J,XGW1,XGELTYP,XGELMNT,"CHOICE",XGC,"EVENT")) COMPLET2^XGEVNT1(XGW1,XGELTYP,XGELMNT,XGC,"SELECT") ;only SELECT events are vaild S $P(^TMP("XGW",$J,XGW1,XGELTYP,XGELMNT,"YXGOTHER"),XG255)=X ;store count I XGGTYP["LIST"!(XGGTYP="DOCUMENT") D I 1 . S:$P(^TMP("XGW",$J,XGW1,XGELTYP,XGELMNT,"YXGOTHER"),XG255,3)="" $P(^("YXGOTHER"),XG255,3)=0 . S XGC=$P(^TMP("XGW",$J,XGW1,"G",XGELMNT,"YXGOTHER"),XG255,5) . I XGC'="",$D(^TMP("XGW",$J,XGW1,"G",XGELMNT,XGATR,XGC)) . ;E S $P(^("YXGOTHER"),XG255,5)=$G(^TMP("XGW",$J,XGW1,"G",XGELMNT,"TOPSHOW")) . E S $P(^TMP("XGW",$J,XGW1,"G",XGG1,"YXGOTHER"),XG255,5)=XGCTOP . S $P(^TMP("XGW",$J,XGW1,"G",XGG1,"YXGOTHER"),XG255,6)=XGCTOP E I XGGTYP="MENU" K ^TMP("XGW",$J,XGW1,"M",XGELMNT,"YXGOTHER") ;menus don't need YXGOTHER Q ; ; CCHOICE(XGW1,XGELTYP,XGELMNT,XGC) ;complete specific choice ;window,element type (G/M), element (gadget name or menu name), choice ; S:'$D(^TMP("XGW",$J,XGW1,XGELTYP,XGELMNT,"CHOICE",XGC,"ACTIVE")) ^("ACTIVE")=1 Q XGGB^INT^1^60169,79033^0 XGGB ;SFISC/VYD - PUSH BUTTON GADGET ;10/20/94 11:05 [ 02/05/95 10:02 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ; PAINT(XGW1,XGG1) ;paint BUTTON type gadget. XGW1 window, XGG1 gadget N T,L,R,%SIZE,A,S,XGLENGTH D COORDG^XGUTIL1(XGW1,XGG1,.T,.L,"",.R) S %SIZE=R-L-1 S XGLENGTH=$$L^XGM1($G(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE"))) S A="I"_^TMP("XGW",$J,XGW1,"G",XGG1,"ACTIVE") ;set title attr S S=$J("",(%SIZE-XGLENGTH)\2) S S=S_$G(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE"))_$J("",%SIZE-$L(S)-XGLENGTH) S S=$E(S,1,$L(S)-(XGLENGTH-%SIZE)) ;trim if title longer than button width I $G(^TMP("XGW",$J,XGW1,"DEFBUTTON"))=XGG1 D I 1 ;if default button . D SAY^XGS(T,L,"<"_$J("",%SIZE)_">",A) . D SAYU^XGS(T,L+1,S,A_"U1") E D SAYU^XGS(T,L,"<"_S_">",A) ;not default button Q ; ; ERASE(XGW1,XGG1) ;erase BUTTON type gadget. XGW1 window, XGG1 gadget N T,L,R D COORDG^XGUTIL1(XGW1,XGG1,.T,.L,"",.R) D SAY^XGS(T,L,$J("",R-L+1)) Q ; ; SERVICE ;service BUTTON type gadget. XGG gadget name N T,L,R,K,S,%SIZE,XGLENGTH D COORDG^XGUTIL1(XGW,XGG,.T,.L,"",.R) S %SIZE=R-L-1 S XGLENGTH=$$L^XGM1($G(^TMP("XGW",$J,XGW,"G",XGG,"TITLE"))) S S=$J("",(%SIZE-XGLENGTH)\2) S S=S_$G(^TMP("XGW",$J,XGW,"G",XGG,"TITLE"))_$J("",%SIZE-$L(S)-XGLENGTH) S S=$E(S,1,$L(S)-(XGLENGTH-%SIZE)) ;trim if title longer than button width S K="" W IOCUOFF ;will have to change to a XGSCRN type call D SAY^XGS(T,L,"<","R1B1") D SAY^XGS(T,R,">","R1B1") D:'$D(XGDEFBTN(XGW)) ;wait for keypress if not servicing DEFBUTTON . S XGRT=0 . F S K=$$READ^XGKB(1) Q:K=" "!(K="^")!(XGRT="CR")!(XGFLAG("ABORT")) . S:K="^" XGFLAG("JUMP")=1 D PAINTFLG^XGUTIL2(XGW,"G",XGG) D:XGFLAG("PAINT")=11!(XGFLAG("PAINT")=21) . D SAY^XGS(T,L,"<","I1") . D SAY^XGS(T,R,">","I1") D:K=" "!(XGRT="CR")!($D(XGDEFBTN(XGW))) . K XGDEFBTN(XGW) ; clear DEFBUTTON flag . D SAYU^XGS(T,L+1,S,$S($G(^TMP("XGW",$J,XGW,"DEFBUTTON"))=XGG:"R1U1",1:"R1")) . U:^%ZOSF("OS")["VAX DSM" IO(0):FLUSH ; update screen immediately in case PACK is turned on . H .5 . D SAYU^XGS(T,L+1,S,"I"_^TMP("XGW",$J,XGW,"G",XGG,"ACTIVE")_$S($G(^TMP("XGW",$J,XGW,"DEFBUTTON"))=XGG:"U1",1:"")) . D:$D(^TMP("XGW",$J,XGW,"G",XGG,"EVENT","SELECT")) E^XGEVNT1(XGW,"G",XGG,"","SELECT") W IOCUON ;will have to change to a XGSCRN type call Q ; COMPLETE(XGG) ;complete any missing info for a button S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"SIZE")) ^("SIZE")=$L($G(^("TITLE")))_C_1 Q ; DEFBUTTN ;DEFBUTTON D . Q:^TMP("XGW",$J,XGW,"G",XGG,"TYPE")="BUTTON" ;if I'm on a button, do nothing . I $D(^TMP("XGW",$J,XGW,"DEFBUTTON")),^TMP("XGW",$J,XGW,"G",^("DEFBUTTON"),"ACTIVE") D . . ;S $P(^TMP("XGD",$J,$PD,"FOCUS"),C,2)=^TMP("XGW",$J,XGW,"DEFBUTTON") . . ;S $P(XGNEWFCS,C,2)=^TMP("XGW",$J,XGW,"DEFBUTTON") . . S XGNEXTG=^TMP("XGW",$J,XGW,"DEFBUTTON") . . S XGFLAG("ABORT")=1,XGDEFBTN(XGW)=1,DIR0QT=1 Q ; ; S(XGW1,XGG1,XGATR,XGVAL) ;set attribute of PUSHBUTTON gadget S XGERR=XGERR_"-"_XGGTYP_" UNKNOWN ATTR. AND/OR UNKNOWN VAL" D HUH^XGUTIL2(XGERR) Q XGGC^INT^1^60169,79033^0 XGGC ;SFISC/VYD - CHECK BOX GADGET ;11/30/94 16:32 [ 12/29/94 9:54 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ; PAINT(XGW1,XGG1) ;paint CHECK type gadget. XGW1 window, XGG1 gadget N T,L,R,%SIZE,XGSAVTTL D COORDG^XGUTIL1(XGW1,XGG1,.T,.L,"",.R) D SAY^XGS(T,L,"["_$S(^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE"):"X",1:" ")_"]","I"_^("ACTIVE")) ;D:$L($G(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE"))) ;. ;S %SIZE=$$CHAR^XGUTIL2(XGW1,XGG1,"SIZE",1) ;. S %SIZE=R-L+1 ;. S XGSAVTTL=^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE") ;. S ^("TITLE")=$E(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE"),1,%SIZE-3) ;truncate title if longer than gadget size ;. S ^TMP("XGW",$J,XGW1,"G",XGG1,"TPOS")="RIGHT" ;fool TITLE painter ;. D TITLE^XGUTIL1(XGW1,XGG1,T,L,L+2) ;. K ^TMP("XGW",$J,XGW1,"G",XGG1,"TPOS") ;clean up ;. S ^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE")=XGSAVTTL ;put back real D:$L($G(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE"))) TITLE^XGUTIL1(XGW1,XGG1,T,L,R) Q ; ; ERASE(XGW1,XGG1) ;erase CHECK type gadget. XGW1 window, XGG1 gadget N T,L,R,%SIZE D COORDG^XGUTIL1(XGW1,XGG1,.T,.L,"",.R) D SAY^XGS(T,L,$J("",R-L+1)) Q ; ; SERVICE ;service CHECK type gadget. XGG gadget name N T,L,K D COORDG^XGUTIL1(XGW,XGG,.T,.L) S ^TMP("XGW",$J,XGW,"G",XGG,"CHANGED")=0 W IOCUON W $$IOXY^XGS(T,L+1) F D Q:XGFLAG("ABORT") . S K=$$READ^XGKB(1) . S:K="^" XGFLAG("JUMP")=1,XGFLAG("ABORT")=1 . D:"^ ^X^x^"[(U_K_U) . . S ^TMP("XGW",$J,XGW,"G",XGG,"CHANGED")=1 . . S ^("VALUE")='^TMP("XGW",$J,XGW,"G",XGG,"VALUE") . . D SAY^XGS(T,L+1,$E(" X",^TMP("XGW",$J,XGW,"G",XGG,"VALUE")+1),"I1") . . W $$IOXY^XGS(T,L+1) . . I ^TMP("XGW",$J,XGW,"G",XGG,"VALUE"),$D(^("EVENT","SELECT")) D E^XGEVNT1(XGW,"G",XGG,"","SELECT") I 1 . . E I '^TMP("XGW",$J,XGW,"G",XGG,"VALUE"),$D(^("EVENT","DESELECT")) D E^XGEVNT1(XGW,"G",XGG,"","DESELECT") Q ; ; COMPLETE(XGG) ;complete any missing info S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"VALUE")) ^("VALUE")=0 Q ; ; DFLTSIZE(XGW1,XGG1) ;set default size N XGUNITS,X,Y S X=$P($G(^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE")),C,1) S Y=$P($G(^("SIZE")),C,2) ;ref ^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE") S XGUNITS=$P($G(^("SIZE")),C,3) ;ref ^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE") S:XGUNITS="" XGUNITS=^TMP("XGW",$J,XGW1,"G",XGG1,"UNITS") ; S:X="" X=3/XGUFCTR(XGUNITS,"X") ; set HORIZONTAL S:Y="" Y=1/XGUFCTR(XGUNITS,"Y") ; set VERTICAL ; S $P(^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE"),C,1,2)=X_C_Y ;store the size Q ; ; S(XGW1,XGG1,XGATR,XGVAL) ;set attribute of CHECKBOX gadget N T,L,B,R D COORDG^XGUTIL1(XGW1,XGG1,.T,.L) D . I XGATR="VALUE" D Q . . I "^11^21^"[(U_XGFLAG("PAINT")_U),^TMP("XGW",$J,XGW1,"G",XGG1,XGATR)'=XGVAL D . . . D SAY^XGS(T,L+1,$S(XGVAL=0:" ",1:"X"),"I"_^TMP("XGW",$J,XGW1,"G",XGG1,"ACTIVE")) . . S ^TMP("XGW",$J,XGW1,"G",XGG1,XGATR)=XGVAL . . S ^TMP("XGW",$J,XGW1,"G",XGG1,"CHANGED")=1 . D . . S XGERR=XGERR_"-"_XGGTYP_" UNKNOWN ATTR. AND/OR UNKNOWN VAL" . . D HUH^XGUTIL2(XGERR) Q XGGD^INT^1^60169,79033^0 XGGD ;SFISC/VYD - DOCUMENT GADGET ;01/18/95 11:05 [ 01/29/95 2:31 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ; PAINT(XGW1,XGG1) ;paint DOCUMENT gadget. XGW1 window, XGG1 gadget N T,L,B,R,S N XGATR,XGMAX,XGWIDTH,XGLINE,XGPOS N XGFRAMED ;coordinates adjustment factor based on FRAMED attr N XGTOPNO ;# of topmost visible line in gadget N XGW,XGG S XGW=XGW1,XGG=XGG1 D SETUP1(XGW1,XGG1) D:$D(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE")) TITLE^XGUTIL1(XGW1,XGG1,T,L,R) ;put up title D @$S(XGFRAMED:"WIN^XGSW(T,L,B,R)",1:"CLEAR^XGSBOX(T,L,B,R)") D:XGFRAMED&(XGWIDTH>6) SAYU^XGS(T,L,"E","R1") D REFRESH1^XGGD3(1) Q ; ; ERASE(XGW1,XGG1) ;erase DOCUMENT gadget. XGW1 window, XGG1 gadget N T,L,B,R N XGSAVTTL ;saved title D COORDG^XGUTIL1(XGW1,XGG1,.T,.L,.B,.R) D:$L($G(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE"))) . S XGSAVTTL=^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE") . S ^("TITLE")=$J("",$L(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE"))) ;stuff spaces . D TITLE^XGUTIL1(XGW1,XGG1,T,L,R) ;put up title . S ^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE")=XGSAVTTL ;restore D CLEAR^XGSBOX(T,L,B,R) Q ; ; SETUP(XGW1,XGG1) ;setup document specific stuff W IOCUON D SETUP1(XGW1,XGG1) Q ; ; SETUP1(XGW1,XGG1) ;setup document specific stuff ;prior to entering here NEW the following variables ;XGFRAMED,XGATR,XGMAX,XGWIDTH,XGLINE,XGPOS,XGTOPNO N % D COORDG^XGUTIL1(XGW1,XGG1,.T,.L,.B,.R) S XGFRAMED=^TMP("XGW",$J,XGW1,"G",XGG1,"FRAMED") S XGATR="I"_^TMP("XGW",$J,XGW1,"G",XGG1,"ACTIVE") S XGMAX=B-T+$S(XGFRAMED:-1,1:2) S XGWIDTH=R-L+$S(XGFRAMED:-1,1:2) S XGLINE=$P(^TMP("XGW",$J,XGW1,"G",XGG1,"YXGOTHER"),XG255,5) ;S XGLINE=1 ;<--- needs to be setup as in SETUP1^XGGL4 (requires YXGOTHER) ;S XGPOS=1 ;<--- needs to be setup as in SETUP1^XGGL4 (requires YXGOTHER) S %=$P(^TMP("XGW",$J,XGW1,"G",XGG1,"YXGOTHER"),XG255,6) S XGPOS=$S(%="":0,1:1) ;S XGTOPNO=0 ;<--- needs to be setup as in SETUP2^XGGL4 (requires YXGOTHER) S XGTOPNO=$P(^TMP("XGW",$J,XGW1,"G",XGG1,"YXGOTHER"),XG255,2) Q ; ; SERVICE ;service TEXT type gadget. XGG gadget name N T,L,B,R,K,N,N1,XGATR,XGMAX N XGWIDTH,XGPOS,XGLINE ;width of box,cursor pos, current line index N XGFRAMED ;coordinates adjustment factor based on FRAMED attr N XGTOPNO ;# of topmost visible line in gadget N XGFRAME ;# of lines to skip to the next N XGSKIP ;# of lines actually skipped D SETUP(XGW,XGG) S ^TMP("XGW",$J,XGW,"G",XGG,"CHANGED")=0 D . S XGRT=0,XGFLAG("ABORT")=0 . F Q:XGFLAG("ABORT") D . . W $$IOXY^XGS(T+XGPOS,L+1) . . S K=$$READ^XGKB(1) . . S:K="^" (XGFLAG("ABORT"),XGFLAG("JUMP"))=1 . . ;if user presses PREV or NEXT move up or down by as many lines as are vsbl . . S XGFRAME=$S(XGRT="PREV"!(XGRT="NEXT"):XGMAX-1,1:1) . . D UP:XGRT="UP"!(XGRT="PREV"),DN:XGRT="DOWN"!(XGRT="NEXT") . . ;D:"^E^e^"[(U_K_U) ;user pressed E or e -- go into editor . . D:XGRT="^E" ;user pressed Ctrl E -- go into editor . . . D EXIT^XGKB . . . W @IOF . . . S DIC="^TMP(""XGW"",$J,XGW,""G"",XGG,""VALUE""," . . . D EN^DIWE . . . X ^%ZOSF("EOFF") . . . S X=0 X ^%ZOSF("RM") . . . W IOKPAM . . . D INIT^XGKB("*") . . . D RESTORE^XGSW("XGSCRN") Q ; ; DN ;user pressed DN-Arrow cursor key S (N,N1)=XGLINE,XGSKIP=0 F S N=$O(^TMP("XGW",$J,XGW,"G",XGG,"VALUE",N)),XGFRAME=XGFRAME-1 Q:N=""!(XGFRAME<0) S XGSKIP=XGSKIP+1,N1=N I XGSKIP>0 S N=N1 D ;if was able to move to the next line . I (XGPOS+XGSKIP)'>XGMAX S XGPOS=XGPOS+XGSKIP,XGLINE=N ;don't scroll . E S XGLINE=N D ;scroll up . . S XGTOPNO=XGTOPNO+XGSKIP-XGMAX+XGPOS . . S ^TMP("XGW",$J,XGW,"G",XGG,"YXGBOTSHOW")=N . . D REFRESH1^XGGD3(-1) . . S XGPOS=XGMAX Q ; ; UP ;user pressed UP-Arrow cursor key S (N,N1)=XGLINE,XGSKIP=0 F S N=$O(^TMP("XGW",$J,XGW,"G",XGG,"VALUE",N),-1),XGFRAME=XGFRAME-1 Q:N=""!(XGFRAME<0) S XGSKIP=XGSKIP+1,N1=N I XGSKIP>0 S N=N1 D ;if was able to move to the next line . I (XGPOS-XGSKIP)'<1 S XGPOS=XGPOS-XGSKIP,XGLINE=N ;no need to scroll . E S XGLINE=N D ;scroll down . . S XGTOPNO=XGTOPNO-XGSKIP+XGPOS-1 . . S $P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),XG255,6)=N . . D REFRESH1^XGGD3(1) . . S XGPOS=1 Q ; ; COMPLETE(XGG) ;complete any missing info for a DOCUMENT gadget N XGMAX,%,Y D COMPLETE^XGGT(XGG) D XGOTHER^XGG(XGW,"G",XGG) S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"SCROLL")) ^("SCROLL")=0 ; ;----------YXGBOTSHOW=subscript of the last line in doc box. If there are fewer lines than the doc box holds set YXGBOTSHOW=XG255 S XGMAX=$$CHAR^XGUTIL2(XGW,XGG,"SIZE",2)-(^TMP("XGW",$J,XGW,"G",XGG,"FRAMED")*2) S %=$P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),XG255,6) ;get TOPSHOW S Y=XGMAX-1 F Q:%=""!('Y) S %=$O(^TMP("XGW",$J,XGW,"G",XGG,"VALUE",%)),Y=Y-1 S ^TMP("XGW",$J,XGW,"G",XGG,"YXGBOTSHOW")=$S('Y:%,1:XG255) Q ; ; S(XGW1,XGG1,XGATR,XGVAL) ;set attribute of DOCUMENT gadget S XGERR=XGERR_"-"_XGGTYP_" UNKNOWN ATTR. AND/OR UNKNOWN VAL" D HUH^XGUTIL2(XGERR) Q ; ; MVAL(XGW1,XGG1,XGVAL) ;merge VALUE M ^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE")=@XGVAL D COMPLETE^XGG(XGW1,XGG1) D REFRESH^XGGD3(XGW1,XGG1) Q XGGD3^INT^1^60169,79033^0 XGGD3 ;SFISC/VYD - LIST BOX GADGET CONTINUE ;01/11/95 14:33 [ 01/15/95 8:14 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ; REFRESH(XGW1,XGG1) ;redisplay visible text and adjust the scroll bar N T,L,B,R,S N XGATR,XGMAX,XGWIDTH,XGFRAMED N XGW,XGG ;if window and gadget are visible and delayupdate is not set D PAINTFLG^XGUTIL2(XGW1,"G",XGG1) D:XGFLAG("PAINT")=11!(XGFLAG("PAINT")=21) . D SETUP1^XGGD(XGW1,XGG1) . S XGW=XGW1,XGG=XGG1 . D REFRESH1(1) Q ; ; REFRESH1(XGDIRCTN) ;redisplay visible text and adjust the scroll bar ;XGDIRCTN: direction in which to paint, if 1 top-bott, if -1 bott-top ; note: if direction=-1 I assume there are at least XGMAX choices N XGLINE,XGPOS,XGSTART,XGSTOP I XGDIRCTN=1 D I 1 . S XGLINE=$P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),XG255,6) . S XGSTART=0 . S XGSTOP=XGMAX-1 E S XGLINE=^TMP("XGW",$J,XGW,"G",XGG,"YXGBOTSHOW"),XGSTART=XGMAX-1,XGSTOP=0 F XGPOS=XGSTART:XGDIRCTN:XGSTOP D OUTPUT I XGLINE'="",XGPOS'=XGSTOP S XGLINE=$O(^TMP("XGW",$J,XGW,"G",XGG,"VALUE",XGLINE),XGDIRCTN) I XGDIRCTN=1 S ^TMP("XGW",$J,XGW,"G",XGG,"YXGBOTSHOW")=$S(XGLINE'="":XGLINE,1:XG255) E S $P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),XG255,6)=XGLINE ;D UPDTSCL1 Q ; ; OUTPUT ;output a single line I XGLINE'="" D . ;S S=$E((^TMP("XGW",$J,XGW,"G",XGG,"VALUE",XGLINE)_$J("",IOM)),1,XGWIDTH) . S S=$E((^TMP("XGW",$J,XGW,"G",XGG,"VALUE",XGLINE,0)_$J("",IOM)),1,XGWIDTH) E S S=$J("",XGWIDTH) D SAY^XGS(T+XGPOS+XGFRAMED,L+XGFRAMED,S,XGATR) Q ; ; %UPDTSCL ;update scroll indicator in list box. This is a more stand alone entry ;point used outside of REFRESH. It should fall through N T,L,B,R,XGTOT,XGMAX,XGOLDSCL,XGNEWSCL,XGTOPNO D SETUP2^XGGL4 ; UPDTSCL1 ;update scroll indicator in list box. This entry point is used ;in the REFRESH N XGNELVTR D:XGTOT>XGMAX!(XGOLDSCL) ; update scroll bar only if more choices than can fit or elevator existed before . ;-------------now update the scroll bar . N XGDNTFIT,XGABOVE,XGRATIO,XGNELVTR . S XGABOVE=XGTOPNO-1 . S XGDNTFIT=XGTOT-XGMAX . S XGRATIO=$S(XGABOVE'>XGDNTFIT:XGABOVE/XGDNTFIT,1:1) . S XGNEWSCL=$J(XGMAX*XGRATIO,0,0) . S XGNEWSCL=$S(XGDNTFIT'>0:0,XGNEWSCL>1:XGNEWSCL,1:1) . S XGNELVTR=XGELVTR . ; . I XGOLDSCL,XGOLDSCL'=XGNEWSCL D . . ;clear scroll position and appearance flag, if any . . ;S $P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),U,3,4)="0"_U_"" . . S XGNELVTR="" . . D SAY^XGS(T+XGOLDSCL,R,IOVL,"G1") ; erase old elevtr . ; . I XGNEWSCL,XGTOPNO=1 D I 1 ;user is at the very top . . ;store new scroll position and clear "+" appearance flag . . ;S XGOLDSCL=XGNEWSCL . . ;S $P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),U,3,4)=XGNEWSCL_U_"" . . S XGNELVTR="" . . D SAY^XGS(T+XGNEWSCL,R,IOTT,"G1") . ; . E I XGNEWSCL,XGTOPNO'<(XGTOT-XGMAX+1) D I 1 ;user at the bottom . . ;store new scroll position and clear "+" appearance flag . . ;S XGOLDSCL=XGNEWSCL . . ;S $P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),U,3,4)=XGNEWSCL_U_"" . . S XGNELVTR="" . . D SAY^XGS(T+XGNEWSCL,R,IOBT,"G1") . ; . E I XGNEWSCL,XGNEWSCL'=XGOLDSCL D I 1 ; elevator moved to new pos . . ;store new scroll position and set appearance flag to "+" . . ;S XGOLDSCL=XGNEWSCL . . ;S $P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),U,3,4)=XGNEWSCL_U_"+" . . S XGNELVTR="+" . . D SAY^XGS(T+XGNEWSCL,R,"+") . ; . ;E I XGNEWSCL,$P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),U,4)="" D I 1 ;user is no longer at the very top/bottom of the list, but the elevator didn't move . E I XGNEWSCL,XGELVTR="" D I 1 ;user is no longer at the very top/bottom of the list, but the elevator didn't move . . ;S $P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),U,4)="+" ;set appearance flag to "+" . . S XGNELVTR="+" . . D SAY^XGS(T+XGNEWSCL,R,"+") . ; . S XGOLDSCL=XGNEWSCL . S XGELVTR=XGNELVTR Q XGGF^INT^1^60169,79033^0 XGGF ;SFISC/VYD - GROUP FRAME GADGETS ;11/30/94 16:34 ;;8.0T19;KERNEL;;Feb 22, 1995 ; PAINT(XGW1,XGG1) ;paint FRAME gadget. XGW1 window, XGG1 gadget N T,L,B,R D COORDG^XGUTIL1(XGW1,XGG1,.T,.L,.B,.R) D FRAME^XGSBOX(T,L,B,R,"I1") ;D:$L($G(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE"))) SAY^XGS(T,L+1,^("TITLE"),"I1") D:$L($G(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE"))) TITLE^XGUTIL1(XGW1,XGG1,T,L,R) Q ; ; ERASE(XGW1,XGG1) ;erase FRAME gadget. XGW1 window, XGG1 gadget N T,L,B,R D COORDG^XGUTIL1(XGW1,XGG1,.T,.L,.B,.R) D FRAME^XGSBOX(T,L,B,R,""," ") ;paint frame of spaces Q ; ; S(XGW1,XGG1,XGATR,XGVAL) ;set attribute of FRAME gadget S XGERR=XGERR_"-"_XGGTYP_" UNKNOWN ATTR. AND/OR UNKNOWN VAL" D HUH^XGUTIL2(XGERR) Q ; ; COMPLETE(XGG1) ;complete any missing attributes for frame K ^TMP("XGW",$J,XGW,"G",XGG1,"ACTIVE"),^("CANCEL"),^("CHANGED") Q XGGL^INT^1^60169,79033^0 XGGL ;SFISC/VYD - LIST BOX GADGET ;01/13/95 11:03 [ 01/15/95 8:24 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ; SERVICE ;service LIST type gadget. XGG gadget name N T,L,B,R,S,A,N,N1 ;top,left,bottom,right,string,attribute,next N XGWIDTH,XGPOS,XGMAX ;width of box,pos in win,# of choi win accmdt N XGSELMAX,XGCHATTR,XGSAVATR ;max selctbl @ 1 time,choice attr,save attr N XGOLDSCL,XGNEWSCL ; old and new scroll positions N XGTOT,XGC ;total # of choices,choice that has focus N XGSKIP,XGTOPNO ;# of choices skipped to next,# of TOPSHOW choice N K,XGFRAME ;key, # of choices to skip to next D SETUP^XGGL4 S ^TMP("XGW",$J,XGW,"G",XGG,"CHANGED")=0 S XGFRAME=1 S XGSKIP=0 ;D DN ;try to place cursor on an ACTIVE choice starting w/ TOPSHOW ;I N="" S XGC=XGC+2 D UP ;try for ACTIVE via UP D . S XGRT=0,XGFLAG("ABORT")=0 . F Q:(XGRT="UP"&(XGGTYP="LISTENTRY")&(XGTOPNO=1)&(XGPOS=1)&(XGSKIP=0))!(XGFLAG("ABORT")) D . . ;Code in next 7 lines has been moved to TAG^XGGL2 on 11/22/94 . . ;I $L(XGC),XGGTYP="LISTENTRY"!(XGGTYP="LISTBUTTON") D I 1 . . ;. ;update text portion w/ new choice . . ;. S ^TMP("XGW",$J,XGW,"G",XGG,"VALUE")=^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",XGC) . . ;. S:XGGTYP="LISTENTRY" L=L-1 . . ;. D TXTUPDT^XGGT(XGW,XGG) . . ;. S:XGGTYP="LISTENTRY" L=L+1 . . ;. I XGGTYP="LISTBUTTON" S ^TMP("XGW",$J,XGW,"G",XGG,"VALUE")=XGC K ^("TOPSHOW") . . W $$IOXY^XGS(T+XGPOS,L+1) . . S K=$$READ^XGKB(1) . . S:K="^" (XGFLAG("ABORT"),XGFLAG("JUMP"))=1 . . ;if user presses [ or ] move up or down by half of displayable choices . . ;if user presses {/PREV or }/NEXT move up or down by as many choices as are vsbl . . S K=$S(XGRT="PREV":"{",XGRT="NEXT":"}",1:K) . . S XGFRAME=$S(K="["!(K="]"):XGMAX\2,K="{"!(K="}"):XGMAX-1,1:1) . . D TAG^XGGL2:K=" ",UP:XGRT="UP"!(K="[")!(K="{"),DN:XGRT="DOWN"!(K="]")!(K="}") . . S:K="+"&(XGGTYP="LISTBUTTON") XGFLAG("ABORT")=1 S:XGGTYP="LISTBUTTON" XGFLAG("CLEAR SCROLL INDICATOR")=1 D SAVSTATE^XGGL2 K XGFLAG("CLEAR SCROLL INDICATOR") ;W:'XGFLAG("ABORT") $$SET^XGSA(XGSAVATR) ;restore attributes Q ; ; DN ;user pressed DN-Arrow cursor key ;if skip-to-active mode desired reverse-comment next 2 lines ;S N=XGC,XGSKIP=0 F S N=$O(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",N)),XGSKIP=XGSKIP+1 Q:N="" Q:$G(^(N,"ACTIVE"))'=0 S (N,N1)=XGC,XGSKIP=0 F S N=$O(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",N)),XGFRAME=XGFRAME-1 Q:N=""!(XGFRAME<0) S XGSKIP=XGSKIP+1,N1=N I XGSKIP>0 S N=N1 D ;if found choice that's active . I (XGPOS+XGSKIP)'>XGMAX S XGPOS=XGPOS+XGSKIP,XGC=N ;don't scroll . E S XGC=N D ;scroll up . . S XGTOPNO=XGTOPNO+XGSKIP-XGMAX+XGPOS . . S ^TMP("XGW",$J,XGW,"G",XGG,"YXGBOTSHOW")=N . . D REFRESH1^XGGL3(-1) . . S XGPOS=XGMAX Q ; ; UP ;user pressed UP-Arrow cursor key ;if skip-to-active mode desired reverse-comment next 2 lines ;S N=XGC,XGSKIP=0 F S N=$O(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",N),-1),XGSKIP=XGSKIP+1 Q:N="" Q:$G(^(N,"ACTIVE"))'=0 S (N,N1)=XGC,XGSKIP=0 F S N=$O(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",N),-1),XGFRAME=XGFRAME-1 Q:N=""!(XGFRAME<0) S XGSKIP=XGSKIP+1,N1=N I XGSKIP>0 S N=N1 D ;if found choice that's active . I (XGPOS-XGSKIP)'<1 S XGPOS=XGPOS-XGSKIP,XGC=N ;don't have to scroll . E S XGC=N D ;scroll down . . S XGTOPNO=XGTOPNO-XGSKIP+XGPOS-1 . . S $P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),XG255,6)=N . . S:XGGTYP'="LISTBUTTON" ^TMP("XGW",$J,XGW,"G",XGG,"TOPSHOW")=N . . D REFRESH1^XGGL3(1) . . S XGPOS=1 Q XGGL1^INT^1^60169,79033^0 XGGL1 ;SFISC/VYD - LIST BOX GADGET CONTINUE ;01/23/95 14:32 ;;8.0T19;KERNEL;;Feb 22, 1995 ; KV(XGW1,XGG1,XGITEM) ;kill VALUE sideffect N XGW,XGG,XGGTYP S XGGTYP=^TMP("XGW",$J,XGW1,"G",XGG1,"TYPE") D PAINTFLG^XGUTIL2(XGW1,"G",XGG1) ; I $G(XGITEM)="" D I 1 ;kill all values . K ^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE") S ^("VALUE")=0 . S XGW=XGW1,XGG=XGG1 . D:"^11^21^"[(U_XGFLAG("PAINT")_U) REFRESH^XGGL3 ; E I $D(^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE",XGITEM)) D ;kill one value . S ^("VALUE")=^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE")-1 K ^("VALUE",XGITEM) . D:"^11^21^"[(U_XGFLAG("PAINT")_U) OUTPUT^XGGL3(XGW1,XGG1,XGITEM) Q ; ; KC(XGW1,XGG1) ;kill all choices sideffect N XGW,XGG,XGGTYP S XGGTYP=^TMP("XGW",$J,XGW1,"G",XGG1,"TYPE") S XGW=XGW1,XGG=XGG1 K ^TMP("XGW",$J,XGW,"G",XGG,"CHOICE"),^("VALUE") D COMPLETE^XGGL4(XGG) D REFRESH^XGGL3 Q ; ; S(XGW1,XGG1,XGATR,XGVAL) ;set atribute of a list gadget N XGGTYP S XGGTYP=^TMP("XGW",$J,XGW1,"G",XGG1,"TYPE") I XGATR="VALUE" D I 1 . ;since it's illegal to set the VALUE node itself, according to MWAPI. . ;I assume that XGVAL identifies the descendant node from VALUE which . ;will be set to an empty string (""). . S ^("VALUE")=^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE")+1,^("VALUE",XGVAL)="" . D:"^11^21^"[(U_XGFLAG("PAINT")_U) OUTPUT^XGGL3(XGW1,XGG1,XGVAL) ; E D I 1 . S XGERR=XGERR_"-LIST UNKNOWN ATTR AND/OR UNKNOWN VALUE" . D HUH^XGUTIL2(XGERR) . S ^TMP("XGW",$J,XGW1,"G",XGG1,XGATR)=XGVAL Q ; ; SC(XGW,XGG,XGITEM,XGVAL) ; add or change some choice in a list ;MTA note: check to see if I need to new XGC here N XGTOPSHO,XGGTYP S XGGTYP=^TMP("XGW",$J,XGW,"G",XGG,"TYPE") S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",XGITEM)) $P(^("YXGOTHER"),XG255)=$P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),XG255)+1,^("CHOICE",XGITEM,"ACTIVE")=1 S ^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",XGITEM)=XGVAL S XGTOPSHO=$P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),XG255,6) ;S:^TMP("XGW",$J,XGW,"G",XGG,"TOPSHOW")="" ^("TOPSHOW")=XGITEM,$P(^("YXGOTHER"),XG255,2)=1,$P(^("YXGOTHER"),XG255,5)=XGITEM I $P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),XG255,2)=0 D . S $P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),XG255,2)=1,$P(^("YXGOTHER"),XG255,5,6)=XGITEM_XG255_XGITEM S:XGGTYP'="LISTBUTTON" ^("TOPSHOW")=XGITEM S:XGTOPSHO]XGITEM $P(^("YXGOTHER"),XG255,2)=$P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),XG255,2)+1 I XGTOPSHO']XGITEM,XGITEM']^TMP("XGW",$J,XGW,"G",XGG,"YXGBOTSHOW") I $T,"LISTENTRY"[^TMP("XGW",$J,XGW,"G",XGG,"TYPE")!(^("TYPE")="LISTBUTTON"&($D(^TMP("XGS",$J,XGID)))) I $T D REFRESH^XGGL3 Q ; ; SC1(XGW1,XGG1,XGC1,XGATR,XGVAL) ;set attribute of a choice in a list N XGGTYP S XGGTYP=^TMP("XGW",$J,XGW1,"G",XGG1,"TYPE") D . I XGATR="ACTIVE" D Q . . S ^TMP("XGW",$J,XGW1,"G",XGG1,"CHOICE",XGC1,XGATR)=XGVAL . . D PAINTFLG^XGUTIL2(XGW1,"G",XGG1) . . D:"^11^21^"[(U_XGFLAG("PAINT")_U) OUTPUT^XGGL3(XGW1,XGG1,XGC1) . I XGATR="AID" S ^TMP("XGW",$J,XGW1,"G",XGG1,"CHOICE",XGC1,XGATR)=XGVAL Q . I $E(XGATR)="Y" S ^TMP("XGW",$J,XGW1,"G",XGG1,"CHOICE",XGC1,XGATR)=XGVAL Q . S XGERR=XGERR_"-LIST unknown CHOICE attribute" . D HUH^XGUTIL2(XGERR) Q ; ; MC(XGD,XGS) ;merge choices into ^$W or K-WAPI equivalent ;XGD:destination. Format win_name,"G"/"M"/"T",gadget_name ;XGS:sourse. Format some root ie ^TEMP,JUNK,ARRAY("NODE") etc. N XGW1,XGW,XGG1,XGG ;window, gadget N XGGTYP S XGW1=$P(XGD,C,1),XGG1=$P(XGD,C,3) S XGGTYP=^TMP("XGW",$J,XGW1,"G",XGG1,"TYPE") M ^TMP("XGW",$J,XGW1,"G",XGG1,"CHOICE")=@XGS D COMPLETE^XGG(XGW1,XGG1) ;reset YXGOTHER, TOPSHOW, YXGBOTSHOW ;try to do visible sideefects if it's not a LISTBUTTON gadget or ;if it is a LISTBUTTON and the list is open/painted I ^TMP("XGW",$J,XGW1,"G",XGG1,"TYPE")'="LISTBUTTON"!((^("TYPE")="LISTBUTTON")&($D(^TMP("XGS",$J,^("ID"))))) D . D PAINTFLG^XGUTIL2(XGW1,"G",XGG1) . I XGFLAG("PAINT")=11!(XGFLAG("PAINT")=21) D ;do visible sideeffects . . S XGW=XGW1,XGG=XGG1 . . S XGD("FIRST")=$O(@XGS@("")),XGD("LAST")=$O(@XGS@(""),-1) ;set up first & last subscripts of the tree merged from . . ;I ^TMP("XGW",$J,XGW1,"G",XGG1,"TOPSHOW")']]XGD("LAST"),XGD("FIRST")']]^("YXGBOTSHOW") D REFRESH^XGGL3 . . I $P(^TMP("XGW",$J,XGW1,"G",XGG1,"YXGOTHER"),XG255,6)']XGD("FIRST")!(XGD("LAST")']^("YXGBOTSHOW")) D REFRESH^XGGL3 Q ; ; MVAL(XGW1,XGG1,XGVAL) ;merge into "VALUE" attribute N XGC1,XGW,XGG,XGCF,XGCL,XGGTYP,% S XGGTYP=^TMP("XGW",$J,XGW1,"G",XGG1,"TYPE") S %=^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE") S XGC1="" F S XGC1=$O(@XGVAL@(XGC1)) Q:XGC1="" D . S:$D(^TMP("XGW",$J,XGW1,"G",XGG1,XGC1)) ^("VALUE",XGC1)="",%=%+1 S ^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE")=% D PAINTFLG^XGUTIL2(XGW1,"G",XGG1) I XGFLAG("PAINT")=11!(XGFLAG("PAINT")=21) D ;do all visible sideeffects .S XGW=XGW1,XGG=XGG1 .S XGCF=$O(@XGVAL@("")),XGCL=$O(@XGVAL@(""),-1) ;set up first & last subscripts . ;I ^TMP("XGW",$J,XGW1,"G",XGG1,"TOPSHOW")']]XGCL,XGCF']]^("YXGBOTSHOW") D REFRESH^XGGL3 . I $P(^TMP("XGW",$J,XGW1,"G",XGG1,"YXGOTHER"),XG255,6)']XGCF!(XGCL']^("YXGBOTSHOW")) D REFRESH^XGGL3 Q XGGL2^INT^1^60169,79033^0 XGGL2 ;SFISC/VYD - LIST BOX GADGET CONTINUE ;02/13/95 09:32 ;;8.0T19;KERNEL;;Feb 22, 1995 ; PAINT(XGW1,XGG1) ;paint LIST gadget. XGW1 window, XGG1 gadget N T,L,B,R,XGMAX,XGTOT,XGTOPNO,XGOLDSCL,XGWIDTH,XGSELMAX N XGPOS,XGSAVATR,XGCHATTR ;save attr, choice attr N XGW,XGG,XGC S XGW=XGW1,XGG=XGG1 ;remove when all funcs are changed to take params D SETUP1^XGGL4 I ^TMP("XGW",$J,XGW1,"G",XGG1,"TYPE")="LISTBUTTON" D WIN^XGSW(T+1,L,B,R,$NA(^TMP("XGS",$J,^TMP("XGW",$J,XGW1,"G",XGG1,"ID")))) I 1 E D . D WIN^XGSW(T,L,B,R) . D:$D(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE"))&(^("TYPE")'="LISTENTRY") TITLE^XGUTIL1(XGW1,XGG1,T,L,R) ;put up title D REFRESH1^XGGL3(1) D SAVSTATE Q ; ; ERASE(XGW1,XGG1) ;erase LIST gadget. XGW1 window, XGG1 gadget N T,L,B,R N XGSAVTTL D COORDG^XGUTIL1(XGW1,XGG1,.T,.L,.B,.R) D:$L($G(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE"))) . S XGSAVTTL=^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE") . S ^("TITLE")=$J("",$L(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE"))) ;stuff spaces . D TITLE^XGUTIL1(XGW1,XGG1,T,L,R) ;put up title . S ^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE")=XGSAVTTL ;restore ;if erasing LISTBUTTON and list portion is not expanded, erase the ; text portion only I ^TMP("XGW",$J,XGW1,"G",XGG1,"TYPE")="LISTBUTTON",'$D(^TMP("XGS",$J,^TMP("XGW",$J,XGW1,"G",XGG1,"ID"))) D SAY^XGS(T,L,$J("",R-L+1)) E D CLEAR^XGSBOX(T,L,B,R) Q ; ; TAG ;if user selected a choice, toggle its color and set or kill its value N XGC1 I $L(XGC),^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",XGC,"ACTIVE") D . ;values of XGFLAG("DESELECT") and its meaning . ; CURRENT - deselect the current choice (toggle it OFF from ON state) . ; OTHER - deselect some other choice because another one is picked . ; NONE - don't deselect any choice . S XGFLAG("DESELECT")="NONE" . I XGGTYP="LISTBUTTON",$L(^TMP("XGW",$J,XGW,"G",XGG,"VALUE")) S XGFLAG("DESELECT")=$S(XGC=^TMP("XGW",$J,XGW,"G",XGG,"VALUE"):"CURRENT",1:"OTHER") . I "^LIST^LONGLIST^"[(U_XGGTYP_U) S XGFLAG("DESELECT")=$S($D(^TMP("XGW",$J,XGW,"G",XGG,"VALUE",XGC)):"CURRENT",^TMP("XGW",$J,XGW,"G",XGG,"VALUE")=1&(XGSELMAX=1):"OTHER",1:"NONE") . ; . ;------ set CHOICE OFF . D:XGFLAG("DESELECT")'="NONE" ;deselect current or some other . . S XGC("NEW")=XGC ;save current choice . . S XGC("POS")=XGPOS ;save current position in list box . . S XGC1=XGC . . D:XGFLAG("DESELECT")="OTHER" . . . ;get choice that needs to be deselected and its position . . . S XGC=$S(XGGTYP="LISTBUTTON":^TMP("XGW",$J,XGW,"G",XGG,"VALUE"),1:$O(^TMP("XGW",$J,XGW,"G",XGG,"VALUE",""))) . . . ;S XGC1=^TMP("XGW",$J,XGW,"G",XGG,"YXGBOTSHOW") . . . ;F XGPOS=XGMAX:-1:0 Q:XGC1=XGC S XGC1=$O(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",XGC1),-1) . . . S XGC1=$P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),XG255,6) . . . F XGPOS=1:1:XGMAX+1 Q:XGC1=XGC!(XGC1="") S XGC1=$O(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",XGC1)) . . ;change VALUE nodes accordingly . . I XGGTYP="LISTBUTTON" D I 1 . . . S ^TMP("XGW",$J,XGW,"G",XGG,"VALUE")=$S(XGFLAG("DESELECT")="OTHER":XGC("NEW"),1:"") . . . D:XGFLAG("DESELECT")="CURRENT" TXTUPDT^XGGT(XGW,XGG) . . E S ^("VALUE")=^TMP("XGW",$J,XGW,"G",XGG,"VALUE")-1 K ^("VALUE",XGC) . . ;D:XGPOS>0 OUTPUT1^XGGL3 ;redisplay old choice if visible . . D:XGPOS'>XGMAX&($L(XGC1)) OUTPUT1^XGGL3 ;redisplay old choice if visible . . ; . . D:$D(^TMP("XGW",$J,XGW,"G",XGG,"EVENT","DESELECT")) . . . D SAVSTATE . . . ;do DESELECT event as many times as # of unselected choices . . . S XGC1="" . . . F S XGC1=$O(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",XGC1)) Q:XGC1="" D . . . . I XGGTYP="LISTBUTTON" D Q . . . . . D:XGC1'=^TMP("XGW",$J,XGW,"G",XGG,"VALUE") E^XGEVNT1(XGW,"G",XGG,XGC1,"DESELECT") . . . . D Q . . . . . D:'$D(^TMP("XGW",$J,XGW,"G",XGG,"VALUE",XGC1)) E^XGEVNT1(XGW,"G",XGG,XGC1,"DESELECT") . . . ;since callback could've changed any/all attributes of this gadget . . . D SETUP^XGGL4 ;get new values . . S XGC=XGC("NEW") ;restore current choice . . S XGPOS=XGC("POS") ;restore current position in list box . ; . ;------ set CHOICE ON . I XGSELMAX>1,^TMP("XGW",$J,XGW,"G",XGG,"VALUE")'XGMAX!(XGOLDSCL) ; update scroll bar only if more choices than can fit or elevator existed before . ;-------------now update the scroll bar . N XGDNTFIT,XGABOVE,XGRATIO,XGNELVTR . S XGABOVE=XGTOPNO-1 . S XGDNTFIT=XGTOT-XGMAX . S XGRATIO=$S(XGABOVE'>XGDNTFIT:XGABOVE/XGDNTFIT,1:1) . S XGNEWSCL=$J(XGMAX*XGRATIO,0,0) . S XGNEWSCL=$S(XGDNTFIT'>0:0,XGNEWSCL>1:XGNEWSCL,1:1) . S XGNELVTR=XGELVTR . ; . I XGOLDSCL,XGOLDSCL'=XGNEWSCL D . . ;clear scroll position and appearance flag, if any . . ;S $P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),U,3,4)="0"_U_"" . . S XGNELVTR="" . . D SAY^XGS(T+XGOLDSCL,R,IOVL,"G1I0R0") ; erase old elevtr . ; . I XGNEWSCL,XGTOPNO=1 D I 1 ;user is at the very top . . ;store new scroll position and clear "+" appearance flag . . ;S XGOLDSCL=XGNEWSCL . . ;S $P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),U,3,4)=XGNEWSCL_U_"" . . S XGNELVTR="" . . D SAY^XGS(T+XGNEWSCL,R,IOTT,"G1I0R0") . ; . E I XGNEWSCL,XGTOPNO'<(XGTOT-XGMAX+1) D I 1 ;user at the bottom . . ;store new scroll position and clear "+" appearance flag . . ;S XGOLDSCL=XGNEWSCL . . ;S $P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),U,3,4)=XGNEWSCL_U_"" . . S XGNELVTR="" . . D SAY^XGS(T+XGNEWSCL,R,IOBT,"G1I0R0") . ; . E I XGNEWSCL,XGNEWSCL'=XGOLDSCL D I 1 ; elevator moved to new pos . . ;store new scroll position and set appearance flag to "+" . . ;S XGOLDSCL=XGNEWSCL . . ;S $P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),U,3,4)=XGNEWSCL_U_"+" . . S XGNELVTR="+" . . D SAY^XGS(T+XGNEWSCL,R,"+","I0R0") . ; . ;E I XGNEWSCL,$P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),U,4)="" D I 1 ;user is no longer at the very top/bottom of the list, but the elevator didn't move . E I XGNEWSCL,XGELVTR="" D I 1 ;user is no longer at the very top/bottom of the list, but the elevator didn't move . . ;S $P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),U,4)="+" ;set appearance flag to "+" . . S XGNELVTR="+" . . D SAY^XGS(T+XGNEWSCL,R,"+","I0R0") . ; . S XGOLDSCL=XGNEWSCL . S XGELVTR=XGNELVTR Q XGGL4^INT^1^60169,79033^0 XGGL4 ;SFISC/VYD - LIST BOX GADGET CONTINUE ;11/23/94 11:19 [ 01/15/95 8:27 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ; COMPLETE(XGG) ;complete any missing nodes with default values ;XGG gadget name ;XGW window name (should already exist) N XGMAX,X,Y,% S XGMAX=$$CHAR^XGUTIL2(XGW,XGG,"SIZE",2)-2 ;S XGMAX=# of lines in box S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"CANCHANGE")) ^("CANCHANGE")=1 S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"SELECTMAX")) ^("SELECTMAX")=1 ; ;----------- set TOPSHOW S %=$G(^TMP("XGW",$J,XGW,"G",XGG,"TOPSHOW")) ; set TOPSHOW I $L(%),$D(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",%)) E S (^TMP("XGW",$J,XGW,"G",XGG,"TOPSHOW"),%)=$O(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",%)) D:%="" . S Y=XGMAX,%=XG255,X="" . F S %=$O(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",%),-1) Q:%=""!('Y) S X=%,Y=Y-1 . S ^TMP("XGW",$J,XGW,"G",XGG,"TOPSHOW")=X ; ;----------- set VALUE S %="",X=0 F S %=$O(^TMP("XGW",$J,XGW,"G",XGG,"VALUE",%)) Q:%="" S X=X+1 S ^TMP("XGW",$J,XGW,"G",XGG,"VALUE")=X ; ;----------- set YXGBOTSHOW=subscript of the last choice in list box. If there are fewer choices than the list box holds set YXGBOTSHOW=XG255 ;when adding a new choice it's used with TOPSHOW to see if the new choice falls within the box range, if it does - refresh the list box S %=^TMP("XGW",$J,XGW,"G",XGG,"TOPSHOW"),Y=XGMAX-1 F Q:%=""!('Y) S %=$O(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",%)),Y=Y-1 S ^TMP("XGW",$J,XGW,"G",XGG,"YXGBOTSHOW")=$S('Y:%,1:XG255) ; ;----------- set YXGOTHER D XGOTHER^XGG(XGW,"G",XGG) ;complete choices and set YXGOTHER Q ; ; SETUP ;setup list box specific stuff ;prior to entering here make sure to NEW the following variables ;T,L,B,R,XGMAX,XGTOT,XGTOPNO,XGOLDSCL,XGWIDTH,XGSELMAX,XGSAVATR ;XGCHATTR,XGPOS ;first check if an event changed focus or made window or gadget inactive or invisible W IOCUON I '$G(XGFLAG("ABORT")),^TMP("XGD",$J,$PD,"FOCUS")=(XGW_C_XGG),$G(^TMP("XGW",$J,XGW,"VISIBLE"))'=0,$G(^("ACTIVE"))'=0,$G(^("G",XGG,"VISIBLE"))'=0,$G(^("ACTIVE"))'=0 ;it's OK E S XGFLAG("ABORT")=1 Q S XGSELMAX=$S(XGGTYP="LISTENTRY"!(XGGTYP="LISTBUTTON"):1,^TMP("XGW",$J,XGW,"G",XGG,"SELECTMAX")>0:^("SELECTMAX"),1:99999999) ;S XGSAVATR=XGCURATR,XGCHATTR="" ; SETUP1 ; entry from REFRESH^XGGL3,S^XGGL1 ;prior to entering here make sure to NEW the following variables ;T,L,B,R,XGMAX,XGTOT,XGTOPNO,XGOLDSCL,XGWIDTH,XGPOS,XGSAVATR,XGCHATTR N % S XGSAVATR=XGCURATR,XGCHATTR="" S XGC=$P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),XG255,5) ;S %=$G(^TMP("XGW",$J,XGW,"G",XGG,"TOPSHOW"),XGC) S %=$P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),XG255,6) S XGPOS=$S(%="":0,1:1) F Q:%=""!(%=XGC) S %=$O(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",%)),XGPOS=XGPOS+1 S XGWIDTH=$$CHAR^XGUTIL2(XGW,XGG,"SIZE",1)-$S(^TMP("XGW",$J,XGW,"G",XGG,"TYPE")="LISTENTRY":3,1:2) ; SETUP2 ; entry from UPDTSCL^XGGL3 ;prior to entering here make sure to NEW the following variables ;T,L,B,R,XGMAX,XGTOT,XGTOPNO,XGOLDSCL D COORDG^XGUTIL1(XGW,XGG,.T,.L,.B,.R) S:^TMP("XGW",$J,XGW,"G",XGG,"TYPE")="LISTENTRY" L=L+1 S XGMAX=B-T-1 ;max # of choices displayable in the box S XGTOT=$P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),XG255),XGTOPNO=$P(^("YXGOTHER"),XG255,2),XGOLDSCL=$P(^("YXGOTHER"),XG255,3),XGELVTR=$P(^("YXGOTHER"),XG255,4) Q XGGLB^INT^1^60169,79033^0 XGGLB ;SFISC/VYD - LISTBUTTON ;12/28/94 16:30 [ 01/15/95 8:27 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ; PAINT(XGW1,XGG1) ;paint LISTBUTTON type gadget. XGG1 gadget name N XGOLDVAL S XGOLDVAL=^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE") S:$L(XGOLDVAL) ^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE")=^TMP("XGW",$J,XGW1,"G",XGG1,"CHOICE",XGOLDVAL) D PAINT^XGGT(XGW1,XGG1) ;paint text portion S ^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE")=XGOLDVAL Q ; ; ERASE(XGW1,XGG1) ;erase LISTBUTTON type gadget. XGG1 gadget name D ERASE^XGGL2(XGW1,XGG1) Q ; ; SERVICE ;service LISTBUTTON type gadget. XGG gadget name N T,L,B,R,K D COORDG^XGUTIL1(XGW,XGG,.T,.L,.B,.R) W IOCUON W $$IOXY^XGS(T,L+1) F Q:XGFLAG("ABORT") D . S K=$$READ^XGKB(1) . S:K="^" (XGFLAG("ABORT"),XGFLAG("JUMP"))=1 . I K=" "!(K="+") D . . D PAINT^XGGL2(XGW,XGG) . . D SERVICE^XGGL D:$D(^TMP("XGS",$J,XGID)) . D RESTORE^XGSW($NA(^TMP("XGS",$J,XGID))) . K ^TMP("XGS",$J,XGID) Q ; ; COMPLETE(XGG1) ;complete any missing info for a LISTBUTTON N XGOLDVAL S XGOLDVAL=$G(^TMP("XGW",$J,XGW,"G",XGG1,"VALUE")) D COMPLETE^XGGLE(XGG1) S ^TMP("XGW",$J,XGW,"G",XGG1,"VALUE")=XGOLDVAL K ^TMP("XGW",$J,XGW,"G",XGG1,"TOPSHOW") Q ; ; S(XGW1,XGG1,XGATR,XGVAL) ;set attribute of LISTBUTTON gadget N T,L,R S XGERR=XGERR_"-LISTBUTTON" I XGATR="VALUE" D I 1 . I $L(XGVAL),'$D(^TMP("XGW",$J,XGW1,"G",XGG1,"CHOICE",XGVAL)) D Q . . D HUH^XGUTIL2("Setting VALUE of a choice that doesn't exist") . S ^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE")=XGVAL . K ^TMP("XGW",$J,XGW1,"G",XGG1,"YXGOTHER") ;clear scroll/pos data . D XGOTHER^XGG(XGW1,"G",XGG1) ;complete choices and set YXGOTHER . I "^11^21^"[(U_XGFLAG("PAINT")_U) D ;do visible sideffcts . . D COORDG^XGUTIL1(XGW1,XGG1,.T,.L,"",.R) . . ;temporarily put choice text in value, paint it, put item # back . . S:$L(XGVAL) ^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE")=^TMP("XGW",$J,XGW1,"G",XGG1,"CHOICE",XGVAL) . . D TXTUPDT^XGGT(XGW1,XGG1) . . S ^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE")=XGVAL E D . S XGERR=XGERR_" UNKNOWN ATTR. AND/OR UNKNOWN VAL" . D HUH^XGUTIL2(XGERR) Q XGGLBL^INT^1^60169,79033^0 XGGLBL ;SFISC/VYD - LABEL GADGET ;11/30/94 16:35 ;;8.0T19;KERNEL;;Feb 22, 1995 ; PAINT(XGW1,XGG1) ;paint LABEL gadget. XGW1 window, XGG1 gadget ;N T,L,R ;D:$L(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE")) ;. D COORDG^XGUTIL1(XGW1,XGG1,.T,.L,"",.R) ;. D SAY^XGS(T,L,$E(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE"),1,R-L+1),"I1") D TITLE^XGUTIL1(XGW1,XGG1) Q ; ; ERASE(XGW1,XGG1) ;erase LABEL gadget. XGW1 window, XGG1 gadget N T,L,R D:$L(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE")) . D COORDG^XGUTIL1(XGW1,XGG1,.T,.L,"",.R) . D SAY^XGS(T,L,$J("",R-L+1)) Q ; ; COMPLETE(XGG1) ;complete any missing info for label K ^TMP("XGW",$J,XGW,"G",XGG1,"ACTIVE"),^("CANCEL"),^("CHANGED") S:'$D(^TMP("XGW",$J,XGW,"G",XGG1,"FRAMED")) ^("FRAMED")=0 S:'$D(^TMP("XGW",$J,XGW,"G",XGG1,"TITLE")) ^("TITLE")="" Q ; ; S(XGW1,XGG1,XGATR,XGVAL) ;set attribute of LABEL gadget S XGERR=XGERR_"-"_XGGTYP_" UNKNOWN ATTR. AND/OR UNKNOWN VAL" D HUH^XGUTIL2(XGERR) Q XGGLE^INT^1^60169,79033^0 XGGLE ;SFISC/VYD - LISTENTRY ;09/21/94 11:55 ;;8.0T19;KERNEL;;Feb 22, 1995 ; PAINT(XGW1,XGG1) ;paint LISTENTRY gadget. XGW1 window, XGG1 gadget N T,L,B,R,XGMAX,XGTOT,XGTOPNO,XGOLDSCL N XGW,XGG S XGW=XGW1,XGG=XGG1 D SETUP2^XGGL4 D PAINT^XGGL2(XGW1,XGG1) ;paint list portion D PAINT^XGGT(XGW1,XGG1) ;paint text portion Q ; ; ERASE(XGW1,XGG1) ;erase LISTENTRY gadget. XGW1 window, XGG1 gadget D ERASE^XGGL2(XGW1,XGG1) Q ; ; SERVICE ;service LISTENTRY type gadget. XGG gadget name S XGRT=0,XGFLAG("ABORT")=0 F Q:XGRT="TAB"!(XGRT="CR")!(XGFLAG("ABORT")) D .D SERVICE^XGGT .D:XGRT="DOWN"&($D(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE"))) ..D SERVICE^XGGL ..S:XGRT="UP" ^TMP("XGW",$J,XGW,"G",XGG,"VALUE")="" Q ; COMPLETE(XGG) ;complete any missing info N XGCLRVAL ;clear value flag S:'$L($G(^TMP("XGW",$J,XGW,"G",XGG,"VALUE"))) XGCLRVAL=1 D COMPLETE^XGGL4(XGG) S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"CHARMAX")) ^("CHARMAX")=0 S:$D(XGCLRVAL) ^TMP("XGW",$J,XGW,"G",XGG,"VALUE")="" K ^TMP("XGW",$J,XGW,"G",XGG,"SELECTMAX") Q XGGLL^INT^1^60169,79033^0 XGGLL ;SFISC/VYD - LONGLIST ;08/04/94 14:48 ;;8.0T19;KERNEL;;Feb 22, 1995 PAINT99(XGW1,XGG1) ;paint LONGLIST gadget. XGW1 window, XGG1 gadget N T,L,B,R,XGMAX,XGTOT,XGTOPNO,XGOLDSCL N XGW,XGG S XGW=XGW1,XGG=XGG1 D SETUP2^XGGL4 D PAINT^XGGL2(XGW1,XGG1) ;paint list portion Q ; ; LLSTS99 ;service LONGLIST type gadget. XGG gadget name S XGRT=0,XGFLAG("ABORT")=0 F Q:XGRT="CR"!(XGFLAG("ABORT")) D .D SERVICE^XGGL Q ; COMPLETE(XGG) ;complete any missing info N % D COMPLETE^XGGL4(XGG) S %=$G(^TMP("XGW",$J,XGW,"G",XGG,"SCROLLRANGE")) S:$P(%,C)="" $P(%,C)=0 S:$P(%,C,2)="" $P(%,C,2)=100 S ^TMP("XGW",$J,XGW,"G",XGG,"SCROLLRANGE")=% Q XGGR^INT^1^60169,79033^0 XGGR ;SFISC/VYD - RADIO BUTTON SET GADGET ;01/27/95 15:51 ;;8.0T19;KERNEL;;Feb 22, 1995 ; PAINT(XGW1,XGG1) ;paint RADIO gadget. XGW1 window, XGG1 name N T,L,B,R,S,XGC N XGW,XGG S XGW=XGW1,XGG=XGG1 D COORDG^XGUTIL1(XGW1,XGG1,.T,.L,.B,.R) D:$D(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE")) TITLE^XGUTIL1(XGW1,XGG1,T,L,R) ;put up title I ^TMP("XGW",$J,XGW1,"G",XGG1,"FRAMED") D I 1 . D WIN^XGSW(T,L,B,R) . S T=T+1,L=L+1,B=B-1,R=R-1 E D CLEAR^XGSBOX(T,L,B,R) S XGC="" F S XGC=$O(^TMP("XGW",$J,XGW1,"G",XGG1,"CHOICE",XGC)) Q:XGC="" D . S S="("_$S(^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE")=XGC:"o",1:" ")_")" . ;remember to check and adjust for SIZE . S S=S_^TMP("XGW",$J,XGW1,"G",XGG1,"CHOICE",XGC) . D SAY^XGS(T,L,S,"I"_^TMP("XGW",$J,XGW1,"G",XGG1,"ACTIVE")) . S T=T+1 Q ; ; ERASE(XGW1,XGG1) ;erase RADIO gadget. XGW1 window, XGG1 gadget N T,L,B,R N XGSAVTTL ;saved title D COORDG^XGUTIL1(XGW1,XGG1,.T,.L,.B,.R) D:$L($G(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE"))) . S XGSAVTTL=^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE") . S ^("TITLE")=$J("",$L(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE"))) ;stuff spaces . D TITLE^XGUTIL1(XGW1,XGG1,T,L,R) ;put up title . S ^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE")=XGSAVTTL ;restore D CLEAR^XGSBOX(T,L,B,R) Q ; ; SERVICE ;service RADIO type gadget. XGG gadget name N K,T,L,B,R,S,XGC,XGPOS,XGOLDPOS,XGTOT D SETUP W IOCUON ;turn cursor on F D Q:XGFLAG("ABORT") . W $$IOXY^XGS(T+XGPOS,L+1) . S K=$$READ^XGKB(1) . S:K="^" XGFLAG("JUMP")=1,XGFLAG("ABORT")=1 . D TAG:K=" ",UP:XGRT="UP",DOWN:XGRT="DOWN" Q ; UP ;Up Arrow pressed S XGC=$O(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",$S(XGPOS'<2:XGC,1:"")),-1) S XGPOS=$S(XGPOS'<2:XGPOS-1,1:XGTOT) Q ; DOWN ;Down Arrow pressed S XGC=$O(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",$S(XGPOS pressed S ^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER")=XGTOT_XG255_XGPOS D:$D(^TMP("XGW",$J,XGW,"G",XGG,"EVENT","DESELECT")) E^XGEVNT1(XGW,"G",XGG,^TMP("XGW",$J,XGW,"G",XGG,"VALUE"),"DESELECT") S ^TMP("XGW",$J,XGW,"G",XGG,"VALUE")=XGC D REFRESH D:$D(^TMP("XGW",$J,XGW,"G",XGG,"EVENT","SELECT")) E^XGEVNT1(XGW,"G",XGG,XGC,"SELECT") ;since callback could've changed any/all attributes of this gadget D SETUP Q ; ; REFRESH ; D SAY^XGS(T+XGOLDPOS,L+1," ") D SAY^XGS(T+XGPOS,L+1,"o","I"_^TMP("XGW",$J,XGW,"G",XGG,"ACTIVE")) S XGOLDPOS=XGPOS Q ; ; COMPLETE(XGG) ;complete any missing info S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"ACTIVE")) ^("ACTIVE")=1 S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"CANCEL")) ^("CANCEL")=0 S ^TMP("XGW",$J,XGW,"G",XGG,"CHANGED")=0 S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"FRAMED")) ^("FRAMED")=1 S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"ROWCOL")) ^("ROWCOL")="COL,1,V" S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"TPOS")) ^("TPOS")="TOP" S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"UNITS")) ^TMP("XGW",$J,XGW,"G",XGG,"UNITS")=^TMP("XGW",$J,XGW,"UNITS") S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"VALUE")) ^("VALUE")="" S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"VISIBLE")) ^("VISIBLE")=1 ; ;----------- set YXGOTHER D XGOTHER^XGG(XGW,"G",XGG) ;complete choices and set YXGOTHER Q ; ; DFLTSIZE(XGW1,XGG1) ;set default size N XGUNITS,X,Y S X=$P($G(^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE")),C,1) S Y=$P($G(^("SIZE")),C,2) ;ref ^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE") S XGUNITS=$P($G(^("SIZE")),C,3) ;ref ^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE") S:XGUNITS="" XGUNITS=^TMP("XGW",$J,XGW1,"G",XGG1,"UNITS") ; S:X="" X=10/XGUFCTR(XGUNITS,"X") ; set HORIZONTAL S:Y="" Y=10/XGUFCTR(XGUNITS,"Y") ; set VERTICAL ; S $P(^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE"),C,1,2)=X_C_Y ;store the size Q ; ; SETUP ;setup radio button specific stuff ;prior to entering here make sure to NEW the following vars ;T,L,B,R ;***** next 2 lines commented out on 1/27/95 ;I '$G(XGFLAG("ABORT")),^TMP("XGD",$J,$PD,"FOCUS")=(XGW_C_XGG),$G(^TMP("XGW",$J,XGW,"VISIBLE"))'=0,$G(^("ACTIVE"))'=0,$G(^("G",XGG,"VISIBLE"))'=0,$G(^("ACTIVE"))'=0 ;it's OK ;E S XGFLAG("ABORT")=1 Q S XGC=^TMP("XGW",$J,XGW,"G",XGG,"VALUE") I $L(XGC),$D(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE",XGC)) E S XGC=$O(^TMP("XGW",$J,XGW,"G",XGG,"CHOICE","")) ;default to 1st choice S XGTOT=$P(^TMP("XGW",$J,XGW,"G",XGG,"YXGOTHER"),XG255),(XGPOS,XGOLDPOS)=$P(^("YXGOTHER"),XG255,2) S:XGPOS=0 (XGPOS,XGOLDPOS)=1 D COORDG^XGUTIL1(XGW,XGG,.T,.L,.B,.R) I ^TMP("XGW",$J,XGW,"G",XGG,"FRAMED") S L=L+1 ;adjust coordinates E S T=T-1,L=L+1 Q ; ; S(XGW1,XGG1,XGATR,XGVAL) ;set attribute of RADIO gadget N T,L,B,R,XGW,XGG,XGC,XGPOS,XGOLDPOS,XGSAVPOS S XGW=XGW1 S XGG=XGG1 D . I XGATR="VALUE" D Q . . I "^11^21^"[(U_XGFLAG("PAINT")_U),^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE")'=XGVAL D . . . D SETUP . . . S XGSAVPOS=XGOLDPOS . . . S ^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE")=XGVAL . . . D XGOTHER^XGG(XGW1,"G",XGG1) . . . D SETUP . . . S XGOLDPOS=XGSAVPOS . . . D REFRESH . S XGERR=XGERR_"-"_XGGTYP_" UNKNOWN ATTR. AND/OR UNKNOWN VAL" . D HUH^XGUTIL2(XGERR) Q XGGSC^INT^1^60169,79033^0 XGGSC ;SFISC/VYD - SCROLL GADGET ;09/21/94 11:52 ;;8.0T19;KERNEL;;Feb 22, 1995 ; PAINT(XGW1,XGG1) ;paint SCROLL gadget, XGW1 window, XGG1 name N T,L,B,P ;top,left,bottom,position Q ; ; ERASE(XGW1,XGG1) ;erase SCROLL gadget, XGW1 window, XGG1 name N T,L,B,P ;top,left,bottom,position Q ; ; SERVICE(XGG,V) ;service SCROLL type gadget, XGG gadget name, V:value N T,L,P ;top,left,position D:'$G(^TMP("XGW",$J,XGW,"G",XGG,"CHANGED"))!($G(^("VALUE"))'=V) .S T=XGWT+$P(^TMP("XGW",$J,XGW,"G",XGG,"POS"),U)-1,L=XGWL+$P(^("POS"),U,2) .S:'$G(V) V=$P($G(^TMP("XGW",$J,XGW,"G",XGG,"SCROLLRANGE")),U) .I $G(^TMP("XGW",$J,XGW,"G",XGG,"SCROLLDIR"))="V" D ;horizontal is not ready ..D:$G(^TMP("XGW",$J,XGW,"G",XGG,"VALUE")) SAY^XGS(T+^("VALUE"),L,$C(97),"G1") ;erase prev ..D SAY^XGS(T+V,L," ","R1") ;draw elevator .S ^TMP("XGW",$J,XGW,"G",XGG,"VALUE")=V .S ^TMP("XGW",$J,XGW,"G",XGG,"CHANGED")=1 Q ; ; S(XGW1,XGG1,XGATR,XGVAL) ;set attribute of SCROLL gadget S XGERR=XGERR_"-"_XGGTYP_" UNKNOWN ATTR. AND/OR UNKNOWN VAL" D HUH^XGUTIL2(XGERR) Q XGGSY^INT^1^60169,79033^0 XGGSY ;SFISC/VYD - SYMBOL ;09/16/94 10:48 ;;8.0T19;KERNEL;;Feb 22, 1995 ; PAINT(XGW1,XGG1) ;paint SYMBOL gadget. XGW1 window, XGG1 gadget N T,L,S D:"M,ERROR^M,INFO^M,QUEST^M,WARN"[$G(^TMP("XGW",$J,XGW1,"G",XGG1,"RESOURCE"),0) . D COORDG^XGUTIL1(XGW1,XGG1,.T,.L) . S S=$S(^TMP("XGW",$J,XGW1,"G",XGG1,"RESOURCE")="M,ERROR":"E",^("RESOURCE")="M,INFO":"*",^("RESOURCE")="M,QUEST":"?",1:"!") . D SAY^XGS(T,L,S,"R1I1") Q ; ; ERASE(XGW1,XGG1) ;erase SYMBOL gadget. XGW1 window, XGG1 gadget N T,L D COORDG^XGUTIL1(XGW1,XGG1,.T,.L) D SAY^XGS(T,L," ") Q ; ; COMPLETE(XGG1) ;complete any missing info for a SYMBOL K ^TMP("XGW",$J,XGW,"G",XGG1,"ACTIVE"),^("CANCEL"),^("CHANGED"),^("SIZE") S:'$D(^TMP("XGW",$J,XGW,"G",XGG1,"SIZE")) ^("SIZE")="1,1,CHAR" Q ; ; DFLTSIZE(XGW1,XGG1) ;set default size N XGUNITS,X,Y S X=$P($G(^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE")),C,1) S Y=$P($G(^("SIZE")),C,2) ;ref ^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE") S XGUNITS=$P($G(^("SIZE")),C,3) ;ref ^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE") S:XGUNITS="" XGUNITS=^TMP("XGW",$J,XGW1,"G",XGG1,"UNITS") ; S:X="" X=1/XGUFCTR(XGUNITS,"X") ; set HORIZONTAL S:Y="" Y=1/XGUFCTR(XGUNITS,"Y") ; set VERTICAL ; S $P(^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE"),C,1,2)=X_C_Y ;store the size Q ; ; S(XGW1,XGG1,XGATR,XGVAL) ;set attribute of SYMBOL gadget S XGERR=XGERR_"-"_XGGTYP_" UNKNOWN ATTR. AND/OR UNKNOWN VAL" D HUH^XGUTIL2(XGERR) Q XGGT^INT^1^60169,79033^0 XGGT ;SFISC/VYD - TEXT GADGET ;02/01/95 13:24 ;;8.0T19;KERNEL;;Feb 22, 1995 ; PAINT(XGW1,XGG1) ;paint TEXT gadget. XGW1 window, XGG1 gadget N T,L,R,S ;S:gadget output string D COORDG^XGUTIL1(XGW1,XGG1,.T,.L,"",.R) D:$D(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE")) TITLE^XGUTIL1(XGW1,XGG1,T,L,R) D:$G(^TMP("XGW",$J,XGW1,"G",XGG1,"FRAMED"))!(^("TYPE")["LIST") SAY^XGS(T,L,"["_$J("",R-L-$S(^("TYPE")="LISTBUTTON":2,1:1))_"]","I"_^("ACTIVE")) D:^TMP("XGW",$J,XGW1,"G",XGG1,"TYPE")="LISTBUTTON" SAY^XGS(T,R,"+","R1I"_^("ACTIVE")) D TXTUPDT(XGW1,XGG1) Q ; ; ERASE(XGW1,XGG1) ;erase DOCUMENT gadget. XGW1 window, XGG1 gadget N T,L,B,R N XGSAVTTL ;saved title D COORDG^XGUTIL1(XGW1,XGG1,.T,.L,.B,.R) D:$L($G(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE"))) . S XGSAVTTL=^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE") . S ^("TITLE")=$J("",$L(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE"))) ;stuff spaces . D TITLE^XGUTIL1(XGW1,XGG1,T,L,R) ;put up title . S ^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE")=XGSAVTTL ;restore D SAY^XGS(T,L,$J("",R-L+1)) Q ; ; TXTUPDT(XGW1,XGG1) ;update text value. ;Entered from SERVICE^XGGL (LISTENTRY or LISTBUTTON) ;S S=$$LJ^XLFSTR(^TMP("XGW",$J,XGW,"G",XGG,"VALUE"),($$CHAR^XGUTIL2(XGW,XGG,"SIZE",1)-2)_"T") S S=$$LJ^XLFSTR(^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE"),(R-L-$S(^("TYPE")="LISTBUTTON":2,1:1))_"T") D SAY^XGS(T,L+1,S,"R0U1I"_^TMP("XGW",$J,XGW1,"G",XGG1,"ACTIVE")) Q ; ; SERVICE ;service TEXT type gadget. XGG gadget name N X,T,L,XGDFLT ;XGDFLT=default answer N XGANS,XGSAVKEY,XGDTIME,XGW1 N XGT1 ;timer D COORDG^XGUTIL1(XGW,XGG,.T,.L) S L=L+1 D EXIT^XGKB W IOCUON ;------------ set up key table for EN^DIR0 reader S XGKEYMAP(1)="CTRLW^XGJUMP;$C(23)" S XGKEYMAP(2)="KP0^XGJUMP;$C(27)_""Op""" S XGKEYMAP(3)="TAB^XGJUMP;$C(9)" S XGKEYMAP(4)="CR^XGJUMP;$C(13)" S XGKEYMAP(5)="PF4^XGJUMP;$C(27)_""OS""" S XGKEYMAP(6)="CTRLBSL^XGJUMP;$C(28)" S XGKEYMAP(7)="CTRLV^XGJUMP;$C(22)" S XGKEYMAP(8)="CTRLR^XGJUMP;$C(18)" S XGKEYMAP(9)="CTRLZ^XGJUMP;$C(26)" S XGKEYMAP(10)="KP0^XGJUMP;$C(27)_""[21~""" K XGKEYMAP(99) ; build key exception string of keys that will NOT trigger ; KEYUP/KEYDOWN event if one is defined. D:'$D(XGSPCIAL) . S %="",XGSPCIAL=U . F S %=$O(XGKEYMAP(%)) Q:%="" D . . S XGSPCIAL=XGSPCIAL_$P(XGKEYMAP(%),";")_U ; I $D(^TMP("XGW",$J,XGW,"G",XGG,"EVENT","KEYDOWN")) D I 1 ;if KEYDOWN event defined .S XGKEYMAP(99)="KEYDOWN^XGGT;KEYDOWN" S XGDTIME=DTIME ;preserve DTIME S DTIME=$S($D(XGT):$O(XGT(0,"")),1:9999999999) ;set to shortest active timer or infinite K DTOUT F Q:XGFLAG("ABORT") D . D EN^DIR0(T,L,$$CHAR^XGUTIL2(XGW,XGG,"SIZE",1)-2,"",^TMP("XGW",$J,XGW,"G",XGG,"VALUE"),$S(^("CHARMAX"):^("CHARMAX"),1:245),"",.XGKEYMAP,"AKPTW",.XGANS,.XGRT) . S ^TMP("XGW",$J,XGW,"G",XGG,"VALUE")=XGANS . S:'^TMP("XGW",$J,XGW,"G",XGG,"CHANGED")&($P(XGRT,U,2)) ^("CHANGED")=$P(XGRT,U,2) . S XGRT=$P(XGRT,U) . S:XGRT="TO" DTOUT=1 . S XGSAVKEY=XGRT ;save it since INIT^XGKB will clear XGRT . D INIT^XGKB("*") . S XGRT=XGSAVKEY ;rstore after INIT^XGKB cleared XGRT . S XGRT=$S(XGRT="N":"CR",XGRT="D":"DOWN",XGRT="PF4":"PF4",1:"") . I $D(DTOUT) D I 1 ;if read timed out . . S %=$O(XGT(0,"")) ;get timer interval . . S XGW1=$P(XGT(0,%,$O(XGT(0,%,"")),"ID"),U,1) ;get timers window name . . S XGT1=$P(XGT(0,%,$O(XGT(0,%,"")),"ID"),U,3) ;get timer name . . D:$D(^TMP("XGW",$J,XGW1,"T",XGT1,"EVENT","TIMER")) E^XGEVNT1(XGW1,"T",XGT1,"","TIMER") . E S XGFLAG("ABORT")=1 ;terminate read cycle S DTIME=XGDTIME ;restore previous value D SAY^XGS(T,L,$$LJ^XLFSTR(XGANS,($$CHAR^XGUTIL2(XGW,XGG,"SIZE",1)-2)_"T"),"U1I"_^TMP("XGW",$J,XGW,"G",XGG,"ACTIVE")) ; ; ;***** next 4 lines commented out on 2/1/95 ;E D ;. I ^TMP("XGW",$J,XGW,"G",XGG,"CHANGED") D ;. . S ^TMP("XGW",$J,XGW,"G",XGG,"VALUE")=XGANS ;. . D:$D(^TMP("XGW",$J,XGW,"G",XGG,"EVENT","CHANGE")) E^XGEVNT1(XGW,"G",XGG,"","CHANGE") W IOCUOFF Q ; ; COMPLETE(XGG) ;complete any missing info for a text gadget S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"ACTIVE")) ^("ACTIVE")=1 S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"CANCEL")) ^("CANCEL")=0 S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"CANCHANGE")) ^("CANCHANGE")=1 S ^TMP("XGW",$J,XGW,"G",XGG,"CHANGED")=0 S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"CHARMAX")) ^("CHARMAX")=0 S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"FRAMED")) ^("FRAMED")=1 S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"TPOS")) ^("TPOS")="TOP" S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"UNITS")) ^TMP("XGW",$J,XGW,"G",XGG,"UNITS")=^TMP("XGW",$J,XGW,"UNITS") S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"VALUE")) ^("VALUE")="" S:'$D(^TMP("XGW",$J,XGW,"G",XGG,"VISIBLE")) ^("VISIBLE")=1 Q ; ; DFLTSIZE(XGW1,XGG1) ;set default size N XGUNITS,X,Y S X=$P($G(^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE")),C,1) S Y=$P($G(^("SIZE")),C,2) ;ref ^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE") S XGUNITS=$P($G(^("SIZE")),C,3) ;ref ^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE") S:XGUNITS="" XGUNITS=^TMP("XGW",$J,XGW1,"G",XGG1,"UNITS") ; S:X="" X=10/XGUFCTR(XGUNITS,"X") ; set HORIZONTAL S:Y="" Y=1/XGUFCTR(XGUNITS,"Y") ; set VERTICAL ; S $P(^TMP("XGW",$J,XGW1,"G",XGG1,"SIZE"),C,1,2)=X_C_Y ;store the size Q ; ; KEYDOWN ;keydown processor ;Y contains either a key that the user pressed or an entry point ;entry point takes precedence. N XGKEY ;I Y?.8E1"^"1.8E D @Y I 1 ;if Y is some entry point do it ;E D ;. S (XGKEY,@XGEVENT@("KEY"))=Y ;. D E^XGEVNT1(XGW,"G",XGG,"","KEYDOWN") ;. S:XGKEY'["TAB"&(XGKEY'="CR")&(XGKEY'["PF4") Y="" I XGSPCIAL'[(U_Y_U) D I 1 . S (XGKEY,@XGEVENT@("KEY"))=Y . D E^XGEVNT1(XGW,"G",XGG,"","KEYDOWN") . S Y="" E D @Y Q ; ; S(XGW1,XGG1,XGATR,XGVAL) ;set attribute of TEXT or LISTENTRY gadget N XGOLDWIN N XGTXTVAL ;actual value of the text gadget N XGINSERT,XGSELOFF ;insert point, select offset ;remove following 4 commented lines after 01/01/95 ;D:XGW'=XGW1 ;.;S XGOLDWIN=XGW,XGW=XGW1 ;.S XGOLDWIN=XGW ;.D COORDW^XGUTIL1(XGW1,.XGWT,.XGWL,.XGWB,.XGWR) ; I XGATR="VALUE" D I 1 . S ^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE")=XGVAL . I XGFLAG("PAINT")=11!(XGFLAG("PAINT")=21) D ;do visible sideeffects . . I $G(@XGEVENT@("TYPE"))="KEYDOWN" D UPDATE^DIR0(XGVAL,99999) I 1 . . E D PAINT(XGW1,XGG1) ; E I XGATR="INSELECT",$D(^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE")) D I 1 . S XGTXTVAL=^TMP("XGW",$J,XGW1,"G",XGG1,"VALUE") . ;set and adjust INSERT and SELOFF according to MWAPI standard specs . S XGINSERT=$S($P(XGVAL,C)<0:0,$P(XGVAL,C)>$L(XGTXTVAL):$L(XGTXTVAL),1:$P(XGVAL,C)) . S XGSELOFF=$S((XGINSERT+$P(XGVAL,C,2))<0:-XGINSERT,(XGINSERT+$P(XGVAL,C,2))>$L(XGTXTVAL):$L(XGTXTVAL)-XGINSERT,1:$P(XGVAL,C,2)) . S ^TMP("XGW",$J,XGW1,"G",XGG1,"INSELECT")=XGINSERT_C_XGSELOFF . I XGFLAG("PAINT")=11!(XGFLAG("PAINT")=21) D UPDATE^DIR0(XGTXTVAL,XGINSERT+1) ; E D . S XGERR=XGERR_"-"_XGGTYP_" UNKNOWN ATTR AND/OR VALUE" . D HUH^XGUTIL2(XGERR) ; ;remove following 3 commented lines after 01/01/95 ;I $D(XGOLDWIN),$D(^TMP("XGW",$J,XGOLDWIN)) D ;.;S XGW=XGOLDWIN ;.D COORDW^XGUTIL1(XGW1,.XGWT,.XGWL,.XGWB,.XGWR) Q XGINENV^INT^1^60169,79033^0 XGINENV ;SF/STAFF - KERNEL VERSION 8 ENVIROMENT CHECK;2/22/93 10:56 ; ;;8.0T12;KERNEL;;Jun 03, 1994 N DIR,DIRUT,Y Q:'$D(^XTV(8995,0)) W !!,"This routines will delete all entries in the WINDOW OBJECT, #8995, and",!,"WINDOW CALL BACK, #8995.8, files. If you have added any data to either" W !,"of these two files, please run PCFILE^XGCSEND to save your changes.",!,"After you have run XGINIT you can then run PCFILE^XGCRECV to restore your",!,"changes.",! S DIR(0)="Y",DIR("A")="OK to continue",DIR("B")="NO" D ^DIR K:$D(DIRUT)!'Y DIFQ Q XGINPRE^INT^1^60169,79033^0 XGINPRE ;SF/STAFF - KERNEL VERSION 8 PRE-INITIALIZATION ;2/22/93 10:56 ; ;;8.0T12;KERNEL;;Jun 03, 1994 N I,X F I=8995,8995.8 S X=$P($G(^XTV(I,0)),"^",1,2) I X]"" K ^XTV(I) S ^(I,0)=X K ^XUTL("XGC") Q XGJUMP^INT^1^60169,79033^0 XGJUMP ;SFISC/VYD - Jump to gadget ;11/02/94 14:21 [ 01/14/95 10:39 AM ] ;;8.0T19;KERNEL;;Feb 22, 1995 CR ;Carriage Return / Enter key pressed to activate default button D:'$L(XGMENU)&('$D(XGFLAG("WINDOW MOVE"))) DEFBUTTN^XGGB Q ; ; TAB ;TAB key pressed = go to the next gadget S XGFLAG("ABORT")=1 ; stop current gadget processing loop S XGNEXTG=$S($D(XGFLAG("KEEP FOCUS")):XGG,1:^TMP("XGW",$J,XGW,"G",XGG,"YXGNEXTG")) S DIR0QT=1 ; terminate field editor read Q ; ; PF4 ;PF4 key pressed = go to the previous gadget S XGFLAG("ABORT")=1 ; stop current gadget processing loop S XGNEXTG=$S($D(XGFLAG("KEEP FOCUS")):XGG,1:^TMP("XGW",$J,XGW,"G",XGG,"YXGPREVG")) S DIR0QT="1^PF4" ; terminate field editor read Q ; ; UARROW ;"^" pressed to jump) N XGS,XGANS D SAVE^XGF(IOSL-2,0,IOSL-1,IOM-1,"XGS") D CLEAR^XGF(IOSL-2,0,IOSL-1,IOM-1) D SAY^XGF(IOSL-2,0,$TR($J("",IOM)," ",IOHL),"G1") D SAY^XGF(IOSL-1,0,"JUMP TO:") W IOCUON D EXIT^XGKB ;to turn off escape processing D EN^DIR0(IOSL-1,8,50,1,"","","","","AKPTW",.XGANS) W IOCUOFF D INIT^XGKB("*") D RESTORE^XGF("XGS") I XGANS[">>>" X $P(XGANS,">>>",2) Q ; ; KP0 ;go to window MENUBAR ;if MENUBAR window node identifies an existing menu I XGMENU="",$D(^TMP("XGW",$J,XGW,"M",$G(^TMP("XGW",$J,XGW,"MENUBAR"),U))) S XGMENU=^TMP("XGW",$J,XGW,"MENUBAR"),XGFLAG("ABORT")=1,DIR0QT=1 Q ; ; CTRLC ;break the program N Y X ^%ZOSF("PROGMODE") ZTRAP:Y "CANCEL" Q ; ; CTRLR ;window resize D:^TMP("XGW",$J,XGW,"RESIZE") . D:XGMENU'="" ABORT^XGM1A(999) . S (XGFLAG("ABORT"),XGFLAG("WINDOW RESIZE"))=1 . S DIR0QT=1 Q ; ; CTRLV ;window movement D:XGMENU'="" ABORT^XGM1A(999) S (XGFLAG("ABORT"),XGFLAG("WINDOW MOVE"))=1 S DIR0QT=1 Q ; ; CTRLW ;window selection I XGW'="XGWSEL" D I 1 . D:XGMENU'="" ABORT^XGM1A(999) . S (XGFLAG("ABORT"),XGFLAG("WINDOW SELECT"))=1 . S DIR0QT=1 E D ETR^XG("XGWSEL","EVENT","CLOSE") Q ; ; CTRLZ ;window close D:$D(^TMP("XGW",$J,XGW,"EVENT","CLOSE")) . D:XGMENU'="" ABORT^XGM1A(999) . S (XGFLAG("ABORT"),XGFLAG("WINDOW CLOSE"))=1 . S DIR0QT=1 Q ; ; CTRLBSL ;window control menu I XGMENU="~XGWM" D ABORT^XGM1A(1) I 1 E D I 1 . D:XGMENU'="" ABORT^XGM1A(999) . S XGMENU="~XGWM" . D M^XG(XGW,"M",XGMENU,$NA(^TMP("XGUTIL",$J,XGMENU))) . ;1=Restore 2=Move 3=Size 4=Minimize 5=Maximize 6=Close 7=Switch To... . S:'^TMP("XGW",$J,XGW,"RESIZE") ^("M",XGMENU,"CHOICE",3,"ACTIVE")=0 . S:'^TMP("XGW",$J,XGW,"ICONIFY")!(^("MIN")) ^("M",XGMENU,"CHOICE",4,"ACTIVE")=0 . S:'$D(^TMP("XGW",$J,XGW,"EVENT","CLOSE")) ^TMP("XGW",$J,XGW,"M",XGMENU,"CHOICE",6,"ACTIVE")=0 . K:XGW="XGWSEL" ^TMP("XGW",$J,XGW,"M",XGMENU,"CHOICE",7) . S XGFLAG("ABORT")=1 . S DIR0QT=1 Q XGKB^INT^1^60169,79033^0 XGKB ;SFISC/VYD - Read with Escape Processing ;07/10/2002 10:58 ;;8.0;KERNEL;**34,244**;Jul 10, 1995 ;;Special thanks to MELDRUM.KEVIN@ISC-SLC.VA.GOV ; INIT(XGTRM) ;turn escape processing on and passed terminator string if any N %,%OS S %OS=^%ZOSF("OS") I %OS["VAX DSM" U $I:(NOLINE:ESCAPE) D:'$D(^XUTL("XGKB")) VAXDSM^XGKB1 I %OS["MSM" U $I:(0::::64) D:'$D(^XUTL("XGKB")) MSM^XGKB1 I %OS["DTM" U $I:(VT=1:ESCAPE=1) D:'$D(^XUTL("XGKB")) DTM^XGKB1 I %OS["OpenM" U $I:(:"CT") D:'$D(^XUTL("XGKB")) DTM^XGKB1 I %OS["GT.M" U $I:(ESCAPE) D:'$D(^XUTL("XGKB")) GTM^XGKB1 I $G(XGTRM)="*" X ^%ZOSF("TRMON") I 1 ;turn all on E I $L($G(XGTRM)) S %=$$SETTRM^%ZOSV(XGTRM) ;turn on passed terminators S XGRT="" Q ; ; EXIT ; Reset device (disable escape processing, turn terminators off) N %OS S %OS=^%ZOSF("OS") I %OS["VAX DSM" U $I:(LINE:NOESCAPE) I %OS["MSM" U $I:(0:::::64) I %OS["DTM" U $I:(ESCAPE=0) I %OS["GT.M" U $I:(NOESCAPE) X ^%ZOSF("TRMOFF") K XGRT Q ; ; ACTION(XGKEY,XGACTION) ;add or remove key-action ;XGKEY:key mnemonic ("F10","NEXT",etc.) ;XGACTION:M executable string ;if action is passed ADD mode is assumed otherwise REMOVE I $D(XGACTION) S ^TMP("XGKEY",$J,XGKEY)=XGACTION E K ^TMP("XGKEY",$J,XGKEY) Q ; ; READ(XGCHARS,XGTO) ; read XGCHARS using escape processing. XGTO timeout (optional). Result returned. ; Char that terminated the read will be in XGRT N S,XGW1,XGT1,XGSEQ ;string,window,timer,timer sequence K DTOUT S XGRT="" D:$G(XGTO)="" ;set timeout value if one wasn't passed . I $D(XGT) D Q ;if timers are defined . . S XGTO=$O(XGT(0,"")) ;get shortest time left of all timers . . S XGW1=$P(XGT(0,XGTO,$O(XGT(0,XGTO,"")),"ID"),U,1) ;get timer's window . . S XGT1=$P(XGT(0,XGTO,$O(XGT(0,XGTO,"")),"ID"),U,3) ;get timer's name . I $D(XGW) S XGTO=99999999 Q ;in emulation read forever . S XGTO=$G(DTIME,600) ; I $G(XGCHARS)>0 R S#XGCHARS:XGTO S:'$T DTOUT=1 I 1 ;fixed length read E R S:XGTO S:'$T DTOUT=1 I 1 ;read as many as possible S:$G(DTOUT)&('$D(XGT1)) S=U ;stuff ^ ; S:$L($ZB) XGRT=$G(^XUTL("XGKB",$ZB)) ;get terminator if any I $G(DTOUT),$D(XGT1),$D(^TMP("XGW",$J,XGW1,"T",XGT1,"EVENT","TIMER")) D I 1 ;if timed out . D E^XGEVNT1(XGW1,"T",XGT1,"","TIMER") E I $L(XGRT),$D(^TMP("XGKEY",$J,XGRT)) X ^(XGRT) ;do some action ; this really should be handled by keyboard mapping -- later Q S ; ; TEST F S X=$$READ Q:X["^" W ?20,X,?40,XGRT,?60,$ZB,! Q XGKB1^INT^1^60169,79033^0 XGKB1 ;SFISC/VYD - Read with Escape Processing cont. ;06/19/2002 13:18 ;;8.0;KERNEL;**244**;Jul 10, 1995 ;;Special thanks to MELDRUM.KEVIN@ISC-SLC.VA.GOV ; VAXDSM ; $ZB ($KEY) values for VAX DSM MSM ; $ZB ($KEY) values for MSM GTM ; $ZB ($KEY) values for GT.M F I=2:1:31 D . S X=$TR($T(KBD+I)," ","") . S ^XUTL("XGKB",$P(X,";",4))=$P(X,";",3) F I=29:1 S X=$TR($T(KBD+I)," ","") Q:$P(X,";",3)="ZZZ" D . S ^XUTL("XGKB",$P(X,";",4)*256+27)=$P(X,";",3) Q ; ; DTM ; $ZB ($KEY) values for DTM F I=2:1 S X=$TR($T(KBD+I)," ","") Q:$P(X,";",3)="ZZZ" D . S @("^XUTL(""XGKB"",$C("_$P(X,";",5)_"))=$P(X,"";"",3)") Q ; ; KBD ; $KEY values for DSM, MSM, and DTM when using escape processing ; Key ;DSM ;DTM (MSM is the same as DSM) ;;^A ;1 ;1 ;;^B ;2 ;2 ;;^C ;3 ;3 ;;^D ;4 ;4 ;;^E ;5 ;5 ;;^F ;6 ;6 ;;^G ;7 ;7 ;;^H ;8 ;8 ;;TAB ;9 ;9 ;;^J ;10 ;10 ;;^K ;11 ;11 ;;^L ;12 ;12 ;;CR ;13 ;13 ;;^N ;14 ;14 ;;^O ;15 ;15 ;;^P ;16 ;16 ;;^Q ;17 ;17 ;;^R ;18 ;18 ;;^S ;19 ;19 ;;^T ;20 ;20 ;;^U ;21 ;21 ;;^V ;22 ;22 ;;^W ;23 ;23 ;;^X ;24 ;24 ;;^Y ;25 ;25 ;;^Z ;26 ;26 ;;^\ ;28 ;28 ;;^] ;29 ;29 ;;^6 ;30 ;30 ;;^_ ;31 ;31 ;;KP0 ;0 ;27,79,112 ;;KP1 ;1 ;27,79,113 ;;KP2 ;2 ;27,79,114 ;;KP3 ;3 ;27,79,115 ;;KP4 ;4 ;27,79,116 ;;KP5 ;5 ;27,79,117 ;;KP6 ;6 ;27,79,118 ;;KP7 ;7 ;27,79,119 ;;KP8 ;8 ;27,79,120 ;;KP9 ;9 ;27,79,121 ;;UP ;17 ;27,91,65 ;;DOWN ;18 ;27,91,66 ;;RIGHT ;19 ;27,91,67 ;;LEFT ;20 ;27,91,68 ;;FIND ;21 ;27,91,49,126 ;;INSERT ;22 ;27,91,50,126 ;;REMOVE ;23 ;27,91,51,126 ;;SELECT ;24 ;27,91,52,126 ;;PREV ;25 ;27,91,53,126 ;;NEXT ;26 ;27,91,54,126 ;;KPENTER ;29 ;27,79,77 ;;PF1 ;32 ;27,79,80 ;;PF2 ;33 ;27,79,81 ;;PF3 ;34 ;27,79,82 ;;PF4 ;35 ;27,79,83 ;;F6 ;37 ;27,91,49,55,126 ;;F7 ;38 ;27,91,49,56,126 ;;F8 ;39 ;27,91,49,57,126 ;;F9 ;40 ;27,91,50,48,126 ;;F10 ;41 ;27,91,50,49,126 ;;F11 ;43 ;27,91,50,51,126 ;;F12 ;44 ;27,91,50,52,126 ;;F13 ;45 ;27,91,50,53,126 ;;F14 ;46 ;27,91,50,54,126 ;;HELP ;48 ;27,91,50,56,126 ;;DO ;49 ;27,91,50,57,126 ;;F17 ;51 ;27,91,51,49,126 ;;F18 ;52 ;27,91,51,50,126 ;;F19 ;53 ;27,91,51,51,126 ;;F20 ;54 ;27,91,51,52,126 ;;KP- ;60 ;27,79,109 ;;KP+ ;61 ;27,79,108 ;;KP. ;62 ;27,79,110 ;;ZZZ XGKILL^INT^1^60169,79033^0 XGKILL ;SFISC/VYD - kill WINDOW, DISPLAY, EVENT ;01/30/95 14:39 [ 02/12/95 11:26 AM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ; K ;K-WAPI equivalent of MWAPI KILL ^$W... N XGOLDPF,XGERR,XGW1,XGT1,XGG1 ;old paint flag, error N XGOLDVAL,XGNEWVAL N % S XGOLDPF=XGFLAG("PAINT") ;save previous S XGERR="KILL" S C="," D:$G(P1)="XGW"&($G(P2)=$J) ;adjst prms cause physical root was passed . F %=3:1:11 I $D(@("P"_%)) S @("P"_(%-2)_"=P"_%) K @("P"_%) D . ;-------- ALL WINDOWS . ;ex: K ^$W . I '$D(P1) D Q . . K XGSCRN("ORDER"),XGSCRN("ORDERX") ;clear window draw order stack . . S XGSCRN("ORDER",0)=$C(1) ;put back wall paper as the bckgrnd win . . S %=$C(1) ;start with window after wall paper . . F S %=$O(^TMP("XGS",$J,%)) Q:%="" K ^(%) . . K ^TMP("XGW",$J) . . D KILL^XGT() ;kill all timers for all windows . . D RESTORE^XGSW($NA(^TMP("XGS",$J,$C(1)))) ;put up wall paper . . S ^TMP("XGD",$J,$PD,"FOCUS")="" . ; . ;-------- ONE WINDOW . ;ex: K ^$W(P1) . I '$D(P2) D:$L(P1) Q . . D:$D(XGSCRN("ORDERX",P1)) REMOVE^XGWIN1(P1) ;erase window if vsble . . D KILL^XGT(P1) ;kill all timers for thiw window . . K ^TMP("XGW",$J,P1) . . D CHGFOCUS^XGWIN1(P1) ;chng focus if its on a window being killed . ; . ;-------- all Gadgets/Menus/Timers/some win attribute in window P1 . ;ex: K ^$W(P1,"G") K ^$W(P1,"T") K ^$W(P1,"ACTIVE") . I '$D(P3) D Q . . I P2="G" D Q ;----- all Gadgets in window P1 . . . K ^TMP("XGW",$J,P1,"G") . . . ;**** next 3 lines commented out 1/1/95 **** . . . ;D:$D(XGSCRN("ORDERX",P1)) ;if P1 is already on screen . . . ;. I P1'=XGW,$D(XGSCRN("ORDERX",XGW)) D SAVE^XGSW(XGWT,XGWL,XGWB,XGWR,$NA(^TMP("XGS",$J,XGW))) ;if altering background window, save current . . . ;. D WINP^XGWIN(P1) . . . D:$D(XGSCRN("ORDERX",P1)) WINP^XGWIN(P1) ;if P1 is already on screen . . ; . . I P2="M" D Q ;----- all Menus in window P1 . . . D PAINTFLG^XGUTIL2(P1) . . . I $L($G(^TMP("XGW",$J,P1,"MENUBAR"))),$D(^TMP("XGW",$J,P1,"M",^("MENUBAR"))) S XGFLAG("PAINT")=XGFLAG("PAINT")+1 . . . K ^TMP("XGW",$J,P1,"M") . . . D:"^10^20^"[(U_XGFLAG("PAINT")_U) MBARP^XGM1A(P1) . . . ;*** Note: visible sideeffect for POP-UP menus isn't supported yet . . ; . . I P2="T" D Q ;----- all Timers in window P1 . . . D KILL^XGT(P1) . . ; . . I P2="ACTIVE" D Q ;----- ^$W("W1","ACTIVE") . . . K ^TMP("XGW",$J,P1,"ACTIVE") . . . D COMPLETE^XGWIN(P1) . . . ;no visible sideeffects . . ; . . I P2="DEFBUTTON" D Q ;----- ^$W("W1","DEFBUTTON") . . . S XGG1=$G(^TMP("XGW",$J,P1,"DEFBUTTON")) . . . D PAINTFLG^XGUTIL2(P1,"G",XGG1) . . . K ^TMP("XGW",$J,P1,"DEFBUTTON") . . . D:"^11^21^"[(U_XGFLAG("PAINT")_U) . . . . D PAINT^XGG(P1,XGG1) ;paint button as normal (not default) . . ; . . I P2="EVENT" D Q ;----- ^$W("W1","EVENT") . . . K ^TMP("XGW",$J,P1,"EVENT") . . . ;no visible sideeffects . . ; . . ;I P2="ICON" D Q . . ; . . ;I P2="ITITLE" D Q . . ; . . I P2="MENUBAR" D Q . . . D PAINTFLG^XGUTIL2(P1) . . . S XGFLAG("PAINT")=XGFLAG("PAINT")+$D(^TMP("XGW",$J,P1,"MENUBAR")) . . . K ^TMP("XGW",$J,P1,"MENUBAR") . . . D:"^11^21^"[(U_XGFLAG("PAINT")_U) . . . . D REMOVE^XGWIN1(P1) . . . . D DFLTSIZE^XGWIN(P1) . . . . ;adjust TOP and BOTTOM coordinate of all gadgets . . . . S XGG1="" . . . . F S XGG1=$O(^TMP("XGW",$J,P1,"G",XGG1)) Q:XGG1="" D . . . . . S $P(^("YXGCOORDS"),U)=$P(^TMP("XGW",$J,P1,"G",XGG1,"YXGCOORDS"),U)-1,$P(^("YXGCOORDS"),U,3)=$P(^("YXGCOORDS"),U,3)-1 . . . . D WINP^XGWIN(P1,1) . . ; . . ;I P2="MIN" D Q . . ; . . I P2="NEXTG" D Q ;----- ^$W("W1","NEXTG") . . . K ^TMP("XGW",$J,P1,"NEXTG") . . . D COMPLETE^XGWIN(P1) . . . ;no visible sideeffects . . ; . . I "^POS^SIZE^"[(U_P2_U) D Q ;--- ^$W("W1","POS") . . . ;save old window position and actual screen coordinates . . . S XGOLDVAL=^TMP("XGW",$J,P1,P2)_";"_^("YXGCOORDS") . . . K ^TMP("XGW",$J,P1,P2) . . . D COMPLETE^XGWIN(P1) ;set default position/size . . . D DFLTSIZE^XGWIN(P1) ;set screen coordinates . . . D:XGOLDVAL'=(^TMP("XGW",$J,P1,P2)_";"_^("YXGCOORDS")) . . . . D PAINTFLG^XGUTIL2(P1) . . . . ;if window is on the screen and coordinates are different . . . . I "^10^20^"[(U_XGFLAG("PAINT")_U),$P(XGOLDVAL,";",2)'=^TMP("XGW",$J,P1,"YXGCOORDS") D . . . . . S XGNEWVAL=^TMP("XGW",$J,P1,"YXGCOORDS") ;save new coords . . . . . S ^TMP("XGW",$J,P1,"YXGCOORDS")=$P(XGOLDVAL,";",2) ;put old ones . . . . . D REMOVE^XGWIN1(P1) . . . . . S ^TMP("XGW",$J,P1,"YXGCOORDS")=XGNEWVAL ;restore new coords . . . . . D WINP^XGWIN(P1,1) . . . . I P2="POS",$D(^TMP("XGW",$J,P1,"EVENT","MOVE")) D E^XGEVNT1(P1,"","","","MOVE") I 1 . . . . E I P2="SIZE",$D(^TMP("XGW",$J,P1,"EVENT","RESIZE")) D E^XGEVNT1(P1,"","","","RESIZE") . . ; . . ;---- SIZE see POS . . ; . . ;I P2="SIZEMIN" D Q . . ; . . ;I P2="TITLE" D Q . . ; . . ;I P2="UNITS" D Q . . ; . . ;I P2="VISIBLE" D Q . . ; . . I $E(P2)="Y" D Q ;--- ^$W("W1","YANYTHING") . . . K ^TMP("XGW",$J,P1,P2) . . ; . . I "^BCOLOR^COLOR^FCOLOR^FFACE^FSIZE^FSTYLE^EVENT^"[(U_P2_U) D Q . . . K ^TMP("XGW",$J,P1,P2) . . ; . . S XGERR=XGERR_"-window attribute "_P2_" in window "_P1 . . D HUH^XGUTIL2(XGERR) . ; . ;-------- some EVENT/GADGET/MENU/TIMER in window P1 . ;ex: K ^$W(P1,"G",P3) K ^$W(P1,"EVENT",P3) . I '$D(P4) D Q . . I P2="EVENT" D Q . . . K ^TMP("XGW",$J,P1,"EVENT",P3) . . I P2="G" D Q . . . D S^XG(P1,"G",P3,"VISIBLE",0) ;erase the gadget first . . . K ^TMP("XGW",$J,P1,"G",P3) . . ;I P2="M" D Q . . I P2="T" D Q ;----- a TIMER in window . . . D KILL^XGT(P1,P3) . . S XGERR=XGERR_"- MENU in window "_P1 . . D HUH^XGUTIL2(XGERR) . ; . ;-------- some window EVENT/GADGET/MENU/TIMER attribute/events/choices . ;ex: K ^$W(P1,"G",P3,"CHOICE") K ^$W(P1,"EVENT",P3,"ENABLE") . I '$D(P5) D Q . . ;I P2="EVENT" D Q ;------ window event attribute . . I P2="G" D Q ;------ gadget attribute/events/choices . . . I P4="CHOICE" D Q . . . . I "LIST,LONGLIST"[^TMP("XGW",$J,P1,"G",P3,"TYPE") D KC^XGGL1(P1,P3) Q . . . I P4="VALUE" D Q . . . . I "LIST,LONGLIST"[^TMP("XGW",$J,P1,"G",P3,"TYPE") D KV^XGGL1(P1,P3) Q . . . . K ^TMP("XGW",$J,P1,"G",P3,"VALUE") . . . . D COMPLETE^XGG(P1,P3) . . . . D PAINTFLG^XGUTIL2(P1,"G",P3) . . . . D:"^11^21^"[(U_XGFLAG("PAINT")_U) PAINT^XGG(P1,P3) . . . I $E(P4)="Y" K ^TMP("XGW",$J,P1,"G",P3,P4) Q . . . S XGERR=XGERR_"-some GADGET attribute" . . . D HUH^XGUTIL2(XGERR) . . I P2="M" D Q ;------ menu attribute/events/choices . . . I $E(P4)="Y" K ^TMP("XGW",$J,P1,"M",P3,P4) Q . . . S XGERR=XGERR_"-some MENU attribute" . . . D HUH^XGUTIL2(XGERR) . . I P2="T" D Q ;------ timer attribute/event . . . I $E(P4)="Y" K ^TMP("XGW",$J,P1,"T",P3,P4) Q . . . S XGERR=XGERR_"-some TIMER attribute" . . . D HUH^XGUTIL2(XGERR) . . S XGERR=XGERR_"- win event attr or an element attr/events/choices" . . D HUH^XGUTIL2(XGERR) . ; . ;-------- some CHOICE/VALUE or event . ;ex: K ^$W(P1,"G",P3,"CHOICE",P5) K ^$W(P1,"G",P3,"VALUE",P5) . I '$D(P6) D Q . . I P2="G" D Q ;------ gadget attribute/events/choices . . . I P4="VALUE" D Q . . . . I "LIST,LONGLIST"[^TMP("XGW",$J,P1,"G",P3,"TYPE") D KV^XGGL1(P1,P3,P5) Q . . . . S XGERR=XGERR_"-some gadget value" D HUH^XGUTIL2(XGERR) . . . S XGERR=XGERR_"-some gadget attribute" . . . D HUH^XGUTIL2(XGERR) . . ;I P2="M" D Q ;------ menu attribute/events/choices . . ;I P2="T" D Q ;------ timer attribute/event . . S XGERR=XGERR_"- win event attr or an element attr/events/choices" . . D HUH^XGUTIL2(XGERR) . ; . ;-------- some CHOICE/EVENT attribute . ; ex: K ^$W(P1,"G",P3,"CHOICE",P5,"ACTIVE") . ; ex: K ^$W(P1,"G",P3,"EVENT",P5,"ENABLE") . I '$D(P7) D Q . . K ^TMP("XGW",$J,P1,P2,P3,P4,P5,P6) . . I P4="CHOICE" D CCHOICE^XGG(P1,P2,P3,P5) Q ;complete one choice . . D COMPLET2^XGEVNT1(P1,P2,P3,"",P5) ;complete one event . ; . ;-------- some choice event . ; ex: K ^$W(P1,"G",P3,"CHOICE",P5,"EVENT",P7) where P7 is SELECT . I '$D(P8) D Q . . K ^TMP("XGW",$J,P1,P2,P3,P4,P5,P6,P7) . ; . ;-------- some choice event attribute . ; ex: K ^$W(P1,"G",P3,"CHOICE",P5,"EVENT",P7,"ENABLE") . D Q . . K ^TMP("XGW",$J,P1,P2,P3,P4,P5,P6,P7,P8) . . D COMPLET2^XGEVNT1(P1,P2,P3,P5,P7) ;complete one event ; S XGFLAG("PAINT")=XGOLDPF ;restore previous U:^%ZOSF("OS")["VAX DSM" IO(0):FLUSH ;update screen immediately Q ; ; KE ;kill event attribute N XGERR S XGERR="KILL-EVENT" S C="," I P1="OK" S XGERR=XGERR_"-OK ATTR BEING KILLED" D HUH^XGUTIL2(XGERR) E S XGERR=XGERR_"-UNKNOWN ATTR" D HUH^XGUTIL2(XGERR) Q ; ; KD ;K-WAPI equivalent of MWAPI KILL ^$W... N XGERR S C="," S XGERR="KILL-DISPLAY-UNKNOWN ATTR" D HUH^XGUTIL2(XGERR) Q XGL^INT^1^60169,79033^0 XGL ;ISC-SF.SEA/JLI,RWF - BASIC GRAPHICS LIBRARY ; ;;8.0T19;KERNEL;;Feb 22, 1995 GETVAL(GADNAM,OARRAY,XWIN) ; Q $$GET^XGLVAL(GADNAM,$G(OARRAY),$G(XWIN)) ; TEXTLIST(IOARRAY) ; Q $$TEXTLIST^XGCDIC1(.IOARRAY) ; DIR ; S X=$$DIR^XGCDIR(.DIR,.Y) Q ; FSELECT(FILE) ; S FILE=$G(FILE) Q $$SETFILE^XGCDIC2(.FILE) ; EDITDOC(DOCARRAY) ; D EDITDOC^XGCWDOC(DOCARRAY) Q SELARR(INARRAY,TITLE) ; Q $$SELARR^XGCDIC(INARRAY,$G(TITLE)) ; SELARRM(INARRAY,XGCARRAY,TITLE,NVALS) ; Q $$SELARRM^XGCDIC(INARRAY,.XGCARRAY,$G(TITLE),$G(NVALS)) XGLDEMO1^INT^1^60169,79033^0 XGLDEMO1 ;SFISC/RWF - TO TEST DEMO WINDOW FROM A CALLBACK ;09/28/94 11:39 ;;8.0T19;KERNEL;;Feb 22, 1995 TEST ; D GO^XGCLOAD("XGL DEMO1","TEST") Q ; ; DO ;In DO callback N WINDOW S WINDOW=@XGEVENT@("WINDOW") ;get the window name S A=$G(@XGWIN@(WINDOW,"G","WHAT","VALUE")) I A]"" D @A Q ; ; EX D ESTO^XG Q XGLDEMO2^INT^1^60169,79033^0 XGLDEMO2 ;SFISC/RWF - DEMO DRAW ;2/22/93 08:32 ;;8.0T19;KERNEL;;Feb 22, 1995 A ; N WNM S WNM=$$NEXTNM^XGCLOAD("DEMO") D LOAD^XGCLOAD("XGL DEMO2",WNM) D SD^XG(WNM,"FOCUS","DEMO,DRAW") S POINTS=10 D S^XG(WNM,"G","NUM","VALUE",POINTS) Q DRAW ;Call back to draw N WNM S WNM=@XGEVENT@("WINDOW") I $D(%DEBUG) W !,"Draw window ",WNM D SETUP D DRAWA,DRAWL I $D(%DEBUG) W !,"End Draw" Q DRAWA ;Draw the circle D ADD("FCOLOR,0,0,0"),ADD("PENSIZE,1") D ADD("ARC,"_HPOS_","_VPOS_","_RADIUS_",0,360") Q DRAWL ;Draw the lines S C="," F I=1:1:POINTS D . F J=I+1:1:POINTS D . . S EI=$S(J>POINTS:J#POINTS+1,1:J) . . D ADD("LINE,"_ARC(I)_C_ARC(EI)) Q ADD(CMD) ;Add to draw list N X S X=$G(ARC("C"))+1,ARC("C")=X D S^XG(WNM,"G","AREA","DRAW",X,CMD) Q SETUP ; N X,Y S POINTS=$G(@XGWIN@(WNM,"G","NUM","VALUE"),10) I (POINTS<5)!(POINTS>16) D . S POINTS=10 D S^XG(WNM,"G","NUM","VALUE",POINTS) . Q K ARC D K^XG(WNM,"G","AREA","DRAW") S ARC=$J(360/POINTS,1,3),HPOS=125,VPOS=125,RADIUS=100 F I=1:1:POINTS D . S X=$$COSDEG^XLFMTH(ARC*I)*RADIUS+HPOS+.5\1 . S Y=$$SINDEG^XLFMTH(I*ARC)*RADIUS+VPOS+.5\1 . S ARC(I)=X_","_Y Q QUIT ; N WNM S WNM=@XGEVENT@("WINDOW") D K^XG(WNM) Q XGLDEMO3^INT^1^60169,79033^0 XGLDEMO3 ;SFISC/VYD - DEMO DRAW ;02/18/94 16:48 ;;8.0T19;KERNEL;;Feb 22, 1995 A ; S C="," N WNM S WNM=$$NEXTNM^XGCLOAD("DEMO") D LOAD^XGCLOAD("XGL DEMO3",WNM) D SD^XG(WNM,"FOCUS","DEMO,DRAW") S POINTS=10 D S^XG(WNM,"G","NUM","VALUE",POINTS) Q DRAW ;Call back to draw N WNM S WNM=@XGEVENT@("WINDOW") D K^XG(WNM,"G","AREA","DRAW") D SETUP I $G(%DEBUG) ZW ARC D DRAWL Q DRAWA ;Draw the circle Q DRAWL ;Draw the lines F I=0:1:POINTS D .S X=COORD("X1")+(OFFSET("X")*I) .S Y=COORD("Y1")+(OFFSET("Y")*I) .D ADD("LINE,"_X_C_COORD("Y1")_C_COORD("X2")_C_Y) F I=0:1:POINTS D .S X=COORD("X2")-(OFFSET("X")*I) .S Y=COORD("Y1")+(OFFSET("Y")*I) .D ADD("LINE,"_COORD("X2")_C_Y_C_X_C_COORD("Y2")) F I=0:1:POINTS D .S X=COORD("X2")-(OFFSET("X")*I) .S Y=COORD("Y2")-(OFFSET("Y")*I) .D ADD("LINE,"_X_C_COORD("Y2")_C_COORD("X1")_C_Y) F I=0:1:POINTS D .S X=COORD("X1")+(OFFSET("X")*I) .S Y=COORD("Y2")-(OFFSET("Y")*I) .D ADD("LINE,"_COORD("X1")_C_Y_C_X_C_COORD("Y1")) Q ADD(CMD) ;Add to draw list N X S X=$G(ARC("C"))+1,ARC("C")=X D S^XG(WNM,"G","AREA","DRAW",X,CMD) Q SETUP ; S POINTS=$G(@XGWIN@(WNM,"G","NUM","VALUE"),10) S OFFSET("X")=$P(@XGWIN@(WNM,"G","AREA","SIZE"),C)/POINTS S OFFSET("Y")=$P(@XGWIN@(WNM,"G","AREA","SIZE"),C,2)/POINTS S COORD("X1")=0 S COORD("X2")=$P(@XGWIN@(WNM,"G","AREA","SIZE"),C) S COORD("Y1")=0 S COORD("Y2")=$P(@XGWIN@(WNM,"G","AREA","SIZE"),C,2) D ADD("FCOLOR,0,0,0"),ADD("PENSIZE,1") Q QUIT ; N WNM S WNM=@XGEVENT@("WINDOW") D K^XG(WNM) Q XGLDEMO4^INT^1^60169,79033^0 XGLDEMO4 ;SFISC/RWF - DEMO DRAW ;3/21/93 09:55 ;;8.0T19;KERNEL;;Feb 22, 1995 TEST ;Test the time D TIME(30) Q ; TIME(SEC) ; N WNM,TMP,IX S WNM=$$NEXTNM^XGCLOAD("DEMO") D LOAD^XGCLOAD("XGL DEMO4",WNM) S TMP("TICK","ACTIVE")=1,TMP("TICK","INTERVAL")=1 S TMP("TICK","EVENT","TIMER")="TICK^XGLDEMO4" D M^XG(WNM,"T","TMP") D SD^XG($PD,"FOCUS",WNM) D K^XG(WNM,"G","AREA","DRAW") D CIRCLE S ^TMP("XGD",$J,WNM)=(360\SEC)_"^0^"_IX Q CIRCLE ;Draw the circle S HPOS=125,VPOS=125,RADIUS=100 D ADD("FCOLOR,0,0,0"),ADD("PENSIZE,1") D ADD("ARC,"_HPOS_","_VPOS_","_RADIUS_",0,360") D ADD("BCOLOR,0,0,0,OPAQUE") Q TICK ; N I,IX,S,E,CNT,P,WNM S WNM=@XGEVENT@("WINDOW") S P=^TMP("XGD",$J,WNM),I=+P,CNT=$P(P,"^",2),IX=$P(P,"^",3) I CNT'<360 G CLEAR S S=$$DEG(CNT),CNT=CNT+I,E=$$DEG(CNT) I SB:A,1:B) MIN(A,B) ; Q $S(AXGLDEVMX XGLDEVMX=XGLDEVFW .I XGLDEVOS["VAX DSM" D VXDDBVAL .E D MSMDBVAL ERR S Y=XGLDEVMX_","_$P(XGLDEVFH,",",2,3) D S^XG(XGLDEVDW,"G","DOCBOX","SIZE",Y) S Y=(XGLDEVMX+100)_","_($P(XGLDEVFH,",",2)+50)_","_$P(XGLDEVFH,",",3) D S^XG(XGLDEVDW,"SIZE",Y) D S^XG(XGLDEVDW,"VISIBLE",1) G ESTART:XGLDEVNT="" D CLEAN Q ESTART ;Start event processing. ;D SD^XG($PD,"FOCUS",XGLDEVDW) S ^$DI($PD,"FOCUS")=XGLDEVDW D ESTA^XG() D K^XG(XGLDEVDW) D CLEAN Q ; CLEAN K %X,%Y,%ZCR,%1,XGLDEVDW,XGLDEVFF,XGLDEVFH,XGLDEVFS,XGLDEVFW,XGLDEVMX,XGLDEVOS,XGLDEVZC,ZOSFV Q V2CL2 S %1=$F(%2,$C(12)) I %1>0 S %=%+1,%2=$E(%2,1,%1-2)_$E(%2,%1,$L(%2)) S %=%+1 S XGLDEVFW=$$WTWIDTH^XG(%X,XGLDEVFF,XGLDEVFS,"NORMAL","PIXEL") S:XGLDEVFW>XGLDEVMX XGLDEVMX=XGLDEVFW Q ; MSMDBVAL ;S ^$W(XGLDEVDW,"G","DOCBOX","VALUE")=^$W(XGLDEVDW,"G","DOCBOX","VALUE")_%X_$C(13,10) S @XGWIN@(XGLDEVDW,"G","DOCBOX","VALUE")=@XGWIN@(XGLDEVDW,"G","DOCBOX","VALUE")_%X_$C(13,10) Q VXDDBVAL S %1=%1+1 S Y=%X_$C(13,10) D S^XG(XGLDEVDW,"G","DOCBOX","VALUE",%1,Y) Q ; CLOSE ;Callback to close document box. S XGLDEVWN=$G(@XGEVENT@("WINDOW")) I XGLDEVWN]"",$G(@XGWIN@(XGLDEVWN,"PARENT"))]"" D Q .D K^XG(XGLDEVWN) K XGLDEVWN Q D ESTO^XG K XGLDEVWN Q XGLDOC^INT^1^60169,79033^0 XGLDOC ;ISC-SF.SEA/JLI - LIBRARY GUI DOCUMENT FUNCTIONS ;12/16/94 12:49 ;;8.0T19;KERNEL;;Feb 22, 1995 DLDOC(WINREF,ARREF,MAXLEN) ; FUNCTION returns the number of lines in ARREF ; after downloading the document from the document gadget identified ; in WINREF Q $$DLDOC^XGC02(WINREF,ARREF,MAXLEN) ; ULDOC(WINREF,ARREF,MAXLEN) ; simple call to move text from the array specied ; by the root ARREF into the document gadget root in WINREF D ULDOC^XGC02(WINREF,ARREF,MAXLEN) Q XGLKEY^INT^1^60169,79033^0 XGLKEY ;SFISC/RWF - MWAPI Key mapping utilities ;01/26/94 10:36 ;;8.0T19;KERNEL;;Feb 22, 1995 KEYCNV(KEY) ;Convert KEYUP punction to value N %,F I $L(KEY)>1 D . I '$D(KEYNM) S KEYNM(1)=$P($T(KEYNM),";;",2),KEYNM(2)=$P($T(KEYNM+1),";;",2) . S F=$TR(KEY,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") . S %=$F(KEYNM(1),F) S:%>0 KEY=$E(KEYNM(1),%) I %<1 S %=$F(KEYNM(2),F) S:%>0 KEY=$E(KEYNM(2),%) . Q Q KEY KEYUP ; I $D(%DEBUG) D . U $P W ! S X="^$E" F S X=$Q(@X) Q:X="" W !,X," = ",@X . W ! . Q N GNM,WNM,KEY S WNM=@XGEVENT@("WINDOW"),X=@XGEVENT@("ELEMENT"),GTYPE=$P(X,","),GNM=$P(X,",",2) S KEY=$$UCASE(@XGEVENT@("KEY")),VALUE=$G(TMP(GNM)) I KEY="DELETE" S VALUE=$E(VALUE,1,$L(VALUE)-1) I $L(KEY)>1 S KEY=$$KEYCNV(KEY) I $L(KEY)=1 S VALUE=VALUE_KEY S X=$TR($J("",$L(VALUE))," ","*"),TMP(GNM)=VALUE D S^XG(WNM,"G",GNM,"VALUE",X),S^XG(WNM,"G",GNM,"INSELECT",$L(X)_",0") Q UCASE(%) ; Q $TR(%,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") KEYNM ;;AMPERSAND&APOSTROPHE'ASCIICIRCUM^ASCIITILDE~ASTERISK*AT@BACKSLASH\BAR|BRACELEFT{BRACERIGHT}BRACKETLEFT[BRACKETRIGHT]COLON:COMMA, ;;DOLLAR$EQUAL=EXCLAM!GRAVE`GREATER>LESS20) D . S X=$E(MSG(I),1,78) . S FW=$$WTWIDTH^XG(X,FF,12,"NORMAL","PIXEL") S:FW>MAX MAX=FW . S WBOX(WNM,"G","LAB"_Y,"TITLE")=X . S WBOX(WNM,"G","LAB"_Y,"POS")=POS_","_(Y-1*FH+FO)_",PIXEL" . S WBOX(WNM,"G","LAB"_Y,"TYPE")="LABEL" . Q ; build MSG window S X=$$MAX^XLFMTH(MAX+70,340),Y=$$MAX^XLFMTH((Y*FH)+60,140) S WBOX(WNM,"SIZE")=X_","_Y,WBOX(WNM,"UNITS")="PIXEL" ;Size the title lines to all be the same S I="LAB" F S I=$O(WBOX(WNM,"G",I)) Q:I'["LAB" D . S WBOX(WNM,"G",I,"SIZE")=(X-70)_","_FH_",PIXEL" S WBOX(WNM,"G","OK","POS")=(X\2-41)_","_(Y-45) S WBOX(WNM,"G","SYMBOL","RESOURCE")=SYM S PARENT=$G(@XGEVENT@("WINDOW")) I $L(PARENT) D . S WBOX(WNM,"PARENT")=PARENT . S WBOX(WNM,"MODAL")="APPLICATION" . S X=@XGWIN@(PARENT,"POS"),WBOX(WNM,"POS")=(X+10)_","_($P(X,",",2)+10)_","_$P(X,",",3) . Q ;Build a seperater ;S WBOX(WNM,"G","SEP","POS")=","_(Y+2) S ^TMP("XGD",$J,WNM,"BUTTON")="TO" Q OK(SYM,MSG,TIME) ;OK button message N WBOX,WNM D BUILD("XGL MSG BOX") G COMMON ; OKCAN(SYM,MSG,TIME) ; N WBOX,WNM D BUILD("XGL MSG BOX2"),PB2 G COMMON ; YNC(SYM,MSG,TIME) ; N WBOX,WNM D BUILD("XGL MSG BOX3"),PB3 COMMON D M^XG(WNM,$NA(WBOX(WNM))) D SD^XG($PD,"FOCUS",WNM) D ESTA^XG(TIME) S V=$G(^TMP("XGD",$J,WNM,"BUTTON")) K ^TMP("XGD",$J,WNM,"BUTTON") D K^XG(WNM) Q V PB2 ;Move the OK, and CANCEL button N X,Y S X=WBOX(WNM,"G","OK","POS"),Y=$P(X,",",2) S WBOX(WNM,"G","OK","POS")=(X-60)_","_Y_",PIXEL" S WBOX(WNM,"G","CAN","POS")=(X+60)_","_Y_",PIXEL" Q PB3 ;Move the OK, and CANCEL button N X,Y S X=WBOX(WNM,"G","OK","POS"),Y=$P(X,",",2) S WBOX(WNM,"G","OK","POS")=(X-90)_","_Y_",PIXEL" S WBOX(WNM,"G","NO","POS")=(X-0)_","_Y_",PIXEL" S WBOX(WNM,"G","CAN","POS")=(X+90)_","_Y_",PIXEL" Q MESG1(ARREF,WRAPFLG) ;Long MSG function, returns 1 Q $$MESG1^XGCWUTL(ARREF,$G(WRAPFLG,1)) MESG2(ARREF,WRAPFLG) ;Long MSG function, returns 1 YES, 0 NO Q $$MESG2^XGCWUTL(ARREF,$G(WRAPFLG,1)) MESG3(ARREF,WRAPFLG) ;Long MSG function, returns 1 YES, 0 NO, -1 CANCEL Q $$MESG3^XGCWUTL(ARREF,$G(WRAPFLG,1)) XGLMTERM^INT^1^60169,79033^0 XGLMTERM ;SF/RWF - Bring up an MTERM window. ;3/17/93 09:00 ;;8.0T19;KERNEL;;Feb 22, 1995 MTERM(A,B) ;Call with routine to run in window, window name. D OPEN(B) D D CLOSE . N B D @A Q Q OPEN(TITLE) ;Open a MTERM and give it the window name NEW W,WIN,WINM,XGOS S XGOS=^%ZOSF("OS") S:'$D(IO(0)) IO(0)=$I S WIN("TITLE")=TITLE_" window",WIN("POS")="2,2,CHAR",WIN("TYPE")="MTERM",WIN("SIZE")="80,24,CHAR" S WINM=$$NEXTNM^XGCLOAD("MT") I XGOS["DSM" D . D M^XG(WINM,"WIN") . S IO=WINM,IOT="MTERM" . OPEN IO:::"MTERM" . U IO . Q I XGOS["MSM" D . S IO=$P O IO U IO . S W="" F S W=$O(@XGWIN@(W)) Q:W="" D S^XG(W,"VISIBLE",0) . Q S IO(1,IO)=WINM Q CLOSE ;Close named MTERM N W,WINM,XGOS S XGOS=^%ZOSF("OS"),WINM=$G(IO(1,IO)) I XGOS["DSM" D . C IO . Q I XGOS["MSM" D . S W="" F S W=$O(@XGWIN@(W)) Q:W="" D S^XG(W,"VISIBLE",1) . Q I WINM]"" D K^XG(WINM) Q XGLOAD^INT^1^60169,79033^0 XGLOAD ;SF/RWF - MERGE WINDOW ;01/26/94 10:09 ;;8.0T19;KERNEL;;Feb 22, 1995 LOAD(SOURCE,%W) ; N IFN I $G(XGWIN)="" D PREP^XG S IFN=$$CHECK(SOURCE) D M^XG(%W,$NA(^XUTL("XGC",IFN))) Q GET(SOURCE,%W,DEST) ;Load window into temp. N IFN S IFN=$$CHECK(SOURCE) M @DEST@(%W)=^XUTL("XGC",IFN) Q NEXTNM(N) ;Build a unused name I $G(XGWIN)="" D PREP^XG I '$D(@XGWIN@(N))#2 Q N F I=1:1:10 Q:'$D(@XGWIN@(N_I))#2 Q N_I CHECK(NAME) ;Lookup in 8995 N %,%1,XGCWIN,XBASG S XGCWIN=$O(^XTV(8995,"B",NAME,0)),%=$G(^XTV(8995,XGCWIN,99),1),%1=$G(^XUTL("XGCH",NAME),2) Q:%=%1 XGCWIN K ^XUTL("XGC",XGCWIN),^XUTL("XGCH",NAME) S XBASG=$NA(^XUTL("XGC",XGCWIN)),XBASG=$E(XBASG,1,$L(XBASG)-1)_"," D ENC^XGCCOMP S ^XUTL("XGCH",NAME)=$G(^XTV(8995,XGCWIN,99)) Q XGCWIN XGLSAMPL^INT^1^60169,79033^0 XGLSAMPL ;SFISC/VYD - Sample window with all gadgets ;09/13/94 16:25 ;;8.0T19;KERNEL;;Feb 22, 1995 D GO^XGCLOAD("XG SAMPLER","SAMPLER") Q ; ; EXIT ; D ESTO^XG Q XGLTIMER^INT^1^60169,79033^0 XGLTIMER ;ISCSF/RWF - MWAPI TIMER SUPORT ;08/30/94 16:10 ;;8.0T19;KERNEL;;Feb 22, 1995 ;How this works, You call 'SET' to add a TIMER to a window ;It will setup the needed data and start the timer. ;In the callback we check the EVENT SEQUENCE number to see ;if any other event has happened, If an event has happend, reset ;the Count and exit. If not decrament the count by the interval and ;see if it is <= to zero, if it is <=0, set timeout flag. SET(WNM,TNM,INT,SEC,DO) ;This sets a timer ACTIVE ; and sets up for a countdown. ;Wname,Tname,Interval,Totaltime,Dotag@zero ;Used by signon to timeout a user. N ZX K ^TMP("XGLTIMER",$J,TNM) S ZX(TNM,"INTERVAL")=INT,ZX(TNM,"ACTIVE")=1 S ZX(TNM,"EVENT","TIMER")="TICK^XGLTIMER("_INT_")" S ^TMP("XGLTIMER",$J,TNM,"SEC")=SEC,^("CNT")=SEC,^("DO")=DO K ^TMP("XGLTIMER",$J,TNM,"SEQ") D M^XG(WNM,"T","ZX") Q TICK(INC) ;This is an entry point for a timer callback to decrament the counter. N TNM,WNM,SEQ,CNT,% S WNM=@XGEVENT@("WINDOW"),TNM=$P(@XGEVENT@("ELEMENT"),",",2),SEQ=@XGEVENT@("SEQUENCE") S %=$G(^TMP("XGLTIMER",$J,TNM,"SEQ"),SEQ-1),CNT=^TMP("XGLTIMER",$J,TNM,"CNT") S ^TMP("XGLTIMER",$J,TNM,"SEQ")=SEQ,SEQ=$S((%+1)=SEQ:SEQ,1:0) ;W !,"TIMER, COUNT: ",CNT," SEQ: ",SEQ Q:CNT<1 ;Stop once it gets to zero I SEQ D ;Got the sequence # expected, decrement CNT . ;S INC=@XGWIN@(WNM,"T",TNM,"INTERVAL") . S ^TMP("XGLTIMER",$J,TNM,"CNT")=CNT-INC,^("SEQ")=SEQ . Q I 'SEQ D ;Sequence # out of seq, Reset CNT to SEC . S ^("CNT")=^TMP("XGLTIMER",$J,TNM,"SEC") . Q I ^TMP("XGLTIMER",$J,TNM,"CNT")'>0 D . S DTOUT="^" D S^XG(WNM,"T",TNM,"ACTIVE",0) ;Stop timer . D @^TMP("XGLTIMER",$J,TNM,"DO") ;Do call back . Q Q CLEAR(WNM,TNM) ;Clear a timer D K^XG(WNM,"T",TNM) K ^TMP("XGLTIMER",$J,TNM) Q XGLUTL^INT^1^60169,79033^0 XGLUTL ;ISC-SF/RWF - Small Utility parts ;6/7/94 10:44 ;;8.0T19;KERNEL;;Feb 22, 1995 Q ESTOP ;Stop a ESTART. Return Y=-1 S Y=-1 D ESTO^XG Q XGLVAL^INT^1^60169,79033^0 XGLVAL ;ISC-SF.SEA/JLI - FUNCTION TO RETURN VALUES ; [ 05/16/94 12:31 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ;; GET(GADNAM,VARRAY,XWIN) ; Returns value from gadget 'GADNAM', any array part ; is returned in the variable VARRAY, XWIN is optional N Y,GADTYP,ERRARR,A,XGCJUNK I $S('$D(XWIN):1,XWIN="":1,1:0) S XWIN=$G(@XGEVENT@("WINDOW")) I XWIN="" D Q Y . S Y="NO WINDOW NAME AVAILABLE ...." . D SHOERR I '$D(@XGWIN@(XWIN)) D Q Y . S Y="THERE IS NO DATA ASSOCIATED WITH THE WINDOW NAME." . D SHOERR I $S('$D(VARRAY):1,VARRAY="":1,1:0) S VARRAY="XGCJUNK" K @VARRAY I $S('($D(GADNAM)#2):1,GADNAM="":1,1:0) D Q Y . S Y="NO GADGET NAME SENT TO GET^XGLVAL, NO VALUE AVAILABLE" . D SHOERR . S @VARRAY=Y ; S GADTYP=$G(@XGWIN@(XWIN,"G",GADNAM,"TYPE")) I GADTYP="" D Q Y . S Y="NO TYPE FOUND FOR A GADGET '"_GADNAM_"' NO VALUE AVAILABLE" . D SHOERR ; S GADTYP=","_GADTYP_"," I ",TEXT,CHECK,SCROLL,LISTENTRY,"[GADTYP D Q Y . S Y=@XGWIN@(XWIN,"G",GADNAM,"VALUE") . S @VARRAY=Y ; I ",LISTBUTTON,RADIO,"[GADTYP D Q Y . S Y=@XGWIN@(XWIN,"G",GADNAM,"VALUE") . I Y="" S @VARRAY=Y Q . S @VARRAY@(Y)=@XGWIN@(XWIN,"G",GADNAM,"CHOICE",Y) . S @VARRAY=Y ; I ",LIST,LONGLIST,"[GADTYP D Q Y . S A="" F S A=$O(@XGWIN@(XWIN,"G",GADNAM,"VALUE",A)) Q:A="" D . . S @VARRAY@(A)=@XGWIN@(XWIN,"G",GADNAM,"CHOICE",A) . S Y=@XGWIN@(XWIN,"G",GADNAM,"VALUE") . S @VARRAY=Y ; I GADTYP=",DOCUMENT," D Q Y . S Y=$NA(@XGWIN@(XWIN,"G",GADNAM)) . S Y=$$DLDOC^XGC02(Y,VARRAY) ; S Y="INVALID GADGET TYPE '"_$P(GADTYP,",",2)_"' FOR RETURNING A VALUE" D SHOERR Q Y ; SHOERR ; S ERRARR(1)="ERROR ENCOUNTERED ON A CALL TO 'GET^XGLVAL'." S ERRARR(2)="" S ERRARR(3)=Y S ERRARR=$$MESG1^XGLMSG("ERRARR") Q XGLWAIT^INT^1^60169,79033^0 XGLWAIT ;ISCSF/RWF - MWAPI, Tell user Im busy ;5/17/94 15:30 ;;8.0T19;KERNEL;;Feb 22, 1995 Q ;Call the WAIT^XGLWAIT(1) to give the user a indication that ;the application is busy. Call with 0 to clear. WAIT(STATE) ;To set a wait window or cursor ;I 'STATE D:$D(@XGWIN@("XGLWAIT")) S^XG("XGLWAIT","VISIBLE",0) Q I 'STATE D K^XG("XGLWAIT") Q I $D(@XGWIN@("XGLWAIT")) D S^XG("XGLWAIT","VISIBLE",1) G W1 D LOAD^XGCLOAD("XGL WAIT BOX","XGLWAIT") W1 D SD^XG($PD,"FOCUS","XGLWAIT") Q TW D WAIT(1) H 15 D WAIT(0) H 5 D WAIT(1) H 12 D WAIT(0) Q XGM1^INT^1^60169,79033^0 XGM1 ;SFISC/VYD - MENU BAR ;08/01/94 15:37 [ 01/14/95 10:40 AM ] ;;8.0T19;KERNEL;;Feb 22, 1995 L(S) ;length Q $L(S)-$L(S,"&")+$L(S,"&&") ; MBARS ;service menu bar at the top of the window N XGC,XGCTXT ;XGC:choice,XGCTXT:choice text N %,XGCLEN,L,K ;XGCLEN:length of the choice text,L:left,K:key S (XGFLAG("ABORT"),XGCLEN)=0 I $D(^TMP("XGW",$J,XGW,"M",XGM,"YXGVALUE")) D ;continue w/ prev choice .S XGC=^TMP("XGW",$J,XGW,"M",XGM,"YXGVALUE") .S L=XGWL+1,%="" F S %=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",%)) Q:%=XGC S L=L+$$L(^(%))+2 .W $$IOXY^XGS(XGWT+1,L) ;E S XGSHIFT=1,XGC="",L=XGWL+1 D SELECT() ;highlight first choice E S XGC="" D SELECT($O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",""))) ;highlight first choice F S K=$$READ^XGKB(1) D:'XGFLAG("ABORT") Q:XGFLAG("ABORT") .I XGRT]"",$T(@XGRT)]"" D @XGRT I 1 .E I K'="",$D(^TMP("XGW",$J,XGW,"M",XGM,"YXGHOTKEY",$$UP^XLFSTR(K))) D KEY D:XGRT="TAB" ABORT^XGM1A(999) Q ; LEFT ; RIGHT ;process LEFT or RIGHT arrow keys N XGNEWC,XGSHIFT S XGSHIFT=$S(XGRT="LEFT":-1,1:1),XGNEWC=XGC S XGNEWC=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGNEWC),XGSHIFT) ;get next/prev S:XGNEWC="" XGNEWC=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGNEWC),XGSHIFT),XGSHIFT=XGSHIFT*2 D:XGNEWC'=XGC DESELECT,SELECT() Q ; F10 ; TAB ; KP0 ;user wanted to get out of the menu bar D ABORT^XGM1A(999) Q ; DOWN ;user pressed down arrow D:$D(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"SUBMENU")) PICK^XGM1A Q ; CR ;user pressed CR (picked an option) I $G(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"ACTIVE"))'=0,'$D(^("SUBMENU")),$D(^("EVENT","SELECT")) D DESELECT,PICK^XGM1A D:$D(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"SUBMENU")) PICK^XGM1A Q ; KEY ;user picked some choice via hot key N XGNEWC S XGNEWC=^TMP("XGW",$J,XGW,"M",XGM,"YXGHOTKEY",$$UP^XLFSTR(K)) D:XGNEWC'=XGC DESELECT,SELECT(XGNEWC) D:$D(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"SUBMENU")) PICK^XGM1A Q ; DESELECT ;paint current choice in unhighlighted color S XGCTXT=" "_^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC)_" " S XGCLEN=$$L(XGCTXT) D SAYU^XGS(XGWT+1,L,XGCTXT,$S($G(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"ACTIVE"))=0:"I0R1",1:"I1R1")) Q ; SELECT(XGNEWC) ;display new choice in highlight ;XGNEWC subsript of the new choice to highlight in selected color N % ; I "1,-1"[$G(XGSHIFT,0) D I 1 ;new choice is to the left or right .S XGC=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC),XGSHIFT) .S L=L+$S(XGSHIFT=1:XGCLEN,1:-1*($$L(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC))+2)) ; E I "2,-2"[$G(XGSHIFT,0) D I 1 ;wrap arround to get to next choice .S XGC=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",""),XGSHIFT/2) ;get 1st/last choice .S L=XGWL+1 I XGSHIFT=2 ;if going from rightmost to leftmost .E S %="" F S %=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",%)) Q:%=XGC S L=L+$$L(^(%))+2 ; calc pos of right most choice in menu bar ; E D ;user jumped to some choice via hotkey K .F D Q:XGC=XGNEWC ..I XGC'="" S L=L+$$L(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC))+2 ..E S L=XGWL+1 ..S XGC=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC)) ; S ^TMP("XGW",$J,XGW,"M",XGM,"YXGVALUE")=XGC S XGCTXT=" "_^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC)_" " D SAYU^XGS(XGWT+1,L,XGCTXT,"E1") W $$IOXY^XGS(XGWT+1,L) Q XGM1A^INT^1^60169,79033^0 XGM1A ;SFISC/VYD - MENU BAR (cont.);11/26/93 09:45 ;10/14/94 14:44 [ 01/14/95 10:40 AM ] ;;8.0T19;KERNEL;;Feb 22, 1995 MBARP(XGW1) ;paint menu bar at the top of the window N XGM1,% ;menu name N XGC,S,A,C,T,L,R ;%,choice,string,attribute,column,top,left D COORDW^XGUTIL1(XGW1,.T,.L,"",.R) D SAY^XGS(T+1,L+1,$J("",R-L-1),"I1R1") S XGM1=^TMP("XGW",$J,XGW1,"MENUBAR") S (S,XGC)="",C=0 F S XGC=$O(^TMP("XGW",$J,XGW1,"M",XGM1,"CHOICE",XGC)) Q:XGC="" D . S S=" "_^TMP("XGW",$J,XGW1,"M",XGM1,"CHOICE",XGC)_" ",A=$S(^(XGC,"ACTIVE")=0:"I0R1",1:"I1R1") . S %=$$HOTKEY(S) . S:%'="" ^TMP("XGW",$J,XGW1,"M",XGM1,"YXGHOTKEY",%)=XGC ;build hotkey table . D SAYU^XGS(T+1,L+1+C,S,A) . S C=C+$$L^XGM1(S) Q ; ; HOTKEY(S) ;return a character that follows first & N %,P F P=1:1:$L(S,"&&") S $P(%,U,P)=$P(S,"&&",P) Q $$UP^XLFSTR($E($P(%,"&",2))) ; ABORT(XGLEVEL) ;abort selection process ;many vars are inhereted so don't NEW them ;XGLEVEL:# of menu levels to abort (typically either 1 or 999) N XGM,XGC F Q:$G(^TMP("XGW",$J,XGW,"MENUBAR"))=$P(XGMENU,U)!(XGMENU="")!(XGLEVEL=0) D .S XGM=$P(XGMENU,U) .D RESTORE^XGSW($NA(^TMP("XGS",$J,XGW_U_"M"_U_XGM))) .K ^TMP("XGS",$J,XGW_U_"M"_U_XGM) .K ^TMP("XGW",$J,XGW,"M",XGM,"YXGVALUE") .S XGMENU=$P(XGMENU,U,2,999),XGLEVEL=XGLEVEL-1 D:XGLEVEL&($G(^TMP("XGW",$J,XGW,"MENUBAR"))=$P(XGMENU,U))&(XGMENU]"") .N %,L,XGCTXT,XGCLEN .S XGM=XGMENU,XGC=^TMP("XGW",$J,XGW,"M",XGM,"YXGVALUE"),XGMENU="" .S L=XGWL+1,%="" F S %=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",%)) Q:%=XGC S L=L+$$L^XGM1(^(%))+2 .D DESELECT^XGM1 K ^TMP("XGW",$J,XGW,"M",XGM,"YXGVALUE") K ^TMP("XGW",$J,XGW,"M",XGM,"YXGCHOICE") S XGFLAG("ABORT")=1,XGG=$P(^TMP("XGD",$J,$PD,"FOCUS"),C,2) Q ; PICK ;user picked a choice ;many vars are inhereted so don't NEW them N XGSUBMNU I $D(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"SUBMENU")) D I 1 .S XGSUBMNU=^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"SUBMENU") .S XGMENU=XGSUBMNU_U_XGMENU ;push menu onto a stack .S ^TMP("XGW",$J,XGW,"M",XGSUBMNU,"YXGCOORDS")=$S($G(^TMP("XGW",$J,XGW,"MENUBAR"))=XGM:2_U_(L-XGWL+1),1:(T+%C-XGWT)_U_(L+R-XGWL)) ;set coords of submenu S ^TMP("XGW",$J,XGW,"M",XGM,"YXGVALUE")=XGC ;remember choice that got picked E D:$D(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"EVENT","SELECT")) .D ABORT(999) ;pop all the menus .D E^XGEVNT1(XGW,"M",XGM,XGC,"SELECT") S XGFLAG("ABORT")=1 Q XGM2^INT^1^60169,79034^0 XGM2 ;SFISC/VYD - POPUP MENU ;10/13/94 11:48 [ 01/14/95 10:40 AM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ; MENUS ;service popup menu N T,L,B,R,A,S,XGC,%C ;top,left,bottom,right,attr,str,choice,counter N K,N ;key,new choice W IOCUOFF D PAINT^XGM2A ;display menu ; ;now process the menu I $D(^TMP("XGW",$J,XGW,"M",XGM,"YXGVALUE")) D ;if a choice was previously selected .S XGC="",%C=0 F S XGC=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC)) S %C=%C+1 Q:XGC=^TMP("XGW",$J,XGW,"M",XGM,"YXGVALUE") E S XGC="",%C=1 D SELECT($O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",""))) S XGFLAG("ABORT")=0 F S K=$$READ^XGKB(1,7) D Q:XGFLAG("ABORT") .D:$D(DTOUT) FLASH^XGM2A .;if XGRT is a line tag in this routine, do that tag .I XGRT]"",XGRT?1.8N!(XGRT?1"%".7AN)!(XGRT?1A.7AN),$T(@XGRT)]"" D @XGRT I 1 .E I K'="",$D(^TMP("XGW",$J,XGW,"M",XGM,"YXGHOTKEY",$$UP^XLFSTR(K))) D KEY I 1 .; .E I XGRT="RIGHT" D ; pressed RIGHT arrow ..S XGFLAG("ABORT")=1 K ^TMP("XGE",$J,"CHOICE") W IOCUON Q ; ; RIGHT ;process RIGHT key D . I $D(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"SUBMENU")) D PICK^XGM1A Q . I $L(XGMENU,U)=2,$P(XGMENU,U,2)=$G(^TMP("XGW",$J,XGW,"MENUBAR")) D Q . . D ABORT^XGM1A(1) ;backup one level . . S XGC=^TMP("XGW",$J,XGW,"M",XGMENU,"YXGVALUE") . . S XGM=XGMENU . . S L=L-1 . . D RIGHT^XGM1,DOWN^XGM1 Q ; ; LEFT ;process LEFT key D:$L(XGMENU,U)>1 ABORT^XGM1A(1) ;backup one level I $L(XGMENU),XGMENU=$G(^TMP("XGW",$J,XGW,"MENUBAR")) D . S XGC=^TMP("XGW",$J,XGW,"M",XGMENU,"YXGVALUE") . S XGM=XGMENU . S L=L-1 . D LEFT^XGM1,DOWN^XGM1 Q ; ; UP ; DOWN ;process UP DOWN keys N XGNEWC,XGSHIFT S XGSHIFT=$S(XGRT="UP":-1,1:1),XGNEWC=XGC S XGNEWC=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGNEWC),XGSHIFT) ;get next/prev S:XGNEWC="" XGNEWC=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGNEWC),XGSHIFT),XGSHIFT=XGSHIFT*2 D:XGNEWC'=XGC DESELECT,SELECT() Q ; F10 ;user wanted to get out of the menu KP0 ;user wanted to get out of the menu D ABORT^XGM1A(1) Q ; TAB ;close all menus, return to previous gadget D ABORT^XGM1A(999) Q CR ;user pressed CR (picked an option) I $G(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"ACTIVE"))'=0,'$D(^("SUBMENU")),$D(^("EVENT","SELECT")) D PICK^XGM1A D:$D(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"SUBMENU")) PICK^XGM1A Q ; KEY ;user picked some choice via hot key N XGNEWC S XGNEWC=^TMP("XGW",$J,XGW,"M",XGM,"YXGHOTKEY",$$UP^XLFSTR(K)) D:XGNEWC'=XGC DESELECT,SELECT(XGNEWC) D:$D(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"SUBMENU")) PICK^XGM1A Q ; ; DESELECT ;paint current choice in unhighlighted color ;S XGCTXT=" "_^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC),XGCTXT=XGCTXT_$J("",R-$$L^XGM1(XGCTXT)) ;D SAYU^XGS(T+%C,L,XGCTXT,$S($G(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"ACTIVE"),1):"I1",1:"I0")) D SAYU^XGS(T+%C,L,^TMP("XGW",$J,XGW,"M",XGM,"YXGCHOICE",XGC),$S($G(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"ACTIVE"),1):"I1",1:"I0")) Q ; SELECT(XGNEWC) ;display new choice in highlight ;XGNEWC subsript of the new choice to highlight in selected color N % ; I "1,-1"[$G(XGSHIFT,0) D I 1 ;new choice below or above current .S %C=%C+$S($D(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"SEPARATOR"))&(XGSHIFT=1):2,1:XGSHIFT) .S XGC=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC),XGSHIFT) .S:$D(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"SEPARATOR"))&(XGSHIFT=-1) %C=%C-1 ; E I "2,-2"[$G(XGSHIFT,0) D I 1 ;wrap arround to get to next choice .S XGC=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",""),XGSHIFT/2) ;get 1st/last choice .S %C=1 I XGSHIFT=2 ;if going from bottom to top .E S %="" F S %=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",%)) Q:%=XGC S %C=%C+$S($D(^(%,"SEPARATOR")):2,1:1) ; calc pos of the bottom choice ; E D ;user jumped to some choice via hotkey K .F D Q:XGC=XGNEWC ..I XGC'="" S %C=%C+$S($D(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"SEPARATOR")):2,1:1) ..E S %C=1 ..S XGC=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC)) ; S ^TMP("XGW",$J,XGW,"M",XGM,"YXGVALUE")=XGC ;S XGCTXT=" "_^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC),XGCTXT=XGCTXT_$J("",R-$$L^XGM1(XGCTXT)) ;D SAYU^XGS(T+%C,L,XGCTXT,"R1") D SAYU^XGS(T+%C,L,^TMP("XGW",$J,XGW,"M",XGM,"YXGCHOICE",XGC),"R1") Q XGM2A^INT^1^60169,79034^0 XGM2A ;SFISC/VYD - POPUP MENU (cont.) ;10/13/94 11:32 [ 01/15/95 8:27 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ; FLASH ;flash the choice to remind user ;D SAYU^XGS(T+%C,L," "_^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC)_$J("",R-$$L^XGM1(^(XGC))-1),"B1R1") D SAYU^XGS(T+%C,L,^TMP("XGW",$J,XGW,"M",XGM,"YXGCHOICE",XGC),"B1R1") S K=$$READ^XGKB(1) Q:XGFLAG("ABORT") ;D SAYU^XGS(T+%C,L," "_^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC)_$J("",R-$$L^XGM1(^(XGC))-1),"R1") D SAYU^XGS(T+%C,L,^TMP("XGW",$J,XGW,"M",XGM,"YXGCHOICE",XGC),"R1") Q ; ; COMPLETE(XGW1,XGM1) ;complete any missing nodes N % S:'$D(^TMP("XGW",$J,XGW1,"M",XGM1,"ACTIVE")) ^("ACTIVE")=1 S ^TMP("XGW",$J,XGW1,"M",XGM1,"ID")=XGW1_U_"M"_U_XGM1 D XGOTHER^XGG(XGW1,"M",XGM1) ;complete choices and set YXGCHOICES S:'$D(^TMP("XGW",$J,XGW1,"M",XGM1,"UNITS")) ^TMP("XGW",$J,XGW1,"M",XGM1,"UNITS")=^TMP("XGW",$J,XGW1,"UNITS") S:'$D(^TMP("XGW",$J,XGW1,"M",XGM1,"VISIBLE")) ^("VISIBLE")=1 ;~XGWM has a special meaning. It's a window control menu that has ;such choices as Move, Resize, Maximize, Minimize, etc. S:XGM1="~XGWM" ^TMP("XGW",$J,XGW1,"M",XGM1,"YXGCOORDS")="0^1" Q ; ; PAINT ;paint initial popup menu N % S T=XGWT+$P(^TMP("XGW",$J,XGW,"M",XGM,"YXGCOORDS"),U),L=XGWL+$P(^("YXGCOORDS"),U,2) ; ;------- determine menu length and width S (R,B)=0,XGC="" F S XGC=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC)) Q:XGC="" D . S %C=$$L^XGM1(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC))+2 . S:%C>R R=%C . S %=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC)) ;next choice . S B=B+$S($D(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"SEPARATOR"))&(%'=""):2,1:1) D:'$D(^TMP("XGS",$J,XGID)) . D WIN^XGSW(T,L-1,T+B+1,L+R,$NA(^TMP("XGS",$J,XGID))) . S %C=0,XGC="" . F S XGC=$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC)),%C=%C+1 Q:XGC="" D . . S A=$S($G(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC,"ACTIVE"))=0:"I0",1:"I1") . . S S=" "_^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC)_$J("",R-$$L^XGM1(^(XGC))-2)_$S($D(^(XGC,"SUBMENU")):"+",1:" ") . . ;build parallel choice list with all choice markers and indicators . . S ^TMP("XGW",$J,XGW,"M",XGM,"YXGCHOICE",XGC)=S . . S %=$$HOTKEY^XGM1A(S) ;get hotkey (if any) . . S:%'="" ^TMP("XGW",$J,XGW,"M",XGM,"YXGHOTKEY",%)=XGC ;build hotkey table . . D SAYU^XGS(T+%C,L,S,A) . . ;if this choice has a separator and there's a next choice . . D:$O(^TMP("XGW",$J,XGW,"M",XGM,"CHOICE",XGC))'=""&($D(^(XGC,"SEPARATOR"))) . . . S %C=%C+1,S=IOLT_$TR($J("",R)," ",IOHL)_IORT . . . D SAY^XGS(T+%C,L-1,S,"G1") Q XGMERG^INT^1^60169,79034^0 XGMERG ;SFISC/VYD - merge WINDOW, DISPLAY, EVENT in K-WAPI ;01/30/95 14:38 ;;8.0T19;KERNEL;;Feb 22, 1995 ; M ;K-WAPI equivalent of MWAPI MERGE into ^$W N XGROOT,XGROOT1 ;root from which to merge N %,XGERR N XGOLDPF ;old paint flag S XGOLDPF=XGFLAG("PAINT") ;save previous S XGERR="MERGE" S C="," D:P1="XGW"&($G(P2)=$J) ;adjust params because physical root was passed . F %=3:1:11 I $D(@("P"_%)) S @("P"_(%-2)_"=P"_%) K @("P"_%) D . ;-------- one or more windows . ;ex: M ^$W=^TMP($J) . I '$D(P2) D Q . . S XGROOT=P1 . . S P1="" . . ;F S P1=$O(@XGROOT@(P1)) Q:P1="" D . . ;. S P2=$NA(@XGROOT@(P1)) . . ;. D ONEWIN^XGMERG1 . . F S P1=$O(@XGROOT@(P1)) Q:P1="" D ONEWIN^XGMERG1(P1,$NA(@XGROOT@(P1))) . ; . ;-------- one window . ;ex: M ^$W("WIN1")=^TMP($J) . I '$D(P3) D Q . . ;D ONEWIN^XGMERG1 . . D ONEWIN^XGMERG1(P1,P2) . ; . I '$D(P4) D Q . . ;--- merge one or more gadgets . . ;ex: M ^$W("WIN1,"G")=^TMP($J) . . I P2="G" D Q . . . S P4="" . . . F S P4=$O(@P3@(P4)) Q:P4="" D MG(P1,P4,P3) . . ; . . ;--- merge one or more menus . . ;ex: M ^$W("WIN1,"M")=^TMP($J) . . I P2="M" D Q . . . S XGERR=XGERR_"-MENUS UNKNOW ATTR/VAL" . . . D HUH^XGUTIL2(XGERR) . . ; . . ;--- merge one or more timers . . ;ex: M ^$W("WIN1,"T")=^TMP($J) . . I P2="T" D Q . . . S P4="" ;P4-timer name . . . F S P4=$O(@P3@(P4)) Q:P4="" D ;get next timer . . . . M ^TMP("XGW",$J,P1,"T",P4)=@P3@(P4) ;merge one timer . . . . D COMPLETE^XGT(P1,P4) . . ; . . S XGERR=XGERR_"-WINDOW ATTRIBUTE UNKNOWN" . . D HUH^XGUTIL2(XGERR) . ; . I '$D(P5) D Q . . ;ex: M ^$W("WIN1","G","MENU1")=^TMP($J) . . I P2="G" D Q . . . D MG(P1,P3,P4) . . ; . . ;ex: M ^$W("WIN1","M","MENU1")=^TMP($J) . . I P2="M" D Q . . . M ^TMP("XGW",$J,P1,"M",P3)=@P4 . . . D COMPLETE^XGM2A(P1,P3) . . ; . . ;ex: M ^$W("WIN1","T","MENU1")=^TMP($J) . . I P2="T" D Q . . . M ^TMP("XGW",$J,P1,"T",P3)=@P4 ;merge one timer . . . D COMPLETE^XGT(P1,P4) . . ; . . S XGERR=XGERR_"-WINDOW UNKNOW ATTR" . . D HUH^XGUTIL2(XGERR) . ; . I '$D(P6) D Q . . I P2="G" D Q ;merge into gadget . . . ;ex: M ^$W("WIN1","G","GADGET1","CHOICE")=^TMP($J) . . . I P4="CHOICE" D Q . . . . D MC^XGGL1(P1_C_P2_C_P3,P5) . . . ; . . . ;ex: M ^$W("WIN1","G","GADGET1","VALUE")=^TMP($J) . . . I P4="VALUE" D Q . . . . I ^TMP("XGW",$J,P1,"G",P3,"TYPE")="DOCUMENT" D Q . . . . . D MVAL^XGGD(P1,P3,P5) ;merge value root into document . . . . ; . . . . I ^TMP("XGW",$J,P1,"G",P3,"TYPE")="LIST" D Q . . . . . D MVAL^XGGL1(P1,P3,P5) ;merge value root into list . . . . ; . . . . S XGERR=XGERR_"-GADGET-VALUE UNKNOW GADGET TYPE" . . . . D HUH^XGUTIL2(XGERR) . . . ; . . . S XGERR=XGERR_"-GADGET UNKNOW ATTR" . . . D HUH^XGUTIL2(XGERR) . . ; . . I P2="M" D Q ;merge into menu . . . S XGERR=XGERR_"-MENU UNKNOW ATTR" . . . D HUH^XGUTIL2(XGERR) . . ; . . I P2="T" D Q ;merge into timer . . . S XGERR=XGERR_"-TIMER UNKNOW ATTR" . . . D HUH^XGUTIL2(XGERR) . ; . S XGERR=XGERR_"- UNKNOW ATTR" . D HUH^XGUTIL2(XGERR) ; S XGFLAG("PAINT")=XGOLDPF ;restore previous U:^%ZOSF("OS")["VAX DSM" IO(0):FLUSH ;update screen immediately Q ; ; MG(XGW1,XGG1,XGROOT) ;merge into one gadget ;equivalent of M ^$W(XGW1,"G",XGG1)=XGROOT N XGG2 ;gadget name from the user passed root ;decide if gadget first needs to be erased S XGFLAG("ERASE")=0 D . D PAINTFLG^XGUTIL2(XGW1,"G",XGG1) . I "^11^21^"'[(U_XGFLAG("PAINT")_U) S XGFLAG("ERASE")=2 Q . S XGG2=$O(@XGROOT@("")) ;get user's gadget name . F %="ACTIVE","POS","SIZE","VALUE","VISIBLE" D Q:XGFLAG("ERASE")=1 . . I $D(@XGROOT@(XGG2,%)),@XGROOT@(XGG2,%)'=^TMP("XGW",$J,XGW1,"G",XGG1,%) S XGFLAG("ERASE")=1 I XGFLAG("ERASE")=1 D HUH^XGUTIL2("I need to erase gadget "_XGG1) M ^TMP("XGW",$J,XGW1,"G",XGG1)=@XGROOT D COMPLETE^XGG(XGW1,XGG1) D PAINTFLG^XGUTIL2(XGW1,"G",XGG1) I XGFLAG("ERASE"),"^11^21^"[(U_XGFLAG("PAINT")_U) D PAINT^XGG(XGW1,XGG1) K XGFLAG("ERASE") Q ; ; MD ;K-WAPI equivalent of MWAPI MERGE into ^$DI S C="," S XGERR="MERGE into ^$DISPLAY" D HUH^XGUTIL2(XGERR) Q XGMERG1^INT^1^60169,79034^0 XGMERG1 ;SFISC/VYD - merge WINDOW, DISPLAY, EVENT in K-WAPI ;12/27/94 15:00 ;;8.0T19;KERNEL;;Feb 22, 1995 ; ONEWIN(XGW1,XGROOT) ;merge one window N XGELTYPE,XGELMNT ;XGELTYPE:"G"/"M"/"T",XGELMNT:gadget/timer/menu name N XGWTOP ;name of topmost window N XGTRACE ;marks gadgets that are pointed via NEXTG N %,T,L,B,R I ^%ZOSF("OS")["DSM" U $I:PACK ;if DSM buffer IO for faster performance S XGFLAG("ERASE")=0 ; ;---- if merging into a window already on the screen and new "key" ; attributes are different, erase the window first D . Q:'$D(XGSCRN("ORDERX",XGW1)) ;currently window is not on the screen . F %="ACTIVE","MIN","POS","SIZE","VISIBLE" D Q:XGFLAG("ERASE")=1 . . I $D(@XGROOT@(%)),@XGROOT@(%)'=^TMP("XGW",$J,XGW1) S XGFLAG("ERASE")=1 D:XGFLAG("ERASE") REMOVE^XGWIN1(XGW1) ; M ^TMP("XGW",$J,XGW1)=@XGROOT D COMPLETE^XGWIN(XGW1) ; F XGELTYPE="G","M","T" S XGELMNT="" D . F S XGELMNT=$O(^TMP("XGW",$J,XGW1,XGELTYPE,XGELMNT)) Q:XGELMNT="" D . . I XGELTYPE="G" D COMPLET2^XGG(XGW1,XGELMNT) Q . . I XGELTYPE="M" D COMPLETE^XGM2A(XGW1,XGELMNT) Q . . I XGELTYPE="T" D COMPLETE^XGT(XGW1,XGELMNT) Q D DFLTSIZE^XGWIN(XGW1) ; D:^TMP("XGW",$J,XGW1,"VISIBLE") ;paint or repaint if visible . ;**** next 5 lines commented out on 1/1/95 **** . ;;get the name of the topmost window . ;S %=$O(XGSCRN("ORDER",""),-1),XGWTOP=XGSCRN("ORDER",%) . ;;if merged window is diff from window on top, save topmost window . ;I XGWTOP'=$C(1),XGW1'=XGWTOP D . ;. D COORDW^XGUTIL1(XGWTOP,.T,.L,.B,.R) . ;. D SAVE^XGSW(T,L,B,R,$NA(^TMP("XGS",$J,XGWTOP))) . D WINP^XGWIN(XGW1) ;paint new window S XGFLAG("ABORT")=1 ;stop current activity, whatever it is K XGFLAG("ERASE") Q ; ; ONEWIN99 ;merge one window N XGELTYPE,XGELMNT ;XGELTYPE:"G"/"M"/"T",XGELMNT:gadget/timer/menu name N %,XGOLDWIN ;name of previous window N XGTRACE ;marks gadgets that are pointed via NEXTG I ^%ZOSF("OS")["DSM" U $I:PACK ;if DSM buffer IO for faster performance S XGFLAG("ERASE")=0 ; ;---- if merging into a window already on the screen and new "key" ;attributes are different, erase it first D . Q:'$D(XGSCRN("ORDERX",P1)) ;currently window is not on the screen . F %="ACTIVE","MIN","POS","SIZE","VISIBLE" D Q:XGFLAG("ERASE")=1 . . I $D(@P2@(%)),@P2@(%)'=^TMP("XGW",$J,P1) S XGFLAG("ERASE")=1 D:XGFLAG("ERASE") REMOVE^XGWIN1(P1) ; M ^TMP("XGW",$J,P1)=@P2 I $L($G(XGW)),$D(XGSCRN("ORDERX",XGW)) S XGOLDWIN=XGW ;remember prev win S XGW=P1 D COMPLETE^XGWIN(XGW) ; F XGELTYPE="G","M","T" S XGELMNT="" F S XGELMNT=$O(^TMP("XGW",$J,XGW,XGELTYPE,XGELMNT)) Q:XGELMNT="" D . I XGELTYPE="G" D COMPLET2^XGG(XGW,XGELMNT) I 1 . E I XGELTYPE="M" D COMPLETE^XGM2A(XGW,XGELMNT) I 1 . E I XGELTYPE="T" D COMPLETE^XGT(XGW,XGELMNT) I 1 D DFLTSIZE^XGWIN(XGW) ; ;---- if window is not on the screen and should be visible, paint it D:'$D(XGSCRN("ORDERX",XGW))&(^TMP("XGW",$J,XGW,"VISIBLE")) . ;save image of previous window . D:$D(XGOLDWIN) SAVE^XGSW(XGWT,XGWL,XGWB,XGWR,$NA(^TMP("XGS",$J,XGOLDWIN))) . D WINP^XGWIN(XGW) ;paint new window ;S:$D(XGOLDWIN) XGW=XGOLDWIN ;get back to previus window S XGFLAG("ABORT")=1 ;stop current activity, whatever it is K XGFLAG("ERASE") Q XGS^INT^1^60169,79034^0 XGS ;SFISC/VYD - SCREEN PRIMITIVES ;03/16/95 11:00 ;;8.0;KERNEL;;Jul 03, 1995 SAY(R,C,S,A) ;use this for coordinate output instead of WRITE ;output to screen and update virtual screen (XGSCRN) ;params: Row (0-IOSL),Col (0-IOM),string, ;scrn attrib ie. I1R0B1 (optional) N XGSAVATR,XGESC,XGOUTPUT ;save attribute,escape str,output stream N % ;set output stream to either XGSCRN (virtual screen) or some window S XGOUTPUT=$S($G(XGFLAG("PAINT"),21)=21:"XGSCRN",1:$NA(^TMP("XGS",$J,XGW1))) S XGSAVATR=XGCURATR ;preserve current attribute to restore later S $X=C+$L(S) S XGESC=$S($L($G(A)):$$CHG^XGSA(A),1:"") S $E(@XGOUTPUT@(R,0),(C+1),$X)=S S $E(@XGOUTPUT@(R,1),(C+1),$X)=$TR($J("",$L(S))," ",XGCURATR) ;S $P(%,XGCURATR,$L(S)+1)="",$E(@XGOUTPUT@(R,1),(C+1),$X)=% I XGOUTPUT="XGSCRN" D I 1 ;if screen painting is to occur . ;output string in a proper place in proper attribute and restore attr . ;W $$IOXY(R,C)_XGESC_S_$S($L($G(A)):$$SET^XGSA(XGSAVATR),1:"") . W $$IOXY(R,C)_XGESC_S_$S(XGSAVATR'=XGCURATR:$$SET^XGSA(XGSAVATR),1:"") . S $Y=R,$X=C+$L(S)-1 E S XGCURATR=XGSAVATR Q ; ; SAYU(R,C,S,A) ;use this for coordinate output instead of WRITE ;output to screen and update virtual screen (XGSCRN) ;params: Row (0-IOSL),Col (0-IOM),string, ;scrn attrib ie. I1R0B1 (optional) N XGSAVATR,XGESC,XGOUTPUT ;save attribute,escape str,output stream N %,%S,P,P1,P2,X ;P1:piece before &, P2:piece from & to the end N XGATR ;set output stream to either XGSCRN (virtual screen) or some window S XGOUTPUT=$S($G(XGFLAG("PAINT"),21)=21:"XGSCRN",1:$NA(^TMP("XGS",$J,XGW1))) S P=$L(S,"&&") F %=1:1:P S $P(X,$C(1),%)=$P(S,"&&",%) ;replace all && with $C(1) I X["&",$G(A)'["U1",'$$STAT^XGSA("U")!($G(A)["U0") D I 1 . S XGSAVATR=XGCURATR ;preserve current attribute to restore later . S XGESC=$S($L($G(A)):$$CHG^XGSA(A),1:"") . S XGATR=XGCURATR ;get pre-underline attributes . S $X=C+$L(X)-1 ;adjust for a single &, which is not printable . ;S $E(XGSCRN(R,0),(C+1),$X)=$TR($TR(X,"&",""),$C(1),"&") . S $E(@XGOUTPUT@(R,0),(C+1),$X)=$TR($P(X,"&")_$P(X,"&",2,999),$C(1),"&") . S $E(@XGOUTPUT@(R,1),(C+1),$X)=$TR($J("",$X-C)," ",XGCURATR) . S P1=$TR($P(X,"&"),$C(1),"&"),P2=$TR($P(X,"&",2,999),$C(1),"&") . S %S=P1_$$CHG^XGSA("U1")_$E(P2) ;preunderline_underlinechar . S $E(@XGOUTPUT@(R,1),(C+1+$L(P1)))=XGCURATR ;record underlinechar . ;S %S=%S_$$CHG^XGSA("U0")_$E(P2,2,999) ;%S_postunderline . S %S=%S_$$SET^XGSA(XGATR)_$E(P2,2,999) ;%S_postunderline . I XGOUTPUT="XGSCRN" D I 1 . . ;output string in a proper place in proper attribute and restore attr . . ;W $$IOXY(R,C)_XGESC_%S_$S($L($G(A)):$$SET^XGSA(XGSAVATR),1:"") . . W $$IOXY(R,C)_XGESC_%S_$S(XGCURATR'=XGSAVATR:$$SET^XGSA(XGSAVATR),1:"") . . S $Y=R,$X=C+$L(X)-2 . E S XGCURATR=XGSAVATR E D SAY(R,C,$TR(S,"&"),A):$D(A),SAY(R,C,$TR(S,"&")):'$D(A) Q ; ; IOXY(R,C) ;cursor positioning WRITE argument instead of execute ;Row,Col Q $C(27,91)_((R+1))_$C(59)_((C+1))_$C(72) XGSA^INT^1^60169,79034^0 XGSA ;SFISC/VYD - screen attribute primitives ;03/15/95 13:50 ;;8.0;KERNEL;;Jul 03, 1995 SET(XGNEWATR) ;set screen attributes return only the ESC codes ;ABSOLUTE setting of screen attributes to new attributes regadless ;of prev state. For relative change use CHG ;XGNEWATR=char represents what all attributes should become ex: R1B0 ;XGCURATR=state of all current attributes in form of a char S XGCURATR=XGNEWATR ;set curr attr var Q ^XUTL("XGATR",XGNEWATR) ; CHG99(XGATR) ;XGATR=passed attribute string ie: R1B0G1 ;RELATIVE change of screen attributes to the new ones. Only changes attributes that were passed, retains others. For ABSOLUTE set use SET N X,%,XGATRLTR,XGATRNO,XGCURBIN,XGESC,XGONOFF ;S XGCURBIN=$$CNV(XGCURATR) S XGCURBIN=^XUTL("XGATR1",XGCURATR) ;parse passed string, generate ESC codes F %=1:2:$L(XGATR) S XGATRLTR=$E(XGATR,%),XGONOFF=$E(XGATR,%+1) D . I XGATRLTR'="E" D ;continue if not EMPTY . . S XGATRNO=$F("BIRDGU",XGATRLTR) ;get attr # to match in XGATRSET . . S $E(XGCURBIN,XGATRNO)=XGONOFF ;chg bin str . E S XGCURBIN="00000001" ;EMPTY attr clears everything ;in case all prev attr got turned off, turn on EMPTY attr S $E(XGCURBIN,8)=$S($E(XGCURBIN,1,7)[1:0,1:1) ;S XGCURATR=$$CNV(XGCURBIN) S XGCURATR=^XUTL("XGATR1",XGCURBIN) Q ^XUTL("XGATR",XGCURATR) ;return escape sequence ; ; CHG(XGATR) ;XGATR=passed attribute string ie: R1B0G1 ;RELATIVE change of screen attributes to the new ones. Only changes attributes that were passed, retains others. For ABSOLUTE set use SET N X,%,XGATRLTR,XGATRASC,XGBIT,XGONOFF S XGATRASC=$A(XGCURATR) F %=1:2:$L(XGATR) S XGATRLTR=$E(XGATR,%),XGONOFF=$E(XGATR,%+1) D . I XGATRLTR'="E" D ;continue if not EMPTY . . S XGBIT=2**($F("UGDRIB",XGATRLTR)-1) ;bit mask . . ;if attribute bit needs to change add/subtract the mask . . S:(XGATRASC\XGBIT#2)'=XGONOFF XGATRASC=XGATRASC+$S(XGONOFF=0:-XGBIT,1:XGBIT) . E S XGATRASC=1 ;EMPTY attr clears everything S:XGATRASC=0 XGATRASC=1 ;if all attr got turned off, turn on EMPTY attr S XGCURATR=$C(XGATRASC) Q ^XUTL("XGATR",XGCURATR) ;return escape sequence ; ; STAT(XGATR) ;returns the state of a specific attribute ;XGATR is the attribute mnemonic character. Possible values are ;B-blinking, I-high intensity, R-reverse, D-double wide, G-graphics ;U-underline, E-empty Q $A(XGCURATR)\(2**($F("EUGDRIB",XGATR)-2))#2 ; ; ESC(XGATR) ;return ESC codes of all attributes in XGATR ;XGATR=char represents what all attributes should be ex: R1B0 N %,XGESC,X,XGBIN I XGATR'=XGEMPATR D ;if setting to other than EMPTY attribute .;get binary representation of CURRENTATTRIBUTES and NEWATTRIBUTES .S XGBIN=$$CNV(XGATR) .S XGESC=IORESET D ;turn off all attr & process only 1s to turn on ..F %=2:1:7 S X=$E(XGBIN,%) S:X XGESC=XGESC_$P(XGATRSET(%),U,2) E S XGESC=IORESET Q XGESC ; ; CNV(ATR) ;convert attribute from character to binary and vice-versa ;if $L(ATR)=8 then binary format is passed and character returned ;if $L(ATR)=1 then character format is passed and binary str returned N X,Y I $L(ATR)=1 S X=$A(ATR),Y="" F S Y=(X#2)_Y,X=X\2 I 'X S Y=$E(100000000+Y,2,9) Q E S Y="" F X=1:1:8 S Y=Y*2+$E(ATR,X) E S Y=$C(Y) Q Y XGSBOX^INT^1^60169,79034^0 XGSBOX ;SFISC/VYD - screen rectengular region primitives ;10/31/94 15:38 ;;8.0;KERNEL;;Jul 03, 1995 FRAME(T,L,B,R,A,C) ;draw a border ;TOP,LEFT,BOTTOM,RIGHT,ATTRIBUTE,frame character N %,%L2,%R2,M,S,X,Y ;M=middle S=string N XGSAVATR I B'>T N IOBLC,IOBRC S (IOBLC,IOBRC)=IOHL ;to draw horizontal line I R'>L N IOTRC,IOBRC S (IOTRC,IOBRC)=IOVL ;to draw vertical line S M=R-L-1 S %L2=L+1,%R2=R+1 ;if frame character passed set frame parts to it, disable graphics S:$L($G(C)) (IOBLC,IOBRC,IOHL,IOTLC,IOTRC,IOVL)=C S XGSAVATR=XGCURATR ;save current screen attributes W $$CHG^XGSA($G(A)_$S($L($G(C)):"",1:"G1")) ;turn on gr attr & leave on S S=IOTLC_$TR($J("",M)," ",IOHL)_IOTRC S $E(XGSCRN(T,0),%L2,%R2)=S S $E(XGSCRN(T,1),%L2,%R2)=$TR($J("",(R-L+1))," ",XGCURATR) W $$IOXY^XGS(T,L)_S ;top line with corners F Y=T+1:1:B-1 D . F X=%L2,%R2 S $E(XGSCRN(Y,0),X)=IOVL,$E(XGSCRN(Y,1),X)=XGCURATR . W $$IOXY^XGS(Y,L)_IOVL_$$IOXY^XGS(Y,R)_IOVL S S=IOBLC_$TR($J("",M)," ",IOHL)_IOBRC S $E(XGSCRN(B,0),%L2,%R2)=S S $E(XGSCRN(B,1),%L2,%R2)=$TR($J("",(R-L+1))," ",XGCURATR) W $$IOXY^XGS(B,L)_S ;bottom line with corners W $$SET^XGSA(XGSAVATR) ;restore previous attributes D:$L($G(C)) GSET^%ZISS ;restore line drawing characters S $Y=B,$X=R Q ; CLEAR(T,L,B,R) ;clear a portion of the screen N %L2,%R2,I,M ;M=length of middle S %L2=L+1,%R2=R+1,M=R-L+1 F I=T:1:B D . S $E(XGSCRN(I,0),%L2,%R2)=$J("",M) . S $E(XGSCRN(I,1),%L2,%R2)=$TR($J("",M)," ",XGCURATR) . W $$IOXY^XGS(I,L)_$J("",M) S $Y=B,$X=R Q XGSET^INT^1^60169,79034^0 XGSET ;SFISC/VYD - set WINDOW, DISPLAY, EVENT in K-WAPI ;01/30/95 16:09 ;;8.0T19;KERNEL;;Feb 22, 1995 ; S ;KWAPI equivalent of S ^$W(...)=... ;assume P1-P9 are inherited from ^XG. Not all parametrs may exist! ; N %,XGERR N XGOLDPF ;old paint flag S XGOLDPF=XGFLAG("PAINT") ;save previous S XGERR="SET" S C="," D:P1="XGW"&(P2=$J) ;adjust parameters because physical root was passed .F %=3:1:11 I $D(@("P"_%)) S @("P"_(%-2)_"=P"_%) K @("P"_%) D . ;-------- window attribute . ;ex: S ^$W("W1","VISIBLE")=1 . I '$D(P4) D Q . . D SW(P1,P2,P3) Q ;set window attributes . ; . ;-------- window event . ;ex: S ^$W("W1","EVENT","CLOSE")="TAG^ROUTINE" . I '$D(P5) D Q . . S XGERR=XGERR_"-WINDOW ATTRIBUTE UNKNOWN" . . I P2="EVENT" D Q . . . S ^TMP("XGW",$J,P1,"EVENT",P3)=P4 . . . D COMPLETE^XGEVNT1(P1) . . D HUH^XGUTIL2(XGERR) . ; . ;-------- element attribute / window event ENABLE or FILTERIN . ;ex: S ^$W("W1","G","BTN1","ACTIVE")=0 . ;ex: S ^$W("W1","EVENT","CLOSE","ENABLE")=0 . I '$D(P6) D Q . . ;-------- gadget attribute . . I P2="G" D Q . . . S XGERR=XGERR_"-GADGET" . . . D SG(P1,P3,P4,P5) . . ;-------- menu attribute . . I P2="M" D Q . . . I $E(P4)="Y" S ^TMP("XGW",$J,P1,"M",P3,P4)=P5 . . . S XGERR="-MENU UNKNOWN ATTRIBUTE OR VALUE" D HUH^XGUTIL2(XGERR) . . ;-------- timer attribute . . I P2="T" D Q . . . S ^TMP("XGW",$J,P1,"T",P3,P4)=P5 D COMPLETE^XGT(P1,P3) . . ;-------- window event ENABLE / FILTERIN . . I P2="EVENT" D Q . . . S ^TMP("XGW",$J,P1,"EVENT",P3,P4)=P5 . . ; . . S XGERR=XGERR_"-WINDOW ATTRIBUTE UNKNOWN" . . D HUH^XGUTIL2(XGERR) . ; . ;-------- element choice or event . ;ex: S ^$W("W1","G","LST1","CHOICE",1)="ONE" . ;ex: S ^$W("W1","G","BTN1","EVENT","SELECT")="TAG^ROUTINE" . I '$D(P7) D Q . . ;-------- gadget choice or event . . I P2="G" D Q . . . S XGERR=XGERR_"-GADGET" . . . I P4="CHOICE" D Q . . . . D SGC(P1,P3,P5,P6) I 1 ;set win,gdgt,"CHOICE",val . . . I P4="EVENT" D Q . . . . S ^TMP("XGW",$J,P1,"G",P3,"EVENT",P5)=P6 . . . . D COMPLETE^XGEVNT1(P1,"G",P3) . . . I P4="VALUE" D Q . . . . D S^XGGL1(P1,P3,"VALUE",P5) . . . S XGERR=XGERR_"-UNKNOWN ATTRIBUTE" . . . D HUH^XGUTIL2(XGERR) . . ;-------- menu choice or event . . ;I P2="M" D Q . . ;-------- timer event . . I P2="T" D Q . . . I P4="EVENT" D Q . . . . S ^TMP("XGW",$J,P1,"T",P3,"EVENT",P5)=P6 . . . . D COMPLETE^XGEVNT1(P1,"T",P3) . . . S XGERR=XGERR_"-TIMER UNKNOWN ATTRIBUTE" . . . D HUH^XGUTIL2(XGERR) . . S XGERR=XGERR_"-ELEMENT ATTRIBUTE UNKNOWN" . . D HUH^XGUTIL2(XGERR) . ; . ;-------- element choice attribute or event attribute . ;ex: S ^$W("W1","G","LST1","CHOICE",1,"ACTIVE")=1 . ;ex: S ^$W("W1","G","BTN1","EVENT","SELECT","ENABLE")=1 . I '$D(P8) D Q . . ;-------- gadget choice or event attribute . . I P2="G" D Q . . . S XGERR=XGERR_"-GADGET" . . . I P4="CHOICE" D Q . . . . D SC1^XGGL1(P1,P3,P5,P6,P7) . . . S XGERR=XGERR_"-UNKOWN ATTRIBUTE" . . . D HUH^XGUTIL2(XGERR) . . ;-------- menu choice or event attribute . . ;I P2="M" D Q . . ;-------- timer event attribute . . ;I P2="T" D Q . . S XGERR=XGERR_"-UNKNOWN ELEMENT AND UNKOWN VALUE" . . D HUH^XGUTIL2(XGERR) ; S XGFLAG("PAINT")=XGOLDPF ;restore previous U:^%ZOSF("OS")["VAX DSM" IO(0):FLUSH ;update screen immediately Q ; ; SW(XGW1,XGATR,XGVAL) ;set window attributes N XGG1 N T,L,B,R S XGERR=XGERR_"-WINDOW" D PAINTFLG^XGUTIL2(XGW1) D . ;------- ACTIVE . I XGATR="ACTIVE" D Q . . S ^TMP("XGW",$J,XGW1,XGATR)=XGVAL . ; . ;------- DEFBUTTON . I XGATR="DEFBUTTON" D Q . . S XGG1=$G(^TMP("XGW",$J,XGW1,"DEFBUTTON")) . . D PAINTFLG^XGUTIL2(XGW1,"G",XGG1) . . ;if window is visible & contains a visible defbutton that's . . ;different from the one that's being set, paint it as regular btn . . I "^11^21^"[(U_XGFLAG("PAINT")_U),$L(XGG1),XGVAL'=XGG1 D . . . K ^TMP("XGW",$J,XGW1,"DEFBUTTON") . . . D PAINT^XGG(XGW1,XGG1) . . S ^TMP("XGW",$J,XGW1,"DEFBUTTON")=XGVAL . . D PAINTFLG^XGUTIL2(XGW1,"G",XGVAL) . . I "^11^21^"[(U_XGFLAG("PAINT")_U),XGVAL'=XGG1 D . . . D PAINT^XGG(XGW1,XGVAL) . ; . ;------- NEXTG (no visible sidefect) . I XGATR="NEXTG" D Q . . S ^TMP("XGW",$J,XGW1,XGATR)=XGVAL . . D COMPLETE^XGWIN(XGW1) . ; . ;------- POS or SIZE . I XGATR="POS"!(XGATR="SIZE") D Q . . D:XGFLAG("PAINT")>0 REMOVE^XGWIN1(XGW1) . . S ^TMP("XGW",$J,XGW1,XGATR)=XGVAL . . D COORDW2^XGUTIL1(XGW1,.T,.L,.B,.R) . . S ^TMP("XGW",$J,XGW1,"YXGCOORDS")=T_U_L_U_B_U_R . . D:XGFLAG("PAINT")>0 WINP^XGWIN(XGW1,1) . ; . ;------- SIZE see POS . ; . ;------- TITLE . I XGATR="TITLE" D Q . . S ^TMP("XGW",$J,XGW1,"TITLE")=XGVAL . . D:XGFLAG("PAINT")>0 TITLE^XGUTIL1(XGW1) . ; . ;------- VISIBLE . I XGATR="VISIBLE" D Q . . S ^TMP("XGW",$J,XGW1,XGATR)=XGVAL . . I XGVAL=0,XGFLAG("PAINT")>0 D I 1 . . . D REMOVE^XGWIN1(XGW1) . . . D CHGFOCUS^XGWIN1(XGW1) . . E I XGVAL=1 D WINP^XGWIN(P1) . ; . ;------- Yattributes . I $E(XGATR)="Y" D Q . . S ^TMP("XGW",$J,XGW1,XGATR)=XGVAL . ; . D Q . . S XGERR=XGERR_"-UNKNOWN ATTR. AND/OR UNKNOW VAL." . . D HUH^XGUTIL2(XGERR) Q ; ; SG(XGW1,XGG1,XGATR,XGVAL) ;set an attribute of a gadget ;window,gadget,attribute,value N XGGTYP ;gadget type S XGGTYP=^TMP("XGW",$J,XGW1,"G",XGG1,"TYPE") D PAINTFLG^XGUTIL2(XGW1,"G",XGG1) D . ;------- ACTIVE . I XGATR="ACTIVE","FRAME/LABEL/SYMBOL"'[XGGTYP D Q . . I ^TMP("XGW",$J,XGW1,"G",XGG1,"ACTIVE")'=XGVAL S ^("ACTIVE")=XGVAL D . . . D:"^11^21^"[(U_XGFLAG("PAINT")_U) PAINT^XGG(XGW1,XGG1) . ; . ;------- CHANGED (no visible sidefect) . I XGATR="CHANGED" S ^TMP("XGW",$J,XGW1,"G",XGG1,"CHANGED")=XGVAL Q . ; . ;------- EVENT (no visible sidefect) . ;****** next line commented out on 1/29/95 . ;I XGATR="EVENT" S ^TMP("XGW",$J,XGW1,"G",XGG1,"EVENT",P5)=P6 Q . ; . ;------- NEXTG (no visible sidefect) . I XGATR="NEXTG" D Q . . S ^TMP("XGW",$J,XGW1,"G",XGG1,XGATR)=XGVAL . . D COMPLETE^XGG(XGW1,XGG1) . ; . ;------- POS or SIZE . I XGATR="POS"!(XGATR="SIZE") D Q . . I "^11^21^"[(U_XGFLAG("PAINT")_U),^TMP("XGW",$J,XGW1,"G",XGG1,XGATR)'=XGVAL D . . . D ERASE^XGG(XGW1,XGG1) . . . S ^TMP("XGW",$J,XGW1,"G",XGG1,XGATR)=XGVAL . . . D COMPLETE^XGG(XGW1,XGG1) . . . D PAINT^XGG(XGW1,XGG1) . . S ^TMP("XGW",$J,XGW1,"G",XGG1,XGATR)=XGVAL . ; . ;------- SIZE see POS . ; . ;------- TITLE . I XGATR="TITLE","GENERIC/SCROLL/SYMBOL"'[XGGTYP D Q . . D:"^11^21^"[(U_XGFLAG("PAINT")_U) . . . S ^("TITLE")=XGVAL_$J("",$L($G(^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE")))-$L(XGVAL)) ;expand to completely overlay old title text . . . D TITLE^XGUTIL1(XGW1,XGG1) . . S ^TMP("XGW",$J,XGW1,XGG1,"TITLE")=XGVAL . ; . ;------- VISIBLE . I XGATR="VISIBLE" D Q . . I "^11^21^"[(U_XGFLAG("PAINT")_U),XGVAL=0 D ERASE^XGG(XGW1,XGG1) I 1 . . E I XGFLAG("PAINT")'<10,XGVAL=1 D . . . S XGFLAG("PAINT")=XGFLAG("PAINT")\10*10+1 ;adjust paint flag . . . D PAINT^XGG(XGW1,XGG1) . . S ^TMP("XGW",$J,XGW1,"G",XGG1,"VISIBLE")=XGVAL . ; . ;------- YANYTHING (no visible sidefect) . I $E(XGATR)="Y" S ^TMP("XGW",$J,XGW1,"G",XGG1,XGATR)=XGVAL Q . ; . D Q . . I XGGTYP="BUTTON" D S^XGGB(XGW1,XGG1,XGATR,XGVAL) Q . . I XGGTYP="CHECK" D S^XGGC(XGW1,XGG1,XGATR,XGVAL) Q . . I XGGTYP="DOCUMENT" D S^XGGD(XGW1,XGG1,XGATR,XGVAL) Q . . I XGGTYP="FRAME" D S^XGGF(XGW1,XGG1,XGATR,XGVAL) Q . . I XGGTYP="LABEL" D S^XGGLBL(XGW1,XGG1,XGATR,XGVAL) Q . . I XGGTYP="LIST" D S^XGGL1(XGW1,XGG1,XGATR,XGVAL) Q . . I XGGTYP="LISTBUTTON" D S^XGGLB(XGW1,XGG1,XGATR,XGVAL) Q . . I XGGTYP="LISTENTRY" D S^XGGT(XGW1,XGG1,XGATR,XGVAL) Q . . I XGGTYP="LONGLIST" D S^XGGL1(XGW1,XGG1,XGATR,XGVAL) Q . . I XGGTYP="RADIO" D S^XGGR(XGW1,XGG1,XGATR,XGVAL) Q . . I XGGTYP="SYMBOL" D S^XGGSY(XGW1,XGG1,XGATR,XGVAL) Q . . I XGGTYP="TEXT" D S^XGGT(XGW1,XGG1,XGATR,XGVAL) Q Q ; ; SGC(XGW1,XGG1,XGITEM,XGVAL) ;set CHOICE value ;window,gadget,choiceitem,value N XGGTYP ;gadget type S XGGTYP=^TMP("XGW",$J,XGW1,"G",XGG1,"TYPE") D SC^XGGL1(XGW1,XGG1,XGITEM,XGVAL) Q ; ; SGE(XGW1,XGG1,XGITEM,XGVAL) ;set CHOICE value Q ; ; SD ;set display attribute ;assume P1-P3 are inherited from ^XG. ;P1:display (usually $PD) ;P2:display attribute ie. "FOCUS","BCOLOR","FCOLOR" ;P3:attribute value ie. "WINDOW1,GADGET1" ;I need to implement a good error trap here ;this code is very unrobust. N %,XGERR S XGERR="SET-DISPLAY" S C="," I P2="FOCUS" D I 1 ; . S XGNEXTG=$P(P3,C,2) ;set next gadget to one that'll be in focus . ;if chng windows and window to get focus is not one that's focused now . I $P(P3,C)'=$P(^TMP("XGD",$J,$PD,"FOCUS"),C) D . . S %=$O(^TMP("XGUTIL",$J,"FOCUS",""),-1)+1 . . S ^TMP("XGUTIL",$J,"FOCUS",%)=^TMP("XGD",$J,$PD,"FOCUS") ;stack the previously focused window E S XGERR=XGERR_"-UNKNOWN ATTR. AND/OR UNKOWN VAL." D HUH^XGUTIL2(XGERR) S ^TMP("XGD",$J,$PD,P2)=P3 Q XGSETUP^INT^1^60169,79034^0 XGSETUP ;SFISC/VYD - setup KWAPI environment ;03/16/95 13:29 ;;8.0;KERNEL;;Jul 03, 1995 PREP ;prepare graphics environment. Can be called multiple times. N %,X S U="^",C="," D CLEAN2 S XG255=$C(255) S XGPAD=$J("",IOM) D:'$D(XGATRSET)!('$D(XGEMPATR))!('$D(XGCURATR))!('$D(IORESET)) ATR D:'$D(^XUTL("XGATR")) ATRTABLE F %=0:1:IOSL-1 D . S XGSCRN(%,0)=XGPAD . S XGSCRN(%,1)=$TR(XGPAD," ",XGEMPATR) D ADJUST^XGSW(0,0,IOSL-1,IOM-1,"XGSCRN") ;store "COORDS" node S XGSCRN("ORDER",0)=$C(1) W IORESET,IOCUOFF,IOKPAM,@IOF S XGCURATR=XGEMPATR X ^%ZOSF("EOFF") S X=0 X ^%ZOSF("RM") D INIT^XGKB("*") ;turn on escape processing S $X=0,$Y=0 ;S ($X,$Y)=0 ;DTM 4.3 choked here Q ; ; KWAPI ;K-WAPI specific setup N % S (XGOLDFCS,XGNEWFCS)="" S XGFLAG("ABORT")=0 ;flag if 1 will stop processing of a gadget S XGFLAG("PAINT")=21 ;initialize paint flag S XGESEQ="1000000^0" ;event_stack_level^event_sequence_counter unique S XGMENU="" ;flag if not empty indicates that user went or is in menu S XGUFCTR("PIXEL","X")=0.125 S XGUFCTR("PIXEL","Y")=0.05 S XGUFCTR("CHAR","X")=1 S XGUFCTR("CHAR","Y")=1 ; ;------------set up DISPLAY with defaults S ^TMP("XGD",$J,$PD,"PLATFORM")="ZEMULATION,KERNEL "_$$VERSION^XPDUTL("XU") S:'$D(^TMP("XGD",$J,$PD,"FOCUS")) ^("FOCUS")="" S:'$D(^TMP("XGD",$J,$PD,"UNITS")) ^("UNITS")="PIXEL" ; ;------------load key-actions D ACTION^XGKB("KP0","D KP0^XGJUMP") ;menubar D ACTION^XGKB("F10","D KP0^XGJUMP") ;menubar D ACTION^XGKB("CR","D CR^XGJUMP") D ACTION^XGKB("^C","D CTRLC^XGJUMP") ;break the program D ACTION^XGKB("^R","D CTRLR^XGJUMP") ;window resize D ACTION^XGKB("^V","D CTRLV^XGJUMP") ;window move D ACTION^XGKB("^W","D CTRLW^XGJUMP") ;window select window D ACTION^XGKB("^Z","D CTRLZ^XGJUMP") ;window close D ACTION^XGKB("^\","D CTRLBSL^XGJUMP") ;window control menu D ACTION^XGKB("TAB","D TAB^XGJUMP") ;next gadget D ACTION^XGKB("PF4","D PF4^XGJUMP") ;previous gadget ; ;------------ set up a window control menu S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",1)="&Restore" S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",2)="&Move" S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",2,"EVENT","SELECT")="MOVE^XGWCTRL" S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",2,"ACCELERATOR")="^V" S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",3)="&Size" S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",3,"EVENT","SELECT")="RESIZE^XGWCTRL" S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",4)="Mi&nimize" S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",5)="Ma&ximize" S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",5,"SEPARATOR")=1 S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",6)="&Close" S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",6,"EVENT","SELECT")="CLOSE^XGWCTRL" S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",6,"SEPARATOR")=1 S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",7)="S&witch To..." S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",7,"EVENT","SELECT")="CTRLW^XGJUMP" ; ;------------ put up wall paper and save it as 1st window ;D GRID^XGFDEMO ;D ^XGWALL ;M ^TMP("XGS",$J,$C(1))=XGSCRN D WINSAVE^XGWIN($C(1),0,0,IOSL,IOM) Q ; ATR ;setup screen/graphic params. load attribute array ; this should usually run once at login N X I ^%ZOSF("OS")["DTM" U $I:VT=1 ;if DTM change to VT220 emulation D HOME^%ZIS,GSET^%ZISS S X="IOBOFF;IOBON;IODWL;IOINHI;IOINORM;IOKPAM;IOKPNM;IORESET;IORVOFF;IORVON;IOSWL;IOUON;IOUOFF" D ENDR^%ZISS S IORESET=$C(27)_"[0m"_IOG0 ;turn off all attr. diff from stnd IORESET S IOCUOFF=$C(27)_"[?25l",IOCUON=$C(27)_"[?25h" ;cursor on, cursor off S XGATRSET(8)=U_IORESET,XGATRSET(2)=IOBOFF_U_IOBON S XGATRSET(3)=IOINORM_U_IOINHI,XGATRSET(4)=IORVOFF_U_IORVON S XGATRSET(5)=IOSWL_U_IODWL,XGATRSET(6)=IOG0_U_IOG1 S XGATRSET(7)=IOUOFF_U_IOUON S (XGCURATR,XGEMPATR)=$C(1) Q ; ATRTABLE ;setup ^XUTL("XGATR" attr letter to ESC code conversion table N % F %=1:1:255 S ^XUTL("XGATR",$C(%))=$$ESC^XGSA($C(%)) Q ; CLEAN ;clean up KWAPI variables, screen/graphic parameters ;this tag does universal clean up. It should be called at the end of all K-WAPI sessions. X ^%ZOSF("EON") ; turn echo on S X=IOM X ^%ZOSF("RM") ;restore right margin for proper wrapping W IOCUON_IOKPNM_IORESET ; cursor on, number mode, reset terminal D EXIT^XGKB ; turn off escape processing D KILL^%ZISS,GKILL^%ZISS K XGATRSET,XGCURATR,XGEMPATR,XGKEYMAP,XGSPCIAL,XGPAD,XG255 K IOCUON,IOCUOFF K XGWIN,XGEVNT,XGDI CLEAN2 ;other than fall through, this is called from PREP K ^TMP("XGE",$J),^TMP("XGD",$J),^TMP("XGS",$J),^TMP("XGW",$J) K ^TMP("XGUTIL",$J),^TMP("XGKEY",$J) ;kill utility and key-action table K XGMENU,XGSCRN,XGWT,XGWL,XGWB,XGWR,XGTRACE,XGOLDFCS,XGNEWFCS K XGW,XGG,XGID,XGMENU,XGFLAG,XGUFCTR,XGDEFBTN,XGNEXTG,XGWAIT Q XGSW^INT^1^60169,79034^0 XGSW ;SFISC/VYD - screen window primitives ;01/11/95 15:58 ;;8.0;KERNEL;;Jul 03, 1995 ; WIN(T,L,B,R,S) ;draw a bordered window ;top,left,bottom,right,screen root S:B'(IOSL-1) B=IOSL-1 ;adjust if longer than screen S R=$J(R/XGUFCTR("CHAR","X"),0,0)+1 ;S:R>(IOM-1) R=IOM-1 ;adjust if wider than screen Q ; ; COORDW29(XGW1,T,L,B,R) ;calculate coordinates of a window N XGUNITS ;units N XGPW,XGPWT,XGPWL ;parent window,parent window top,parent window left N % S:'$D(XGW1) XGW1=XGW ; ;S XGUNITS=unit component of POS, if component not present than UNITS attrib of the window S XGUNITS=$S($P(^TMP("XGW",$J,XGW1,"POS"),C,3)]"":$P(^("POS"),C,3),1:^("UNITS")) ; convert TOP and LEFT to pixels S T=($P(^TMP("XGW",$J,XGW1,"POS"),C,2)*XGUFCTR(XGUNITS,"Y"))\1 S L=($P(^TMP("XGW",$J,XGW1,"POS"),C)*XGUFCTR(XGUNITS,"X"))\1 ; offset from parent window(s).Work in pixels for consistancy ; follow the windows' PARENT link to adjust Top and Left coordinates ; stop looping when A) window doesn't have a PARENT node, or ; B) window isn't TIED to its parent, or ; C) PARENT points to window which doesn't exist, or ; D) PARENT points to itself (circular reference) S XGPW=XGW1 F S %=$G(^TMP("XGW",$J,XGPW,"PARENT"),XG255) Q:'^("TIED")!('$D(^TMP("XGW",$J,%))!(%=XGPW)) D .S XGPW=% .S XGUNITS=$S($P(^TMP("XGW",$J,XGPW,"POS"),C,3)]"":$P(^("POS"),C,3),1:^("UNITS")) .S XGPWT=($P(^TMP("XGW",$J,XGPW,"POS"),C,2)*XGUFCTR(XGUNITS,"Y"))\1 .S XGPWL=($P(^TMP("XGW",$J,XGPW,"POS"),C)*XGUFCTR(XGUNITS,"X"))\1 .S T=XGPWT+T+1,L=XGPWL+L+1 S XGUNITS=$S($P(^TMP("XGW",$J,XGW1,"SIZE"),C,3)]"":$P(^("SIZE"),C,3),1:^("UNITS")) S B=T+(($P(^TMP("XGW",$J,XGW1,"SIZE"),C,2)*XGUFCTR(XGUNITS,"Y"))\1) S R=L+(($P(^TMP("XGW",$J,XGW1,"SIZE"),C)*XGUFCTR(XGUNITS,"X"))\1) S XGWT("PIXEL")=T,XGWL("PIXEL")=L,XGWB("PIXEL")=B,XGWR("PIXEL")=R ; convert TOP,LEFT,BOTTOM,RIGHT to CHAR add 1 to BOTTOM,RIGHT S T=(T/XGUFCTR("CHAR","Y"))\1,L=(L/XGUFCTR("CHAR","X"))\1 S B=(B/XGUFCTR("CHAR","Y"))\1+$S($D(^TMP("XGW",$J,XGW1,"MENUBAR")):2,1:1) ;S:B>(IOSL-1) B=IOSL-1 ;adjust if longer than screen S R=(R/XGUFCTR("CHAR","X"))\1+1 ;S:R>(IOM-1) R=IOM-1 ;adjust if wider than screen Q ; ; COORDG(XGW1,XGG1,T,L,B,R) ;calculate coordinates of a gadget N XGWC,XGGC ;window coordinates, gadget corrdinates ;S:$G(XGW1)="" XGW1=XGW ;S:$G(XGG1)="" XGG1=XGG S XGWC=^TMP("XGW",$J,XGW1,"YXGCOORDS") S XGGC=^TMP("XGW",$J,XGW1,"G",XGG1,"YXGCOORDS") S T=$P(XGWC,U,1)+$P(XGGC,U,1) S L=$P(XGWC,U,2)+$P(XGGC,U,2) S B=$P(XGWC,U,1)+$P(XGGC,U,3) S R=$P(XGWC,U,2)+$P(XGGC,U,4) Q ; ; TITLE(XGW1,XGG1,T,L,R) ;output gadget title ;XGW window, XGG gadget N A,XGTITLE,XGLEN,%,X,P ;A:attribute,XGLEN:title length,P:piece N %XPOS,%YPOS,%SIZE I $L($G(XGG1)) D I 1 ;paint title for a gadget . D:'$D(T)!('$D(L))!('$D(R)) COORDG(XGW1,XGG1,.T,.L,"",.R) . S A=$S($G(^TMP("XGW",$J,XGW1,"G",XGG1,"ACTIVE"),1):"I1",1:"I0") ;set title attr . S XGTITLE=^TMP("XGW",$J,XGW1,"G",XGG1,"TITLE") E D ;paint title for a window . D:'$D(T)!('$D(L))!('$D(R)) COORDW2(XGW1,.T,.L,"",.R) . S A="I"_^TMP("XGW",$J,XGW1,"ACTIVE") ;set title attr . S XGTITLE=$G(^TMP("XGW",$J,XGW1,"TITLE")) S %SIZE=R-L+1 D . I $G(XGG1)="" D Q ;paint title for window . . S XGTITLE=$E(XGTITLE,1,%SIZE) . . S %XPOS=(%SIZE-$L(XGTITLE))\2+L . . S %YPOS=T . . ;replace prev title by paint top of window frame . . D SAY^XGS(T,L+1,$TR($J("",%SIZE-2)," ",IOHL),"G1") . I XGGTYP="BUTTON" D Q . . S %XPOS=L,%YPOS=T . I XGGTYP="CHECK" D Q . . S %XPOS=L+3,%YPOS=T . . S XGTITLE=$E(XGTITLE,1,%SIZE-3) . I XGGTYP="FRAME" D Q . . S %XPOS=L+1,%YPOS=T . . S XGTITLE=$E(XGTITLE,1,%SIZE-2) . I XGGTYP="LABEL" D Q . . S %XPOS=L,%YPOS=T . . S XGTITLE=$E(XGTITLE,1,%SIZE) . D Q . . S %XPOS=$S($G(^TMP("XGW",$J,XGW1,"G",XGG1,"TPOS"))="LEFT":L-$$L^XGM1(XGTITLE),$G(^("TPOS"))="RIGHT":R+1,1:L) . . S %YPOS=$S("\LEFT\RIGHT\"[("\"_$G(^TMP("XGW",$J,XGW1,"G",XGG1,"TPOS"))_"\"):T,1:T-1) D SAYU^XGS(%YPOS,%XPOS,XGTITLE,A) Q XGUTIL2^INT^1^60169,79034^0 XGUTIL2 ;SFISC/VYD - KWAPI utility functions ;02/02/95 11:24 [ 02/02/95 9:01 PM ] ;;8.0T19;KERNEL;;Feb 22, 1995 ; PAINTFLG(XGW1,XGELTYP,XGELMNT) ;set paint flag ;flag value window visible, window is on top, element visible ; 0 0 err if on top 0 ; 1 0 err if on top 1 ; 10 1 0 0 ; 11 1 0 1 ; 20 1 1 0 ; 21 1 1 1 N % ;------ set window component of the flag S XGFLAG("PAINT")=$D(XGSCRN("ORDERX",XGW1)) S %=$O(XGSCRN("ORDER",""),-1) ;get subscript of topmost window S %=XGSCRN("ORDER",%) ;% = window on top S XGFLAG("PAINT")=(XGFLAG("PAINT")+(%=XGW1))*10 ;------ set gadget/menu component of the flag D:$L($G(XGELMNT)) . I XGELTYP="G" S XGFLAG("PAINT")=XGFLAG("PAINT")+$G(^TMP("XGW",$J,XGW1,XGELTYP,XGELMNT,"VISIBLE"),0) Q . ;if checking menu that's a MENUBAR of a window, VISIBLE is ignored . I $L($G(^TMP("XGW",$J,XGW1,"MENUBAR"))),XGELMNT=^("MENUBAR") S XGFLAG("PAINT")=XGFLAG("PAINT")+1 Q ; ; CHAR(XGW1,XGG1,XGATR,XGHV) ;return gadget attribute (POS/SIZE) in chars ;XGW1:window,XGG1:gadget,XGATR:POS/SIZE,XGHV:1=horizontal 2=vertical N XGUNITS ;units N XGHV1 ;horizontal or vertical component expressed in "X" or "Y" S XGUNITS=$S($P(^TMP("XGW",$J,XGW1,"G",XGG1,XGATR),C,3)]"":$P(^(XGATR),C,3),1:^("UNITS")) ;Q $J($P(^TMP("XGW",$J,XGW1,"G",XGG1,XGATR),C,XGHV)/$S(XGUNITS="PIXEL":$S(XGHV=2:20,1:8),1:1),0,0) S XGHV1=$S(XGHV=2:"Y",1:"X") ;convert 1 to X or 2 to Y respectively Q $J($P(^TMP("XGW",$J,XGW1,"G",XGG1,XGATR),C,XGHV)*XGUFCTR(XGUNITS,XGHV1),0,0) ;***** next line commented on 12/1/94 ;Q ($P(^TMP("XGW",$J,XGW1,"G",XGG1,XGATR),C,XGHV)*XGUFCTR(XGUNITS,XGHV1))\1 ; ; WAIT(%ONOFF) ;Put up or erase the "WAIT" indicator N %,XGSAVSCR ;used to save top line to restore after writing WAIT ;if %ONOFF=1 and "WAIT" isn't on the screen already it will be painted ;***** next 1 line commented out 2/2/95 ;I %ONOFF,$E(XGSCRN(0,0),IOM-3,IOM)'="WAIT",'$D(XGWAIT) D I 1 I %ONOFF,'$D(XGWAIT) D I 1 . D SAVE^XGSW(0,IOM-4,0,IOM-1,"XGWAIT") . F %=0,1 S XGSAVSCR(0,%)=XGSCRN(0,%) ;don't leave a trace . D SAY^XGS(0,IOM-4,"WAIT","B1R1") . F %=0,1 S XGSCRN(0,%)=XGSAVSCR(0,%) ;restore to state prior to WAIT ; ;***** next 3 lines commented out 2/2/95 ;E D ;otherwise remove ;. D:$E(XGSCRN(0,0),IOM-3,IOM)="WAIT"&($D(XGWAIT)) RESTORE^XGSW("XGWAIT") ;. K XGWAIT E D:$E(XGSCRN(0,0),IOM-3,IOM)=$E($G(XGWAIT(0,0)),IOM-3,IOM) ;otherwise remove . S $E(XGSCRN(0,0),IOM-3,IOM)="WAIT" ;to force RESTORE to work . D RESTORE^XGSW("XGWAIT") . K XGWAIT Q ; ; HUH(MSG) ;this entry point is used whenever the application's ;request and intention could not be understood N %,T,L,B,R,Y,XGKEY,XGRT N XGOLDPF ;old paint flag W *7 H .5 W *7 Q:KWAPI>1 S XGOLDPF=XGFLAG("PAINT") ;save previous S XGFLAG("PAINT")=21 S T=4,L=0,B=20,R=IOM-1 D WIN^XGSW(T,L,B,R,$NA(^TMP("XGS",$J,"XGERR"))) D SAY^XGS(T+1,L+2,"If you're reading this, it means that the application tried to do something") D SAY^XGS(T+2,L+2,"that the Kernel Windowing API could not understand.") D SAY^XGS(T+4,L+2,"Please make a note of this error and notify G.KERNEL DEV GROUP@ISC-SF") D SAY^XGS(T+5,L+2,"or call (415) 744-7520. Thanks!") D:$D(MSG) SAY^XGS(T+7,L+5,"The program intent was: "_MSG) S %=1 F Q:'$D(@("P"_%)) D .I %#2 D SAY^XGS(T+9+(%\2),L+5,"P"_%_" = **"_@("P"_%)_"##") .E D SAY^XGS(T+8+(%\2),L+40,"P"_%_" = **"_@("P"_%)_"##") .S %=%+1 ; X ^%ZOSF("PROGMODE") S XGFLAG("CAN BREAK")=Y&(^%ZOSF("OS")["VAX DSM") I XGFLAG("CAN BREAK") D SAY^XGS(B-1,L+1,"Press any key to continue, or ""B"" to break the program and drop into debugger.","R1") I 1 E D SAY^XGS(B-1,L+22," Press any key to continue ","R1") I 1 R XGKEY#1:999 I XGFLAG("CAN BREAK"),"^B^b^"[(U_XGKEY_U) X "ZDEBUG ON BREAK" I 1 E D RESTORE^XGSW($NA(^TMP("XGS",$J,"XGERR"))) K ^TMP("XGS",$J,"XGERR") K XGFLAG("CAN BREAK") S XGFLAG("PAINT")=XGOLDPF ;restore previous Q XGVB0^INT^1^60169,79034^0 XGVB0 ;ISC-SF/EG - VB 2 MWAPI Translator ;09/14/94 11:03 AM ;;8.0T19;KERNEL;;Feb 22, 1995 MAIN(HOST,DISPLAY,COMPILE) ; ;M extrinsic function ; ;Inputs ; ;HOST (STR) Host file name with full directory reference ;DISPLAY (BOOL) Display MWAPI yes/no ;COMPILE (BOOL) Compile window into object file yes/no ; ;Outputs ; ;FORM (STR) Window name if success, else numeric<0 for error ; N IEN,TMP,ORRY,FORM,X S X=^%ZOSF("ERRTN"),@^%ZOSF("TRAP") S U="^" S TMP=$NA(^TMP("XGVB",$J)) S ORRY=$NA(^TMP("XGVB",$J)) S X="XG" X ^%ZOSF("TEST") IF '$T Q "-1^KERNEL GUI NOT INSTALLED" IF '$D(^DD(8995)) Q "-1^KERNEL GUI NOT INSTALLED" IF '$D(^DD(8995.1)) Q "-1^TRANSLATOR NOT INSTALLED" D K^XG() ;kill all windows using KWAPI call IF ^%ZOSF("OS")["MSM" ZSTOP S FORM=$$BARY^XGVB1(HOST,TMP,ORRY,DISPLAY,COMPILE) ;build array from VB resource IF +FORM'<0 D . IF DISPLAY=-1 D . . S @ORRY@(FORM,"VISIBLE")=1 . . K @ORRY@(FORM,"~1") . . D M^XG(FORM,$NA(^TMP("XGVB",$J,FORM))) ;merge ^$W using KWAPI call K @ORRY@("~1") Q "#^"_FORM XGVB1^INT^1^60169,79034^0 XGVB1 ;ISC-SF/EG - VB to MWAPI Translator (FORM Object) ;09/14/94 11:03 AM ;;8.0T19;KERNEL;;Feb 22, 1995 BARY(FREF,TARRY,ORRY,DISP,COMP) ;Convert VB "Form" to MWAPI "Window" ;Type Extrinsic M function ; ;Input ; ;FREF Host file reference, i.e. C:\DATA\VB\A1BB0.FRM ;TARRY Temporary array ;ORRY Output Array (will be merged to ^$W). Use closed form ;DISP display window ;COMP compile window into object file ; ;Output ; ;FORMNM Form name ;-1^Text Error ; N ATTNM,ATTVL,ATTRIB,COM,COUNT,ERR,EXIT,EXIT1,FH,FORMNM,FRMTYPE,GADGET,GADGETNM,GADGETVL,I,LEVEL,LINE,LINE1,PREFIX,OREF,OREFS N TMP,ORRY,FORM,XGVB,SEQ N OUT,DWIDTH,LOFF,TOFF,WOFF,HOFF,DFONT,DFONTP,DFONTS ; ;get default parameters S ERR=0 I '$D(U) S U="^" S (ORRY,TMP)=$NA(^TMP("XGVB",$J)) K @TMP,@ORRY D DEFPRM^XGVBUTL1(.XGVB) ; ;read VB resource file and build MWAPI hierarchy global K @TARRY S OREFS=TARRY IF OREFS'["(" S OREFS=OREFS_"("_$J_")" S OREF=$S(TARRY["(":$E(TARRY,1,$L(TARRY)-1)_","_"""~1"""_")",1:TARRY_"("_$C(34)_$C(34)_"~1"_$C(34)_")") S TARRY=OREF S (COUNT,EXIT,LEVEL)=0 S SEQ=0 S FH=$$FOPEN^XGVBUTL1(FREF) S FORMNM="" IF +FH<0 Q FH F D Q:EXIT . S LINE=$$FREAD^XGVBUTL(FH) IF COUNT=0 D . . S COUNT=1 . . IF $E(LINE,3,9)'="VERSION" S EXIT=1,ERR="-1^FILE IS NOT IN TEXT FORMAT" . . Q . IF LINE="-1^EOF" S EXIT=1 Q . IF $TR(LINE,"begin","BEGIN")["BEGIN" D Q . . S LINE=$TR(LINE,"^0") . . S PREFIX=$P(LINE_0,$E($TR(LINE," ")_0)) . . IF $L(PREFIX)>0 S LINE=$P(LINE,PREFIX,2) . . S LEVEL=LEVEL+1 . . S GADGET=$P(LINE," ",2) . . S GADGETVL=$$UC($P(LINE," ",3)) . . S I=0 F D Q:I="DONE" . . . IF '$D(XGVB("W",GADGETVL)) S XGVB("W",GADGETVL)="",I="DONE" Q . . . S GADGETVL=GADGETVL_I . . . S I=I+1 . . S:FORMNM="" FORMNM=GADGETVL,FRMTYPE=GADGET . . D . . . IF GADGET="Form"!(GADGET="MDIForm") D Q . . . . S @OREF@(GADGET,GADGETVL)="" . . . . IF TARRY["(" S TARRY(LEVEL)=$E(TARRY,1,$L(TARRY)-1)_","_$C(34)_GADGETVL_$C(34)_")" Q . . . . S TARRY(LEVEL)=TARRY_"("_$C(34)_$C(34)_GADGETVL_$C(34)_")" Q . . . IF GADGET="Menu" D Q . . . . S:'$D(@OREFS@(FORMNM,"MENUBAR")) @OREFS@(FORMNM,"MENUBAR")="MBAR" . . . . S PREFIX=$S(LEVEL#2=0:"""CHOICE""",1:"""SUBMENU""") . . . . S @OREF@(GADGETVL,GADGET)="" . . . . IF LEVEL=2 S TARRY(LEVEL)=$E(TARRY,1,$L(TARRY)-1)_","_"""M"""_","_"""MBAR"""_","_PREFIX_","_$C(34)_GADGETVL_$C(34)_")" Q . . . . S TARRY(LEVEL)=$E(TARRY,1,$L(TARRY)-1)_","_$C(34)_GADGETVL_$C(34)_")" Q . . . S @OREF@(GADGETVL,GADGET)="" . . . S PREFIX=$S(LEVEL=2:"""G""",1:"""CHOICE""") . . . IF TARRY["(" S TARRY(LEVEL)=$E(TARRY,1,$L(TARRY)-1)_","_PREFIX_","_$C(34)_GADGETVL_$C(34)_")" Q . . . S TARRY(LEVEL)=TARRY_"("_PREFIX_","_$C(34)_$C(34)_GADGETVL_$C(34)_")" . . S TARRY=TARRY(LEVEL) . . S COUNT=COUNT+1 . IF $TR($TR(LINE," ",""),"end","END")="0^END" D IF LEVEL=0!(LEVEL<0) S EXIT=1 Q . . S LEVEL=LEVEL-1 . . S:LEVEL>0 TARRY=TARRY(LEVEL) . IF COUNT>1 D . . S LINE1=$TR($E(LINE,3,255)," ") . . S ATTNM=$P(LINE1,"=") . . S ATTVL=$P($P(LINE1,"=",2),"'") . . IF $TR(LINE,"caption","CAPTION")["CAPTION"!($TR(LINE,"name","NAME")["NAME") D . . . S ATTVL=$P($P(LINE,"=",2),"'") . . . S ATTVL=$P(ATTVL,$C(34),2) . . . S ATTVL=$TR(ATTVL,$C(34)) . . . Q . . S @TARRY@(ATTNM)=$E(ATTVL,1,255) . . S COUNT=COUNT+1 D ^%ZISC IF +ERR<0 Q ERR ;now go through array again, translate and cleanup S TARRY=OREF S EXIT=0 S FORMNM=$O(@OREF@(FRMTYPE,"")) D BFORM^XGVB1A(TARRY,OREFS,FRMTYPE,FORMNM) ;do VB form S TARRY=$P(OREF,")")_","_$C(34)_FORMNM_$C(34)_")" F D Q:EXIT=1 . S EXIT1=0 . S TARRY=$Q(@TARRY) IF TARRY=""!(TARRY'[$P($NA(@OREFS),")")) S EXIT=1 Q . S COM=$L(TARRY)-$L($TR(TARRY,",")) . S GADGET=$P($P(TARRY,",",COM+1),")") . S GADGET=$TR(GADGET,$C(34)) . S GADGETNM=$P($P(TARRY,",",COM),")") . S GADGETNM=$TR(GADGETNM,$C(34)) . IF GADGETNM'=FORMNM D BGDGT^XGVB1B(TARRY,OREFS,$O(@OREF@(GADGETNM,"")),COM) Q FORMNM ; UC(X) ;return upper case X Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") XGVB1A^INT^1^60169,79034^0 XGVB1A ;ISC-SF/EG - VB to MWAPI Translator (FORM Object) ;09/14/94 11:03 AM ;;8.0T19;KERNEL;;Feb 22, 1995 BFORM(IN,OUT,GADGET,GADGETNM) ;translate form ;Type M Subroutine ; ;Input ; ;IN Source array of VB resources ;OUT Array of translated resources ;GADGET Gadget type (i.e. Form, Label) ;GADGETNM Gadget name (i.e. "CANCEL" for a cancel button) ; N EXIT,X,SREF,PHEIGHT,PWIDTH,XT,XF S XT="MWAPI" S XF="FORM" S EXIT=0 S X="" S PHEIGHT=$S(GADGET="Form":"Height",1:"ClientHeight") S PWIDTH=$S(GADGET="Form":"Width",1:"ClientWidth") F D Q:EXIT . S X=$O(@IN@(GADGETNM,X)) IF X="" S EXIT=1 Q . S SREF=$$V2M(XT,XF,X) . IF +SREF<0 Q . S ATTRIB=$S('$D(@IN@(GADGETNM,X)):$P(SREF,U,2),1:@IN@(GADGETNM,X)) . IF ATTRIB=-1 S ATTRIB=1 . IF $P(SREF,U)="FSIZE" S ATTRIB=ATTRIB\1 . S @OUT@(GADGETNM,$P(SREF,U))=ATTRIB . IF $P(SREF,U)="RESIZE" S @OUT@(GADGETNM,$P(SREF,U))=$S(@IN@(GADGETNM,X)=2:1,1:0) . IF $P(SREF,U)="POS" S @OUT@(GADGETNM,$P(SREF,U))=($$WDT(@IN@(GADGETNM,"Left"),XGVB("TWIPS"),XGVB("LOFF")))_","_($$WDT(@IN@(GADGETNM,"Top"),XGVB("TWIPS"),XGVB("TOFF"))) . IF $P(SREF,U)="SIZE" S @OUT@(GADGETNM,$P(SREF,U))=($$WDT(@IN@(GADGETNM,PWIDTH),XGVB("TWIPS"),XGVB("WOFF")))_","_($$WDT(@IN@(GADGETNM,PHEIGHT),XGVB("TWIPS"),XGVB("HOFF"))) . IF $P(SREF,U)["COLOR" D . . S @OUT@(GADGETNM,$P(SREF,U))=$$COLOR^XGVBUTL(@IN@(GADGETNM,X)) IF '$D(@OUT@(GADGETNM,"COLOR")) S @OUT@(GADGETNM,"COLOR")=XGVB("COLOR") IF '$D(@OUT@(GADGETNM,"FFACE")) S @OUT@(GADGETNM,"FFACE")=XGVB("FONT") IF '$D(@OUT@(GADGETNM,"FSIZE")) S @OUT@(GADGETNM,"FSIZE")=XGVB("FONTP")\1 IF '$D(@OUT@(GADGETNM,"FSTYLE")) S @OUT@(GADGETNM,"FSTYLE")=XGVB("FONTS") Q WDT(DIM,DWIDTH,DOFF) ; ;Type Extrinsic M Function ; ;Input ; ;DIM Dimension in Pixels ;DWIDTH Conversion factor ;DOFF Conversion Offset ; ;Output ; ;Numeric Conversion of Twips to Pixels ; N T S T=(DIM\DWIDTH)+DOFF IF T'>0 S T=T*(-1) Q T TYPE(GADGET,PARAM) ; ;Type Extrinsic M function ; ;Input ; ;GADGET Type of VB gadget (i.e."ComboBox") ;PARAM Gadget specifier (type "2" ComboBox a.k.a drop down list ; ;Output ; ;TYPE Equivalent MWAPI gadget (in the example, return LISTBUTTON ; N DA,TYPE S (DA,TYPE)="" IF $D(^XTV(8995.12,"TYPE",GADGET,PARAM)) D . S DA=$O(^XTV(8995.12,"B",^XTV(8995.12,"TYPE",GADGET,PARAM),DA)) . IF $P(^XTV(8995.12,DA,9),"^") S TYPE=$P(^(0),U) Q TYPE ; V2M(X,Y,Z) ;returns object and value which translates X ;Type Extrinsic M function ; ;Input ; ;X Translation TYPE (normally MWAPI to vb) ;Y Gadget translating ;Z Attribute to translate ; ;Output ; ; Gadget^Default value ; N G,H,K,R S K=X_","_Y_","_Z IF K="" Q "-1^BAD PARAMETERS" S R=$NA(^XTV(8995.13)) S G=$O(@R@("AD",K,0)) IF G="" Q "-1^NO TRANSLATION FOR OBJECT" S H=$O(@R@("AD",K,G,0)) Q $P($G(@R@(G,0)),"^")_"^"_$P($G(@R@(G,9.1,H,2)),"^") XGVB1B^INT^1^60169,79034^0 XGVB1B ;ISC-SF/EG - VB to MWAPI Translator (FORM Object) ;09/14/94 11:03 AM ;;8.0T19;KERNEL;;Feb 22, 1995 BGDGT(INREF,OREF,GADGET,COM) ; ;Type M Subroutine ; ;Input ; ;INREF Source array of VB resources ;OREF Array of translated resources ;GADGET Gadget type (i.e. Form, Label) ;COM Gadget name (i.e. "CANCEL" for a cancel button) ; N ATTRIB,EXIT,IN,OUT,X,HEXCOLOR,R,G,B,TMP,SREF,P,MENU,I,TMPNM,GDGTDONE,XT,XF S XT="MWAPI" S XF="COMMON" S (P,MENU,EXIT)=0 S ATTRIB="" S X="" F X=1:1:COM S P=$F(INREF,",",P) S IN=$E(INREF,1,P-2)_")" S OUT=$P(IN,",""~1"",")_","_$P(IN,",""~1"",",2) S P=""",""M"",""" IF IN[P S MENU=1,XF="MENU" F D Q:EXIT . S X=$O(@IN@(X)) IF X="" S EXIT=1 Q . S SREF=$$V2M(XT,XF,X) . IF +SREF<0 Q . S ATTRIB=$S(X="SUBMENU":GADGETNM_"1",'$D(@IN@(X)):$P(SREF,U,2),1:@IN@(X)) . IF ATTRIB=-1 S ATTRIB=1 . IF MENU S @OUT=ATTRIB Q . IF GADGET="Frame"&($D(@OUT@("CHOICE"))>1) D . . S TMPNM="" . . IF '$D(GDGTDONE(GADGETNM)) F I=1:1 S TMPNM=$O(@OUT@("CHOICE",TMPNM)) Q:TMPNM="" D . . . K @OUT@("CHOICE",TMPNM) . . . S @OUT@("CHOICE",TMPNM)=TMPNM . . . S GDGTDONE(GADGETNM)="" . . . S @OUT@("TYPE")="RADIO" . IF 'MENU S @OUT@($P(SREF,U))=ATTRIB . ;IF $P(SREF,U)="RESIZE" S @OUT@($P(SREF,U))=$S(@IN@(X)=2:1,1:0) . IF $P(SREF,U)="POS" S @OUT@($P(SREF,U))=($$WDT(@IN@("Left"),XGVB("TWIPS"),XGVB("LOFF")))_","_($$WDT(@IN@("Top"),XGVB("TWIPS"),XGVB("TOFF"))) . IF $P(SREF,U)="SIZE" S @OUT@($P(SREF,U))=($$WDT(@IN@("Width"),XGVB("TWIPS"),XGVB("WOFF")))_","_($$WDT(@IN@("Height"),XGVB("TWIPS"),XGVB("HOFF"))) . IF $P(SREF,U)["COLOR" D . . IF GADGET="CommandButton" K @OUT@($P(SREF,U)) Q . . S @OUT@($P(SREF,U))=$$COLOR^XGVBUTL(@IN@(X)) S P=$S($D(@IN@("Style")):@IN@("Style"),1:0) IF 'MENU D . S X=$$TYPE(GADGET,P) . IF X="" K @OUT Q . IF X'="MENU" S:'$D(GDGTDONE(GADGETNM)) @OUT@("TYPE")=X K @IN Q WDT(DIM,DWIDTH,DOFF) ; ;Type Extrinsic M Function ; ;Input ; ;DIM Dimension in Pixels ;DWIDTH Conversion factor ;DOFF Conversion Offset ; ;Output ; ;Numeric Conversion of Twips to Pixels ; N T S T=(DIM\DWIDTH)+DOFF IF T'>0 S T=T*(-1) Q T TYPE(GADGET,PARAM) ; ;Type Extrinsic M function ; ;Input ; ;GADGET Type of VB gadget (i.e."ComboBox") ;PARAM Gadget specifier (type "2" ComboBox a.k.a drop down list ; ;Output ; ;TYPE Equivalent MWAPI gadget (in the example, return LISTBUTTON ; N DA,TYPE S (DA,TYPE)="" IF $D(^XTV(8995.12,"TYPE",GADGET,PARAM)) D . S DA=$O(^XTV(8995.12,"B",^XTV(8995.12,"TYPE",GADGET,PARAM),DA)) . IF $P(^XTV(8995.12,DA,9),"^") S TYPE=$P(^(0),U) Q TYPE ; V2M(X,Y,Z) ;returns object and value which translates X ;Type Extrinsic M function ; ;Input ; ;X Translation TYPE (normally MWAPI to vb) ;Y Gadget translating ;Z Attribute to translate ; ;Output ; ; Gadget^Default value ; N G,H,K,R S K=X_","_Y_","_Z IF K="" Q "-1^BAD PARAMETERS" S R=$NA(^XTV(8995.13)) S G=$O(@R@("AD",K,0)) IF G="" Q "-1^NO TRANSLATION FOR OBJECT" S H=$O(@R@("AD",K,G,0)) Q $P($G(@R@(G,0)),"^")_"^"_$P($G(@R@(G,9.1,H,2)),"^") XGVB2^INT^1^60169,79034^0 XGVB2 ;ISC-SF/EG - VB 2 MWAPI Translator (FORM Object) [ 06/09/94 11:51 AM ] ;;V1.0T1;KERNEL;;05/09/94 12:49 PM FORM(SREF) ;form attributes ; S SREF("BorderStyle")="RESIZE^1" S SREF("~1","RESIZE")="" S SREF("Enabled")="ACTIVE^1" S SREF("~1","ACTIVE")="" S SREF("ActiveControl")="DEFBUTTON^" S SREF("~1","DEFBUTTON")="" S SREF("FontName")="FFACE^MS Sans Serif" S SREF("~1","FFACE")="" S SREF("FontSize")="FSIZE^12" S SREF("~1","FSIZE")="" S SREF("Caption")="TITLE^" S SREF("~1","TITLE")="" S SREF("MDIChild")="PARENT^0" S SREF("~1","PARENT")="" S SREF("MinButton")="ICONIFY^1" S SREF("~1","ICONIFY")="" S SREF("Visible")="VISIBLE^1" S SREF("~1","VISIBLE")="" S SREF("BackColor")="COLOR^65535,65535,65535" S SREF("~1","COLOR")="" S SREF("ForeColor")="FCOLOR^65535,65535,65535" S SREF("~1","FCOLOR")="" S SREF("Height")="SIZE^" S SREF("~1","SIZE")="" S SREF("Left")="POS^" S SREF("Top")="POS^" S SREF("~1","POS")="" ;S SREF("ScaleHeight")="SIZE" ;S SREF("ScaleLeft")="POS" ;S SREF("ScaleMode")="UNITS" ;S SREF("ScaleTop")="POS" ;S SREF("ScaleWidth")="SIZE" ;S SREF("FontUnderline")=" ;S SREF("FontItalic") ;S SREF("FontBold")="" Q ; GADGET(GADGET,GADGETNM,TARRY,ORRY) ;gadget attributes ; S SREF("BackColor")="BCOLOR^0,0,0" S SREF("Caption")="TITLE^" ;S SREF("DragIcon")="" ;S SREF("DragMode")="" ;S SREF("Enabled")="ACTIVE^1" ;S SREF("FontBold")="" ;S SREF("FontItalic")="" ;S SREF("FontName")="FFACE^M,DEFAULT" ;S SREF("FontSize")="FSIZE^12" ;S SREF("FontStrikethru")="" ;S SREF("FontUnderline")="" S SREF("ForeColor")="FCOLOR^0,0,0" S SREF("Height")="SIZE^" S SREF("Left")="POS^" ;S SREF("MousePointer")="" ;S SREF("TabIndex")="" ;S SREF("TabStop")="" ;S SREF("Tag")="" S SREF("Top")="POS^" S SREF("Visible")="VISIBLE^1" S SREF("Width")="POS^" Q MENU(GADGET) ;menu attributes ; S SREF("Caption")="CHOICE^" S SREF("SUBMENU")="SUBMENU^" S SREF("CHOICE")="CHOICE^" Q XGVBUTL^INT^1^60169,79034^0 XGVBUTL ;ISC-SF/EG - VB to MWAPI Translator Utilities ;09/14/94 11:03 AM ;;8.0T19;KERNEL;;Feb 22, 1995 ; FREAD(DEV) ;Read a line from Host File ;Type Extrinsic M function ; ;Input ; ;DEV Operating system host file device ; ;Output ; ;0^Text Success ;-1^Txt Error occured ; N ERR,X S ERR=0 IF $G(DEV)="" Q "-1^MISSING DEVICE PARAMETER" ; ;U DEV R X:20 S ERR=$$STATUS U DEV R X:20 IF +ERR'=0 Q ERR Q 0_"^"_X ; STATUS() ;Status of last host file operation ;Type Extrinsic M Function ; ;Input ; ;None ; ;Output ; ;RESULT=0 Last IO operation was completed w/o error ;-1^EOF End of File reached ;Numeric (NonZero) Last IO operation failed ; N RESULT S RESULT=0 ;IF ^%ZOSF("OS")["MSM" D ;. IF $ZC=0 S RESULT=0 Q ;. IF $ZC<0 S RESULT="-1^EOF" Q ;. S RESULT="-1" Q RESULT ; COLOR(X) ;Color conversion from VB to MWAPI ;Type Extrinsic M function ; ;Input ; ;X Visual Basic color number (in Hex) ; ;Output ; ;R,G,B Converted color to MWAPI (3 Integers separated by commas) ; N R,G,B IF '$D(X)!(X="")!(X'["&") Q "0,0,0" S X=$TR(X,"&","") S R=$E(X,$L(X)-1,$L(X)) S R=$$ZHEX(R)*257 S G=$E(X,$L(X)-3,$L(X)-2) S G=$$ZHEX(G)*257 S B=$E(X,$L(X)-5,$L(X)-4) S B=$$ZHEX(B)*257 Q R_","_G_","_B ; ZHEX(H) ;Return decimal equivalent of hex number ;Type Extrinsic M function ; ;Input ;H Hex number ; ;Output ; Decimal equivalent of H (success) ;"ERROR" Error ; N D,N,P,E,L S (E,N,D)=0,L=$L(H) F P=1:1:L D Q:(N="ERROR")!(E="ERROR") . S N=$E(H,P) . S N=$$CNVRT(N) . Q:N="ERROR" . S E=$$POWER(16,(L-P)) . Q:E="ERROR" . S D=D+(N*E) Q:(N="ERROR")!(E="ERROR") "-1^ERROR" Q D ; CNVRT(X) ;Return decimal equivalent of single hex character ;Type Extrinsic M function ; ;Input ; ;X Single hex number/letter ; ;Output ; ; Decimal equivalent of X (success) ;"ERROR" Error ; ;decimal I ($A(X)>47)&($A(X)<58) Q X ;A through F I ($A(X)>64)&($A(X)<71) Q ($A(X)-55) ;error Q "ERROR" ; POWER(X,Y) ;Return X to the Yth power ;Type Extrinsic M function ; ;Input ; ;X Base number ;Y Exponent (must be an integer) ; ;Output ; ;X**Y (success) ;"ERROR" Error ; N Z,W,INV ;check exponent (ERROR) Q:((Y#1)'=0) "ERROR" ;check for negative exponent S INV=$S((Y<0):1,1:0) S:INV Y=0-Y ;determine X**Y S W=1 Q:(Y=0) 1 F Z=1:1:Y S W=W*X ;exponent<0 - invert S:INV W=1/W Q W TEST() ;sanity check, is M running? ;Type Extrinsic M Function ; ;Input ; ;None ; ;Ouput ; ;message ; N X,Y S X=^%ZOSF("ERRTN"),@^%ZOSF("TRAP") X ^%ZOSF("UCI") Q "Connected to "_Y_" running "_$P($G(^%ZOSF("OS")),"^") ; SETENV() ;setup Kernel environment ;Type Extrinsic M function ; ;Input ; ;None ; ;Output ; ;$$TEST() ; N X S X=^%ZOSF("ERRTN"),@^%ZOSF("TRAP") D PREP^XG ; setup KWAPI environment D SET1^XUS IF ^%ZOSF("OS")["MSM",$D(IO(1,51)) D . D HOME^%ZIS . D ^%ZISC Q $$TEST() ; KILLENV() ;kill environment ;Type Extrinsic M function ; ;Input ; ;None ; ;Output ; ;$$TEST() ; N X S X=^%ZOSF("ERRTN"),@^%ZOSF("TRAP") D K^XG() IF ^%ZOSF("OS")["MSM" ZSTOP D CLEAN^XG Q $$TEST() ; KILLWIN(WID) ;kill window ;Type Extrinsic M function ; ;Input ; ;None ; ;Output ; ;0 Success ; ; D K^XG() Q 0 WEDIT() ;start up the window editor ;Type M subroutine N ERR S ERR=$$SETENV() D ^XGCWEDIT Q ; ERRT ;General error trap Q XGVBUTL1^INT^1^60169,79034^0 XGVBUTL1 ;ISC-SF/EG - VB to MWAPI Translator Utilities ;09/14/94 11:03 AM ;;8.0T19;KERNEL;;Feb 22, 1995 ; POSTIN ;postinit U 0 W !,"Postinit Begins" N D0,D1,DA,DIK K ^XTV(8995.13,"AD") S DIK="^XTV(8995.13," D IXALL^DIK U 0 W !,"Postinit Finished" Q ; FOPEN(FREF) ;Open Host File ;Type Extrinsic M function ; ;Input ; ;FREF Host file reference, i.e. C:\DATA\VB\FILE.FRM ; ;Output ; ;IO Success, file handle is to be passed to other ; HFS I/O utilities ;-1^Txt Error ; N IOP,%ZIS IF $G(FREF)="" Q "-1^MISSING HFS PARAMETER" IF $G(XGVB("HFS"))="" Q "-1^MISSING HFS DEVICE" S IOP=XGVB("HFS") D . IF XGVB("OS")["MSM" D Q . . S %ZIS("IOPAR")="("_$C(34)_FREF_$C(34)_":"_$C(34)_"R"_$C(34)_")" . IF XGVB("OS")["DTM" D Q . . S %ZIS("IOPAR")="(""R"":FILE="_$C(34)_FREF_$C(34)_")" . IF XGVB("OS")["DSM" D . . S %ZIS("HFSNAME")=FREF . . S %ZIS("HFSMODE")="R" IF $G(%ZIS("IOPAR"))=""&($G(%ZIS("HFSNAME"))="") Q "-1^I/O NOT SUPPORTED FOR THIS OS" D ^%ZIS S DEV=IO IF POP S DEV="-1^FILE OPEN ERROR" Q DEV ; DEFPRM(Z) ;get default parameters ;Type M subroutine with passed parameter ; ;Input ; ;Z Output array by reference N IEN,OUT S IEN="1," ;only 1 entry in parameter file D GETS^DIQ(8995.1,IEN,"*","IE","OUT") S Z("TWIPS")=$G(OUT(8995.1,IEN,1.1,"I")) ;Twips to Pixel factor S Z("HFS")=$G(OUT(8995.1,IEN,1.2,"I")) ;host file S (Z("LOFF"),Z("WOFF"))=+$G(OUT(8995.1,IEN,2.1,"I")) ;linear offset S (Z("TOFF"),Z("HOFF"))=+$G(OUT(8995.1,IEN,2.2,"I")) ;linear offset S Z("FONT")=$G(OUT(8995.1,IEN,1.3,"I")) ;default font S Z("FONTP")=+$G(OUT(8995.1,IEN,1.4,"I")) ;default font point S Z("FONTS")=$G(OUT(8995.1,IEN,1.5,"I")) ;default font style S Z("COLOR")=$G(OUT(8995.1,IEN,3.1,"I")) ;default color S Z("OS")=$G(OUT(8995.1,IEN,4.1,"E")) ;default OS Q ; COMP(NAME,ARRY) ;Calls the Kernel uncompiler (to store window array) ;Type M Subroutine ; ;Input ; ;NAME Name to save window under ;ARRY Closed form array containing window definition ; ;Output ; ;NONE ; N X,Y D SET1^XUS S X=^%ZOSF("ERRTN"),@^%ZOSF("TRAP") D SILENT^XGCUNCOM(NAME,ARRY) Q XGWALL^INT^1^60169,79034^0 XGWALL ;SFISC/VYD - Wallpaper for terminal GUI emulation mode ;11/10/94 16:08 ;;8.0T19;KERNEL;;Feb 22, 1995 ; N ZXGTEXT,I,J,OFFSET S OFFSET=$S(IOM=80:2,1:0) A ;F I=0:1 S ZXGTEXT=$TEXT(TEXT+I) Q:ZXGTEXT']"" D ;. D SAY^XGS(I,0,$E($P(ZXGTEXT,";;",2),1+OFFSET,IOM+OFFSET)) B F I=0:1:5 F J=0:6:18 S ZXGTEXT=$TEXT(TEXT+I+J) Q:ZXGTEXT']"" D . D SAY^XGS(I+J,0,$E($P(ZXGTEXT,";;",2),1+OFFSET,IOM+OFFSET)) C ;F I=11:-1:0 F J=I,23-I S ZXGTEXT=$TEXT(TEXT+J) Q:ZXGTEXT']"" D ;. D SAY^XGS(J,0,$E($P(ZXGTEXT,";;",2),1+OFFSET,IOM+OFFSET)) Q TEXT ;; /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ ;; //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ ;;///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\ ;;\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\/// ;; \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// ;; \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ ;; /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ ;; //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ ;;///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\ ;;\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\/// ;; \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// ;; \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ ;; /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ ;; //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ ;;///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\ ;;\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\/// ;; \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// ;; \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ ;; /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ ;; //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ //\\ ;;///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\ ;;\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\///\\\/// ;; \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// \\// ;; \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ XGWALL1^INT^1^60169,79034^0 XGWALL1 ; SFISC/KC - Wallpaper for terminal GUI emulation mode ;11/10/94 16:08 ;;8.0T19;KERNEL;;Feb 22, 1995 ; F I=1:1 S ZXGTEXT=$TEXT(TEXT+I) Q:ZXGTEXT']"" D . D SAY^XGS(I,0,$P(ZXGTEXT,";;",2)) . ;W !,$P(ZXGTEXT,";;",2) Q TEXT ;; ;; ,-(Oo ,-(Oo ,-(Oo ,-(Oo ;; /_ __\ /_ __\ /_ __\ /_ __\ ;; | )/ / oO)-. | )/ / oO)-. | )/ / oO)-. | )/ / oO)-. ;; } /|__/ /__ _\ } /|__/ /__ _\ } /|__/ /__ _\ } /|__/ /__ _\ ;; `--` ` \ \( | `--` ` \ \( | `--` ` \ \( | `--` ` \ \( | ;; ,-(Oo \__|\ { ,-(Oo \__|\ { ,-(Oo \__|\ { ,-(Oo \__|\ { ;; /_ __\ ' '--' /_ __\ ' '--' /_ __\ ' '--' /_ __\ ' '--' ;; | )/ / oO)-. | )/ / oO)-. | )/ / oO)-. | )/ / oO)-. ;; } /|__/ /__ _\ } /|__/ /__ _\ } /|__/ /__ _\ } /|__/ /__ _\ ;; `--` ` \ \( | `--` ` \ \( | `--` ` \ \( | `--` ` \ \( | ;; ,-(Oo \__|\ { ,-(Oo \__|\ { ,-(Oo \__|\ { ,-(Oo \__|\ { ;; /_ __\ ' '--' /_ __\ ' '--' /_ __\ ' '--' /_ __\ ' '--' ;; | )/ / oO)-. | )/ / oO)-. | )/ / oO)-. | )/ / oO)-. ;; } /|__/ /__ _\ } /|__/ /__ _\ } /|__/ /__ _\ } /|__/ /__ _\ ;; `--` ` \ \( | `--` ` \ \( | `--` ` \ \( | `--` ` \ \( | ;; ,-(Oo \__|\ { ,-(Oo \__|\ { ,-(Oo \__|\ { ,-(Oo \__|\ { ;; /_ __\ ' '--' /_ __\ ' '--' /_ __\ ' '--' /_ __\ ' '--' ;; | )/ / oO)-. | )/ / oO)-. | )/ / oO)-. | )/ / oO)-. ;; } /|__/ /__ _\ } /|__/ /__ _\ } /|__/ /__ _\ } /|__/ /__ _\ ;; `--` ` \ \( | `--` ` \ \( | `--` ` \ \( | `--` ` \ \( | ;; \__|\ { \__|\ { \__|\ { \__|\ { ;; ' '--' ' '--' ' '--' ' '--' XGWALL2^INT^1^60169,79034^0 XGWALL2 ;SFISC/VYD - Wallpaper for terminal GUI emulation mode ;11/10/94 16:09 ;;8.0T19;KERNEL;;Feb 22, 1995 ; N ZXGTEXT,I F I=0:1 S ZXGTEXT=$TEXT(TEXT+I) Q:ZXGTEXT']"" D . D SAY^XGS(I,0,$P(ZXGTEXT,";;",2)) . ;W !,$P(ZXGTEXT,";;",2) Q TEXT ;;\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\// ;; // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // ;;//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\ ;;\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \ ;;\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\// ;; // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // ;;//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\ ;;\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \ ;;\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\// ;; // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // ;;//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\ ;;\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \ ;;\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\// ;; // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // ;;//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\ ;;\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \ ;;\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\// ;; // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // ;;//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\ ;;\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \ ;;\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\// ;; // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // ;;//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\ ;;\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \ XGWCTRL^INT^1^60169,79034^0 XGWCTRL ;SFISC/VYD - WINDOW CONTROL ;10/06/94 15:49 ;;8.0T19;KERNEL;;Feb 22, 1995 ; MOVE ;window movement N T,L,B,R,K,S ;top,left,bottom,right,key,string N H,W ;height,width N XGOLDC ;old coordinates N XGOLDATR,XGNWATR1,XGNWATR2,% ; W IOCUOFF S XGOLDATR=XGCURATR ;save current scrn attr S XGNWATR1=$$CHG^XGSA("E1G1R1B1") ;setup attributes for corners S XGNWATR2=$$CHG^XGSA("E1G1R1") ;setup attributes for corners D COORDW^XGUTIL1(XGW,.T,.L,.B,.R) ;get window coordinates S XGOLDC=T_U_L_U_B_U_R ;save window coordinates S XGFLAG("WINDOW MOVE")=1 S XGFLAG("ABORT")=0 ; F D Q:XGFLAG("ABORT") . S S=$$IOXY^XGS(T,L)_$S('$D(XGFLAG("WINDOW RESIZE")):XGNWATR1,1:XGNWATR2)_IOTLC . S S=S_$$IOXY^XGS(T,R)_XGNWATR1_IOTRC_$$IOXY^XGS(B,L)_XGNWATR1_IOBLC . S S=S_$$IOXY^XGS(B,R)_XGNWATR1_IOBRC . W S . S XGFLAG("ABORT READ")=0 . ; . F D Q:XGFLAG("ABORT READ") . . S K=$$READ^XGKB(1) . . I XGRT="CR" S XGFLAG("ABORT READ")=1 Q . . I K=" " S XGFLAG("ABORT READ")=1 Q . . I XGRT="DOWN",B<(IOSL-1) S XGFLAG("ABORT READ")=1 Q . . I XGRT="RIGHT",R<(IOM-1) S XGFLAG("ABORT READ")=1 Q . . I $D(XGFLAG("WINDOW RESIZE")) D Q ;if resizing a window . . . I XGRT="UP",B>(T+1) S XGFLAG("ABORT READ")=1 Q . . . I XGRT="LEFT",R>(L+1) S XGFLAG("ABORT READ")=1 Q . . E D ;otherwise moving a window . . . I XGRT="UP",T>0 S XGFLAG("ABORT READ")=1 Q . . . I XGRT="LEFT",L>0 S XGFLAG("ABORT READ")=1 Q . ; . I XGRT="UP" D Q . . D RSTRCRNR . . S B=B-1 . . S:'$D(XGFLAG("WINDOW RESIZE")) T=T-1 . E I XGRT="DOWN" D Q . . D RSTRCRNR . . S B=B+1 . . S:'$D(XGFLAG("WINDOW RESIZE")) T=T+1 . E I XGRT="LEFT" D Q . . D RSTRCRNR . . S R=R-1 . . S:'$D(XGFLAG("WINDOW RESIZE")) L=L-1 . E I XGRT="RIGHT" D Q . . D RSTRCRNR . . S R=R+1 . . S:'$D(XGFLAG("WINDOW RESIZE")) L=L+1 . E I XGRT="CR"!(K=" ") S XGFLAG("ABORT")=1 ; W $$SET^XGSA(XGOLDATR) ;all units should be supported later ;storing POS in pixels under assumption that original POS was in pixels ;storing SIZE in pixels under assumption that original SIZE was in pixels S H=B-T-1 ;set height S %=$G(^TMP("XGW",$J,XGW,"MENUBAR")) I %'="",^TMP("XGW",$J,XGW,"M",%,"VISIBLE") S H=H-1 ;adjust for menubar S H=H*20 ;convert to PIXELs S W=(R-L-1)*8 ;width in PIXELs S T=T*20 ;convert to PIXELs S L=L*8 I $D(XGFLAG("WINDOW RESIZE")) D S^XG(XGW,"SIZE",W_C_H_C_"PIXEL") I 1 E D S^XG(XGW,"POS",L_C_T) K XGFLAG("ABORT READ") K XGFLAG("WINDOW MOVE") Q ; ; RSTRCRNR ;restore corners N S S S=$S('$D(XGFLAG("WINDOW RESIZE")):$$IOXY^XGS(T,L)_$$ESC^XGSA($E(XGSCRN(T,1),L+1))_$E(XGSCRN(T,0),L+1),1:"") S S=S_$$IOXY^XGS(T,R)_$$ESC^XGSA($E(XGSCRN(T,1),R+1))_$E(XGSCRN(T,0),R+1) S S=S_$$IOXY^XGS(B,L)_$$ESC^XGSA($E(XGSCRN(B,1),L+1))_$E(XGSCRN(B,0),L+1) S S=S_$$IOXY^XGS(B,R)_$$ESC^XGSA($E(XGSCRN(B,1),R+1))_$E(XGSCRN(B,0),R+1) W S Q ; ; RESIZE ;window resize S XGFLAG("WINDOW RESIZE")=1 D MOVE K XGFLAG("WINDOW RESIZE") Q ; ; CLOSE ;do window CLOSE event K XGFLAG("WINDOW CLOSE") D:$D(^TMP("XGW",$J,XGW,"EVENT","CLOSE")) E^XGEVNT1(XGW,"","","","CLOSE") Q XGWIN^INT^1^60169,79034^0 XGWIN ;SFISC/VYD - K-WAPI Window Functions ;02/13/95 15:47 ;;8.0T19;KERNEL;;Feb 22, 1995 WINP(XGW,XGFAST) ;paint window on the screen N XGG,XGOLDPF,XGGTYP ;gadget, old paint flag, gadget type N %,T,L,B,R N XGWTOP ;top window ;N XGWT,XGWL,XGWB,XGWR S XGOLDPF=XGFLAG("PAINT") ;save previous S XGFLAG("PAINT")=21 ;make sure that gadgets get painted D:'$D(XGFAST) ;preserve background window if there is one . S %=$O(XGSCRN("ORDER",""),-1),XGWTOP=XGSCRN("ORDER",%) . ;if painted window is diff from window on top, save topmost window . I XGWTOP'=$C(1),XGW'=XGWTOP D WINSAVE(XGWTOP) D COORDW^XGUTIL1(XGW,.XGWT,.XGWL,.XGWB,.XGWR) ;set coords for cur win D WINORDER(XGW) ;;D ADJUST^XGSW(XGWT,XGWL,XGWB,XGWR,$NA(^TMP("XGS",$J,XGW))) D WIN^XGSW(XGWT,XGWL,XGWB,XGWR) D TITLE^XGUTIL1(XGW) D:$D(^TMP("XGW",$J,XGW,"MENUBAR")) MBARP^XGM1A(XGW) ;paint all VISIBLE gadgets S XGG="" F S XGG=$O(^TMP("XGW",$J,XGW,"G",XGG)) Q:XGG="" D . D:^TMP("XGW",$J,XGW,"G",XGG,"VISIBLE") PAINT^XGG(XGW,XGG) S XGFLAG("PAINT")=XGOLDPF ;restore previous Q ; ; COMPLETE(XGW1) ;complete any missing attributes w/ defaults N XGWP,XGEVNT ;parent window, event N T,L,B,R S:'$D(^TMP("XGW",$J,XGW1,"ACTIVE")) ^("ACTIVE")=1 S:'$D(^TMP("XGW",$J,XGW1,"DISPLAY")) ^("DISPLAY")=$PD S:'$D(^TMP("XGW",$J,XGW1,"FFACE")) ^("FFACE")="M,DEFAULT" S:'$D(^TMP("XGW",$J,XGW1,"FSIZE")) ^("FSIZE")=12 S:'$D(^TMP("XGW",$J,XGW1,"FSTYLE")) ^("FSTYLE")="NORMAL" D:$D(^TMP("XGW",$J,XGW1,"EVENT")) COMPLETE^XGEVNT1(XGW1) S:'$D(^TMP("XGW",$J,XGW1,"ICONIFY")) ^("ICONIFY")=1 S ^TMP("XGW",$J,XGW1,"ID")=XGW1 S:'$D(^TMP("XGW",$J,XGW1,"MIN")) ^("MIN")=0 S:'$D(^TMP("XGW",$J,XGW1,"POS")) ^("POS")="0,0" S:'$D(^TMP("XGW",$J,XGW1,"RESIZE")) ^("RESIZE")=1 S:'$D(^TMP("XGW",$J,XGW1,"TIED")) ^("TIED")=0 S:'$D(^TMP("XGW",$J,XGW1,"TYPE")) ^("TYPE")="APPLICATION" S:'$D(^TMP("XGW",$J,XGW1,"VISIBLE")) ^("VISIBLE")=1 ; ;----------------- MODAL S:'$D(^TMP("XGW",$J,XGW1,"MODAL"))&(^("TYPE")="APPLICATION") ^("MODAL")="APPLICATION" ; ;----------------- UNITS D:'$D(^TMP("XGW",$J,XGW1,"UNITS")) ;assign units of parent window or display .S XGWP=$G(^TMP("XGW",$J,XGW1,"PARENT")) .I XGWP]"",$D(^TMP("XGW",$J,XGWP)) S ^TMP("XGW",$J,XGW1,"UNITS")=^TMP("XGW",$J,XGWP,"UNITS") .E S ^TMP("XGW",$J,XGW1,"UNITS")=^TMP("XGD",$J,^TMP("XGW",$J,XGW1,"DISPLAY"),"UNITS") ; ;----------------- YXGNEXTG link to first gadget S ^TMP("XGW",$J,XGW1,"YXGNEXTG")=$G(^TMP("XGW",$J,XGW1,"NEXTG"),$O(^TMP("XGW",$J,XGW1,"G",""))) Q ; ; DFLTSIZE(XGW1) ;set up SIZE and YXGCOORDS nodes N %,X,Y,XGUNITS,XGG1 N T,L,B,R D:$G(^TMP("XGW",$J,XGW1,"SIZE"))'?1.N1","1.N.E . S X=$P($G(^TMP("XGW",$J,XGW1,"SIZE")),C,1) . S Y=$P($G(^("SIZE")),C,2) ;r ^TMP("XGW",$J,XGW1,"SIZE") . S XGUNITS=$P($G(^("SIZE")),C,3) ;r ^TMP("XGW",$J,XGW1,"SIZE") . S:XGUNITS="" XGUNITS=^TMP("XGW",$J,XGW1,"UNITS") . S X=X*XGUFCTR(XGUNITS,"X") ;convert from any unit to CHAR . S Y=Y*XGUFCTR(XGUNITS,"Y") ;convert from any unit to CHAR . ; . S XGG1="" . F S XGG1=$O(^TMP("XGW",$J,XGW1,"G",XGG1)) Q:XGG1="" D . . S B=$P(^TMP("XGW",$J,XGW1,"G",XGG1,"YXGCOORDS"),U,3),R=$P(^("YXGCOORDS"),U,4) . . S:B>Y Y=B ;if gadget extends beyond window bottom set new bottom . . S:R>X X=R ;if gadget extends beyond window right edge set new edge . S:$D(^TMP("XGW",$J,XGW1,"MENUBAR")) Y=Y-1 ;adjust hight if MENUBAR . S X=X/XGUFCTR(XGUNITS,"X") ;convert from CHAR to original units . S Y=Y/XGUFCTR(XGUNITS,"Y") ;convert from CHAR to original units . S:$P($G(^TMP("XGW",$J,XGW1,"SIZE")),C,1)="" $P(^("SIZE"),C,1)=X . S:$P($G(^TMP("XGW",$J,XGW1,"SIZE")),C,2)="" $P(^("SIZE"),C,2)=Y ; ;--YXGCOORDS=TOP^LEFT^BUTTOM^RIGHT in CHAR, relative to edge of the screen D COORDW2^XGUTIL1(XGW1,.T,.L,.B,.R) S ^TMP("XGW",$J,XGW1,"YXGCOORDS")=T_U_L_U_B_U_R Q ; ; WINORDER(XGW1) ;assign the passed window the topmost order N % K:$D(XGSCRN("ORDERX",XGW1)) XGSCRN("ORDER",XGSCRN("ORDERX",XGW1)) S %=$O(XGSCRN("ORDER",""),-1)+1 S XGSCRN("ORDER",%)=XGW1 S XGSCRN("ORDERX",XGW1)=% ;**** next 3 lines commented out 12/20/94. Previously used as temporary fix **** ;D:'$D(^TMP("XGS",$J,XGW1)) ;. D COORDW^XGUTIL1(XGW1,.T,.L,.B,.R) ;set coords for cur win ;. D SAVE^XGSW(T,L,B,R,$NA(^TMP("XGS",$J,XGW1))) Q ; ; WINSAVE(XGW1,T,L,B,R) ;save the passed window D:'$D(T)!('$D(L))!('$D(B))!('$D(R)) COORDW^XGUTIL1(XGW1,.T,.L,.B,.R) ;set coords for cur win D SAVE^XGSW(T,L,B,R,$NA(^TMP("XGS",$J,XGW1))) Q XGWIN1^INT^1^60169,79034^0 XGWIN1 ;SFISC/VYD - K-WAPI Window Functions ;02/13/95 16:01 ;;8.0T19;KERNEL;;Feb 22, 1995 ; SETUP(XGW1) ;switch from current topmost window to the passed one N XGWTOP,% S %=$O(XGSCRN("ORDER",""),-1) ;get subscript of topmost window S XGWTOP=XGSCRN("ORDER",%) ;XGWTOP gets window on top D . I $G(XGW1)="" S XGW1=XGWTOP Q ;set up w/ topmost window . I XGW1=XGWTOP Q ;asking for topmost window . ;otherwise requested window is not on top so the current topmost . ; window needs to be saved and the requested window painted on top . D WINSAVE^XGWIN(XGWTOP) . D RESTORE^XGSW($NA(^TMP("XGS",$J,XGW1))) . K ^TMP("XGS",$J,XGW1) . D WINORDER^XGWIN(XGW1) ;establish passed window as topmost D PAINTFLG^XGUTIL2(XGW1) D COORDW^XGUTIL1(XGW1,.XGWT,.XGWL,.XGWB,.XGWR) I XGWTOP'=$C(1),$D(^TMP("XGW",$J,XGWTOP,"EVENT","UNFOCUS")) D E^XGEVNT1(XGWTOP,"","","","UNFOCUS") I $D(^TMP("XGW",$J,XGWTOP,"EVENT","FOCUS")) D E^XGEVNT1(XGWTOP,"","","","FOCUS") Q ; ; SETUP99(XGWOLD,XGWNEW) ;switch from one window to another N % D:$G(XGWNEW)="" ;if new window is not passed set it to topmost window . S %=$O(XGSCRN("ORDER",""),-1) ;get subscript of topmost window . S XGWNEW=XGSCRN("ORDER",%) ;XGWNEW gets window on top ; D:$L($G(XGWOLD)) ;if switching from an old window . D:$D(XGSCRN("ORDERX",XGWOLD)) SAVE^XGSW(XGWT,XGWL,XGWB,XGWR,$NA(^TMP("XGS",$J,XGWOLD))) . ;D:$O(XGSCRN("ORDER",""),-1)'=XGWNEW ;if window that's on top is not the new one . D PAINTFLG^XGUTIL2(XGWNEW) . D:XGFLAG("PAINT")<20 . . D RESTORE^XGSW($NA(^TMP("XGS",$J,XGWNEW))) . . K ^TMP("XGS",$J,XGWNEW) . . D WINORDER^XGWIN(XGWNEW) ; D COORDW^XGUTIL1(XGWNEW,.XGWT,.XGWL,.XGWB,.XGWR) Q ; ; CHGFOCUS(XGWOLD) ;change focus from XGWOLD (old window) to previous win ;if lifting focus from a window which is currently in focus, set focus ;to previous window which is VISIBLE and ACTIVE N XGNXTFCS,% S C="," D:$P(^TMP("XGD",$J,$PD,"FOCUS"),C)=XGWOLD . ;S XGNXTFCS=XGWOLD ;**** commented out on 1/3/95 **** . S XGNXTFCS="" . S %="" . F S %=$O(^TMP("XGUTIL",$J,"FOCUS",%),-1) Q:%="" D Q:XGNXTFCS="" Q:$G(^TMP("XGW",$J,$P(XGNXTFCS,C),"ACTIVE"))&($G(^("VISIBLE"))) . . S XGNXTFCS=^TMP("XGUTIL",$J,"FOCUS",%) . . K ^TMP("XGUTIL",$J,"FOCUS",%) . S:%="" XGNXTFCS="" . S ^TMP("XGD",$J,$PD,"FOCUS")=XGNXTFCS . S:$L(XGNXTFCS) XGFLAG("ABORT")=1 Q ; ; REMOVE(XGW1) ;remove a window from the screen N %,I,%NXTWIN,%ROW,%S,A,%CP N T,L,B,R N T1,L1,B1,R1 N T2,L2,B2,R2 N XGSAVATR,XGWTOP ;save attribute, window on top S XGSAVATR=XGCURATR S %=$O(XGSCRN("ORDER",""),-1),XGWTOP=XGSCRN("ORDER",%) ;get topmost win I XGW1'=XGWTOP,XGWTOP'=$C(1) D WINSAVE^XGWIN(XGWTOP) ;if curr win not on top, save topmost win ; D COORDW^XGUTIL1(XGW1,.T,.L,.B,.R) D ADJUST^XGSW(.T,.L,.B,.R) K XGSCRN("ORDER",XGSCRN("ORDERX",XGW1)),XGSCRN("ORDERX",XGW1) K ^TMP("XGS",$J,XGW1) ;-------------------clear rectengular screen region behind the window F I=T:1:B F %=0,1 S $E(XGSCRN(I,%),L,R)=$E(^TMP("XGS",$J,$C(1),I,%),L,R) ;-------------------put all windows back S I=0 F S I=$O(XGSCRN("ORDER",I)) Q:I="" D . S %NXTWIN=XGSCRN("ORDER",I) . S %=^TMP("XGS",$J,%NXTWIN,"COORDS") . S T1=$P(%,U),L1=$P(%,U,2),B1=$P(%,U,3),R1=$P(%,U,4) . D:'(L1>R!(R1B)!(B1T1:T,1:T1),B2=$S(B>B1:B1,1:B) . . S L2=$S(L>L1:L,1:L1),R2=$S(R>R1:R1,1:R) . . F %ROW=T2:1:B2 F %=0,1 D . . . S $E(XGSCRN(%ROW,%),L2,R2)=$E(^TMP("XGS",$J,%NXTWIN,%ROW,%),L2,R2) ;-----------------------update the screen F I=T:1:B D . I $E(XGSCRN(I,1),L,R)=$TR($J("",R-L+1)," ",XGCURATR) S %S=$E(XGSCRN(I,0),L,R) . E S %S="",%=L,A=XGCURATR D . . F %CP=L:1:R D:$E(XGSCRN(I,1),%CP)'=A . . . S A=$E(XGSCRN(I,1),%CP) . . . S %S=%S_$E(XGSCRN(I,0),%,%CP-1)_$$SET^XGSA(A),%=%CP . . S %S=%S_$E(XGSCRN(I,0),%,%CP) . W $$IOXY^XGS(I,L-1)_%S W $$SET^XGSA(XGSAVATR) ;reset screen & XGCURATR to original Q XGWINSEL^INT^1^60169,79034^0 XGWINSEL ;SFISC/VYD - Window Selection ;9/28/94 15:15 ;;8.0T19;KERNEL;;Feb 22, 1995 N %,X,XGWDEF K XGFLAG("WINDOW SELECT") D GET^XGCLOAD("XG WINDOW SELECT",$NA(XGWDEF("XGWSEL"))) S %="",X=0 F S %=$O(^TMP("XGW",$J,%)) Q:%="" D .;S X=X+1 .I ^(%,"VISIBLE") D ;ref ^TMP("XGW",$J,%) . S XGWDEF("XGWSEL","G","WINLIST","CHOICE",%)=$G(^("TITLE"),"???") ;ref ^TMP("XGW",$J,%) . S XGWDEF("XGWSEL","G","WINLIST","CHOICE",%,"ACTIVE")=^("ACTIVE") ;ref ^TMP("XGW",$J,%) S $P(XGWDEF("XGWSEL","POS"),C)=IOM-$P(XGWDEF("XGWSEL","SIZE"),C)-2 D M^XG("XGWDEF") D SD^XG($PD,"FOCUS","XGWSEL") Q ; CANCEL ;window select CANCEL button pressed S (XGFLAG("ABORT"),DIR0QT)=1 D K^XG("XGWSEL") Q ; OK ;window select OK button pressed N XGNXTWIN D:@XGWIN@("XGWSEL","G","WINLIST","VALUE") ;if some window was selected .S XGNXTWIN=$O(@XGWIN@("XGWSEL","G","WINLIST","VALUE","")) .D SD^XG($PD,"FOCUS",XGNXTWIN) D K^XG("XGWSEL") Q XGWT^INT^1^60169,79034^0 XGWT ;SFISC/VYD - $WTFIT and $WTWIDTH ;02/16/94 11:37 ;;8.0T19;KERNEL;;Feb 22, 1995 WTWIDTH() ;returns width of EXPR in UNITSPEC ;currently only PIXEL is supported ;Q $L(EXPR)*XGUFCTR("CHAR","X") Q $L(EXPR)/XGUFCTR("PIXEL","X")