- %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 44
- ;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
- ;
- %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 44
- +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 ;
