ZUDTM.m

ZU ;SF/GFT - For DTM, TIE ALL TERMINALS EXCEPT CONSOLE TO THIS ROUTINE!! ;10/31/95  09:51 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;8.0;KERNEL;**13**;Jul 10, 1995

 ; *** For DataTree ***

 ZITRAP CTRLC^ZU

 S ZUGUI2=($I=1),ZUGUI=$G(ZUGUI1)&$G(ZUGUI2)

 G ^XUS

 ;

G ;Entry Point for GUI devices

 S ZUGUI1=1 G EN

ERR S $ZT="" L  ;Come here on error, save Y and $ZR

 S ZUY=$S($D(Y)#2:Y,1:"undefined"),ZUZR=$ZR 

 B 0 X ^%ZOSF("PROGMODE") Q:Y

 S $ZT="HALT^ZU"

 I $G(IO)]"",$D(IO(1,IO)),$E($G(IOST))="P" U IO W @$S($D(IOF):IOF,1:"#")

 G:$ZE["<INRPT>" CTRLC

 I $ZE["NOPEN>^XUS" I $D(XUEXIT),XUEXIT D C^XUS H  ; Trap <NOPEN> which appears to be due to modem control and breaking micom connection without logging it in ^%ZTER

 I $D(IO)=11 U IO(0) W !!,"RECORDING THAT AN ERROR OCCURED ---",!!?10,$ZE,!!?15,"Sorry 'bout that",!!,*7

 S %ZTERLRG=$ZR,%ZT("^XUTL(""XQ"",$J)")="" D ^%ZTER K %ZT S XUERF="" ; Capture symbol table first!

 I $G(DUZ)'>0 HALT

 ;

CTRLC I $D(IO)=11 U IO(0) C:IO'=IO(0) IO S IO=IO(0)

 W:$ZE["<INRPT>" !,"--Interrupt Acknowledged",!

CTRLC2 G:$G(^XUTL("XQ",$J,"T"))<2 ^XUSCLEAN

 S ^XUTL("XQ",$J,"T")=1,XQY=^(1),XQY0=$P(XQY,"^",2,99)

 G:$P(XQY0,"^",4)'="M" CTRLC2

 S XQPSM=$P(XQY,"^",1),XQY=+XQPSM,XQPSM=$P(XQPSM,XQY,2,3)

 G:'XQY ^XUSCLEAN

 S $ZT="ERR^ZU" G M1^XQ

 ;

HALT S $ZT="" I $D(^XUTL("XQ",$J)) D BYE^XUSCLEAN

 HALT

 ;

ZU        ;SF/GFT - For DTM, TIE ALL TERMINALS EXCEPT CONSOLE TO THIS ROUTINE!! ;10/31/95  09:51 [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;**13**;Jul 10, 1995

 +3       ; *** For DataTree ***

 +4 

*** ERROR ***

 +5        SET ZUGUI2=($IO=1)

           SET ZUGUI=$GET(ZUGUI1)&$GET(ZUGUI2)

 +6        GOTO ^XUS

 +7       ;

G         ;Entry Point for GUI devices

 +1        SET ZUGUI1=1

           GOTO EN

ERR       ;Come here on error, save Y and $ZR

           SET $ZT=""

           LOCK 

 +1        SET ZUY=$SELECT($DATA(Y)#2:Y,1:"undefined")

           SET ZUZR=$ZR

 +2        BREAK 0

           XECUTE ^%ZOSF("PROGMODE")

           IF Y

               QUIT 

 +3        SET $ZT="HALT^ZU"

 +4        IF $GET(IO)]""

               IF $DATA(IO(1,IO))

                   IF $EXTRACT($GET(IOST))="P"

                       USE IO

                       WRITE @$SELECT($DATA(IOF):IOF,1:"#")

 +5        IF $ZE["<INRPT>"

               GOTO CTRLC

 +6       ; Trap <NOPEN> which appears to be due to modem control and breaking micom connection without logging it in ^%ZTER

           IF $ZE["NOPEN>^XUS"

               IF $DATA(XUEXIT)

                   IF XUEXIT

                       DO C^XUS

                       HANG 

 +7        IF $DATA(IO)=11

               USE IO(0)

               WRITE !!,"RECORDING THAT AN ERROR OCCURED ---",!!?10,$ZE,!!?15,"Sorry 'bout that",!!,*7

 +8       ; Capture symbol table first!

           SET %ZTERLRG=$ZR

           SET %ZT("^XUTL(""XQ"",$J)")=""

           DO ^%ZTER

           KILL %ZT

           SET XUERF=""

 +9        IF $GET(DUZ)'>0

               HALT 

 +10      ;

CTRLC      IF $DATA(IO)=11

               USE IO(0)

               IF IO'=IO(0)

                   CLOSE IO

               SET IO=IO(0)

 +1        IF $ZE["<INRPT>"

               WRITE !,"--Interrupt Acknowledged",!

CTRLC2     IF $GET(^XUTL("XQ",$JOB,"T"))<2

               GOTO ^XUSCLEAN

 +1        SET ^XUTL("XQ",$JOB,"T")=1

           SET XQY=^(1)

           SET XQY0=$PIECE(XQY,"^",2,99)

 +2        IF $PIECE(XQY0,"^",4)'="M"

               GOTO CTRLC2

 +3        SET XQPSM=$PIECE(XQY,"^",1)

           SET XQY=+XQPSM

           SET XQPSM=$PIECE(XQPSM,XQY,2,3)

 +4        IF 'XQY

               GOTO ^XUSCLEAN

 +5        SET $ZT="ERR^ZU"

           GOTO M1^XQ

 +6       ;

HALT       SET $ZT=""

           IF $DATA(^XUTL("XQ",$JOB))

               DO BYE^XUSCLEAN

 +1        HALT 

 +2       ;