ZTMS0.m

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