- XUS9 ;SF/RWF,ISD/HGW - Find a user ; 1/18/12 8:20am
- ;;8.0;KERNEL;**258,590,804**;Jul 10, 1995;Build 8
- ;Per VHA Directive 2004-038, this routine should not be modified
- N %,%DT,%H,DA,DIC,I,Y,X,X1,XU1,XU2,XU3,XU4,XU5,XU6,XU7,XUSER,XUJOB,XUVOL,XUCI,XUDT,XUNODE
- 1 X ^%ZOSF("UCI") S XU1=$P(Y,",",1),XU2=^%ZOSF("VOL"),X="T-1",%DT="" D ^%DT S XU4=Y
- A S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Find User: " D ^DIC G EXIT:Y'>0 S DA=+Y,XUSER=$P(Y,"^",2)
- W !!,"User: ",XUSER,$S($D(^XUSEC(0,"CUR",DA))=10:" is found on;",1:" isn't currently on the system")
- F XU5=0:0 S XU5=$O(^XUSEC(0,"CUR",DA,XU5)) Q:XU5'>0 D B
- W !,"DONE" G A
- EXIT ;K %,%H,DA,DIC,I,Y,X
- EX2 ;K XU1,XU2,XU3,XU4,XU5,XU6,XUSER,XUJOB,XUVOL,XUCI,XUDT
- Q
- B ;Find
- G:XU5<XU4 REMOVE ;Sign-on more than 24 hours old.
- S XU3=$S($D(^XUSEC(0,XU5,0)):^(0),1:"") G REMOVE:'$L(XU3),REMOVE:$P(XU3,"^",4)
- S XUCI=$P(XU3,"^",8),XUVOL=$P(XU3,"^",5),Y=XU5,XUJOB=$P(XU3,"^",3),XU6=XUJOB D DD^%DT S XUDT=Y
- I XUJOB>2048 S X1=16,X=XUJOB D CNV^XTBASE S XU6=XUJOB_" ("_Y_")"
- D GETENV^%ZOSV S XU7=$P(Y,"^",3) ; p590 Get node of current user
- S XU7=$P(XU7,".") ;P804
- S XUNODE=$S($P(XU3,"^",10)]"":$P(XU3,"^",10),1:"unknown") ; p590 Identify node in sign-on log
- Q:XUCI'=XU1!(XUVOL'=XU2) ;G:$S($D(^XUTL("XQ",XUJOB,"DUZ")):^("DUZ"),1:0)'=DA REMOVE ; p590
- I XU7=XUNODE G:$S($D(^XUTL("XQ",XUJOB,"DUZ")):^("DUZ"),1:0)'=DA REMOVE ; p590 XUJOB is only unique to a node
- W !,"Job: ",XU6," on ",XUCI,",",XUVOL," node: ",XUNODE," from ",XUDT ; p590 Changed output format
- W !,"Device: ",$P(XU3,"^",2) W:$P(XU3,"^",9)]"" " (",$P(XU3,"^",9),")"
- ;Q:XUCI'=XU1!(XUVOL'=XU2) G:$S($D(^XUTL("XQ",XUJOB,"DUZ")):^("DUZ"),1:0)'=DA REMOVE
- W !?3,"Menu path:"
- ; p590 XUJOB is only unique to a node
- I XU7=XUNODE I $D(^XUTL("XQ",XUJOB,"T")) F I=1:1:^XUTL("XQ",XUJOB,"T") Q:'$D(^XUTL("XQ",XUJOB,I)) S Y=^(I) W !,?I*3+2,$P(Y,"^",3)
- I XU7'=XUNODE W !?3,"You must sign-on to node ",XUNODE," to see this menu path."
- ;I $D(^XUTL("XQ",XUJOB,"T")) F I=1:1:^XUTL("XQ",XUJOB,"T") Q:'$D(^XUTL("XQ",XUJOB,I)) S Y=^(I) W !,?I*3+2,$P(Y,"^",3) ; p590
- W !
- Q
- REMOVE ;Questionable entry removed
- ;If we have a sign-off time just remove the "CUR" X-ref.
- I $P($G(^XUSEC(0,XU5,0)),"^",4) K ^XUSEC(0,"CUR",DA,XU5) Q
- N FDA
- S FDA(3.081,XU5_",",3)=$$NOW^XLFDT,FDA(3.081,XU5_",",16)=1
- D UPDATE^DIE("","FDA")
- Q
- INQ ;Entry from print template used by "User Inquiry" [XUSERINQ]
- Q:'$D(D0) N DA X ^%ZOSF("UCI") S XU1=$P(Y,",",1),XU2=^%ZOSF("VOL"),DA=D0,XU4=DT-1
- F XU5=0:0 S XU5=$O(^XUSEC(0,"CUR",DA,XU5)) Q:XU5'>0 D B
- G EX2
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUS9 2569 printed Feb 18, 2025@23:38:28 Page 2
- XUS9 ;SF/RWF,ISD/HGW - Find a user ; 1/18/12 8:20am
- +1 ;;8.0;KERNEL;**258,590,804**;Jul 10, 1995;Build 8
- +2 ;Per VHA Directive 2004-038, this routine should not be modified
- +3 NEW %,%DT,%H,DA,DIC,I,Y,X,X1,XU1,XU2,XU3,XU4,XU5,XU6,XU7,XUSER,XUJOB,XUVOL,XUCI,XUDT,XUNODE
- 1 XECUTE ^%ZOSF("UCI")
- SET XU1=$PIECE(Y,",",1)
- SET XU2=^%ZOSF("VOL")
- SET X="T-1"
- SET %DT=""
- DO ^%DT
- SET XU4=Y
- A SET DIC="^VA(200,"
- SET DIC(0)="AEMQ"
- SET DIC("A")="Find User: "
- DO ^DIC
- if Y'>0
- GOTO EXIT
- SET DA=+Y
- SET XUSER=$PIECE(Y,"^",2)
- +1 WRITE !!,"User: ",XUSER,$SELECT($DATA(^XUSEC(0,"CUR",DA))=10:" is found on;",1:" isn't currently on the system")
- +2 FOR XU5=0:0
- SET XU5=$ORDER(^XUSEC(0,"CUR",DA,XU5))
- if XU5'>0
- QUIT
- DO B
- +3 WRITE !,"DONE"
- GOTO A
- EXIT ;K %,%H,DA,DIC,I,Y,X
- EX2 ;K XU1,XU2,XU3,XU4,XU5,XU6,XUSER,XUJOB,XUVOL,XUCI,XUDT
- +1 QUIT
- B ;Find
- +1 ;Sign-on more than 24 hours old.
- if XU5<XU4
- GOTO REMOVE
- +2 SET XU3=$SELECT($DATA(^XUSEC(0,XU5,0)):^(0),1:"")
- if '$LENGTH(XU3)
- GOTO REMOVE
- if $PIECE(XU3,"^",4)
- GOTO REMOVE
- +3 SET XUCI=$PIECE(XU3,"^",8)
- SET XUVOL=$PIECE(XU3,"^",5)
- SET Y=XU5
- SET XUJOB=$PIECE(XU3,"^",3)
- SET XU6=XUJOB
- DO DD^%DT
- SET XUDT=Y
- +4 IF XUJOB>2048
- SET X1=16
- SET X=XUJOB
- DO CNV^XTBASE
- SET XU6=XUJOB_" ("_Y_")"
- +5 ; p590 Get node of current user
- DO GETENV^%ZOSV
- SET XU7=$PIECE(Y,"^",3)
- +6 ;P804
- SET XU7=$PIECE(XU7,".")
- +7 ; p590 Identify node in sign-on log
- SET XUNODE=$SELECT($PIECE(XU3,"^",10)]"":$PIECE(XU3,"^",10),1:"unknown")
- +8 ;G:$S($D(^XUTL("XQ",XUJOB,"DUZ")):^("DUZ"),1:0)'=DA REMOVE ; p590
- if XUCI'=XU1!(XUVOL'=XU2)
- QUIT
- +9 ; p590 XUJOB is only unique to a node
- IF XU7=XUNODE
- if $SELECT($DATA(^XUTL("XQ",XUJOB,"DUZ"))
- GOTO REMOVE
- +10 ; p590 Changed output format
- WRITE !,"Job: ",XU6," on ",XUCI,",",XUVOL," node: ",XUNODE," from ",XUDT
- +11 WRITE !,"Device: ",$PIECE(XU3,"^",2)
- if $PIECE(XU3,"^",9)]""
- WRITE " (",$PIECE(XU3,"^",9),")"
- +12 ;Q:XUCI'=XU1!(XUVOL'=XU2) G:$S($D(^XUTL("XQ",XUJOB,"DUZ")):^("DUZ"),1:0)'=DA REMOVE
- +13 WRITE !?3,"Menu path:"
- +14 ; p590 XUJOB is only unique to a node
- +15 IF XU7=XUNODE
- IF $DATA(^XUTL("XQ",XUJOB,"T"))
- FOR I=1:1:^XUTL("XQ",XUJOB,"T")
- if '$DATA(^XUTL("XQ",XUJOB,I))
- QUIT
- SET Y=^(I)
- WRITE !,?I*3+2,$PIECE(Y,"^",3)
- +16 IF XU7'=XUNODE
- WRITE !?3,"You must sign-on to node ",XUNODE," to see this menu path."
- +17 ;I $D(^XUTL("XQ",XUJOB,"T")) F I=1:1:^XUTL("XQ",XUJOB,"T") Q:'$D(^XUTL("XQ",XUJOB,I)) S Y=^(I) W !,?I*3+2,$P(Y,"^",3) ; p590
- +18 WRITE !
- +19 QUIT
- REMOVE ;Questionable entry removed
- +1 ;If we have a sign-off time just remove the "CUR" X-ref.
- +2 IF $PIECE($GET(^XUSEC(0,XU5,0)),"^",4)
- KILL ^XUSEC(0,"CUR",DA,XU5)
- QUIT
- +3 NEW FDA
- +4 SET FDA(3.081,XU5_",",3)=$$NOW^XLFDT
- SET FDA(3.081,XU5_",",16)=1
- +5 DO UPDATE^DIE("","FDA")
- +6 QUIT
- INQ ;Entry from print template used by "User Inquiry" [XUSERINQ]
- +1 if '$DATA(D0)
- QUIT
- NEW DA
- XECUTE ^%ZOSF("UCI")
- SET XU1=$PIECE(Y,",",1)
- SET XU2=^%ZOSF("VOL")
- SET DA=D0
- SET XU4=DT-1
- +2 FOR XU5=0:0
- SET XU5=$ORDER(^XUSEC(0,"CUR",DA,XU5))
- if XU5'>0
- QUIT
- DO B
- +3 GOTO EX2