- 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 Mar 13, 2025@21:18 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
