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 ---[H[J[2J[HXUSTERM2 743 printed Oct 16, 2024@18:13:53 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
