Routine: XUSCLEAN

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

C ;Do device close execute, User exit.

 N XUDEV

 S XUDEV=$S($D(^XUTL("XQ",$J,"IOS")):^("IOS"),1:"")

 D ^%ZISC,BYE

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

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

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)

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

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

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

XUSCLEAN.m