%ZTMS0 ;SEA/RDS-TaskMan: Submanager, Part 2 (Trap Functions) ;09/25/08 16:07
;;8.0;KERNEL;**24,118,275,446**;JUL 10, 1995;Build 35
;Per VHA Directive 2004-038, this routine should not be modified.
;
ERROR2 ;ERROR--trap
L +^%ZTSCH("ER"):99 H 1 S ZTH=$H
S ^%ZTSCH("ER",+ZTH,$P(ZTH,",",2))=$$EC^%ZOSV
S ^%ZTSCH("ER",+ZTH,$P(ZTH,",",2),1)="Caused by the submanager while trapping an error."
L
X "HALT " ;HALT JOB
;
STATUS ;ERROR--update task's status in Task File, Call w/ ^%ZTSK locked
S ZTE=$E(%ZTME,1,70)
S ZTE=$TR(ZTE,"^","~")
S $P(^%ZTSK(%ZTMETSK,.1),"^",1,3)=$S(ZTQUEUED>.5:"C^",1:"L^")_$H_"^"_ZTE
S $P(^%ZTSK(%ZTMETSK,.12),"^",2,9)=%ZTMEH_"^"_%ZTME
S ^%ZTSK(%ZTMETSK,.12,%ZTMEH)=%ZTME
Q
;
DEVBAD ;ERROR--dequeue all entries for a bad device
N ZT,ZT1,ZT2,ZT3,ZT4
Q:'$$DEVLK^%ZTMS1(1,ZTDEVOK)
L +^%ZTSCH("IO"):5 G DBX:'$T S $P(^%ZTSCH("IO"),"^")=$$H3^%ZTM($H)
S ZT2=ZTDEVOK,ZT3=""
F S ZT3=$O(^%ZTSCH("IO",ZT2,ZT3)),ZT4="" Q:ZT3="" F S ZT4=$O(^%ZTSCH("IO",ZT2,ZT3,ZT4)) Q:ZT4="" L +^%ZTSK(ZT4):99 D DQ L -^%ZTSK(ZT4)
K ^%ZTSCH("IO",ZTDEVOK)
I $O(^%ZTSCH("IO",""))="" K ^%ZTSCH("IO")
L -^%ZTSCH("IO")
DBX D DEVLK^%ZTMS1(-1,ZTDEVOK)
Q
;
DQ ;DEVBAD--remove a task from the waiting list for a bad device
K ^%ZTSCH("IO",ZT2,ZT3,ZT4)
S $P(^%ZTSK(ZT4,.1),"^",1,3)="B^"_$H_"^BAD IO DEVICE "_ZT2
K ^%ZTSK(ZT4,.26,ZT2)
I $O(^%ZTSK(ZT4,.26,""))]"" Q
K ^%ZTSK(ZT4,.26)
Q
;
ERCLOZ ;ERROR--close device after error
;N %ZT1 S %ZT1=(IO=$G(^XUTL("XQ",$J,"IO")))
I $L($G(IO)) S IO("C")="" D ^%ZISC ;Close the current device
;I $G(^XUTL("XQ",$J,"IO"))'=$I D ERC2
I $L(IO),$D(IO(1,IO)) S IO("C")="" D ^%ZISC ;Close a second device open
Q
;
ERC2 ;Close original Device
N POP
S POP=1 D RESETVAR^%ZIS Q:POP
;S IOS=$P(%ZTTV,"^",2),(IO,IO(0))=$P(%ZTTV,"^",5),IOT=$P(%ZTTV,"^",6),IOF=$P(%ZTTV,"^",11),IOST=$P(%ZTTV,"^",12),IO("C")=""
I $D(IO(1,IO)) S IO("C")="" D ^%ZISC
Q
;
XREF ;ERROR--cross-reference TaskMan Error file entry by context of error
S ZTERROX=$S('%ZTMETSK:"an unknown task.",1:"Task # "_%ZTMETSK_".")
S ZTQUEUED=$G(ZTQUEUED)
I ZTQUEUED=0 S ZTERROX1="Caused by the submanager." Q
I ZTQUEUED=.5 S ZTERROX1="Caused by the submanager while preparing "_ZTERROX Q
I ZTQUEUED=.6 S ZTERROX1="Caused by submanager after "_ZTERROX Q
S ZTERROX1="Caused by "_ZTERROX
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZTMS0 2371 printed Nov 22, 2024@17:26:33 Page 2
%ZTMS0 ;SEA/RDS-TaskMan: Submanager, Part 2 (Trap Functions) ;09/25/08 16:07
+1 ;;8.0;KERNEL;**24,118,275,446**;JUL 10, 1995;Build 35
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
ERROR2 ;ERROR--trap
+1 LOCK +^%ZTSCH("ER"):99
HANG 1
SET ZTH=$HOROLOG
+2 SET ^%ZTSCH("ER",+ZTH,$PIECE(ZTH,",",2))=$$EC^%ZOSV
+3 SET ^%ZTSCH("ER",+ZTH,$PIECE(ZTH,",",2),1)="Caused by the submanager while trapping an error."
+4 LOCK
+5 ;HALT JOB
XECUTE "HALT "
+6 ;
STATUS ;ERROR--update task's status in Task File, Call w/ ^%ZTSK locked
+1 SET ZTE=$EXTRACT(%ZTME,1,70)
+2 SET ZTE=$TRANSLATE(ZTE,"^","~")
+3 SET $PIECE(^%ZTSK(%ZTMETSK,.1),"^",1,3)=$SELECT(ZTQUEUED>.5:"C^",1:"L^")_$HOROLOG_"^"_ZTE
+4 SET $PIECE(^%ZTSK(%ZTMETSK,.12),"^",2,9)=%ZTMEH_"^"_%ZTME
+5 SET ^%ZTSK(%ZTMETSK,.12,%ZTMEH)=%ZTME
+6 QUIT
+7 ;
DEVBAD ;ERROR--dequeue all entries for a bad device
+1 NEW ZT,ZT1,ZT2,ZT3,ZT4
+2 if '$$DEVLK^%ZTMS1(1,ZTDEVOK)
QUIT
+3 LOCK +^%ZTSCH("IO"):5
if '$TEST
GOTO DBX
SET $PIECE(^%ZTSCH("IO"),"^")=$$H3^%ZTM($HOROLOG)
+4 SET ZT2=ZTDEVOK
SET ZT3=""
+5 FOR
SET ZT3=$ORDER(^%ZTSCH("IO",ZT2,ZT3))
SET ZT4=""
if ZT3=""
QUIT
FOR
SET ZT4=$ORDER(^%ZTSCH("IO",ZT2,ZT3,ZT4))
if ZT4=""
QUIT
LOCK +^%ZTSK(ZT4):99
DO DQ
LOCK -^%ZTSK(ZT4)
+6 KILL ^%ZTSCH("IO",ZTDEVOK)
+7 IF $ORDER(^%ZTSCH("IO",""))=""
KILL ^%ZTSCH("IO")
+8 LOCK -^%ZTSCH("IO")
DBX DO DEVLK^%ZTMS1(-1,ZTDEVOK)
+1 QUIT
+2 ;
DQ ;DEVBAD--remove a task from the waiting list for a bad device
+1 KILL ^%ZTSCH("IO",ZT2,ZT3,ZT4)
+2 SET $PIECE(^%ZTSK(ZT4,.1),"^",1,3)="B^"_$HOROLOG_"^BAD IO DEVICE "_ZT2
+3 KILL ^%ZTSK(ZT4,.26,ZT2)
+4 IF $ORDER(^%ZTSK(ZT4,.26,""))]""
QUIT
+5 KILL ^%ZTSK(ZT4,.26)
+6 QUIT
+7 ;
ERCLOZ ;ERROR--close device after error
+1 ;N %ZT1 S %ZT1=(IO=$G(^XUTL("XQ",$J,"IO")))
+2 ;Close the current device
IF $LENGTH($GET(IO))
SET IO("C")=""
DO ^%ZISC
+3 ;I $G(^XUTL("XQ",$J,"IO"))'=$I D ERC2
+4 ;Close a second device open
IF $LENGTH(IO)
IF $DATA(IO(1,IO))
SET IO("C")=""
DO ^%ZISC
+5 QUIT
+6 ;
ERC2 ;Close original Device
+1 NEW POP
+2 SET POP=1
DO RESETVAR^%ZIS
if POP
QUIT
+3 ;S IOS=$P(%ZTTV,"^",2),(IO,IO(0))=$P(%ZTTV,"^",5),IOT=$P(%ZTTV,"^",6),IOF=$P(%ZTTV,"^",11),IOST=$P(%ZTTV,"^",12),IO("C")=""
+4 IF $DATA(IO(1,IO))
SET IO("C")=""
DO ^%ZISC
+5 QUIT
+6 ;
XREF ;ERROR--cross-reference TaskMan Error file entry by context of error
+1 SET ZTERROX=$SELECT('%ZTMETSK:"an unknown task.",1:"Task # "_%ZTMETSK_".")
+2 SET ZTQUEUED=$GET(ZTQUEUED)
+3 IF ZTQUEUED=0
SET ZTERROX1="Caused by the submanager."
QUIT
+4 IF ZTQUEUED=.5
SET ZTERROX1="Caused by the submanager while preparing "_ZTERROX
QUIT
+5 IF ZTQUEUED=.6
SET ZTERROX1="Caused by submanager after "_ZTERROX
QUIT
+6 SET ZTERROX1="Caused by "_ZTERROX
+7 QUIT
+8 ;
