cI532	;Controle UGL ;%I532 ; [ 08/24/01  12:33 PM ]
	G YZ
	;
AL(Q)	;Controle OD+UL+TO+TOL+INTR
	D OD(Q),UL(Q),TO(Q),TOL(Q),INTR(Q)
	Q
	;
OD(Q)	;Controle OD, O1, O2, OB
	D UGL(Q,"OD","O1","O2","OB")
	Q
	;
UL(Q)	;Controle UL, U1, U2, UB
	D UGL(Q,"UL","U1","U2","UB")
	Q
	;
TO(Q)	;Controle TO, TO1, TO2, TOB
	D UGL(Q,"TO","TO1","TO2","TOB")
	Q
	;
TOL(Q)	;Controle TOL, TOL1, TOL2, TOLB
	D UGL(Q,"TOL","TOL1","TOL2","TOLB")
	Q
	;
INTR(Q)	;Controle INTR, INTR1, INTR2, INTRB
	D UGL(Q,"INTR","INTR1","INTR2","INTRB")
	Q
	;
	; Initialisatie
UGL(Q,UGL,UG1,UG2,UGB)	
1	S $ZT="^cA407" I $G(Q)'?1.3U G YZ
	I '$D(@("^"_Q_"BA(99,1)")) G YZ
	S QN=^(1),D="\",U=";" D ^cA106,^cA105,QT^cQ5
	S TEMP=$NA(^TEMPC($T(+0),UGL)) K @TEMP
	S @TEMP@(0,"Begin")=DT_D_TD_D_$H,ER=0
	S @TEMP@(0,"Q")=Q_D_QN
	;
	; UGL tov UG1 en UG2
2	S @TEMP@(1)=UGL
	S KC=0 F  S KC=$O(@("^"_Q_UGL)@(KC)) Q:KC=""  D
	. I UGL="INTR",$E(KC)="%" Q   ; INTR("%F") en INTR("%P")
	. S US="" F  S US=$O(@("^"_Q_UGL)@(KC,US)) Q:US=""  D
	.. S UR="" F  S UR=$O(@("^"_Q_UGL)@(KC,US,UR)) Q:UR=""  D
	... F I=0:1:3 I '$D(@("^"_Q_UGL)@(KC,US,UR,I)) S @TEMP@(1,UGL,KC,US,UR,I)="<undef>"
	... I '$D(@("^"_Q_UG1)@(US,UR)) S @TEMP@(1,UGL,KC,US,UR,UG1,US,UR)="<undef>"
	... I $D(@("^"_Q_UG1)@(US,UR)) S I=$P($G(^(UR)),D) I I'=KC S @TEMP@(1,UGL,KC,US,UR,UG1,US,UR)=I
	... I '$D(@("^"_Q_UG2)@(US,KC,UR)) S @TEMP@(1,UGL,KC,US,UR,UG2,US,KC,UR)="<undef>"
	;
	; UG1 tov UGL en UG2
3	S @TEMP@(2)=UG1
	S US="" F  S US=$O(@("^"_Q_UG1)@(US)) Q:US=""  D
	. S UR="" F  S UR=$O(@("^"_Q_UG1)@(US,UR)) Q:UR=""  D
	.. S KC=$P($G(^(UR)),D),FNR=""
	.. S FNR=$O(@("^"_Q_UG1)@(US,UR,FNR)) I FNR Q
	.. I KC="" S @TEMP@(2,UG1,US,UR)=KC Q
	.. F I=0:1:3 I '$D(@("^"_Q_UGL)@(KC,US,UR,I)) S @TEMP@(2,UG1,US,UR,UGL,KC,US,UR,I)="<undef>"
	.. I '$D(@("^"_Q_UG2)@(US,KC,UR)) S @TEMP@(2,UG1,US,UR,UG2,US,KC,UR)="<undef>"
	;
	; UG2 tov UGL en UG1
4	S @TEMP@(3)=UG2
	S US="" F  S US=$O(@("^"_Q_UG2)@(US)) Q:US=""  D
	. S KC="" F  S KC=$O(@("^"_Q_UG2)@(US,KC)) Q:KC=""  D
	.. S UR="" F  S UR=$O(@("^"_Q_UG2)@(US,KC,UR)) Q:UR=""  D
	... F I=0:1:3 I '$D(@("^"_Q_UGL)@(KC,US,UR,I)) S @TEMP@(3,UG2,US,KC,UR,UGL,KC,US,UR,I)="<undef>"
	... I '$D(@("^"_Q_UG1)@(US,UR)) S @TEMP@(3,UG2,US,KC,UR,UG1,US,UR)="<undef>"
	... I $D(@("^"_Q_UG1)@(US,UR)) S I=$P($G(^(UR)),D) I I'=KC S @TEMP@(3,UG2,US,KC,UR,UG1,US,UR)=I
	;
	; UGB tov UGL, UG1, UG2
5	S @TEMP@(4)=UGB
	S US="" F  S US=$O(@("^"_Q_UGB)@(US)) Q:US=""  D
	. S UR="" F  S UR=$O(@("^"_Q_UGB)@(US,UR)) Q:UR=""  D
	.. S KC=$P($G(^(UR)),D)
	.. I KC="" S @TEMP@(4,UGB,US,UR)=KC Q
	.. F I=0:1:3 I '$D(@("^"_Q_UGL)@(KC,US,UR,I)) S @TEMP@(4,UGB,US,UR,UGL,KC,US,UR,I)="<undef>"
	.. I '$D(@("^"_Q_UG2)@(US,KC,UR)) S @TEMP@(4,UGB,US,UR,UG2,US,KC,UR)="<undef>"
	.. I '$D(@("^"_Q_UG1)@(US,UR)) S @TEMP@(4,UGB,US,UR,UG1,US,UR)="<undef>"
	.. I $D(@("^"_Q_UG1)@(US,UR)) S I=$P($G(^(UR)),D) I I'=KC S @TEMP@(4,UGB,US,UR,UG1,US,UR)=I
	;
Y	D ^cA105 S @TEMP@(0,"Einde")=DT_D_TD_D_$H
	; I ER D
	; . I UGL="OD" D D1008^cANEM0($T(+0),$P($T(T1),U,2))
	; . I UGL="TO" D D1009^cANEM0($T(+0),$P($T(T1),U,3))
YZ	Q
	;
ZZ	; 25.09.01 - 11 u 01 * V7.88