| 1 | XUP ;SFISC/RWF - Setup enviroment for programmers ;09/21/2004 16:35
|
|---|
| 2 | ;;8.0;KERNEL;**208,258,284**;Jul 10, 1995
|
|---|
| 3 | W !,"Setting up programmer environment"
|
|---|
| 4 | N $ESTACK,$ETRAP S $ECODE="",$ETRAP="" ;Clear and error trap
|
|---|
| 5 | X ^%ZOSF("TYPE-AHEAD")
|
|---|
| 6 | ;Check if Production and report
|
|---|
| 7 | W !,"This is a "_$S($$PROD^XUPROD(1):"PRODUCTION",1:"TEST")_" account.",!
|
|---|
| 8 | ;
|
|---|
| 9 | K ^UTILITY($J),^XUTL("XQ",$J) D KILL1^XUSCLEAN
|
|---|
| 10 | S U="^",DT=$$DT^XLFDT
|
|---|
| 11 | S XUEOFF=^%ZOSF("EOFF"),XUEON=^%ZOSF("EON"),U="^",XUTT=0,XUIOP=""
|
|---|
| 12 | D GETENV^%ZOSV S XUENV=Y,XUVOL=$P(Y,U,2),XUCI=$P(Y,U,1)
|
|---|
| 13 | ;Reset DUZ if user "Switched Identities".
|
|---|
| 14 | I $D(DUZ("SAV")) S DUZ=+DUZ("SAV"),DUZ(0)=$P(DUZ("SAV"),U,2) K DUZ("SAV")
|
|---|
| 15 | ;Get user info
|
|---|
| 16 | I $G(DUZ)>0 D DUZ(DUZ)
|
|---|
| 17 | I $G(DUZ)'>0!('$D(DUZ(0))) D ASKDUZ G:Y'>0 EXIT
|
|---|
| 18 | I '$D(XQUSER) S XQUSER=$S($D(^VA(200,DUZ,20)):$P(^(20),"^",2),1:"Unk")
|
|---|
| 19 | S DTIME=600 ;Set a temp DTIME
|
|---|
| 20 | ;Getting Terminal Type
|
|---|
| 21 | ZIS I XUTT D ENQ^XUS1 G:$D(XUIOP(1)) ZIS2 S Y=0 D TT^XUS3 I Y>0 S XUIOP(1)=$P(XUIOP,";",2) G ZIS2
|
|---|
| 22 | S X="`"_+$G(^VA(200,DUZ,1.2)),DIC="^%ZIS(2,",DIC(0)="MQ"_$S(X]"`0":"",1:"AE") D ^DIC G:Y'>0 EXIT
|
|---|
| 23 | S XUIOP(1)=$P(Y,U,2) I DIC(0)["A",$G(^VA(200,+DUZ,0))]"" S $P(^VA(200,DUZ,1.2),U,1)=+Y
|
|---|
| 24 | ZIS2 S %ZIS="L",IOP="HOME;"_XUIOP(1) D ^%ZIS G EXIT:POP W !,"Terminal Type set to: ",IOST,!
|
|---|
| 25 | S DTIME=$$DTIME(DUZ,IOS),DUZ("BUF")=1,XUDEV=IOS
|
|---|
| 26 | ;Save info, Set last sign-on
|
|---|
| 27 | D SAVE^XUS1 S $P(^VA(200,DUZ,1.1),"^",1)=$$NOW^XLFDT
|
|---|
| 28 | ;Check Mail
|
|---|
| 29 | S Y=$P($G(^XMB(3.7,DUZ,0)),U,6) I Y W !,"You have "_Y_" new message"_$S(Y=1:"",1:"s")_"."
|
|---|
| 30 | ;Setup error trap
|
|---|
| 31 | I $$GET^XPAR("USR^SYS","XUS-XUP SET ERROR TRAP",1,"Q") S $ETRAP="D ERR^XUP"
|
|---|
| 32 | D KILL1^XUSCLEAN S $P(XQXFLG,U,3)="XUP" D ^XQ1
|
|---|
| 33 | EXIT D KILL1^XUSCLEAN K XQY,XQY0
|
|---|
| 34 | I $$GET^XPAR("USR^SYS","XUS-XUP VPE",1,"Q"),$D(^%ZVEMS) X ^%ZVEMS ;Run VPE
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | ASKDUZ X XUEOFF S DIR(0)="FO",DIR("A")="Access Code" D ^DIR W ! X XUEON I $D(DIRUT) S Y=-1 Q
|
|---|
| 38 | S X=$$UP^XLFSTR(X) S:X[":" XUTT=1,X=$P(X,":",1)_$P(X,":",2)
|
|---|
| 39 | D ^XUSHSH S Y=$O(^VA(200,"A",X,0))
|
|---|
| 40 | K DUZ D DUZ(+Y) Q
|
|---|
| 41 | ;
|
|---|
| 42 | DUZ(DA) ;Build DUZ for a user. Used by Mailman.
|
|---|
| 43 | ;(p284) Make the setting of several DUZ parts conditional.
|
|---|
| 44 | N Y S Y(0)=$G(^VA(200,+DA,0)),Y("XUS")=$G(^XTV(8989.3,1,"XUS"))
|
|---|
| 45 | S DUZ=DA
|
|---|
| 46 | S:$G(DUZ(0))'="@" DUZ(0)=$P(Y(0),"^",4)
|
|---|
| 47 | S DUZ(1)="",DUZ("AG")=$P($G(^XTV(8989.3,1,0)),"^",8)
|
|---|
| 48 | S:'$G(DUZ(2)) DUZ(2)=$O(^VA(200,DUZ,2,0))
|
|---|
| 49 | S:'DUZ(2) DUZ(2)=+$P(Y("XUS"),U,17)
|
|---|
| 50 | S:'$L($G(DUZ("LANG"))) DUZ("LANG")=$P(Y("XUS"),U,7)
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | DTIME(E,D) ;Return DTIME value for user E, device D.
|
|---|
| 54 | N P S P=$P($G(^VA(200,+$G(E),200)),"^",10) S:P="" P=$P($G(^%ZIS(1,+$G(D),"XUS")),"^",10) S:P="" P=$P($G(^XTV(8989.3,1,"XUS")),"^",10)
|
|---|
| 55 | Q $S(P]"":P,1:300)
|
|---|
| 56 | ;
|
|---|
| 57 | ERR ;
|
|---|
| 58 | U $P
|
|---|
| 59 | W !,"$ECODE=",$ECODE," $STACK=",$STACK
|
|---|
| 60 | R !!,"Want to record the error: No// ",%XUP:600 I "Yy"[$E(%XUP_"N") D ^%ZTER
|
|---|
| 61 | D UNWIND^%ZTER ;S:'$ESTACK $ECODE="" S $ETRAP="" Q:$QUIT "" Q
|
|---|
| 62 | ;
|
|---|
