cQGPARSE	;Parse generalized global reference ;cQGPARSE;
	;       
	;Modified %GPARSE
	;Parse generalized global reference. (PTR,PK,DL,FLH) ; DKA291 12/26/95  ; Compiled March 6, 2000 19:35:25
	; Routine: %GPARSE
	;
	F  D TRYONE Q:%G=""  Q:%M'<0
	Q
SELECT	R !,"Global ^",%G Q:%G=""  I %G="?" D INT^%GD S %M=-2 Q
	S %GG=%G
	D INT I %M=-2  W *7,"  [Invalid global reference]" G SELECT
	D GDEF I %M=-2  W *7,"  [Invalid global reference]" G SELECT
	D GXLATE
	S %G=%GG
	Q
	;
TRYONE	I '$D(%G) S %G="" Q
	D INT I %M=-2  W *7,"  [Invalid global reference]" Q
	D GDEF I %M=-2  W *7,"  [Invalid global reference]" Q
	;
	; The global should be defined.  Expect <PROTECT> or <NETWORK>.
GDEF	S $ZT="DEFERR" I '$D(@%N) W "  ???" S %M=-2
	Q
DEFERR	S $ZT="" W:$ZE'["<SYNTAX>" !,$ZE S %M=-2 Q  ; JEB025
	;
GXLATE	; Display whether a translation is in effect
	S $ZT="GXLERR"
	I "[|"'[$E(%N,2),($S($ZU(90,1,$ZU(5),$TR(%N,"^"))>0:$ZU(90,2,3,$ZU(90,1,$ZU(5),$TR(%N,"^"))),$ZU(90,1,$ZU(5),$TR(%N,"^"))<0:$ZU(90,2,6,-$ZU(90,1,$ZU(5),$TR(%N,"^"))),1:0)'=0) D
	. W " -- NOTE: translation in effect"
GXLERR	S $ZT="",$ZE=""
	Q
	; ----------------------------------------------------------------
	;
	; Internal entry - %G already exists (question already asked).
	;RETURN:  Same, except if %M=-2 had a syntax error.
	;         Doesn't check to see if global defined.
INT	N %A,%D,%F,%I,%P,%X
	D P I '%F S %M=-2 Q
	K %B,%A S %X=$P(%G,"(",2,256) S %N=$P(%G,"("),%NFULL=%N
	S %GLO=$P(%N,"^",2,$L(%N,"^"))
	D R Q
P	;SYNTAX VERIFIER.  Also called from %GIGEN.
	I $E(%G)'="^" S %G="^"_%G
	S %F=0 I %G?1"^(".E Q  ; Naked reference not allowed.
	S %F=2 I %G'["(" S %G=%G_"(" ; Entire global.
	I %G?.E1"," S %E=1 ; All below this level.
	E  I %G?.E1")" S %E=2,%G=$E(%G,1,$L(%G)-1)_"," ; This level only.
	E  S %E=3 ; This level and all below.
	Q
R	;PARSE %G.  Doesn't accept scientific notation.
	; Also called from %GIGEN.
	S %M=1,%B=1,%L=0,%P=0 G RT:%X=""
	; start scanning a new subscript
RRR	S %A="" I $E(%X,%M)="," S %X=$E(%X,1,%M-1)_""""""_$E(%X,%M,999)
RR	I $E(%X,%M)="""" F %I=1:1 S %M=%M+1 Q:%M>$L(%X)  I $E(%X,%M)="""" S %M=%M+1 G RR
	I $E(%X,%M)="(" S %P=%P+1,%M=%M+1 G RR
	I $E(%X,%M)=")",%P S %P=%P-1,%M=%M+1 G RR
	I ":,)"'[$E(%X,%M),$E(%X,%M)'?1C S %M=%M+1 G RR
	I $E(%X,%M)?1P,%P S %M=%M+1 G RR
	I $E(%X,%M)=":" G ERR:%A]"" S %A=1_$E(%X,%B,%M-1),%M=%M+1,%B=%M G RR
	I $E(%X,%M)'=",",$E(%X,%M)'=")",$E(%X,%M)]"" G ERR
	S %L=%L+1,%B(%L)=$E(%X,%B,%M-1),%M=%M+1,%B=%M
	D S Q:%M=-2  G RRR:%M'>$L(%X)
RT	F %I=1:1:%L Q:%B(%I)=""!(%C(%I)]"")
	S %M=%I-1 Q
ERR	S %M=-2 Q
	;
	; put subscript in purer form without "", etc.
	; and setup %C() for ranges
S	S %C(%L)="" I %A]"" DO  G S1
	. D S1 S %C(%L)=$S(%B(%L)]"":%B(%L),1:$C(255,255)),%B(%L)=$E(%A,2,999)
S1	I %B(%L)'["E",%B(%L)=+%B(%L) Q  ;#
	I %P=1,%E=2,%M'<$L(%X) DO
	. S:%B(%L)?.E1"," %B(%L)=$E(%B(%L),1,$L(%B(%L))-1),%M=%M-1
	. S %E=3,%B(%L)=%B(%L)_")" ;Right paren mistakenly
	;          attached to whole global, not just this subexpression
	Q:%B(%L)=""
	S $ZT="S10ERR"
	;Reduce likelihood of using our variables inadvertently
	I %B(%L)["%" N %A,%C,%D,%E,%F,%G,%I,%M,%N,%P,%X,%ZT
	S @("%B(%L)="_%B(%L)) Q
S10ERR	S $ZT="" W "  "_$P($ZE,">")_"> in ",%B(%L) S %M=-2 Q
	;
ZZ	; 17.01.2012 - 15:58 * Cache-r6.4.9