- XUSG ;SFISC/RWF - SIGNON from GUI screen ;01/23/96 12:41
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSG 2382 printed Feb 18, 2025@23:38:57 Page 2
- XUSG ;SFISC/RWF - SIGNON from GUI screen ;01/23/96 12:41
- +1 ;;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
- *** ERROR ***
- DO SD^XG($PD,"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