cABIECGS        ; Export - Global Output ;%ABIE; [ 02/07/01  10:51 AM ]
 ;
MAIN New X,G,%TIM,%DAT,IO,IOSZ,IOT,IOPAR,POP,%JO,%G,HEAD
 ;
IO 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 !,"Could not open file",! S QUIT=2 Q
 S G=0 D INT^%T,INT^%D
IOLoop R !,"Description: ",HEAD,!
 D INT^%T
 D wout($ZDATE($h,2)_"  "_%TIM_"   Cache")
 D wout(HEAD)
 ;
 ;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)
 F  U 0 D ^%GPARSE Q:%G=""  S ^UTILITY($J,%G)=""
 S %data="" U 0
 F  S %data=$O(^UTILITY($J,%data)) Q:%data=""  S %G=%data D ^cABIECGP D G1 U IO W "*",!,"*",!
EXIT ;
 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 W %HN W:F ! W @%N W:F !
 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))
 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_")")
 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) I TRF'=TRT D
 . I $E(r)="^" S %J=r X RULE(0) S r=%J Q
 . S %DATA=r X GLOTR S r=%DATA
 U IO W r,!
 Q