ZU ;SF/GFT - For DTM, TIE ALL TERMINALS EXCEPT CONSOLE TO THIS ROUTINE!! ;10/31/95 09:51
;;8.0;KERNEL;**13**;Jul 10, 1995
; *** For DataTree ***
EN S $ZT="ERR^ZU"
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZUDTM 1343 printed Dec 13, 2024@02:16:40 Page 2
ZU ;SF/GFT - For DTM, TIE ALL TERMINALS EXCEPT CONSOLE TO THIS ROUTINE!! ;10/31/95 09:51
+1 ;;8.0;KERNEL;**13**;Jul 10, 1995
+2 ; *** For DataTree ***
EN SET $ZT="ERR^ZU"
+1
*** ERROR ***
+2 SET ZUGUI2=($IO=1)
SET ZUGUI=$GET(ZUGUI1)&$GET(ZUGUI2)
+3 GOTO ^XUS
+4 ;
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 ;
