source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/ZUONT.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1ZU ;SF/RWF - For Cache and Open M! ;06/13/2006
2 ;;8.0;KERNEL;**34,94,118,162,170,225,419**;Jul 10, 1995;Build 5
3 ;TIE ALL TERMINALS EXCEPT CONSOLE TO THIS ROUTINE!
4EN N $ES,$ETRAP S $ETRAP="D ERR^ZU Q:$QUIT -9 Q"
5 D:+$G(^%ZTSCH("LOGRSRC")) LOGRSRC^%ZOSV("$LOGIN$")
6 ;The next line keeps sign-on users from taking the last slot
7 ;It can be commented out if not needed.
8 I $$AVJ^%ZOSV()<3 W $C(7),!!,"** TROUBLE ** - NO AVALIABLE JOBS ** CALL IRM NOW! **" G HALT
9 ;Only call ShareLic for Telnet connections.
10 I ($I["|TNT|")!($I["TNA") D SHARELIC^%ZOSV(0)
11 G ^XUS
12 ;
13 ;
14ERR ;Come here on error
15 ; Try and handle stack overflow errors specifically
16 I $ZE["STACK" S $ET="Q:$ST>"_($ST-8)_" D ERR2^ZU" Q
17ERR2 ;
18 S $ET="D UNWIND^ZU" L ;Backup trap (419)
19 Q:$ECODE["<PROG>"
20 ;
21 D ^%ZTER K %ZT ; Capture symbol table first!
22 ;
23 I $G(IO)]"",$D(IO(1,IO)),$E($G(IOST))="P" D
24 . U IO
25 . W @$S($D(IOF):IOF,1:"#")
26 I $G(IO(0))]"" D
27 . U IO(0)
28 . W !!,"RECORDING THAT AN ERROR OCCURRED ---"
29 . W !!?15,"Sorry 'bout that"
30 . W !,*7
31 . W !?10,"$STACK=",$STACK," $ECODE=",$ECODE
32 . W !?10,"$ZERROR=",$ZERROR
33 ;
34 I $G(DUZ)'>0 G HALT
35 X ^%ZOSF("PROGMODE") Q:Y
36 S $ET="D HALT^ZU" ;419
37 I $ZE'["<INTERRUPT>" S XUERF="" G ^XUSCLEAN ;419
38CTRLC I $D(IO)=11 U IO(0) W !,"--Interrupt Acknowledged",!
39 D KILL1^XUSCLEAN ;Clean up symbol table
40 S $ECODE=",U55,"
41 Q
42 ;
43UNWIND ;Unwind the stack
44 Q:$ESTACK>1 G CTRLC2:$ECODE["U55"
45 S $ECODE=""
46 Q
47 ;
48CTRLC2 S $ECODE="" G:$G(^XUTL("XQ",$J,"T"))<2 ^XUSCLEAN
49 S ^XUTL("XQ",$J,"T")=1,XQY=^(1),XQY0=$P(XQY,"^",2,99)
50 G:$P(XQY0,"^",4)'="M" HALT
51 S XQPSM=$P(XQY,"^",1),XQY=+XQPSM,XQPSM=$P(XQPSM,XQY,2,3)
52 G:'XQY ^XUSCLEAN
53 S $ECODE="",$ETRAP="D ERR^ZU"
54 G M1^XQ
55 ;
56HALT S $ECODE="" I $D(^XUTL("XQ",$J)) D BYE^XUSCLEAN
57 D:+$G(^%ZTSCH("LOGRSRC")) LOGRSRC^%ZOSV("$LOGOUT$")
58 HALT
59 ;
Note: See TracBrowser for help on using the repository browser.