- XUSG1 ;SF-ISC/STAFF - SIGNON from GUI screen ;9/28/94 14:54 [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- ;;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
- XUSG1 ;SF-ISC/STAFF - SIGNON from GUI screen ;9/28/94 14:54 [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- +2 ;;8.0;KERNEL;;Jul 10, 1995
- +3 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 DO SD^XG($PDISPLAY,"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