Changeset 636 for FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUP.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUP.m
r628 r636 1 XUP ;SFISC/RWF - Setup enviroment for programmers ; 10/12/06 12:452 ;;8.0;KERNEL;**208,258,284 ,432**;Jul 10, 1995;Build 31 XUP ;SFISC/RWF - Setup enviroment for programmers ;09/21/2004 16:35 2 ;;8.0;KERNEL;**208,258,284**;Jul 10, 1995 3 3 W !,"Setting up programmer environment" 4 S U="^",$ECODE="",$ETRAP="" ;Clear error and error trap4 N $ESTACK,$ETRAP S $ECODE="",$ETRAP="" ;Clear and error trap 5 5 X ^%ZOSF("TYPE-AHEAD") 6 6 ;Check if Production and report … … 14 14 I $D(DUZ("SAV")) S DUZ=+DUZ("SAV"),DUZ(0)=$P(DUZ("SAV"),U,2) K DUZ("SAV") 15 15 ;Get user info 16 I $G(DUZ)>.5,$D(^VA(200,DUZ,0))[0 K DUZ W !,"DUZ Must point to a real user." G EXIT ;p43217 16 I $G(DUZ)>0 D DUZ(DUZ) 18 17 I $G(DUZ)'>0!('$D(DUZ(0))) D ASKDUZ G:Y'>0 EXIT 19 18 I '$D(XQUSER) S XQUSER=$S($D(^VA(200,DUZ,20)):$P(^(20),"^",2),1:"Unk") 20 19 S DTIME=600 ;Set a temp DTIME 21 S DILOCKTM=+$G(^DD("DILOCKTM"),1) ;p43222 20 ;Getting Terminal Type 23 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 … … 33 31 I $$GET^XPAR("USR^SYS","XUS-XUP SET ERROR TRAP",1,"Q") S $ETRAP="D ERR^XUP" 34 32 D KILL1^XUSCLEAN S $P(XQXFLG,U,3)="XUP" D ^XQ1 35 EXIT ;Clean-up and exit 36 D KILL1^XUSCLEAN K XQY,XQY0 37 I $G(DUZ)>0,$$GET^XPAR("USR^SYS","XUS-XUP VPE",1,"Q"),$D(^%ZVEMS) X ^%ZVEMS ;Run VPE 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 38 35 Q 39 36 ; 40 ASKDUZ ;Ask for Access Code 41 N X 42 ;X XUEOFF S DIR(0)="FO",DIR("A")="Access Code" D ^DIR W ! X XUEON I $D(DIRUT) S Y=-1 Q 43 X XUEOFF W !,"Access Code: " S X=$$ACCEPT^XUS() X XUEON 44 I X["^"!('$L(X)) S Y=-1 Q 37 ASKDUZ X XUEOFF S DIR(0)="FO",DIR("A")="Access Code" D ^DIR W ! X XUEON I $D(DIRUT) S Y=-1 Q 45 38 S X=$$UP^XLFSTR(X) S:X[":" XUTT=1,X=$P(X,":",1)_$P(X,":",2) 46 39 D ^XUSHSH S Y=$O(^VA(200,"A",X,0)) 47 K DUZ D DUZ(+Y) 48 Q 40 K DUZ D DUZ(+Y) Q 49 41 ; 50 42 DUZ(DA) ;Build DUZ for a user. Used by Mailman. 51 43 ;(p284) Make the setting of several DUZ parts conditional. 52 N Y 53 S Y(0)=$G(^VA(200,+DA,0)),Y("XUS")=$G(^XTV(8989.3,1,"XUS")) 44 N Y S Y(0)=$G(^VA(200,+DA,0)),Y("XUS")=$G(^XTV(8989.3,1,"XUS")) 54 45 S DUZ=DA 55 46 S:$G(DUZ(0))'="@" DUZ(0)=$P(Y(0),"^",4) 56 47 S DUZ(1)="",DUZ("AG")=$P($G(^XTV(8989.3,1,0)),"^",8) 57 48 S:'$G(DUZ(2)) DUZ(2)=$O(^VA(200,DUZ,2,0)) 58 S:'DUZ(2) DUZ(2)=+$P(Y("XUS"), "^",17)59 S:'$L($G(DUZ("LANG"))) DUZ("LANG")=$P(Y("XUS"), "^",7)49 S:'DUZ(2) DUZ(2)=+$P(Y("XUS"),U,17) 50 S:'$L($G(DUZ("LANG"))) DUZ("LANG")=$P(Y("XUS"),U,7) 60 51 Q 61 52 ; 62 53 DTIME(E,D) ;Return DTIME value for user E, device D. 63 N P 64 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) 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) 65 55 Q $S(P]"":P,1:300) 66 56 ; 67 57 ERR ; 68 N %XUPU $P58 U $P 69 59 W !,"$ECODE=",$ECODE," $STACK=",$STACK 70 W !,"Location: ",$STACK($STACK-1,"PLACE")71 60 R !!,"Want to record the error: No// ",%XUP:600 I "Yy"[$E(%XUP_"N") D ^%ZTER 72 61 D UNWIND^%ZTER ;S:'$ESTACK $ECODE="" S $ETRAP="" Q:$QUIT "" Q 62 ;
Note:
See TracChangeset
for help on using the changeset viewer.