XUSG ;SFISC/RWF - SIGNON from GUI screen ;01/23/96 12:41 [ 04/02/2003 8:29 AM ]
;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
;;8.0;KERNEL;**16**;Jul 10, 1995
A K (ZUGUI1,ZUGUI2)
S XQXFLG("GUI")=$G(ZUGUI1)_"^"_$G(ZUGUI2) S:'$L(ZUGUI2) KWAPI=1
D SET1^XUS(1)
D PREP^XG,K^XG() K TMP
D GET^XGCLOAD("XU XUS W1",$NA(TMP("XUS")))
;move INTRO text in to window.
D INTRO^XUS1A($NA(TMP("XUS","G","INTRO","CHOICE")))
S TMP("XUS","G","UCIVOL","TITLE")="UCI: "_XUCI_" Volume set: "_XQVOL,TMP("XUS","G","DEV","TITLE")="Device: "_$S($D(IO("ZIO")):IO("ZIO"),1:$I)
D M^XG("XUS",$NA(TMP("XUS"))) K TMP("XUS")
D CLEAR S XUM=$$SET2^XUS() G:XUM NO
D SET^XGLTIMER("XUS","TIMER",2,60,"TO^XUSG")
D ESTA^XG() I $D(DTOUT)!(DUZ=0)!(XUM>0) G QUIT
PGM ;
S Y=+$G(^%ZIS(1,XUDEV,201)) I Y>0 D CHK S XQY=Y G:Y O
S Y=+$G(^VA(200,DUZ,201)) I Y>0 D CHK S XQY=Y G:Y O
S XUM=5 G NO
O D CHEK^XQ83
;S:$P($G(XQXFLG("GUI")),U,2)="" KWAPI=1
S (XUA,PGM)="XQ" ;$S($D(KWAPI):"XQ",1:"XQSUITE")
D K^XG("XUS"),CLEAN^XG
P G NEXT^XUS1
;
QUIT D K^XG("XUS")
Q ;G HALT^ZU?
CANCEL ;
S DUZ=0
D ESTO^XG
Q
OK ;See if code is good.
S AV=$G(TMP("ACODE")) S:'$L($P(AV,";",2)) $P(AV,";",2)=$G(TMP("VCODE"))
G:AV="^;^" CANCEL
D CLEAR Q:AV=";" S DUZ=$$CHECKAV^XUS(AV,.XUSER) K AV
S XUM=$$UVALID^XUS() G:XUM NO
D USERG^XUSG1 ;if needed call SEC^XUS3:($D(^%ZIS(1,XUDEV,"TIME"))!$D(^(95)))
D ESTO^XG
Q
KEYDOWN ;Keydown to convert key to *
I $D(%DEBUG) D W !
. W ! S X="^$E" F S X=$Q(@X) Q:X="" W !,X," = ",@X
. 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")!(KEY="BACKSPACE") S VALUE=$E(VALUE,1,$L(VALUE)-1)
I "^DELETE^BACKSPACE^BS^"[(U_KEY_U) S VALUE=$E(VALUE,1,$L(VALUE)-1)
I $L(KEY)>1 S KEY=$$KEYCNV^XGLKEY(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
NO S XUM=$$NO^XUS3()
D CLEAR Q:'XUM
D ESTO^XG
Q
CLEAR ;
F X="ACODE","VCODE" D S^XG("XUS","G",X,"VALUE","") K TMP(X)
D SD^XG($PD,"FOCUS","XUS,ACODE")
Q
UCASE(%) ;
Q $TR(%,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
CHK ;Check if valid option
I $D(^DIC(19,Y,0)),$S($P(^(0),U,6)="":1,1:$D(^XUSEC($P(^(0),U,6),DUZ))) Q
S Y=0 Q
TO ;CALL ON A TIME OUT
D ^XGLMSG("E","TIME OUT",5)
D ESTO^XG
Q
XUSG ;SFISC/RWF - SIGNON from GUI screen ;01/23/96 12:41 [ 04/02/2003 8:29 AM ]
+1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
+2 ;;8.0;KERNEL;**16**;Jul 10, 1995
A KILL (ZUGUI1,ZUGUI2)
+1 SET XQXFLG("GUI")=$GET(ZUGUI1)_"^"_$GET(ZUGUI2)
IF '$LENGTH(ZUGUI2)
SET KWAPI=1
+2 DO SET1^XUS(1)
+3 DO PREP^XG
DO K^XG()
KILL TMP
+4 DO GET^XGCLOAD("XU XUS W1",$NAME(TMP("XUS")))
+5 ;move INTRO text in to window.
+6 DO INTRO^XUS1A($NAME(TMP("XUS","G","INTRO","CHOICE")))
+7 SET TMP("XUS","G","UCIVOL","TITLE")="UCI: "_XUCI_" Volume set: "_XQVOL
SET TMP("XUS","G","DEV","TITLE")="Device: "_$SELECT($DATA(IO("ZIO")):IO("ZIO"),1:$IO)
+8 DO M^XG("XUS",$NAME(TMP("XUS")))
KILL TMP("XUS")
+9 DO CLEAR
SET XUM=$$SET2^XUS()
IF XUM
GOTO NO
+10 DO SET^XGLTIMER("XUS","TIMER",2,60,"TO^XUSG")
+11 DO ESTA^XG()
IF $DATA(DTOUT)!(DUZ=0)!(XUM>0)
GOTO QUIT
PGM ;
+1 SET Y=+$GET(^%ZIS(1,XUDEV,201))
IF Y>0
DO CHK
SET XQY=Y
IF Y
GOTO O
+2 SET Y=+$GET(^VA(200,DUZ,201))
IF Y>0
DO CHK
SET XQY=Y
IF Y
GOTO O
+3 SET XUM=5
GOTO NO
O DO CHEK^XQ83
+1 ;S:$P($G(XQXFLG("GUI")),U,2)="" KWAPI=1
+2 ;$S($D(KWAPI):"XQ",1:"XQSUITE")
SET (XUA,PGM)="XQ"
+3 DO K^XG("XUS")
DO CLEAN^XG
P GOTO NEXT^XUS1
+1 ;
QUIT DO K^XG("XUS")
+1 ;G HALT^ZU?
QUIT
CANCEL ;
+1 SET DUZ=0
+2 DO ESTO^XG
+3 QUIT
OK ;See if code is good.
+1 SET AV=$GET(TMP("ACODE"))
IF '$LENGTH($PIECE(AV,";",2))
SET $PIECE(AV,";",2)=$GET(TMP("VCODE"))
+2 IF AV="^;^"
GOTO CANCEL
+3 DO CLEAR
IF AV=";"
QUIT
SET DUZ=$$CHECKAV^XUS(AV,.XUSER)
KILL AV
+4 SET XUM=$$UVALID^XUS()
IF XUM
GOTO NO
+5 ;if needed call SEC^XUS3:($D(^%ZIS(1,XUDEV,"TIME"))!$D(^(95)))
DO USERG^XUSG1
+6 DO ESTO^XG
+7 QUIT
KEYDOWN ;Keydown to convert key to *
+1 IF $DATA(%DEBUG)
Begin DoDot:1
+2 WRITE !
SET X="^$E"
FOR
SET X=$QUERY(@X)
IF X=""
QUIT
WRITE !,X," = ",@X
+3 QUIT
End DoDot:1
WRITE !
+4 NEW GNM,WNM,KEY
+5 SET WNM=@XGEVENT@("WINDOW")
SET X=@XGEVENT@("ELEMENT")
SET GTYPE=$PIECE(X,",")
SET GNM=$PIECE(X,",",2)
+6 SET KEY=$$UCASE(@XGEVENT@("KEY"))
SET VALUE=$GET(TMP(GNM))
+7 ;I (KEY="DELETE")!(KEY="BACKSPACE") S VALUE=$E(VALUE,1,$L(VALUE)-1)
+8 IF "^DELETE^BACKSPACE^BS^"[(U_KEY_U)
SET VALUE=$EXTRACT(VALUE,1,$LENGTH(VALUE)-1)
+9 IF $LENGTH(KEY)>1
SET KEY=$$KEYCNV^XGLKEY(KEY)
+10 IF $LENGTH(KEY)=1
SET VALUE=VALUE_KEY
+11 SET X=$TRANSLATE($JUSTIFY("",$LENGTH(VALUE))," ","*")
SET TMP(GNM)=VALUE
+12 DO S^XG(WNM,"G",GNM,"VALUE",X)
DO S^XG(WNM,"G",GNM,"INSELECT",$LENGTH(X)_",0")
+13 QUIT
NO SET XUM=$$NO^XUS3()
+1 DO CLEAR
IF 'XUM
QUIT
+2 DO ESTO^XG
+3 QUIT
CLEAR ;
+1 FOR X="ACODE","VCODE"
DO S^XG("XUS","G",X,"VALUE","")
KILL TMP(X)
+2 DO SD^XG($PDISPLAY,"FOCUS","XUS,ACODE")
+3 QUIT
UCASE(%) ;
+1 QUIT $TRANSLATE(%,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
CHK ;Check if valid option
+1 IF $DATA(^DIC(19,Y,0))
IF $SELECT($PIECE(^(0),U,6)="":1,1:$DATA(^XUSEC($PIECE(^(0),U,6),DUZ)))
QUIT
+2 SET Y=0
QUIT
TO ;CALL ON A TIME OUT
+1 DO ^XGLMSG("E","TIME OUT",5)
+2 DO ESTO^XG
+3 QUIT
