Merge lp:~jontai/openvista-gtm-integration/additional-routines into lp:openvista-gtm-integration

[Jon Tai]

[JSHER (joel-sher)]

review: Approve

[lp:~jontai/openvista-gtm-integration/additional-routines]

44. By Jon Tai <jon@interceptor> on 2009-05-01

new version of ZSTART (named ZSTARTGUX; the KIDS build will rename it to ZSTART during installation)

45. By Jon Tai <jon@interceptor> on 2009-05-01

this should be named ZTER

46. By Jon Tai <jon@interceptor> on 2009-05-01

take Joel's version of ZTER

47. By Jon Tai <jon@interceptor> on 2009-05-01

give credit back to Robert Larson

48. By Jon Tai <jon@interceptor> on 2009-05-01

take Joel's version of ZTMGRSET

49. By Jon Tai <jon@interceptor> on 2009-05-01

update ZCD from Joel

50. By Jon Tai <jon@interceptor> on 2009-05-01

change ZSTOP to be like ZSTART

51. By Jon Tai <jon@interceptor> on 2009-05-01

one last missing routine

[jeff.apple (jeff-apple)]

RORHL7A, Rev 41
  Can't we just remove the -1 from the $Q and be done with it? It's just being used as an iterator, and that will work even if we K the current item. The "K A,CNT" looks like a problem to me since A's content gets wiped out and we only do one K on the FIELDS.

ZISHGUX.m, Rev 41
  Can't we remove the commented-out lines under LIST()?

ZU.m
  Why are we removing I %ZPOS["^" S ^XUTL("XUSYS",$J,"codeline")=$T(@%ZPOS)?
  Also, either remove it or not, but don't comment it out.

review: Needs Fixing

[lp:~jontai/openvista-gtm-integration/additional-routines]

52. By Jon Tai on 2009-05-02

remove comments per Jeff

=== added file 'mumps/MSCGUX53.m'
--- mumps/MSCGUX53.m	1970-01-01 00:00:00 +0000
+++ mumps/MSCGUX53.m	2009-04-30 17:33:21 +0000
@@ -0,0 +1,7 @@
+MSCGUX53 ;MSC/JDS - ENVIRONMENT CHECK	; ; 29 Apr 2009  1:47 PM
+ ;;**MSC**;
+ I $G(^%ZOSF("OS"))'["GT.M" Q    ;Not GTM
+ I $P($ZV,"V",2)<5.3 D MESS^XPDUL("GT.M version must be 5.3 or Greater") S XPDABORT=2
+
+
+

=== added file 'mumps/MSCXUS3A.m'
--- mumps/MSCXUS3A.m	1970-01-01 00:00:00 +0000
+++ mumps/MSCXUS3A.m	2009-04-30 17:33:05 +0000
@@ -0,0 +1,59 @@
+MSCXUS3A ;SF-ISC/STAFF MSC/JDS - CHANGE UCI'S ;24DEC2004
+ ;;8.0;KERNEL;**13,282,MSC**;Jul 10, 1995
+ Q
+ ;PICK A UCI TO SWITCH TO
+SWITCH ;Allow users that have the UCI fIeld In there NP fIle to swItch UCI's.
+ W !!,"Switch UCI's optIon.",!
+ ;I $$PROGMODE^%ZOSV() W !,$C(7),"No switching UCI's In Programmer Mode." Q
+ N DIR,X,Y,PGM,%UCI,DEF,L,USERNAME
+ S DEF="ZU" ;DEF is default routine to swItch to.
+UCI Q:'$G(DUZ)  S USERNAME=$P($G(^VA(200,DUZ,0)),U) Q:USERNAME=""
+ S DIR(0)="S^"_$$NSP(USERNAME) I DIR(0)'[";" W "YOU AREN'T A USER IN ANY OTHER NAMESPACE" Q
+ S DIR("A")="Select NAMESPACE"
+ D ^DIR K DIR I $D(DUOUT)!$D(DTOUT)!(U[X) Q
+SAME I X="" Q  ;Didn't select anythIng.
+ ;D PM
+ S (X,%UCI)=Y(0) X ^%ZOSF("UCICHECK") I 0[Y G BAD
+ K XQY0 S Y=$O(^[%UCI]VA(200,"B",USERNAME,0))
+ I Y S DIR=$P($G(^[%UCI]VA(200,Y,201)),U)
+ I DIR,$P($G(^[%UCI]DIC(19,DIR,0)),U,4)="M" S DUZ=Y,XQY=DIR,(DEF,PGM)="%MSCXUCI" G NXT
+BAD W !,"UCI not found!" D SHOW G UCI
+ ;
+NXT ;Here we go.
+ D C^XUSCLEAN K ^XUTL("XQ",$J),^XUTL($J),^TMP($J),^UTILITY($J)
+ K DA G GO^%MSCXUCI
+ ;
+ ;
+SHOW W ! S I=0,UC="",X=$S($D(^VA(200,DUZ,201)):+^(201),1:0)
+ W !,"Enter ^ to return to your current menu, or select from:"
+ F I=0:0 S I=$O(^VA(200,DUZ,.2,I)) Q:I'>0  D
+ . W !,?5 S UC=$G(^VA(200,DUZ,.2,I,0)),X=$P(UC,U,1),UC=$P(UC,U,2,99)
+ . I UC'[":" W I
+ . D PM W ?10,X X ^%ZOSF("UCICHECK") I 0[Y W " -- Not currently a valId  UCI!",$C(7) Q
+ . W:UC]"" ":"_UC
+ . Q
+ Q
+ ;
+PM I X="PROD"!(X="MGR") S X=^%ZOSF(X)
+ Q
+ ;
+ ;
+ ;
+NSP(USERNAME) ;LIST OTHER NAMESPACES WHERE THIS USER IS
+ N X,L,I,Y
+ X ^%ZOSF("UCI") S Y=$P(Y,",") I ^%ZOSF("OS")["GT.M" G GTMNSP
+ f I=1:1:$zu(90,0) s L($zu(90,2,0,I))="" ;***CACHE-SPECIFIC   FROM %NSP
+ S (I,L,X)="" F  S I=$O(L(I)) Q:I=""  I I'=Y D  ;NOT THE CURRENT ONE
+ .N DUZ S DUZ=$O(^[I]VA(200,"B",USERNAME,0)) Q:'DUZ
+ .I $P($G(^[I]VA(200,DUZ,0)),U,3)=""!'$G(^(201)) Q  ;THEY MUST HAVE ACCESS CODE AND PRIMARY MENU OPTION OVER THERE
+ .S L=L+1,X=X_L_":"_I_";"
+ Q X
+GTMNSP	;
+ N CURRENT S CURRENT=Y
+ D LIST^ZCD()
+ S (I,L,X)="" F  S I=$O(Y(I)) Q:'I  S A=Y(I) I A'=CURRENT D  ;NOT THE CURRENT ONE
+ .S A=$P($ZG,"/"_$$CURRENT^ZCD_"/")_"/"_A_"/"_$P($ZG,"/"_$$CURRENT^ZCD_"/",2)
+ .N DUZ S DUZ=$O(^[A]VA(200,"B",USERNAME,0)) Q:'DUZ
+ .I $P($G(^[A]VA(200,DUZ,0)),U,3)=""!'$G(^(201)) Q  ;THEY MUST HAVE ACCESS CODE AND PRIMARY MENU OPTION OVER THERE
+ .S L=L+1,X=X_L_":"_A_";"
+ Q X

=== added file 'mumps/RORHL7A.m'
--- mumps/RORHL7A.m	1970-01-01 00:00:00 +0000
+++ mumps/RORHL7A.m	2009-04-30 17:33:05 +0000
@@ -0,0 +1,250 @@
+RORHL7A ;HCIOFO/SG MSC/JDS- HL7 UTILITIES ; 7/29/05 1:35pm
+ ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+ ;
+ Q
+ ;
+ ;***** ADDS THE SEGMENT TO THE HL7 MESSAGE BUFFER
+ ;
+ ; SEG           Complete HL7 segment
+ ;
+ ; The ADDSEGC^RORHL7A procedure adds the HL7 segment to the HL7
+ ; message buffer defined by the ROREXT("HL7BUF") parameter
+ ; (the ^TMP("HLS",$J), by default). The <TAB>, <CR> and <LF>
+ ; characters are replaced with spaces. Long segments are split
+ ; among sub-nodes of the main segment node in the destination
+ ; buffer.
+ ;
+ ; The RORHL array and some nodes of the ROREXT array must be
+ ; initialized (either by the $$INIT^RORHL7 or manually) before
+ ; calling this procedure.
+ ;
+ADDSEGC(SEG) ;
+ N I1,I2,MAXLEN,NODE,PTR,PTR1,SID,SL
+ S NODE=ROREXT("HL7BUF"),PTR=$G(ROREXT("HL7PTR"))+1
+ S HLFS=RORHL("FS"),HLECH=RORHL("ECH")
+ Q:$P(SEG,HLFS)=""  ; Segment Name
+ ;--- Assign the Set ID if necessary
+ S SID=$$SETID($P(SEG,HLFS))
+ S:SID>0 $P(SEG,HLFS,2)=SID
+ ;--- Remove empty trailing fields
+ S I2=$L(SEG,HLFS)
+ F I1=I2:-1:1  Q:$TR($P(SEG,HLFS,I1),HLECH)'=""
+ S:I1<I2 $P(SEG,HLFS,I1+1,I2)=""
+ ;--- Store the segment
+ S SL=$L(SEG),MAXLEN=245  K @NODE@(PTR)
+ S @NODE@(PTR)=$TR($E(SEG,1,MAXLEN),$C(9,10,13),"   ")
+ S ROREXT("HL7SIZE")=$G(ROREXT("HL7SIZE"))+SL+1
+ ;--- Split the segment into sub-nodes if necessary
+ D:SL>MAXLEN
+ . S I2=MAXLEN
+ . F PTR1=1:1  S I1=I2+1,I2=I1+MAXLEN-1  Q:I1>SL  D
+ . . S @NODE@(PTR,PTR1)=$TR($E(SEG,I1,I2),$C(9,10,13),"   ")
+ ;--- Save the pointer
+ S ROREXT("HL7PTR")=PTR
+ Q
+ ;
+ ;***** ASSEMBLES THE SEGMENT AND ADDS IT TO THE HL7 MESSAGE BUFFER
+ ;
+ ; .FIELDS       Reference to a local variable where the HL7
+ ;               fields are stored
+ ;
+ ;  FIELDS(
+ ;    0)         Segment name
+ ;    I,         Field value
+ ;      i)       Continuation of the value if it is
+ ;    ...        longer than than 245 characters
+ ;
+ ; The ADDSEGF^RORHL7A procedure assembles the HL7 segment from
+ ; provided field values and adds it to the HL7 message buffer
+ ; defined by the ROREXT("HL7BUF") node (the ^TMP("HLS",$J), by
+ ; default). The <TAB>, <CR> and <LF> characters are replaced with
+ ; spaces. Long segments are split among sub-nodes of the main
+ ; segment node in the destination buffer.
+ ;
+ ; The RORHL array and some nodes of the ROREXT array must be
+ ; initialized (either by the $$INIT^RORHL7 or manually) before
+ ; calling this procedure.
+ ;
+ADDSEGF(FIELDS) ;
+ ; RORBUF        Temporary buffer for the segment construction
+ ; RORIS         Current continuation subscript in the HL7 buffer
+ ; RORNODE       Closed root of the HL7 message buffer
+ ; RORPTR        Current subscript in the HL7 message buffer
+ ; RORSL         Number of characters that can be appended to the
+ ;               RORBUF before it has to be emptied into the HL7
+ ;               message buffer
+ ;
+ N FLD,I,LASTFLD,RORBUF,RORIS,RORNODE,RORPTR,RORSL
+ Q:$G(FIELDS(0))=""  ; Segment Name
+ S RORNODE=ROREXT("HL7BUF"),RORPTR=$G(ROREXT("HL7PTR"))+1
+ S HLFS=RORHL("FS"),HLECH=RORHL("ECH")
+ ;--- Assign the Set ID if necessary
+ S I=$$SETID(FIELDS(0))
+ S:I>0 FIELDS(1)=I
+ ;--- Remove empty trailing fields
+ S I=$NA(FIELDS)
+ N A,CNT F  S I=$Q(@I)  Q:I=""  S CNT=$G(CNT)+1,A(CNT)=I I $TR(@I,HLECH)'=""  K A,CNT
+ F I=1:1 Q:'$D(A(I))  K @A(I)
+ ;--- Initialize construction variables
+ S RORBUF=FIELDS(0),I=$L(RORBUF)
+ S ROREXT("HL7SIZE")=$G(ROREXT("HL7SIZE"))+I+1
+ S RORIS=0,RORSL=245-I
+ ;--- Append the fields and store the segment
+ S LASTFLD=+$O(FIELDS(" "),-1)
+ F FLD=1:1:LASTFLD  D
+ . D APPEND(HLFS_$G(FIELDS(FLD)))
+ . ;--- Process the field continuation nodes
+ . S I=""
+ . F  S I=$O(FIELDS(FLD,I))  Q:I=""  D APPEND(FIELDS(FLD,I))
+ ;--- Flush the buffer if necessary
+ D:RORBUF'=""
+ . I 'RORIS  S @RORNODE@(RORPTR)=RORBUF  Q
+ . S @RORNODE@(RORPTR,RORIS)=RORBUF
+ S ROREXT("HL7PTR")=RORPTR
+ Q
+ ;
+ ;***** APPENDS THE FIELD VALUE TO THE HL7 SEGMENT
+ ;
+ ; VAL           Value of the field (or its part)
+ ;
+ ; This is an internal function. Do not call it directly.
+ ;
+APPEND(VAL) ;
+ N BASE,L
+ S VAL=$TR(VAL,$C(9,10,13),"   "),L=$L(VAL)
+ S ROREXT("HL7SIZE")=$G(ROREXT("HL7SIZE"))+L
+ I L'>RORSL  S RORBUF=RORBUF_VAL,RORSL=RORSL-L  Q
+ ;---
+ S RORBUF=RORBUF_$E(VAL,1,RORSL),L=L-RORSL
+ S BASE=1
+ F  D  Q:L'>0
+ . I 'RORIS  S @RORNODE@(RORPTR)=RORBUF
+ . E  S @RORNODE@(RORPTR,RORIS)=RORBUF
+ . S BASE=BASE+RORSL,RORIS=RORIS+1,RORSL=245
+ . S RORBUF=$E(VAL,BASE,BASE+RORSL-1),L=L-RORSL
+ S RORSL=-L
+ Q
+ ;
+ ;***** RETURNS THE BHS SEGMENT
+ ;
+ ; BID           Batch message ID
+ ;
+ ; [BDT]         Batch message creation time in internal FileMan
+ ;               format (NOW by default)
+ ;
+ ; [COMMENT]     Optional comment
+ ;
+ ; The RORHL local variable must be initialized by the $$INIT^RORHL7
+ ; function before calling this entry point.
+ ;
+BHS(BID,BDT,COMMENT) ;
+ N CS,SEG,TMP
+ D BHS^HLFNC3(.RORHL,BID,.SEG)
+ Q:$G(SEG)="" ""
+ S HLFS=RORHL("FS"),HLECH=RORHL("ECH"),CS=$E(HLECH,1)
+ ;--- Post-processing
+ S SEG=SEG_$G(SEG(1))
+ S:$G(BDT)'>0 BDT=$$NOW^XLFDT
+ S TMP=$E($P($$SITE^VASITE,U,3),1,3)
+ S $P(SEG,HLFS,4)=TMP_CS_$G(^XMB("NETNAME"))_CS_"DNS"
+ S $P(SEG,HLFS,5)="ROR AAC"
+ S $P(SEG,HLFS,7)=$$FMTHL7^XLFDT(BDT)
+ S TMP=$P(SEG,HLFS,9)
+ S $P(TMP,CS,3)=$P(TMP,CS,3)_$E(HLECH,2)_$G(RORHL("ETN"))
+ S $P(SEG,HLFS,9)=TMP
+ S $P(SEG,HLFS,10)=$G(COMMENT)
+ Q SEG
+ ;
+ ;***** RETURNS BTS SEGMENT
+ ;
+ ; MSGCNT        Batch message count
+ ; [COMMENT]     Batch comment
+ ;
+ ; The RORHL variable must be initialized by the INIT^HLFNC2 before
+ ; calling this entry point
+ ;
+BTS(MSGCNT,COMMENT) ;
+ Q "BTS"_RORHL("FS")_MSGCNT_RORHL("FS")_$G(COMMENT)
+ ;
+ ;***** LOADS THE HL7 FIELD (OR ITS PART) TO THE BUFFER
+ ;
+ ; VAL           Value of the field (or its part)
+ ;
+ ; FLD           Number of the field in the segment (piece number)
+ ;
+FIELD(VAL,FLD) ;
+ N BASE,L
+ S:FLD>RORFLD RORFLD=FLD,RORIS=0,RORSL=245
+ S L=$L(VAL),BASE=1
+ F RORIS=RORIS:1  D  Q:L'>0
+ . I 'RORIS  S RORSEG(RORFLD)=$G(RORSEG(RORFLD))_$E(VAL,BASE,BASE+RORSL-1)
+ . E  S RORSEG(RORFLD,RORIS)=$G(RORSEG(RORFLD,RORIS))_$E(VAL,BASE,BASE+RORSL-1)
+ . S BASE=BASE+RORSL,L=L-RORSL,RORSL=245
+ S RORSL=-L
+ Q
+ ;
+ ;***** LOADS THE HL7 SEGMENT INTO THE RPOVIDED BUFFER
+ ;
+ ; .RORSEG       Reference to a local variable where the HL7
+ ;               fields will be stored. The fields are stored
+ ;               in the following format:
+ ;
+ ;                 RORSEG(FldNum)=FldVal
+ ;
+ ;               If the value is longer that 245 characters then
+ ;               the continuation nodes are created:
+ ;
+ ;                 RORSEG(FldNum,#)=FldValCont
+ ;
+ ; ROR8SRC       Closed root of the source buffer containing
+ ;               the HL7 segment
+ ;
+LOADSEG(RORSEG,ROR8SRC) ;
+ N BUF,FLD,I,IFL,NFL,RORFLD,RORIS,RORSL
+ S HLFS=RORHL("FS")  K RORSEG
+ ;--- Process the main segment
+ S BUF=$G(@ROR8SRC),NFL=$L(BUF,HLFS)
+ F IFL=1:1:NFL  S RORSEG(IFL-1)=$P(BUF,HLFS,IFL)
+ Q:$D(@ROR8SRC)<10
+ ;--- Process the sub-segments
+ S (FLD,RORFLD)=NFL-1,RORIS=0,RORSL=245-$L(RORSEG(FLD))
+ S I=""
+ F  S I=$O(@ROR8SRC@(I))  Q:I=""  D
+ . S BUF=@ROR8SRC@(I),NFL=$L(BUF,HLFS)
+ . D FIELD($P(BUF,HLFS),FLD)
+ . F IFL=2:1:NFL  S FLD=FLD+1  D FIELD($P(BUF,HLFS,IFL),FLD)
+ Q
+ ;
+ ;***** RETURNS TEXT EXPLANATIONS OF THE HL7 MESSAGE STATUS
+ ;
+ ; MSGST         Status value returned by the $$MSGSTAT^HLUTIL
+ ;
+MSGSTXT(MSGST) ;
+ N ST  S ST=+MSGST
+ Q:'ST "Message does not exist"
+ Q:ST=1 "Waiting in queue"
+ Q:ST=1.5 "Opening connection"
+ Q:ST=1.7 "Awaiting response"
+ Q:ST=2 "Awaiting application ack"
+ Q:ST=3 "Successfully completed"
+ Q:ST=4 "Error"
+ Q:ST=8 "Being generated"
+ Q:ST=9 "Awaiting processing"
+ Q "Unknown"
+ ;
+ ;***** ASSIGNS THE 'SET ID'
+ ;
+ ; SEGNAME       Name of the HL7 segment
+ ; [DISINC]      Disable increment of the Set ID
+ ;
+ ; Return Values:
+ ;        ""  Not required for this segment
+ ;        >0  Value for the Set ID field
+ ;
+SETID(SEGNAME,DISINC) ;
+ N SETID
+ Q:$G(SEGNAME)="" ""
+ S SETID=+$G(ROREXT("HL7SID",SEGNAME))
+ Q:SETID'>0 ""
+ S:'$G(DISINC) ROREXT("HL7SID",SEGNAME)=SETID+1
+ Q SETID

=== added file 'mumps/ZCD.m'
--- mumps/ZCD.m	1970-01-01 00:00:00 +0000
+++ mumps/ZCD.m	2009-05-01 17:29:59 +0000
@@ -0,0 +1,172 @@
+ZCD	; MSC/JKT,JDS ; "Namespace" utilities for GT.M/Unix ; 01/30/2009
+	;;8.0;KERNEL;**MSC**;April 21 2009
+	; This routine assumes that your global directory file exists one 
+	; directory below the root of the instance, e.g., 
+	;
+	; /opt/openvista/instance/globals/mumps.gld
+	;
+	; or
+	;
+	; /home/vista/instance/g/default.gld
+	;
+	; The actual file name of the global directory file and the actual name
+	; of the parent directory are never checked, so their names do not 
+	; matter.
+	G CD
+	;
+CURRENT()
+	; return the name of the current OpenVista instance
+	Q $P($ZG,"/",$L($ZG,"/")-2)
+	;
+PATH()
+	; return the path to the current OpenVista instance
+	N I,X S X=""
+	S X=$P($ZG,"/",1,$L($ZG,"/")-2)
+	Q X
+	;
+ROOT()
+	; return the path where all OpenVista instances live
+	N I,X S X=""
+	S X=$P($ZG,"/",1,$L($ZG,"/")-3)
+	Q X
+	;
+LIST()
+	; returns an array (Y) of OpenVista instances on this system
+	;
+	; FIXME: a "user friendly" version of this list should screen out the 
+	;        current instance name and any instances that the current user 
+	;        should not be allowed to switch to (they must have access 
+	;        code and primary menu option in the target instance to switch)
+	;
+	; FIXME: this routine currently requires GT.M V5.3003 because it uses 
+	;        PIPE I/O.  We many want to make it compatible with older 
+	;        versions of GT.M by falling back to using temporary files, 
+	;        but on versions of GT.M V5.3003 and later, we definitely want 
+	;        to use PIPEs to avoid temporary files moving forward.
+	N P,I,X
+	S P="ls"
+	O P:(COMMAND="ls --color=none -1 "_$$ROOT():READONLY)::"PIPE"
+	U P
+	F I=1:1 R X Q:X=""  S Y(I)=X,Y("B",X)=""
+	U $P 
+	C P
+	Q
+	;
+GTMPATH(INSTANCE)
+	; return the path to the version of GT.M this instance uses
+	;
+	; FIXME: handle the case when INSTANCE is bogus
+	; 
+	N P,X
+	S P="readlink"
+	O P:(COMMAND="readlink "_$$ROOT()_"/"_INSTANCE_"/gtm":READONLY)::"PIPE"
+	U P
+	R X
+	U $P
+	C P
+	Q X
+	;
+SWITCH(INSTANCE)
+	; switch to another OpenVista instance by setting $ZG and $ZRO
+	;
+	; there are several ways to do this; try them in order until 
+	; one succeeds
+	;
+	; FIXME: we may want to allow this entry point to be called using DO
+	Q:$$SWITCH1(INSTANCE) 1
+	Q:$$SWITCH2(INSTANCE) 1
+	Q:$$SWITCH3(INSTANCE) 1
+	Q 0
+	;
+SWITCH1(INSTANCE)
+	; private entry point
+	;
+	; look for new values of $ZG and $ZRO in env directory of 
+	; target instance
+	N ZG,ZRO,G,RO
+	;
+	; FIXME: if file does not exist or is unreadable (permission 
+	;        denied), Q 0
+	;S G=$$ROOT()_"/"_INSTANCE_"/env/gtmgbldir"
+	;O G:READONLY U G R ZG U $P C G
+	N I,A S A="/"_$$CURRENT()_"/",ZG=""
+	F I=1:1:$L($ZG,A) S ZG=ZG_$P($ZG,A,I)_$S(I=$L($ZG,A):"",1:"/"_INSTANCE_"/")
+	;
+	; FIXME: if file does not exist or is unreadable (permission 
+	;        denied), Q 0
+	;S RO=$$ROOT()_"/"_INSTANCE_"/env/gtmroutines"
+	;O RO:READONLY U RO R ZRO U $P C RO
+	S ZRO=""
+	F I=1:1:$L($ZRO,A) S ZRO=ZRO_$P($ZRO,A,I)_$S(I=$L($ZRO,A):"",1:"/"_INSTANCE_"/")
+	;
+	S $ZG=ZG,$ZRO=ZRO
+	;
+	;zlink the buffer
+	X "Q"
+	N I
+	S I=$view("rtnnext","")
+NEXT	F  S I=$VIEW("rtnnext",I) Q:I=""  I I'="GTM$DMOD" D
+	.I I="ZCD" Q
+	.I $E(I)="%" Q:($E(I,2)'="Z")
+	.K %ZR D SILENT^%RSEL(I) I $D(%ZR(I)) S A=$TR(I,"%","_") N $ET S $ET="G NEXT^ZCD" ZLINK A_".m" Q
+	.N DIE,X,B S X=I,B(1,0)=I_" ;",B(2,0)=" ZMESSAGE 150374338:$PIECE($ZPOSITION,""^"",2)",B(3,0)=" QUIT"
+	.S DIE="B(",XCN=0 N I D SAVE(X)
+	; FIXME: do we need to set $ZINTERRUPT and $PATH?
+	Q 1
+	;
+SWITCH2(INSTANCE)
+	; private entry point
+	;
+	; look for new values of $ZG and $ZRO in env file of target instance
+	;
+	; if the env file does not exist or is unreadable (permission denied) 
+	; or unparsable, Q 0 without setting $ZG and $ZRO
+	;
+	; FIXME: implement this
+	;
+	; FIXME: do we need to set $ZINTERRUPT and $PATH?
+	Q 0
+	;
+SWITCH3(INSTANCE)
+	; private entry point
+	;
+	; get new values of $ZG and $ZRO by replacing $$PATH() with 
+	; $$ROOT()_"/"_INSTANCE.  Q 0 without setting $ZG and $ZRO if the 
+	; resulting paths don't actually exist or we do not have permission to
+	; access them
+	;
+	; FIXME: implement this
+	;
+	; FIXME: do we need to set $ZINTERRUPT and $PATH?
+	Q 0
+	;
+CD	;Interactive
+	N Y,DIR
+	R !,"Namespace: ",DIR
+	I DIR["^"!(DIR="") Q
+	D LIST()
+	I DIR["?" G HELP
+	I '$D(Y("B",DIR)) W !,"Invalid Namespace" G CD
+	I $$GTMPATH($$CURRENT())'=$$GTMPATH(DIR) W !,"Inconsistent GTM versions",! G CD
+	S $ZPROMPT=DIR_">"
+	S A=$$SWITCH1(DIR)
+	Q
+HELP	N A S A=""
+	F  S A=$O(Y("B",A)) Q:A=""  W !,A
+	W ! G CD
+	Q
+SAVE(RN) ;Save a routine
+	N %,%F,%I,%N,SP,$ETRAP
+	S $ETRAP="S $ECODE="""" Q"
+	S %I=$I,SP=" ",%F="/tmp/"_$J_"/"_RN_".m"
+	ZSYSTEM "mkdir /tmp/"_$J
+	O %F:(newversion:noreadonly:blocksize=2048:recordsize=2044) U %F
+	F  S XCN=$O(@(DIE_XCN_")")) Q:XCN'>0  S %=@(DIE_XCN_",0)") Q:$E(%,1)="$"  I $E(%)'=";" W $P(%,SP)_$C(9)_$P(%,SP,2,99999),!
+	C %F ;S %N=$$NULL
+	S ZR=$ZRO,$ZRO=$ZRO_" /tmp/"_$J_"/"
+	ZLINK RN
+	ZSYSTEM "rm -r /tmp/"_$J
+	S $ZRO=ZR
+	;C %N
+	U %I
+	Q

=== added file 'mumps/ZISHGUX.m'
--- mumps/ZISHGUX.m	1970-01-01 00:00:00 +0000
+++ mumps/ZISHGUX.m	2009-04-30 17:33:05 +0000
@@ -0,0 +1,230 @@
+%ZISH ;ISF/AC,RWF MSC/JDS- GT.M for UNIX Host file Control ;01/04/2005  08:13
+ ;;8.0;KERNEL;**275,306,MSC**;Jul 10, 1995;
+ ; for GT.M for Unix/VMS, version 4.3
+ ;
+OPENERR ;
+ Q 0
+ ;
+OPEN(X1,X2,X3,X4,X5,X6) ;SR. Open file
+ ;D OPEN^%ZISH([handlename],[directory],filename,[accessmode],[recsize])
+ ;X1=handle name
+ ;X2=directory, X3=filename, X4=access mode
+ ;X5=new file max record size, X6=Subtype
+ ;
+ N %,%1,%2,%IO,%I2,%P,%T,X,Y,$ETRAP
+ S $ETRAP="D OPNERR^%ZISH"
+ S U="^",X2=$$DEFDIR($G(X2)),X4=$$UP^XLFSTR(X4)
+ S Y=$S(X4["A":"append",X4["R":"readonly",X4["W":"newversion",1:"readonly")
+ S Y=Y_$S(X4["B":":fixed:nowrap:recordsize=512",$G(X5)&(X4["W"):":WIDTH="_+X5,1:"")
+ S:$E(Y)=":" Y=$E(Y,2,999) S %IO=X2_X3,%I2="%IO:"_$S($L(Y):"("_Y_")",1:"")_":3"
+ O @%I2 S %T=$T
+ I '%T S POP=1 Q
+ S IO=%IO,IO(1,IO)="",IOT="HFS",POP=0 D SUBTYPE^%ZIS3($G(X6))
+ I $G(X1)]"" D SAVDEV^%ZISUTL(X1)
+ U IO U $P ;Enable use of $ZA to test EOF condition.
+ Q
+OPNERR ;error on open
+ S POP=1,$ECODE=""
+ U:$G(%P)]"" %P
+ Q
+ ;
+CLOSE(X) ;SR. Close HFS device not opened by %ZIS.
+ ;X1=Handle name, IO=device
+ I IO]"" C IO K IO(1,IO)
+ I $G(X)]"" D RMDEV^%ZISUTL(X)
+ D HOME^%ZIS
+ Q
+DEL(%ZX1,%ZX2) ;ef,SR. Del fl(s)
+ ;S Y=$$DEL^%ZISH("dir path",$NA(array))
+ N %ZISH,%ZISHLGR,%ZX,X,%ZXDEL
+ S %ZX1=$$DEFDIR($G(%ZX1)),%ZXDEL=1,%ZISH=""
+ F  S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH=""  D
+ . N $ETRAP,$ESTACK S $ETRAP="D DELERR^%ZISH"
+ . I %ZISH["*" S %ZXDEL=0 Q  ; Wild card not allowed.
+ . S %ZX=$ZSEARCH(%ZX1_%ZISH)
+ . Q:%ZX']""           ; File doesn't exist - not an error, just quit.
+ . O %ZX:READONLY:0
+ . I '$T S %ZXDEL=0 Q  ; Can't open it.
+ . C %ZX:DELETE
+ . I $ZSEARCH(%ZX)]"" S %ZXDEL=0 ; Delete was not successful.
+ Q %ZXDEL
+DELERR ;Trap any $ETRAP error, unwind and return.
+ S $ETRAP="D UNWIND^%ZTER"
+ S %ZXDEL=0
+ D UNWIND^%ZTER
+ Q
+ ;
+LIST(DIR,LIST,RETURN) ;ef,SR. Set local array holding fl names
+ ;S Y=$$LIST^ZISH("/dir/","list_root","return_root")
+ ;list_root can have XX("A*"), XX("test.com")...
+ ;Both arrays passed as $NA values (closed roots).
+ ;N %IO,%X,%ZISH,%ZISH1,%ZISHIO,%ZX,POP,X,%ZISHDL1,%ZISHDL2,%ZISHDN1,%ZISHDN2
+ ;N $ETRAP,$ESTACK S $ETRAP="G LSTEOF^%ZISH",%ZX1=$$DEFDIR($G(%ZX1))
+ ;S %IO=$I,%ZISHDN1="_ZISH"_$J_".TMPA",%ZISHDN2="ZISH"_$J_".TMPB"
+ ;%ZISHDL1=%ZX1_%ZISHDN1,%ZISHDL2=%ZX1_%ZISHDN2
+ ;S $ZT="G SPAWNERR^%ZISH"
+ ;Init %ZISHDL1, %ZISHDL2 by deleteing them
+ ;I $ZSEARCH(%ZISHDL1)["ZISH" ZSYSTEM "rm "_%ZISHDL1
+ ;I $ZSEARCH(%ZISHDL2)["ZISH" ZSYSTEM "rm "_%ZISHDL2_";*"
+ ;Get fls, Build listing in %ZISHDL1 with ls
+ S %ZISH1=0,%ZISH=""
+ N WANT,GLOB,NAME  S WANT="",DIR=$$DEFDIR($G(DIR))  F  S WANT=$O(@LIST@(WANT)) Q:WANT=""  D  
+ . S GLOB=DIR_WANT,NAME=""
+ . F  S NAME=$ZSEARCH(GLOB) Q:NAME=""  S @RETURN@($P(NAME,DIR,2))=""
+ Q $Q(@RETURN)]""
+LSTEOF S $ZT=""
+ I $L(%IO) U:$D(IO(1,%IO)) IO
+ ;C %ZISHDL1 ;:DELETE
+ ;I $L($ZSEARCH(%ZISHDL2)) ZSYSTEM "DEL "_%ZISHDL2
+ ;I $L($ZSEARCH(%ZISHDL1)) ZSYSTEM "DEL "_%ZISHDL1_";*"
+ S $ECODE=""
+ Q ($Q(@%ZX3)]"")
+ ;
+LIST1(%ZX,%ZD) ;Get one part of the list
+ N $ET,$ES S $ET="D LSTERR^%ZISH"
+ ;ZSYSTEM "ls -1 "_%ZX_" > "_%ZISHDL1
+ ;O %ZISHDL1:readonly:1 U %ZISHDL1
+ ;F  R %X:1 Q:$ZEOF  S @%ZX3@(%X)=""
+ ;C %ZISHDL1:DELETE
+ N %ZY,%ZI,%ZJ
+ S %ZY=$ZSEARCH("*.X") ;Clear vector
+ S %ZY=$P(%ZX,"*")
+ F  S %ZI=$ZSEARCH(%ZX) Q:'$L(%ZI)!(%ZI'[%ZY)  S %ZJ=$P(%ZI,%ZD,2),@%ZX3@(%ZJ)=""
+ Q 1
+LSTERR ;Error in list
+ I $ZSEARCH(%ZISHDL2)["ZISH" ZSYSTEM "DEL "_%ZISHDL2_";*"
+ Q 0
+ ;
+SPAWNERR ;TRAP ERROR OF SPAWN
+ O %ZISHDL1:READONLY:1 I $T C %ZISHDL1:DELETE
+ S $ECODE=""
+ Q 0
+ ;
+MV(X1,X2,Y1,Y2) ;ef,SR. Rename a fl
+ ;S Y=$$MV^ZISH("/dir/","fl","/dir/","fl")
+ N X,Y,%ZISHDL1
+ S %ZISHDL1="ZISH"_$J_".TMPA",X1=$$DEFDIR($G(X1)),Y1=$$DEFDIR($G(Y1))
+ S $ZT="SPAWNERR^%ZISH"
+ ;Pbv or qit
+ I (X2="")!(Y2="") Q 0
+ ZSYSTEM "mv "_X1_X2_" "_Y1_Y2 ;Use system command
+ S Y=$ZSEARCH(Y1_Y2)
+ Q $L(Y)>0
+ ;
+PWD() ;ef,SR. Print working directory
+ N Y
+ S Y=$$DEFDIR("")
+ S:Y="" Y=$ZDIR
+ Q Y
+ ;
+DEFDIR(DF) ;ef. Default Dir and frmt
+ S DF=$G(DF) Q:DF="." "" ;Special way to get current dir.
+ S:DF="" DF=$G(^XTV(8989.3,1,"DEV"))
+ ;Check syntax, VMS needs : or [ ]
+ I ^%ZOSF("OS")["VMS" D  Q DF ;***EXIT FOR VMS/GTM
+ . N P1,P2
+ . I DF[":" S P1=$P(DF,":")_":",P2=$P(DF,":",2)
+ . E  S P1="",P2=DF
+ . I P1="",P2["$" S DF=P2 Q  ;Assume a logical
+ . I $L(P2) S:P2'["[" P2="["_P2 S:P2'["]" P2=P2_"]"
+ . S DF=P1_P2
+ . Q
+ ;
+ ;Check syntax, Unix check leading & trailing "/"
+ I "./"'[$E(DF) S DF="/"_DF
+ I $E(DF,$L(DF))'="/" S DF=DF_"/"
+ Q DF
+STATUS() ;ef,SR. Return EOF status
+ U $I
+ Q $ZEOF
+ ;
+EOF(X) ;Eof flag, Pass in $ZA
+ Q X
+QL(X) ;Qlfrs
+ Q:X=""
+ S:$E(X)'="-" X="-"_X
+ Q
+FL(X) ;Fl len
+ N ZOSHP1,ZOSHP2
+ S ZOSHP1=$P(X,"."),ZOSHP2=$P(X,".",2)
+ I $L(ZOSHP1)>14 S X=4 Q
+ I $L(ZOSHP2)>8 S X=4 Q
+ Q
+ ;
+MAKEREF(HF,IX,OVF) ;Internal call to rebuild global ref.
+ ;Return %ZISHF,%ZISHO,%ZISHI,%ZISUB
+ N I,F,MX
+ S OVF=$G(OVF,"%ZISHOF")
+ S %ZISHI=$$QS^DDBRAP(HF,IX),MX=$$QL^DDBRAP(HF) ;
+ S F=$NA(@HF,IX-1) ;Get first part
+ I IX=1 S %ZISHF=F_"(%ZISHI" ;Build root, IX=1
+ I IX>1 S %ZISHF=$E(F,1,$L(F)-1)_",%ZISHI" ;Build root
+ S %ZISHO=%ZISHF_","_OVF_",%OVFCNT)" ;Make overflow
+ F I=IX+1:1:MX S %ZISHF=%ZISHF_",%ZISUB("_I_")",%ZISUB(I)=$$QS^DDBRAP(HF,I)
+ S %ZISHF=%ZISHF_")"
+ Q
+FTG(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;ef,SR. Unload contents of host file into global
+ ;p1=host file directory
+ ;p2=host file name
+ ;p3= $NAME REFERENCE INCLUDING STARTING SUBSCRIPT
+ ;p4=INCREMENT SUBSCRIPT
+ ;p5=Overflow subscript, defaults to "OVF"
+ N %ZA,%ZB,%ZC,%ZL,X,%OVFCNT,%CONT
+ N I,%ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHLGR,%ZISHOF,%ZISHOX,%ZISHS,%ZX,%ZISHY,POP,%ZISUB,%EXIT
+ S %ZX1=$$DEFDIR($G(%ZX1)),%ZISHOF=$G(%ZX5,"OVF")
+ D MAKEREF(%ZX3,%ZX4,"%ZISHOF")
+ D OPEN^%ZISH(,%ZX1,%ZX2,"R")
+ I POP Q 0
+ N $ETRAP S %EXIT=0,$ETRAP="S %ZA=1,%EXIT=1,$ECODE="""" Q"
+ U IO F  K %XX D READNXT(.%XX) Q:$$EOF(%ZA)  D
+ . S @%ZISHF=%XX
+ . I $D(%XX)>2 F %OVFCNT=1:1 Q:'$D(%XX(%OVFCNT))  S @%ZISHO=%XX(%OVFCNT)
+ . S %ZISHI=%ZISHI+1
+ . Q
+ D CLOSE() ;Normal exit
+ Q '%EXIT
+ ;
+ERREOF D CLOSE() ;Got error Reading file
+ Q 0
+ ;
+READNXT(REC) ;
+ N T,I,X,%
+ U IO R X:2 S %ZA=$ZEOF,REC=$E(X,1,255)
+ Q:$L(X)<256
+ S %=256 F I=1:1 Q:$L(X)<%  S REC(I)=$E(X,%,%+254),%=%+255
+ Q
+GTF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Load contents of global to host file.
+ ;Previously name LOAD
+ ;p1=$NAME of global reference
+ ;p2=incrementing subscript
+ ;p3=host file directory
+ ;p4=host file name
+ N %ZISHY,%ZISHLGR,%ZISHOX
+ S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"W")
+ Q %ZISHY
+ ;
+GATF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Append to host file.
+ ;
+ ;p1=$NAME of global reference
+ ;p2=incrementing subscript
+ ;p3=host file directory
+ ;p4=host file name
+ N %ZISHY
+ S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"A")
+ Q %ZISHY
+ ;
+MGTF(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;
+ ;p1=$NAME of global reference
+ ;p2=incrementing subscript
+ ;p3=host file directory
+ ;p4=host file name
+ N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHLGR,%ZISHS,%ZISHOX,IO,%ZX,Y
+ D MAKEREF(%ZX1,%ZX2)
+ D OPEN^%ZISH(,%ZX3,%ZX4,%ZX5) ;Default dir set in open
+ I POP Q 0
+ N X
+ N $ETRAP S $ETRAP="",X="ERREOF^%ZISH",@^%ZOSF("TRAP")
+ F  Q:'($D(@%ZISHF)#2)  S %ZX=@%ZISHF,%ZISHI=%ZISHI+1 U IO W %ZX,!
+ D CLOSE() ;Normal Exit
+ Q 1
+ ;

=== added file 'mumps/ZOSFGUX.m'
--- mumps/ZOSFGUX.m	1970-01-01 00:00:00 +0000
+++ mumps/ZOSFGUX.m	2009-04-30 17:33:05 +0000
@@ -0,0 +1,135 @@
+ZOSFGUX ;SFISC/MVB,PUG/TOAD MSC/JDS- ZOSF Table for GT.M for Unix ;10 Feb 2003 6:37 pm
+ ;;8.0;KERNEL;**275,MSC**;Jul 10, 1995
+ ;; for GT.M for Unix, version 4.3
+ ;
+ S %Y=1,DTIME=$G(DTIME,600)
+ K ^%ZOSF("MASTER"),^%ZOSF("SIGNOFF")
+ I '$D(^%ZOSF("VOL")) S ^%ZOSF("VOL")="ROU"
+ K ZO F I="MGR","PROD","VOL","TMP" S:$D(^%ZOSF(I)) ZO(I)=^%ZOSF(I)
+ F I=1:2 S Z=$P($T(Z+I),";;",2) Q:Z=""  S X=$P($T(Z+1+I),";;",2,99) S:Z="OS" $P(^%ZOSF(Z),"^")=X I Z'="OS" S ^%ZOSF(Z)=$S($D(ZO(Z)):ZO(Z),1:X)
+ ;
+OS S ^%ZOSF("OS")="GT.M (Unix)^19"
+ ;
+MGR W !,"NAME OF MANAGER'S UCI,VOLUME SET: "_^%ZOSF("MGR")_"// " R X:DTIME I X]"" X ^("UCICHECK") G MGR:0[Y S ^%ZOSF("MGR")=X
+PROD ;
+ W !,"The value of PRODUCTION will be used in the GETENV api."
+ W !,"PRODUCTION (SIGN-ON) UCI,VOLUME SET: "_^%ZOSF("PROD")_"// " R X:DTIME I X]"" X ^("UCICHECK") G PROD:0[Y S ^%ZOSF("PROD")=X
+ ;See that VOL and PROD agree.
+ I ^%ZOSF("PROD")'[^%ZOSF("VOL") S ^%ZOSF("VOL")=$P(^%ZOSF("PROD"),",",2)
+VOL W !,"The VOLUME name must match the one in PRODUCTION."
+ W !,"NAME OF VOLUME SET: "_^%ZOSF("VOL")_"//" R X:DTIME
+ I X]"" D  I X'?3U W "MUST BE 3 Upper case." G VOL
+ . I ^%ZOSF("PROD")'[X W !,"Must match PRODUCTION"
+ . S:X?3U ^%ZOSF("VOL")=X
+TMP ;Get the temp directory
+ W !,"The temp directory for the system: '"_^%ZOSF("TMP")_"'//"
+ R X:DTIME I $L(X),X'?1"/".E G TMP
+ I $L(X) S ^%ZOSF("TMP")=X
+ W !,"^%ZOSF setup"
+ Q
+ ;
+Z ;
+ ;;ACTJ
+ ;;S Y=$$ACTJ^%ZOSV()
+ ;;AVJ
+ ;;S Y=$$AVJ^%ZOSV()
+ ;;BRK
+ ;;U $I:(CENABLE)
+ ;;DEL
+ ;;N %RD,%OD S %RD=$P($S($ZRO["(":$P($P($ZRO,"(",2),")"),1:$ZRO)," ")_"/",%OD=$S($ZRO["(":$P($ZRO,"(",1)_"/",1:%RD) ZSYSTEM "rm -f "_%RD_X_".m" ZSYSTEM "rm -f "_%OD_X_".o"
+ ;;EOFF
+ ;;U $I:(NOECHO)
+ ;;EON
+ ;;U $I:(ECHO)
+ ;;EOT
+ ;;S Y=$ZA\1024#2 ; <=====
+ ;;ERRTN
+ ;;^%ZTER
+ ;;ETRP
+ ;;Q
+ ;;GD
+ ;;G ^%GD
+ ;;$INC
+ ;;0
+ ;;JOBPARAM
+ ;;G JOBPAR^%ZOSV
+ ;;LABOFF
+ ;;U IO:(NOECHO) ; <=====
+ ;;LOAD
+ ;;D LOAD^%ZOSV2(X) ;S %N=0 F XCNP=XCNP+1:1 S %N=%N+1,%=$T(+%N^@X) Q:$L(%)=0  S @(DIF_XCNP_",0)")=%
+ ;;LPC
+ ;;S Y="" ; <=====
+ ;;MAGTAPE
+ ;;S %MT("BS")="*1",%MT("FS")="*2",%MT("WTM")="*3",%MT("WB")="*4",%MT("REW")="*5",%MT("RB")="*6",%MT("REL")="*7",%MT("WHL")="*8",%MT("WEL")="*9" ; <=====
+ ;;MAXSIZ
+ ;;Q
+ ;;MGR
+ ;;VAH,ROU
+ ;;MTBOT
+ ;;S Y=$ZA\32#2 ; <=====
+ ;;MTERR
+ ;;S Y=$ZA\32768#2 ; <=====
+ ;;MTONLINE
+ ;;S Y=$ZA\64#2 ; <=====
+ ;;MTWPROT
+ ;;S Y=$ZA\4#2 ; <=====
+ ;;NBRK
+ ;;U $I:(NOCENABLE)
+ ;;NO-PASSALL
+ ;;U $I:(NOPASSTHRU)
+ ;;NO-TYPE-AHEAD
+ ;;U $I:(NOTYPEAHEAD)
+ ;;PASSALL
+ ;;U $I:(PASSTHRU)
+ ;;PRIINQ
+ ;;S Y=$$PRIINQ^%ZOSV()
+ ;;PRIORITY
+ ;;Q  ;G PRIORITY^%ZOSV
+ ;;PROD
+ ;;VAH,ROU
+ ;;PROGMODE
+ ;;S Y=$$PROGMODE^%ZOSV()
+ ;;RD
+ ;;G ^%RD
+ ;;RESJOB
+ ;;Q:'$D(DUZ)  Q:'$D(^XUSEC("XUMGR",+DUZ))  N XQZ S XQZ="^FORCEX[MGR]" D DO^%XUCI ; <=====
+ ;;RM
+ ;;U $I:WIDTH=$S(X<256:X,1:0)
+ ;;RSEL
+ ;;K ^UTILITY($J) D ^%RSEL S X="" X "F  S X=$O(%ZR(X)) Q:X=""""  S ^UTILITY($J,X)=""""" K %ZR
+ ;;RSUM
+ ;;S Y=0 F %=1,3:1 S %1=$T(+%^@X),%3=$F(%1," ") Q:'%3  S %3=$S($E(%1,%3)'=";":$L(%1),$E(%1,%3+1)=";":$L(%1),1:%3-2) F %2=1:1:%3 S Y=$A(%1,%2)*%2+Y
+ ;;SS
+ ;;D ^MSCZJOB
+ ;;SAVE
+ ;;D SAVE^%ZOSV2(X) ;N %I,%F S %I=$I,%F=$P($S($ZRO["(":$P($P($ZRO,"(",2),")"),1:$ZRO)," ")_"/"_X_".m" O %F:(NEWVERSION) U %F X "F  S XCN=$O(@(DIE_XCN_"")"")) Q:+XCN'=XCN  S %=@(DIE_XCN_"",0)"") Q:$E(%,1)=""$""  I $E(%)'="";"" W %,!" C %F U %I
+ ;;SIZE
+ ;;S Y=0 F I=1:1 S %=$T(+I) Q:%=""  S Y=Y+$L(%)+2 ; <=====
+ ;;TEST
+ ;;I X]"",$T(^@X)]""
+ ;;TMK
+ ;;S Y=$ZA\16384#2
+ ;;TMP
+ ;;/tmp/
+ ;;TRAP
+ ;;$ZT="G "_X
+ ;;TRMOFF
+ ;;U $I:(TERMINATOR="")
+ ;;TRMON
+ ;;U $I:(TERMINATOR=$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,127))
+ ;;TRMRD
+ ;;S Y=$A($ZB)
+ ;;TYPE-AHEAD
+ ;;U $I:(TYPEAHEAD)
+ ;;UCI
+ ;;S Y=^%ZOSF("PROD")
+ ;;UCICHECK
+ ;;S Y=1
+ ;;UPPERCASE
+ ;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+ ;;XY
+ ;;S $X=DX,$Y=DY ; <=====
+ ;;VOL
+ ;;ROU
+ ;;ZD
+ ;;S Y=$$HTE^XLFDT(X,2) I $L($P(Y,"/"))=1 S Y=0_Y

=== added file 'mumps/ZU.m'
--- mumps/ZU.m	1970-01-01 00:00:00 +0000
+++ mumps/ZU.m	2009-04-30 17:33:05 +0000
@@ -0,0 +1,87 @@
+ZU	;SF/JLI,RWF MSC/JDS- For GT.M, TIE ALL TERMINALS TO THIS ROUTINE!! ;11/24/2003  11:34
+	;;8.0;KERNEL;**275,MSC**;Jul 10, 1995
+	; for GT.M for VMS & Unix, version 4.3
+	;
+	;The env var ZINTRRUPT should be set to catch all interrupts.
+EN	;See that escape processing is off, Conflict with Screenman
+	U $P:(NOCENABLE:NOESCAPE)
+	D:+$G(^%ZTSCH("LOGRSRC")) LOGRSRC^%ZOSV("$LOGIN$")
+	N $ESTACK,$ETRAP S $ETRAP="D ERR^ZU Q:$QUIT -9 Q"
+	S $ZINTERRUPT="I $$JOBEXAM^ZU($ZPOSITION)"
+	D COUNT^XUSCNT(1)
+	G ^XUS
+	;
+G	;Entry point for GUI device.
+	Q
+	;
+ERR	;Come here on error
+	; handle stack overflow errors specially
+	I $P($ZS,",",3)["STACKOFLOW" S $ET="Q:$ST>"_($ST-8)_"  D ERR2^ZU" Q
+	;
+ERR2	S $ETRAP="D UNWIND^ZU" L  U $P:NOCENABLE
+	;
+	Q:$ECODE["<PROG>"
+	I $P($ZS,",",2,3)["^XUS1A:2, %GTM-E-IOWRITERR" G HALT
+	;
+	I $G(IO)]"",$D(IO(1,IO)),$E($G(IOST))="P" D
+	. U IO
+	. W @$S($D(IOF):IOF,1:"#")
+	I $G(IO(0))]"" D
+	. U IO(0)
+	. W !!,"RECORDING THAT AN ERROR OCCURRED ---"
+	. W !!?15,"Sorry 'bout that"
+	. W !,*7
+	. W !?10,"$STACK=",$STACK,"  $ECODE=",$ECODE
+	. W !?10,"$ZSTATUS=",$ZSTATUS
+	;
+	D ^%ZTER K %ZT S XUERF="" ; Capture symbol table first!
+	;
+	I $G(DUZ)'>0 G HALT
+	;
+CTRLC	I $D(IO)=11 U IO(0) C:IO'=IO(0) IO S IO=IO(0)
+	W:$P($ZS,",",3)["-CTRLC" !,"--Interrupt Acknowledged",!
+	D KILL1^XUSCLEAN ;Clean up symbol table
+	S $ECODE=",<<POP>>,"
+	Q
+	;
+UNWIND	;Unwind the stack
+	Q:$ESTACK>1  G CONT:$ECODE["<<HALT>>",CTRLC2:$ECODE["<<POP>>"
+	S $ECODE=""
+	Q
+	;
+CTRLC2	S $ECODE="" G:$G(^XUTL("XQ",$J,"T"))<2 ^XUSCLEAN
+	S ^XUTL("XQ",$J,"T")=1,XQY=$G(^(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 $ECODE="",$ETRAP="D ERR^ZU Q:$QUIT 0 Q"
+	U $P:NOESCAPE G M1^XQ
+	;
+HALT	I $D(^XUTL("XQ",$J)) D:$G(DUZ)>0 BYE^XUSCLEAN
+	D COUNT^XUSCNT(-1)
+	I '$ESTACK G CONT
+	S $ETRAP="D UNWIND^ZU" ;Set new trap
+	S $ECODE=",<<HALT>>," ;Cause error to unwind stack
+	D:+$G(^%ZTSCH("LOGRSRC")) LOGRSRC^%ZOSV("$LOGOUT$")
+	Q
+CONT	;
+	S $ECODE="",$ETRAP=""
+	D:+$G(^%ZTSCH("LOGRSRC")) LOGRSRC^%ZOSV("$LOGOUT$")
+	I $D(XQXFLG("HALT")) HALT
+	I ($PRINCIPAL["_TNA") HALT  ;Check for TelNet
+	S X="Waiting "_($J#1000000) D SETENV^%ZOSV ;Change VMS name
+	;For sites that want to retain the connection, uncomment the next line
+	;U $P:NOCENABLE R !,"Enter return to continue: ",X:600 S:'$T X="^" G:X'="^" ^ZU
+	HALT
+	;
+JOBEXAM(%ZPOS)	;
+	N %reference S %reference=$REFERENCE
+	S ^XUTL("XUSYS",$J,0)=$H,^XUTL("XUSYS",$J,"INTERRUPT")=$G(%ZPOS)
+	;I %ZPOS["^" S ^XUTL("XUSYS",$J,"codeline")=$T(@%ZPOS)
+	K ^XUTL("XUSYS",$J,"JE")
+	I $G(^XUTL("XUSYS","COMMAND"))'="EXAM" ZSHOW "SD":^XUTL("XUSYS",$J,"JE")
+	I $G(^XUTL("XUSYS","COMMAND"))="EXAM" ZSHOW "*":^XUTL("XUSYS",$J,"JE")
+	I $G(^XUTL("XUSYS",$J,"CMD"))="HALT" ;To do.
+	ZSHOW "*":^TMP("MSCZJOB",$J)
+	Q 1
+	;