cABIECGS	       ; Export - Global Output ;%ABIE; [ 05/22/01  8:54 AM ]
	;
MAIN	New X,G,%TIM,%DAT,IO,IOSZ,IOT,IOPAR,POP,%JO,%G,HEAD
	;
IO	K QUIT
	S IO=TRFIL,OIBS="*8",OIF="#",OIM=132,IOPAR="(""WNS"")",IOSL=66,IOST="RMS",IOT="RMS",MSYS="M/WNT"
	O IO:"WNS":0 S OK=$T I 'OK W:'quiet !,"Could not open file",! S QUIT=2 Q
	S G=0 D INT^%T,INT^%D
IOLoop	S HEAD=$G(%ABIE("COM"),"Export from "_$ZU(5))
	I 'quiet R !,"Description: ",HEAD,!
	I TRT="E" D wout("Extended "_HEAD_"~Format=5.V~",0)
	D wout($ZDATE($h,2)_"  "_%TIM_"   Cache",0)
	I TRT'="E" D wout(HEAD,0)
	;
	;Modified %G follows
	;
	N POP
	N %E,%N,%NFULL,%B,%C,%L,%M,%G,%GLO            ;Used by %GPARSE
	N F                                           ;Used by %SETF
	N NullOK                                                     ; BIN002
	I $D(%ST)<11 N %ST D ^%ST
	D ^%SETF
	;
	S NullOK=$$NulAllow^%GOGEN
LOOP	;
	S $ZT="ERR" K ^UTILITY($J)
	I 'quiet F  U 0 D SELECT^cABIECGP Q:%G=""  I %M'=-2 S ^UTILITY($J,%G)=""
	I quiet K ^UTILITY($J) M ^UTILITY($J)=@%ABIE("SEL")
	S %data="" U 0
	F  S %data=$O(^UTILITY($J,%data)) Q:%data=""  S %G=%data D ^cABIECGP I %M'=-2 D G1 I TRT="M" U IO W "*",!,"*",!
EXIT	;
	I TRT="C" U IO W !!
	I TRT="E" W $C(0,0,0,0)
	I TRT="M" U IO W "**",!,"**",!
	U 0 C:IO'=$I IO
	Q
ERR	;
	S $ZT=""
	G:$ZE?1"<INT".E LOOP
	U 0 W !,$ZE
	G EXIT
	;
G1	
	N %HN,GREF,HREF,HGDIFF,LWLH,LWLEV,LWLENG,LEV,SHOLEV,First     ;BIN002
	S %HN=%N I %HN?1"^[".E S %HN="^"_$P(%HN,"]",$L(%HN,"]"))
	S HGDIFF=$L(%N)-$L(%HN)
	S LWLH=0,LWLEV=0,LWLENG=0
	I '%M,%N_"("=%G,$D(@%N)'=10 d wout(%HN,1),wout(@%N,0)
	I 'NullOK,$O(@%N@(""))="" Q
	I NullOK,$O(@%N@(""))="",'$D(@%N@("")) Q
	S SHOLEV=%L-(%E>1) ; Show only nodes at LEV>SHOLEV.
	;S SHOLEV=%L ; met deze instelling enkel onderliggende nodes!
	S GREF=%N_"(",HREF=%HN_"("
	S First=NullOK
	D CHILDREN(1)
	Q
	;---------------------------------------------------------------------
	; Process all the children on subscript level LEV of one parent node.
	; Naked reference is to level LEV.
CHILDREN(LEV)	
	N LENGTH,SUBSCR,Z
	S LENGTH=$L(GREF),SUBSCR=$S(LEV'>%L:%B(LEV),1:"")
	; If nulls are allowed, and %GPARSE indicates to start with null, and
	;  we have not already done so, and there are any null subscripts then
	;  try displaying them
	I NullOK,$G(%B(LEV))="",'$G(LEV(LEV)),$D(^("")) DO  S LEV(LEV)=1
	. S SUBSCR="" D ACHILD
	; Process a subscript
	I SUBSCR'="",$D(^(SUBSCR))
	E  S SUBSCR=$O(^(SUBSCR))
	F  Q:$$PASTEND  D ACHILD I SUBSCR'="" S SUBSCR=$O(^(SUBSCR))
	Q
	;---------------------------------------------------------------------
ACHILD	;
	N Subs
	S Subs=$$QS^%GOGEN(SUBSCR)
	S GREF=GREF_Subs,HREF=HREF_Subs
	S %D=$D(^(SUBSCR))
	I LEV>SHOLEV,(%D'=10)!(%E=2) I %D'=10 D SHOWREF,wout(^(SUBSCR),0)
	I %D>9,(%E'=2)!(LEV<%L) D DESCEND
	S GREF=$E(GREF,1,LENGTH),HREF=$E(HREF,1,LENGTH-HGDIFF)
	S:LEV'>%M SUBSCR=""
	Q
	; ---------- SUBROUTINES ----------
	;---------------------------------------------------------------------
	; $$PASTEND true if SUBSCR exceeds range of subscripts.
PASTEND()	;
	I SUBSCR="" Q 1
	I LEV>%L Q 0
	I %C(LEV)="" Q (%B(LEV)'="")&(%B(LEV)'=SUBSCR)
	I SUBSCR=%C(LEV) Q 0
	I SUBSCR'["E",SUBSCR=+SUBSCR G K51
	; have a string subscript currently
	I %C(LEV)'["E",%C(LEV)=+%C(LEV) Q 1 ; endpoint is numeric, too far
	Q SUBSCR]%C(LEV)
	; have a numeric subscript currently
K51	
	I %C(LEV)'["E",%C(LEV)=+%C(LEV) Q SUBSCR>%C(LEV)
	Q 0 ; endpoint is a string, o.k.
	;
	;--------------------------------------------------------------------
	;---------------------------------------------------------------------
	; Show the global reference HREF.
SHOWREF	;
	D wout(HREF_")",1)
	S LWLENG=LENGTH-HGDIFF
	Q
	;---------------------------------------------------------------------
	; Drop one level.
DESCEND	
	N DUMMY,First
	S First=NullOK
	S GREF=GREF_",",HREF=HREF_","
	S DUMMY=$O(^(SUBSCR,""))                                   ;AHS016
	D CHILDREN(LEV+1) S DUMMY=$O(@($E(GREF,1,$L(GREF)-1)_")")) ;AHS016
	S LWLEV=0,LWLENG=0
	Q
	;
	; Added
wout(r,x)	         S x=$G(x,0)  ; x = 0 = data,  x = 1 = gloref
	I TRT="E" U IO W $C($L(r)#256),$C($L(r)\256),r Q
	I TRF'=TRT D
	. I x S %J=r X RULE(0) S r=%J
	. S %DATA=r X GLOTR S r=%DATA
	U IO W r,!
	Q