XUSCLEAN ;SF/STAFF - CLEANUP BEFORE EXIT ;10/26/06 08:12
;;8.0;KERNEL;**1002,1003,1004,1005,1007,1016**;APR 1, 2003;Build 5
;;8.0;KERNEL;**13,59,165,353,434**;Jul 10, 1995;Build 6
;THIS ROUTINE CONTAINS LOCAL MODIFICATION BY IHS/HQW/JLS 12/24/97
H ;;Exit point for all R/S applications
LOCK ;Unlock any locks
S U="^"
;Unwind Exit Actions
I $D(^XUTL("XQ",$J,"T")) S %XQEA=^("T") D
. F %XQEA1=%XQEA:-1:1 I $D(^XUTL("XQ",$J,%XQEA1)),$P(^(%XQEA1),U,16) S %XQEA2=+^(%XQEA1) I $D(^DIC(19,%XQEA2,15)),$L(^(15)) X ^(15)
K %XQEA,%XQEA1,%XQEA2
;Jump if the home device was closed
G:$D(IO("C")) H2
;Clear the screen
I $S($D(IOST)[0:1,IOST="":1,IOST["C-":1,1:0),'$D(XUERF) W !!!!!!!!!!!!!!!!!!!!!!!
I $D(XQNOLOG) W !!,"==> Sorry, all activity on this volume set is being halted! Try again later.",*7,*7,*7,!!!!
;W !!,"Halting at " S X=$P($H,",",2),Y=$E(X#3600\60+100,2,3),X=X\3600,Z=0 S:X>11 Z=1 S:'X X=12 S:X>12 X=X-12 W X,":",Y," ",$S(Z:"pm",1:"am")
W !!,"Logged out at "_$$HTE^XLFDT($H,"1FMP")
D:$D(DUZ("NEWCODE")) NEWCODE
;NON-R/S exit thru here also.
H2 ;No talking after this point
D C,XUTL
;un-comment the following line if you want FM space recall cleared
;after each session.
;K ^DISV($G(DUZ,0))
S:'($D(XQXFLG)#2) XQXFLG="" I $D(XQCH),XQCH="HALT" S $P(XQXFLG,U,3)=""
I ($D(XQNOHALT)#2)!($D(ZTQUEUED)#2)!($P(XQXFLG,U,3)="XUP") K XQNOHALT,XQXFLG Q ;Return to REST^XQ12, ^XUP or Taskman.
;This was for modem hang up code. Obsolete now
I $D(^%ZIS("H"))#2 X ^("H")
;Go to ZU to do final halt.
G HALT^ZU
;
TOUCH ;SR. API to set the keepalive node, Only set once a day
Q:+$G(^XUTL("XQ",$J,"KEEPALIVE"))=+$H
S ^XUTL("XQ",$J,"KEEPALIVE")=$H
Q
;
C ;Do device close execute, User exit.
N XUDEV
S XUDEV=$S($D(^XUTL("XQ",$J,"IOS")):^("IOS"),1:"")
D ^%ZISC,BYE
Q
;
;Called from Broker, VistaLink, R/S
BYE ;Set flags to show user has left. Called from anyplace the user exits
N DA,DIK,R0,%
I $G(^VA(200,+$G(DUZ),1.1)) S $P(^VA(200,DUZ,1.1),"^",3)=0
S DA=+$G(^XUTL("XQ",$J,0)) D LOUT(DA)
I $D(^XUSEC(0,DA,0)) D
. S R0=^XUSEC(0,DA,0)
. I $G(IO("IP"))]"",$P(R0,"^",13)]"" S %=$$CMD^XWBCAGNT(.R0,"XWB DELETE HANDLE",$P(R0,"^",13))
K ^XUTL("XQ",$J)
Q
;
LOUT(DA) ;Enter log-out time, in Sign-on log
N DIK
I $D(^XUSEC(0,DA,0)) D
. S R0=^(0),$P(^(0),"^",4)=$$NOW^XLFDT,DIK="^XUSEC(0,",DIK(1)="3" D EN1^DIK
Q
;
XUTL ;Cleanup JOB temporary Globals
N XQN D CLEAN^DILF ;Cleanup FM too.
K ^XUTL($J),^UTILITY($J),^TMP($J)
S XQN=" " F S XQN=$O(^XUTL(XQN)) Q:XQN="" K:"^XQO^XGATR^XGKB^"'[XQN ^XUTL(XQN,$J)
;----- BEGIN IHS MODIFICATION - XU*8.0*1007
;THE BELOW LINE IS COMMENTED OUT AND REPLACED BY A NEW LINE TO CHECK
;FOR THE EXISTANCE OF THE XBDBQUE VARIABLE BEFORE KILLING THE ^TMP
;GLOBAL FOR DOUBLE QUEUED JOBS. ORIGINAL MOD BY IHS/HQW/JLS 12/24/97
;S XQN=" " F S XQN=$O(^TMP(XQN)) Q:XQN="" K ^TMP(XQN,$J)
I '$G(XBDBQUE) S XQN=" " F S XQN=$O(^TMP(XQN)) Q:XQN="" K ^TMP(XQN,$J)
;----- END IHS MODIFICATION
S XQN=" " F S XQN=$O(^UTILITY(XQN)) Q:XQN="" K:"^ROU^GLO^LRLTR"'[XQN ^UTILITY(XQN,$J)
K ^XUTL("ZISPARAM",$I)
Q
;
NEWCODE ;Remind user they changed there VC.
W !!,*7,"But, as I recall...",!,"You've changed your VERIFY CODE during this session.",!,"Please remember it for next time." H 4
Q
;
;Entry point to clear symbol table
KILL ;SR. This is what was requested.
K %1,%2,%3 S %3=+$G(^XUTL("XQ",$J,"T"))
;See if Menu stack has Variable to protect.
F %1=%3:-1:1 S %2=+$G(^XUTL("XQ",$J,%1)),%2=$G(^DIC(19,%2,"NOKILL")) I %2]"" N @%2
;Fall into next part of kill.
KILL1 ;To clean up ALL but kernel variables.
I $$BROKER^XWBLIB S %2=$P($T(VARLST^XWBLIB),";;",2) I %2]"" N @%2 ;Protect Broker variables.
N XGWIN,XGDI,XGEVENT ;P434 remove KWAPI
N XQAEXIT,XQAUSER,XQX1,XQAKILL,XQAID
;p434 add DILOCKTM, remove XRTL, %ZH0
K (DUZ,DTIME,DILOCKTM,DT,DISYS,IO,IOBS,IOF,IOM,ION,IOSL,IOST,IOT,IOS,IOXY,U,XQVOL,XQY,XQY0,XQDIC,XQPSM,XQPT,XQAUDIT,XQXFLG,ZTSTOP,ZTQUEUED,ZTREQ)
K IO("C"),IO("Q")
Q
;
XMR ;Entry point from XUS to DO xmr and cleanup after.
N XQXFLG ;p434
D NEXT^XUS1 S XQXFLG="",XQXFLG("HALT")=1 G H2
XUSCLEAN ;SF/STAFF - CLEANUP BEFORE EXIT ;10/26/06 08:12
+1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007,1016**;APR 1, 2003;Build 5
+2 ;;8.0;KERNEL;**13,59,165,353,434**;Jul 10, 1995;Build 6
+3 ;THIS ROUTINE CONTAINS LOCAL MODIFICATION BY IHS/HQW/JLS 12/24/97
H ;;Exit point for all R/S applications
+1 ;Unlock any locks
LOCK
+2 SET U="^"
+3 ;Unwind Exit Actions
+4 IF $DATA(^XUTL("XQ",$JOB,"T"))
SET %XQEA=^("T")
Begin DoDot:1
+5 FOR %XQEA1=%XQEA:-1:1
IF $DATA(^XUTL("XQ",$JOB,%XQEA1))
IF $PIECE(^(%XQEA1),U,16)
SET %XQEA2=+^(%XQEA1)
IF $DATA(^DIC(19,%XQEA2,15))
IF $LENGTH(^(15))
XECUTE ^(15)
End DoDot:1
+6 KILL %XQEA,%XQEA1,%XQEA2
+7 ;Jump if the home device was closed
+8 IF $DATA(IO("C"))
GOTO H2
+9 ;Clear the screen
+10 IF $SELECT($DATA(IOST)[0:1,IOST="":1,IOST["C-":1,1:0)
IF '$DATA(XUERF)
WRITE !!!!!!!!!!!!!!!!!!!!!!!
+11 IF $DATA(XQNOLOG)
WRITE !!,"==> Sorry, all activity on this volume set is being halted! Try again later.",*7,*7,*7,!!!!
+12 ;W !!,"Halting at " S X=$P($H,",",2),Y=$E(X#3600\60+100,2,3),X=X\3600,Z=0 S:X>11 Z=1 S:'X X=12 S:X>12 X=X-12 W X,":",Y," ",$S(Z:"pm",1:"am")
+13 WRITE !!,"Logged out at "_$$HTE^XLFDT($HOROLOG,"1FMP")
+14 IF $DATA(DUZ("NEWCODE"))
DO NEWCODE
+15 ;NON-R/S exit thru here also.
H2 ;No talking after this point
+1 DO C
DO XUTL
+2 ;un-comment the following line if you want FM space recall cleared
+3 ;after each session.
+4 ;K ^DISV($G(DUZ,0))
+5 IF '($DATA(XQXFLG)#2)
SET XQXFLG=""
IF $DATA(XQCH)
IF XQCH="HALT"
SET $PIECE(XQXFLG,U,3)=""
+6 ;Return to REST^XQ12, ^XUP or Taskman.
IF ($DATA(XQNOHALT)#2)!($DATA(ZTQUEUED)#2)!($PIECE(XQXFLG,U,3)="XUP")
KILL XQNOHALT,XQXFLG
QUIT
+7 ;This was for modem hang up code. Obsolete now
+8 IF $DATA(^%ZIS("H"))#2
XECUTE ^("H")
+9 ;Go to ZU to do final halt.
+10 GOTO HALT^ZU
+11 ;
TOUCH ;SR. API to set the keepalive node, Only set once a day
+1 IF +$GET(^XUTL("XQ",$JOB,"KEEPALIVE"))=+$HOROLOG
QUIT
+2 SET ^XUTL("XQ",$JOB,"KEEPALIVE")=$HOROLOG
+3 QUIT
+4 ;
C ;Do device close execute, User exit.
+1 NEW XUDEV
+2 SET XUDEV=$SELECT($DATA(^XUTL("XQ",$JOB,"IOS")):^("IOS"),1:"")
+3 DO ^%ZISC
DO BYE
+4 QUIT
+5 ;
+6 ;Called from Broker, VistaLink, R/S
BYE ;Set flags to show user has left. Called from anyplace the user exits
+1 NEW DA,DIK,R0,%
+2 IF $GET(^VA(200,+$GET(DUZ),1.1))
SET $PIECE(^VA(200,DUZ,1.1),"^",3)=0
+3 SET DA=+$GET(^XUTL("XQ",$JOB,0))
DO LOUT(DA)
+4 IF $DATA(^XUSEC(0,DA,0))
Begin DoDot:1
+5 SET R0=^XUSEC(0,DA,0)
+6 IF $GET(IO("IP"))]""
IF $PIECE(R0,"^",13)]""
SET %=$$CMD^XWBCAGNT(.R0,"XWB DELETE HANDLE",$PIECE(R0,"^",13))
End DoDot:1
+7 KILL ^XUTL("XQ",$JOB)
+8 QUIT
+9 ;
LOUT(DA) ;Enter log-out time, in Sign-on log
+1 NEW DIK
+2 IF $DATA(^XUSEC(0,DA,0))
Begin DoDot:1
+3 SET R0=^(0)
SET $PIECE(^(0),"^",4)=$$NOW^XLFDT
SET DIK="^XUSEC(0,"
SET DIK(1)="3"
DO EN1^DIK
End DoDot:1
+4 QUIT
+5 ;
XUTL ;Cleanup JOB temporary Globals
+1 ;Cleanup FM too.
NEW XQN
DO CLEAN^DILF
+2 KILL ^XUTL($JOB),^UTILITY($JOB),^TMP($JOB)
+3 SET XQN=" "
FOR
SET XQN=$ORDER(^XUTL(XQN))
IF XQN=""
QUIT
IF "^XQO^XGATR^XGKB^"'[XQN
KILL ^XUTL(XQN,$JOB)
+4 ;----- BEGIN IHS MODIFICATION - XU*8.0*1007
+5 ;THE BELOW LINE IS COMMENTED OUT AND REPLACED BY A NEW LINE TO CHECK
+6 ;FOR THE EXISTANCE OF THE XBDBQUE VARIABLE BEFORE KILLING THE ^TMP
+7 ;GLOBAL FOR DOUBLE QUEUED JOBS. ORIGINAL MOD BY IHS/HQW/JLS 12/24/97
+8 ;S XQN=" " F S XQN=$O(^TMP(XQN)) Q:XQN="" K ^TMP(XQN,$J)
+9 IF '$GET(XBDBQUE)
SET XQN=" "
FOR
SET XQN=$ORDER(^TMP(XQN))
IF XQN=""
QUIT
KILL ^TMP(XQN,$JOB)
+10 ;----- END IHS MODIFICATION
+11 SET XQN=" "
FOR
SET XQN=$ORDER(^UTILITY(XQN))
IF XQN=""
QUIT
IF "^ROU^GLO^LRLTR"'[XQN
KILL ^UTILITY(XQN,$JOB)
+12 KILL ^XUTL("ZISPARAM",$IO)
+13 QUIT
+14 ;
NEWCODE ;Remind user they changed there VC.
+1 WRITE !!,*7,"But, as I recall...",!,"You've changed your VERIFY CODE during this session.",!,"Please remember it for next time."
HANG 4
+2 QUIT
+3 ;
+4 ;Entry point to clear symbol table
KILL ;SR. This is what was requested.
+1 KILL %1,%2,%3
SET %3=+$GET(^XUTL("XQ",$JOB,"T"))
+2 ;See if Menu stack has Variable to protect.
+3 FOR %1=%3:-1:1
SET %2=+$GET(^XUTL("XQ",$JOB,%1))
SET %2=$GET(^DIC(19,%2,"NOKILL"))
IF %2]""
NEW @%2
+4 ;Fall into next part of kill.
KILL1 ;To clean up ALL but kernel variables.
+1 ;Protect Broker variables.
IF $$BROKER^XWBLIB
SET %2=$PIECE($TEXT(VARLST^XWBLIB),";;",2)
IF %2]""
NEW @%2
+2 ;P434 remove KWAPI
NEW XGWIN,XGDI,XGEVENT
+3 NEW XQAEXIT,XQAUSER,XQX1,XQAKILL,XQAID
+4 ;p434 add DILOCKTM, remove XRTL, %ZH0
+5 KILL (DUZ,DTIME,DILOCKTM,DT,DISYS,IO,IOBS,IOF,IOM,ION,IOSL,IOST,IOT,IOS,IOXY,U,XQVOL,XQY,XQY0,XQDIC,XQPSM,XQPT,XQAUDIT,XQXFLG,ZTSTOP,ZTQUEUED,ZTREQ)
+6 KILL IO("C"),IO("Q")
+7 QUIT
+8 ;
XMR ;Entry point from XUS to DO xmr and cleanup after.
+1 ;p434
NEW XQXFLG
+2 DO NEXT^XUS1
SET XQXFLG=""
SET XQXFLG("HALT")=1
GOTO H2
