- XQUSR ;MJM/SEA Display User Chracteristics XUUSERDISP ;01/30/2001 14:00 [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- ;;8.0;KERNEL;**169**;Jul 10, 1995
- USER ;
- USERN ;
- N XQA
- I '$D(IOF) S IOP="" D ^%ZIS K IOP
- S XQPAGE=$S($D(IOSL):IOSL-2,1:18),XQLINE=9
- S $P(XQDSH,"-",41)="-"
- S I="",IORV="""""",IORVX="""""" I $D(IOST(0)) S:$D(^%ZIS(2,IOST(0),5)) I=^(5) S:$L($P(I,U,4)) IORV=$P(I,U,4) S:$L($P(I,U,5)) IORVX=$P(I,U,5)
- I '$D(DTIME) S DTIME=$S('$D(^VA(200,DUZ,200)):"",1:$P(^(200),U,10)) I '$L(DTIME) S DTIME=$S('$D(^%ZIS(1,$I,"XUS")):"",1:$P(^("XUS"),U,10)) I '$L(DTIME) S DTIME=$P(^XTV(8989.3,1,"XUS"),U,10)
- I '$D(ION) S %ZIS="N0",IOP="HOME" D ^%ZIS
- W @IOF,!,@IORV,$P(^VA(200,DUZ,0),U,1),@IORVX," (#",DUZ,")",?30,"DEVICE: ",@IORV,ION,@IORVX," ($I: ",$I,")",?65,"JOB: ",@IORV,$J,@IORVX
- W !!,"ENVIRONMENT",?40,"ATTRIBUTES",!,$E(XQDSH,1,11),?40,$E(XQDSH,1,11)
- S X="N" I $D(^VA(200,DUZ,200)) S X=$P(^(200),U,9) S:'$L(X) X="N"
- W !?3,"Site ........ ",^DD("SITE"),?43,"Type-ahead ....... ",X
- S Y="unknown" I $D(^%ZOSF("UCI")) X ^("UCI")
- W !?3,"UCI ......... ",Y,?43,"Time-out ......... ",DTIME
- S X="unknown" I $D(^VA(200,DUZ,1.1)) S X=$P(+^(1.1),".",2)
- W !?3,"Signed on ... ",$E(X,1,2)_":"_$E(X,3,4),?43,"Fileman code(s) .. ",DUZ(0)
- I $D(IOST)#10 W !?3,"Terminal type ",IOST
- ;Show the Person Class
- W !!,"Person Class: " D SHPC^XUSER1(DUZ)
- I $D(^VA(200,DUZ,51)) D
- . W !!,"KEYS HELD",!,$E(XQDSH,1,9)
- . D GKEYS^XUSER1(DUZ,.XQA),SHLIST^XUSER1(.XQA,3,4) S:$D(DIRUT) XQUPAR=1 K DIRUT
- .Q
- Q:$D(XQUPAR)
- D HOW
- W !!,"Enter '^' to escape, <CR> to view Mailman user info: " R X:DTIME S:'$T X=U I '$L(X) S Y=DUZ W @IOF D EN^XMA7
- ;
- K %,%Y,X,XQDSH,XQLINE,XQPAGE,XQUPAR,Y
- Q
- ;
- HOW S:'$D(XQDSH) $P(XQDSH,"-",21)="-" W !!,"MENU PATH",!,$E(XQDSH,1,9)
- I '$D(^XUTL("XQ",$J,"T")) W !?5,"==> No User stack in ^XUTL." Q
- S XQLINE=XQLINE+2 I XQLINE'<XQPAGE D PAUSE Q:$D(XQUPAR) S XQLINE=0
- F Z=1:1:^XUTL("XQ",$J,"T") Q:$D(XQUPAR) D
- .W !,?Z-1*2,$P(^(Z),U,3)," (",$P(^(Z),U,2),")"
- .S XQLINE=XQLINE+1 I XQLINE'<XQPAGE D PAUSE S XQLINE=0
- .Q
- Q
- ;
- TIME ;
- D ^XQDATE W " "_%Y
- Q
- ;
- PAUSE ;Hold the screen
- N XQ I 1
- R !!,"Hit RETURN or ENTER to continue or ""^"" to halt: ",XQ:DTIME
- I '$T S XQ=U
- I XQ=U S XQUPAR=""
- Q
- XQUSR ;MJM/SEA Display User Chracteristics XUUSERDISP ;01/30/2001 14:00 [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- +2 ;;8.0;KERNEL;**169**;Jul 10, 1995
- USER ;
- USERN ;
- +1 NEW XQA
- +2 IF '$DATA(IOF)
- SET IOP=""
- DO ^%ZIS
- KILL IOP
- +3 SET XQPAGE=$SELECT($DATA(IOSL):IOSL-2,1:18)
- SET XQLINE=9
- +4 SET $PIECE(XQDSH,"-",41)="-"
- +5 SET I=""
- SET IORV=""""""
- SET IORVX=""""""
- IF $DATA(IOST(0))
- IF $DATA(^%ZIS(2,IOST(0),5))
- SET I=^(5)
- IF $LENGTH($PIECE(I,U,4))
- SET IORV=$PIECE(I,U,4)
- IF $LENGTH($PIECE(I,U,5))
- SET IORVX=$PIECE(I,U,5)
- +6 IF '$DATA(DTIME)
- SET DTIME=$SELECT('$DATA(^VA(200,DUZ,200)):"",1:$PIECE(^(200),U,10))
- IF '$LENGTH(DTIME)
- SET DTIME=$SELECT('$DATA(^%ZIS(1,$IO,"XUS")):"",1:$PIECE(^("XUS"),U,10))
- IF '$LENGTH(DTIME)
- SET DTIME=$PIECE(^XTV(8989.3,1,"XUS"),U,10)
- +7 IF '$DATA(ION)
- SET %ZIS="N0"
- SET IOP="HOME"
- DO ^%ZIS
- +8 WRITE @IOF,!,@IORV,$PIECE(^VA(200,DUZ,0),U,1),@IORVX," (#",DUZ,")",?30,"DEVICE: ",@IORV,ION,@IORVX," ($I: ",$IO,")",?65,"JOB: ",@IORV,$JOB,@IORVX
- +9 WRITE !!,"ENVIRONMENT",?40,"ATTRIBUTES",!,$EXTRACT(XQDSH,1,11),?40,$EXTRACT(XQDSH,1,11)
- +10 SET X="N"
- IF $DATA(^VA(200,DUZ,200))
- SET X=$PIECE(^(200),U,9)
- IF '$LENGTH(X)
- SET X="N"
- +11 WRITE !?3,"Site ........ ",^DD("SITE"),?43,"Type-ahead ....... ",X
- +12 SET Y="unknown"
- IF $DATA(^%ZOSF("UCI"))
- XECUTE ^("UCI")
- +13 WRITE !?3,"UCI ......... ",Y,?43,"Time-out ......... ",DTIME
- +14 SET X="unknown"
- IF $DATA(^VA(200,DUZ,1.1))
- SET X=$PIECE(+^(1.1),".",2)
- +15 WRITE !?3,"Signed on ... ",$EXTRACT(X,1,2)_":"_$EXTRACT(X,3,4),?43,"Fileman code(s) .. ",DUZ(0)
- +16 IF $DATA(IOST)#10
- WRITE !?3,"Terminal type ",IOST
- +17 ;Show the Person Class
- +18 WRITE !!,"Person Class: "
- DO SHPC^XUSER1(DUZ)
- +19 IF $DATA(^VA(200,DUZ,51))
- Begin DoDot:1
- +20 WRITE !!,"KEYS HELD",!,$EXTRACT(XQDSH,1,9)
- +21 DO GKEYS^XUSER1(DUZ,.XQA)
- DO SHLIST^XUSER1(.XQA,3,4)
- IF $DATA(DIRUT)
- SET XQUPAR=1
- KILL DIRUT
- +22 QUIT
- End DoDot:1
- +23 IF $DATA(XQUPAR)
- QUIT
- +24 DO HOW
- +25 WRITE !!,"Enter '^' to escape, <CR> to view Mailman user info: "
- READ X:DTIME
- IF '$TEST
- SET X=U
- IF '$LENGTH(X)
- SET Y=DUZ
- WRITE @IOF
- DO EN^XMA7
- +26 ;
- +27 KILL %,%Y,X,XQDSH,XQLINE,XQPAGE,XQUPAR,Y
- +28 QUIT
- +29 ;
- HOW IF '$DATA(XQDSH)
- SET $PIECE(XQDSH,"-",21)="-"
- WRITE !!,"MENU PATH",!,$EXTRACT(XQDSH,1,9)
- +1 IF '$DATA(^XUTL("XQ",$JOB,"T"))
- WRITE !?5,"==> No User stack in ^XUTL."
- QUIT
- +2 SET XQLINE=XQLINE+2
- IF XQLINE'<XQPAGE
- DO PAUSE
- IF $DATA(XQUPAR)
- QUIT
- SET XQLINE=0
- +3 FOR Z=1:1:^XUTL("XQ",$JOB,"T")
- IF $DATA(XQUPAR)
- QUIT
- Begin DoDot:1
- +4 WRITE !,?Z-1*2,$PIECE(^(Z),U,3)," (",$PIECE(^(Z),U,2),")"
- +5 SET XQLINE=XQLINE+1
- IF XQLINE'<XQPAGE
- DO PAUSE
- SET XQLINE=0
- +6 QUIT
- End DoDot:1
- +7 QUIT
- +8 ;
- TIME ;
- +1 DO ^XQDATE
- WRITE " "_%Y
- +2 QUIT
- +3 ;
- PAUSE ;Hold the screen
- +1 NEW XQ
- IF 1
- +2 READ !!,"Hit RETURN or ENTER to continue or ""^"" to halt: ",XQ:DTIME
- +3 IF '$TEST
- SET XQ=U
- +4 IF XQ=U
- SET XQUPAR=""
- +5 QUIT
