XUSG1 ;SF-ISC/STAFF - SIGNON from GUI screen ;9/28/94 14:54
;;8.0;KERNEL;;Jul 10, 1995
Q
USERG ;Call from in OK Callback
K XUTEXT N WIN,FOCUS
I '$L($P(XUSER(1),U,2)) G CHVC
I +$P(XOPT,U,15),(XUSER(1)+$P(XOPT,U,15)'>+$H) G CHVC
S XUM=$$USER^XUS1A() G:XUM NO^XUSG
D GET^XGCLOAD("XU XUS W2","WIN(""XUS2"")") ;Build XUTEXT message into window
F J=0:0 S J=$O(XUTEXT(J)) Q:J'>0 D
. S N="LAB"_J M WIN("XUS2","G",N)=WIN("XUS2","G","LAB1")
. S WIN("XUS2","G",N,"TITLE")=$E(XUTEXT(J),2,255)
. S $P(WIN("XUS2","G",N,"POS"),",",2)=(J-1*20+10)
. Q
D DIVSET
D S^XG("XUS","ACTIVE",0),M^XG("XUS2",$NA(WIN("XUS2")))
D SD^XG($PD,"FOCUS",FOCUS)
D ESTA^XG(),K^XG("XUS2"),DUZ^XUS1A
Q
DIVSET ;Setup the DIV list box
S WIN("XUS2","G","DIV","VISIBLE")=0,FOCUS="XUS2,OK" K WIN("XUS2","G","DIV","CHOICE")
S Y=$O(^VA(200,DUZ,2,0)),X=$O(^(Y)) I X>0,$D(^DIC(4,0)) D
. S WIN("XUS2","G","DIV","VISIBLE")=1,FOCUS="XUS2,DIV"
. S J=0 F S J=$O(^VA(200,DUZ,2,J)) Q:J'>0 D
. . S WIN("XUS2","G","DIV","CHOICE","A"_J)=$P($G(^DIC(4,J,0)),U)
. . Q
. S DUZ(2)=Y,WIN("XUS2","G","DIV","VALUE","A"_Y)=""
. Q
Q
OK2 ;OK button from welcome
D ESTO^XG
Q
DIV ;Select a div
N WNM,G S WNM="XUS2",G="G"
Q:'@XGWIN@(WNM,G,"DIV","CHANGED")
S X=$O(@XGWIN@(WNM,G,"DIV","VALUE","")),DUZ(2)=+$E(X,2,9)
Q
CHVC ;The Verify code needs changing
N XUJ
S XUJ(1)="SORRY you can not use this device right now.",XUJ(2)="Your VERIFY CODE needs to be changed.",XUJ(3)="Please sign on from a regular terminal to do this."
S XUM=$$OK^XGLMSG("I",.XUJ,60),XUM=4,DUZ=0 G NO^XUSG
;D CVC^XUS2 G:$D(DUOUT) H^XUS S XUSER(1)=^VA(200,DUZ,.1)
Q
NEXT ;
G NEXT^XUS1
;
;
DD(Y) Q $S($E(Y,4,5):$P("Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec","^",+$E(Y,4,5))_" ",1:"")_$S($E(Y,6,7):+$E(Y,6,7)_",",1:"")_($E(Y,1,3)+1700)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSG1 1832 printed Oct 16, 2024@18:13:19 Page 2
XUSG1 ;SF-ISC/STAFF - SIGNON from GUI screen ;9/28/94 14:54
+1 ;;8.0;KERNEL;;Jul 10, 1995
+2 QUIT
USERG ;Call from in OK Callback
+1 KILL XUTEXT
NEW WIN,FOCUS
+2 IF '$LENGTH($PIECE(XUSER(1),U,2))
GOTO CHVC
+3 IF +$PIECE(XOPT,U,15)
IF (XUSER(1)+$PIECE(XOPT,U,15)'>+$HOROLOG)
GOTO CHVC
+4 SET XUM=$$USER^XUS1A()
if XUM
GOTO NO^XUSG
+5 ;Build XUTEXT message into window
DO GET^XGCLOAD("XU XUS W2","WIN(""XUS2"")")
+6 FOR J=0:0
SET J=$ORDER(XUTEXT(J))
if J'>0
QUIT
Begin DoDot:1
+7 SET N="LAB"_J
MERGE WIN("XUS2","G",N)=WIN("XUS2","G","LAB1")
+8 SET WIN("XUS2","G",N,"TITLE")=$EXTRACT(XUTEXT(J),2,255)
+9 SET $PIECE(WIN("XUS2","G",N,"POS"),",",2)=(J-1*20+10)
+10 QUIT
End DoDot:1
+11 DO DIVSET
+12 DO S^XG("XUS","ACTIVE",0)
DO M^XG("XUS2",$NAME(WIN("XUS2")))
+13
*** ERROR ***
DO SD^XG($PD,"FOCUS",FOCUS)
+14 DO ESTA^XG()
DO K^XG("XUS2")
DO DUZ^XUS1A
+15 QUIT
DIVSET ;Setup the DIV list box
+1 SET WIN("XUS2","G","DIV","VISIBLE")=0
SET FOCUS="XUS2,OK"
KILL WIN("XUS2","G","DIV","CHOICE")
+2 SET Y=$ORDER(^VA(200,DUZ,2,0))
SET X=$ORDER(^(Y))
IF X>0
IF $DATA(^DIC(4,0))
Begin DoDot:1
+3 SET WIN("XUS2","G","DIV","VISIBLE")=1
SET FOCUS="XUS2,DIV"
+4 SET J=0
FOR
SET J=$ORDER(^VA(200,DUZ,2,J))
if J'>0
QUIT
Begin DoDot:2
+5 SET WIN("XUS2","G","DIV","CHOICE","A"_J)=$PIECE($GET(^DIC(4,J,0)),U)
+6 QUIT
End DoDot:2
+7 SET DUZ(2)=Y
SET WIN("XUS2","G","DIV","VALUE","A"_Y)=""
+8 QUIT
End DoDot:1
+9 QUIT
OK2 ;OK button from welcome
+1 DO ESTO^XG
+2 QUIT
DIV ;Select a div
+1 NEW WNM,G
SET WNM="XUS2"
SET G="G"
+2 if '@XGWIN@(WNM,G,"DIV","CHANGED")
QUIT
+3 SET X=$ORDER(@XGWIN@(WNM,G,"DIV","VALUE",""))
SET DUZ(2)=+$EXTRACT(X,2,9)
+4 QUIT
CHVC ;The Verify code needs changing
+1 NEW XUJ
+2 SET XUJ(1)="SORRY you can not use this device right now."
SET XUJ(2)="Your VERIFY CODE needs to be changed."
SET XUJ(3)="Please sign on from a regular terminal to do this."
+3 SET XUM=$$OK^XGLMSG("I",.XUJ,60)
SET XUM=4
SET DUZ=0
GOTO NO^XUSG
+4 ;D CVC^XUS2 G:$D(DUOUT) H^XUS S XUSER(1)=^VA(200,DUZ,.1)
+5 QUIT
NEXT ;
+1 GOTO NEXT^XUS1
+2 ;
+3 ;
DD(Y) QUIT $SELECT($EXTRACT(Y,4,5):$PIECE("Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec","^",+$EXTRACT(Y,4,5))_" ",1:"")_$SELECT($EXTRACT(Y,6,7):+$EXTRACT(Y,6,7)_",",1:"")_($EXTRACT(Y,1,3)+1700)
+1 QUIT
