XUSTERM2.m

XUSTERM2 ;SFISC/RWF - USER TERMINATE, PACKAGE FILE RUN ;9/7/94  16:23 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;8.0;KERNEL;;Jul 10, 1995

 ;;.1;;

 D B,A

 Q

A ;FOR v8 only, loop thru package file and do clean-up routines.

 N XUI,XUJ,XUGRP

 F XU1=0:0 S XU1=$O(^DIC(9.4,XU1)) Q:XU1'>0  S XU2=$P($G(^DIC(9.4,XU1,200)),"^",1,2) D:$L($P(XU2,"^",2)) T2(XU2,XUDA)

 K XU1,XU2 Q

T2(XU1,DA) ;Set trap and call one with DA=IFN of user.

 ;Protect what we need to return.

 N XUDA

 S X="TX^XUSTERM2",@^%ZOSF("TRAP"),X=$P(XU1,"^",2) X ^%ZOSF("TEST") Q:'$T

 D @XU1

 Q

TX D @^%ZOSF("ERRTN") Q

 ;

B ;Call XQOR to handle protocall.

 N XUI,XUJ,XUGRP S XUIFN=XUDA N XUDA ;Protect ourself.

 S X="TX^XUSTERM2",@^%ZOSF("TRAP"),DIC="^DIC(19,",X="XU USER TERMINATE"

 D EN^XQOR

 K X,DIC Q

XUSTERM2  ;SFISC/RWF - USER TERMINATE, PACKAGE FILE RUN ;9/7/94  16:23 [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;;Jul 10, 1995

 +3       ;;.1;;

 +4        DO B

           DO A

 +5        QUIT 

A         ;FOR v8 only, loop thru package file and do clean-up routines.

 +1        NEW XUI,XUJ,XUGRP

 +2        FOR XU1=0:0

               SET XU1=$ORDER(^DIC(9.4,XU1))

               IF XU1'>0

                   QUIT 

               SET XU2=$PIECE($GET(^DIC(9.4,XU1,200)),"^",1,2)

               IF $LENGTH($PIECE(XU2,"^",2))

                   DO T2(XU2,XUDA)

 +3        KILL XU1,XU2

           QUIT 

T2(XU1,DA) ;Set trap and call one with DA=IFN of user.

 +1       ;Protect what we need to return.

 +2        NEW XUDA

 +3        SET X="TX^XUSTERM2"

           SET @^%ZOSF("TRAP")

           SET X=$PIECE(XU1,"^",2)

           XECUTE ^%ZOSF("TEST")

           IF '$TEST

               QUIT 

 +4        DO @XU1

 +5        QUIT 

TX         DO @^%ZOSF("ERRTN")

           QUIT 

 +1       ;

B         ;Call XQOR to handle protocall.

 +1       ;Protect ourself.

           NEW XUI,XUJ,XUGRP

           SET XUIFN=XUDA

           NEW XUDA

 +2        SET X="TX^XUSTERM2"

           SET @^%ZOSF("TRAP")

           SET DIC="^DIC(19,"

           SET X="XU USER TERMINATE"

 +3        DO EN^XQOR

 +4        KILL X,DIC

           QUIT