XUS9.m

XUS9 ;SF/RWF,ISD/HGW - Find a user ; 1/18/12 8:20am

 ;;8.0;KERNEL;**258,590**;Jul 10, 1995;Build 7

 ;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 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

XUS9      ;SF/RWF,ISD/HGW - Find a user ; 1/18/12 8:20am

 +1       ;;8.0;KERNEL;**258,590**;Jul 10, 1995;Build 7

 +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       ; p590 Identify node in sign-on log

           SET XUNODE=$SELECT($PIECE(XU3,"^",10)]"":$PIECE(XU3,"^",10),1:"unknown")

 +7       ;G:$S($D(^XUTL("XQ",XUJOB,"DUZ")):^("DUZ"),1:0)'=DA REMOVE ; p590

           IF XUCI'=XU1!(XUVOL'=XU2)

               QUIT 

 +8       ; p590 XUJOB is only unique to a node

           IF XU7=XUNODE

               IF $SELECT($DATA(^XUTL("XQ",XUJOB,"DUZ"))

                   GOTO REMOVE

 +9       ; p590 Changed output format

           WRITE !,"Job: ",XU6," on ",XUCI,",",XUVOL," node: ",XUNODE," from ",XUDT

 +10       WRITE !,"Device: ",$PIECE(XU3,"^",2)

           IF $PIECE(XU3,"^",9)]""

               WRITE "  (",$PIECE(XU3,"^",9),")"

 +11      ;Q:XUCI'=XU1!(XUVOL'=XU2)  G:$S($D(^XUTL("XQ",XUJOB,"DUZ")):^("DUZ"),1:0)'=DA REMOVE

 +12       WRITE !?3,"Menu path:"

 +13      ; p590 XUJOB is only unique to a node

 +14       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)

 +15       IF XU7'=XUNODE

               WRITE !?3,"You must sign-on to node ",XUNODE," to see this menu path."

 +16      ;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

 +17       WRITE !

 +18       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