XUSTERM2.m

XUSTERM2 ;SFISC/RWF - USER TERMINATE, PACKAGE FILE RUN ;9/7/94  16:23

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XUSTERM2   743     printed  Apr 09, 2024@21:17:33                                                                                                                                                                                                     Page 2

XUSTERM2  ;SFISC/RWF - USER TERMINATE, PACKAGE FILE RUN ;9/7/94  16:23

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

 +2       ;;.1;;

 +3        DO B

           DO A

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