source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSG.m@ 862

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

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1XUSG ;SFISC/RWF - SIGNON from GUI screen ;01/23/96 12:41
2 ;;8.0;KERNEL;**16**;Jul 10, 1995
3A K (ZUGUI1,ZUGUI2)
4 S XQXFLG("GUI")=$G(ZUGUI1)_"^"_$G(ZUGUI2) S:'$L(ZUGUI2) KWAPI=1
5 D SET1^XUS(1)
6 D PREP^XG,K^XG() K TMP
7 D GET^XGCLOAD("XU XUS W1",$NA(TMP("XUS")))
8 ;move INTRO text in to window.
9 D INTRO^XUS1A($NA(TMP("XUS","G","INTRO","CHOICE")))
10 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)
11 D M^XG("XUS",$NA(TMP("XUS"))) K TMP("XUS")
12 D CLEAR S XUM=$$SET2^XUS() G:XUM NO
13 D SET^XGLTIMER("XUS","TIMER",2,60,"TO^XUSG")
14 D ESTA^XG() I $D(DTOUT)!(DUZ=0)!(XUM>0) G QUIT
15PGM ;
16 S Y=+$G(^%ZIS(1,XUDEV,201)) I Y>0 D CHK S XQY=Y G:Y O
17 S Y=+$G(^VA(200,DUZ,201)) I Y>0 D CHK S XQY=Y G:Y O
18 S XUM=5 G NO
19O D CHEK^XQ83
20 ;S:$P($G(XQXFLG("GUI")),U,2)="" KWAPI=1
21 S (XUA,PGM)="XQ" ;$S($D(KWAPI):"XQ",1:"XQSUITE")
22 D K^XG("XUS"),CLEAN^XG
23P G NEXT^XUS1
24 ;
25QUIT D K^XG("XUS")
26 Q ;G HALT^ZU?
27CANCEL ;
28 S DUZ=0
29 D ESTO^XG
30 Q
31OK ;See if code is good.
32 S AV=$G(TMP("ACODE")) S:'$L($P(AV,";",2)) $P(AV,";",2)=$G(TMP("VCODE"))
33 G:AV="^;^" CANCEL
34 D CLEAR Q:AV=";" S DUZ=$$CHECKAV^XUS(AV,.XUSER) K AV
35 S XUM=$$UVALID^XUS() G:XUM NO
36 D USERG^XUSG1 ;if needed call SEC^XUS3:($D(^%ZIS(1,XUDEV,"TIME"))!$D(^(95)))
37 D ESTO^XG
38 Q
39KEYDOWN ;Keydown to convert key to *
40 I $D(%DEBUG) D W !
41 . W ! S X="^$E" F S X=$Q(@X) Q:X="" W !,X," = ",@X
42 . Q
43 N GNM,WNM,KEY
44 S WNM=@XGEVENT@("WINDOW"),X=@XGEVENT@("ELEMENT"),GTYPE=$P(X,","),GNM=$P(X,",",2)
45 S KEY=$$UCASE(@XGEVENT@("KEY")),VALUE=$G(TMP(GNM))
46 ;I (KEY="DELETE")!(KEY="BACKSPACE") S VALUE=$E(VALUE,1,$L(VALUE)-1)
47 I "^DELETE^BACKSPACE^BS^"[(U_KEY_U) S VALUE=$E(VALUE,1,$L(VALUE)-1)
48 I $L(KEY)>1 S KEY=$$KEYCNV^XGLKEY(KEY)
49 I $L(KEY)=1 S VALUE=VALUE_KEY
50 S X=$TR($J("",$L(VALUE))," ","*"),TMP(GNM)=VALUE
51 D S^XG(WNM,"G",GNM,"VALUE",X),S^XG(WNM,"G",GNM,"INSELECT",$L(X)_",0")
52 Q
53NO S XUM=$$NO^XUS3()
54 D CLEAR Q:'XUM
55 D ESTO^XG
56 Q
57CLEAR ;
58 F X="ACODE","VCODE" D S^XG("XUS","G",X,"VALUE","") K TMP(X)
59 D SD^XG($PD,"FOCUS","XUS,ACODE")
60 Q
61UCASE(%) ;
62 Q $TR(%,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
63CHK ;Check if valid option
64 I $D(^DIC(19,Y,0)),$S($P(^(0),U,6)="":1,1:$D(^XUSEC($P(^(0),U,6),DUZ))) Q
65 S Y=0 Q
66TO ;CALL ON A TIME OUT
67 D ^XGLMSG("E","TIME OUT",5)
68 D ESTO^XG
69 Q
Note: See TracBrowser for help on using the repository browser.