dmTOOL	; Linken naar de TOOL ;dmTOOL [ 12/06/2001 - 08:51:23 - 58779,31883 ]
	;
T1	; Fout bij save;
	;
T1F	; Fout bij save;
	;
T1E	; Fout bij save;
	;
YZ	Q
	;
BPRINT(QU,WDRIVER,IP,PORT)	; opbouw van ^cPRINT(boot,$j)
	; QU = initialen
	; WDRIVER = windows-driver van de locale windows-printer
	; IP   = IP-adres van de client
	; PORT = IP-port van de client (niet verplicht)
	S $ZT="ERR^"_$T(+0)
	N @$$INITVAR("WDRIVER,IP,PORT")     ; initialisatie variabelen + exclusieve new : N (%dmINIT,%Q1,D,DD,...A,B)
	d ^cAN325(QU,,,$G(WDRIVER),$G(IP),$G(PORT))
	Q boot
	;
CHK(Q,DMS,UI1)	; Check op linken naar ...
	S $ZT="^dmERROR"
	N (Q,UI1,DMS,QU,QT)
	S OK=1
	I '$L($G(UI1)) G CHKZ
	I '$L($G(DMS)) G CHKZ
	D
	. N UI1,DMS,OK
	. D INIT
	D DMS^cAN000("UQC","USC",DMS,1) I '$L(UQC)!'$L(USC) G CHKZ
	I '$D(^DMC(UQC,USC,"LINK")) G CHKZ
	S I=0,OK=1 F  S I=$O(^DMC(UQC,USC,"LINK",I)) Q:I=""  S J=^(I) D  Q:'OK
	. N UQC,USC,DMS,I
	. S DMS=$P(J,D),BI=$P(J,D,2) ; I '$P(J,D,3) Q  
	. D DMS^cAN000("UQC","USC",DMS,1) Q:UQC=""!(USC="")  Q:'$D(^DMC(UQC,USC,"DATA","INDEX"))
	. S IREF=^("INDEX")
	. S S1=UI1_" ",S2=S1 F  S S2=$O(@IREF@(BI,S2)) Q:$E(S2,1,$L(S1))'=S1  S OK=0 Q
CHKZ	Q OK
	;
CHKNOA(Q,QU,QT)	
	S $ZT="^dmERROR"
	N (Q,QU,QT)
	D INIT
	Q $$NOA^cA5003(QU,QT,1)
	;
INIT	; %dmINIT,%Q1,D,DD,DJ,DM,DT,Q,QD,QL,QM,QN,QP,QS,QT,QTU,QU,QZ,TD,U,boot,bootrvg,client,cs,master,slave,workst opzetten
	; !!!!!    indien hier een variabele wordt bijgezet moet dit ook in INITVAR gebeuren  !!!!
	S $ZT="TRAP^cAN000"
	s D="\",U=";"
	S:'$D(QT) QT="E"
	D ^cA105,^cA106
	I $G(%dmINIT) G INITZ    ; reeds geïnitialiseerd, hoeft nu niet meer
	D:'$D(boot) MASTER^cQ5 
	n oQ,R,i
	S oQ=$G(Q)
	I '$L($G(Q)),$L($G(^cLOG(boot,"Q",cs))) S Q=$P(^(cs),D,2) I '$L(Q) S Q=$P(^(cs),D)
	S:'$l($G(Q)) Q="EA"
	S:'$L($G(QU)) QU="VBA"
	f i="QL","QS","QM","QZ","QN" S:'$L($G(@i)) @i=""
	S QTU=$S($L(QT):$F("FDE",QT),1:1)
	S QP=1 S:Q'=oQ!'$D(QD) QD=$G(@("^"_Q_"BA(34)"))
	S %Q1="^TEMP(""%1"",$J)" 
	S %dmINIT=1
INITZ	Q
	;
INITVAR(R,INCL)	; initialisatie + samenstellen string met var. voor een EXCLUSIEVE New 
	; R        = welke variabelen moeten bijgezet worden in de uitgangstring
	;             vb : R ="A,B" : Uitgang  = "(%Q1,D,DD,...,A,B)"
	; INCL  =1 = Inclusief ipv exclusief
	;       Niet verplicht : default = 0 of niet bestaand : dus steeds EXCLUSIEF
	;       
	I '$G(%dmINIT) D INIT              ; initialisatie variabelen
	; samenstellen string met standaard variabelen + variabelen meegegeven in R
	S R=$S('$G(INCL):"(",1:"")_"%dmINIT,%Q1,D,DD,DJ,DM,DT,Q,QD,QL,QM,QN,QP,QS,QT,QTU,QU,QZ,TD,U,boot,bootrvg,client,cs,master,slave,workst"_$S($L($G(R)):",",1:"")_$G(R)_$S('$G(INCL):")",1:"")
	Q R
	;
GETPAR(Q,DMS,QT)	; ophalen parameters per klasse
	; uitgang : Omschrijving in taal QT_D_index1 van ^DATA_D_index2 van ^DATA
	N (Q,DMS,QT)
	S $ZT="TRAP^cAN000"
	S (R,R0,R1)="",D="\",U=";"
	I '$L(Q) G GETPARZ
	I '$L(DMS) G GETPARZ
	I '$L($G(QT)) S QT=""
	S QTU=$S($L(QT):$F("FDE",QT),1:1)
	S R0=$G(^DMS(Q,DMS)),R1=$G(^(DMS,0)) I $L(R0),$P(R1,D,30) S R0=D
	I '$L(R0) S R0=$G(^DMS(0,DMS)),R1=$G(^(DMS,0)) I $L(R0),$P(R1,D,30) S R0=D
	S UQC=$P(R0,D),USC=$P(R0,D,2)
	I '$L(UQC)!'$L(USC) G GETPARZ
	S R=$P(R1,D,QTU-1*10+1) I '$L(R) S R=$P(R1,D)    ; Description
	S DATA=$G(^DMC(UQC,USC,"DATA","REF"))
	I '$L(DATA) G GETPARZ
	F i=1,2 S $P(R,D,i+1)=$TR($P($P($P(DATA,"(",2),",",i),")"),"""","")   ; index 1 en 2 bepalen
GETPARZ	Q R     
	;
LOCK(Q,DMS,UI1,LOCK)	  ; lock/unlock
	; Q   = Q-waarde (defaul="EA")
	; DMS = srt bestand : zie ^DMS(Q,DMS
	; ID  = UI1 van bestand (ev. nieuw bestand)
	; LOCK = 0 : unlock
	; LOCK = 1 of onbestaand : lock
	S $ZT="^dmERROR"
	n (Q,DMS,UI1,LOCK,QU,QT)
	S:'$L($G(LOCK)) LOCK=1        
	D
	. N DMS,UI1,LOCK
	. D INIT
	S OK=0 
	D DMS^cAN000("UQC","USC",DMS,1) I '$L(UQC)!'$L(USC) G LOCKZ        
	S OK=$$L(Q,UQC,USC,UI1,'LOCK) I 'OK G LOCKZ
LOCKZ	Q OK
	;
L(Q,UQC,USC,UI1,UNLOCK)	
	; UNLOCK = 1 : indien unlock
	S $ZT="^dmERROR"
	N UREF,OK
	S OK=0
	S UREF=$G(^DMC(UQC,USC,"DATA","REF")) I '$L(UREF) G LZ
	I UREF[",UI1" F  Q:$TR($P(UREF,",",$L(UREF,",")),")""")="UI1"  S UREF=$P(UREF,",",1,$L(UREF,",")-1)_$S(UREF["@(":")"")",1:")")
	; lock
	I '$G(UNLOCK) S OK=+$$PLUS^cANLOCK($NA(@UREF),2)
	; unlock
	I $G(UNLOCK) S OK=1 L -@UREF
LZ	Q OK
	;
NR(Q,DMS)	      ; ophalen eerst volgend vrij nummer
	S $ZT="^dmERROR"
	N (Q,DMS,QU,QT)
	D 
	. N DMS
	. D INIT
	D DMS^cAN000("UQC","USC",DMS,1) I '$L(UQC)!'$L(USC) Q ""
	I $L($G(^(2))) S UQC=$P(^(2),D),USC=$P(^(2),D,2)
	S R=$$NR^cAN000
NRZ	Q R
	;
PRINT(Q,QU,PRINTID,IPPORT,XECUTE)	
	N (Q,QU,PRINTID,IPPORT,XECUTE,QU,QT)
	S $ZT="^dmERROR"
	S OK=1
	D
	. N PRINTID,IPPORT,OK,XECUTE
	. D INIT^dmTOOL
	D BF70^cAN322(PRINTID,1,$G(IPPORT)) I E S OK=0_D_K G PRINTZ
	S OK=1
	X XECUTE
	S:'$D(OK) OK=1
PRINTZ	Q OK
	;
SAVE(Q,UFU,DMS,UI1,TAB,USA,UQA)	; save gegevens
	; Q   = Q-waarde (default = "EA") 
	; UFU = analogi met UFU van de tool : verplicht !
	;        met uitzondering van UFU="X" = effectief verwijderen
	; DMS = ^DMS(Q,DMS : verplicht !
	; UI1 = UI1 (key)  : indien niet openen : verplicht !
	; TAB = Tabel met waardes (door te geven als .TAB)
	; USA = analoog met USA uit tool (indien niet ingevuld = DMS)
	; UQA = analoog met UQA uit tool (indien niet ingevuld : zie ^DMS(Q,DMS,"DMA",UFU
	S $ZT="^dmERROR"
	N (Q,UFU,DMS,UI1,TAB,UQA,USA,SQLCODE,QU,QT)
	D 
	. N UFU,DMS,UI1,TAB,UQA,USA
	. D INIT
	I '$L($G(USA)) S USA=DMS
	S UQA=$G(UQA)
	S UFU=$G(UFU),SQLCODE=0
	S K="-",%oper=$S(UFU="O":"INSERT",UFU="W":"UPDATE",1:"DELETE")
	; D TSTART        ; start transactie
	; moet zo staan want anders geldt de error-trap niet
	If $zu(115,1)=1 { TSTART  } ElseIf '$TLEVEL,$zu(115,1)=2 { TSTART  } s $zt="TETrap^"_$T(+0)
	; Openen
	I UFU="O" D P^cAN220(USA,UQA,$G(UI1),"TAB","") G SAVEY
	; wijzigen (in blok)
	I UFU="W" D  G SAVEY
	. ; kijken of er niet eerst een undelete moet gebeuren ?
	. I $D(TAB(130)),'TAB(130),$$SIG^cAFA1(DMS,UI1,130)=2 D U^cAN220(USA,UQA,UI1) Q:K="-"  K TAB(130)
	. I '$L($O(TAB(""))) Q  ; niets meer te wijzigen
	. D B^cAN220(USA,UQA,UI1,"TAB") 
	; Verwijderen (niveau 2)
	I UFU="V" D V^cAN220(USA,UQA,UI1) G SAVEY
	; Verwijderen (effectief)
	I UFU="X" D X^cAN220(USA,UQA,UI1) G SAVEY
SAVEY	I K="-" S SQLCODE=-403,%msg=$p($t(@("T1"_QT)),U,2)_" "_DMS D LOG^dmERROR
	D TCOMMIT
SAVEZ	Q $S(K="-":0,1:1_D_$G(NUI1))
	;
TSTART	; start transactie : copy uit xxx.Tx.mac %INSERT of %UPDATE
	If $zu(115,1)=1 { TSTART  } ElseIf '$TLEVEL,$zu(115,1)=2 { TSTART  } s $zt="TETrap^"_$T(+0)
	Q
	;
TCOMMIT	; commit transactie : copy uit xxx.Tx.mac %INSERT of %UPDATE
	i $zu(115,1)=1 TCOMMIT
	Q
	;
UNIQUE(Q,DMS,BI,X,oUI1)	; test op uniek gegeven
	S $ZT="^dmERROR"
	N (Q,DMS,BI,X,oUI1,QU,QT)
	D
	. N DMS,BI,X,oUI1
	. D INIT
	S OK=1,UI1=$$UI1^cAFA1(DMS,BI,X)
	I $L(UI1),UI1'=$g(oUI1) S OK=0
UNIQUEZ	Q OK
	;
VBF(A,B)	; voorbeeld van een functie
	; via INITVAR worden de nodige standaardvar. opgezet (%Q,D,DD,Q,...)
	; via N @$$INITVAR("A,B") gebeurt de init. + worden de standaard variabelen en var. A, B EXCLUSIEF genewed
	; Exclusieve NEW : alle variabelen uitgezonderd deze tussen de haakjes worden genewed
	S $ZT="^dmERROR"
	N @$$INITVAR("A,B")     ; initialisatie variabelen + exclusieve new : N (%dmINIT,%Q1,D,DD,...A,B)
	; is er reeds geïnitialiseerd, maar wil je dit toch opnieuw doen :
	; k %dmINIT N @$$INITVAR("A,B")
	W !,A,!,B
	W !,$G(Test)
	S Test="12599"
VBZ	Q
	;
ERR	; errortrap
	D LOG^dmERROR
	S OK=0_"\Error occuring during built temporary file : "_$ze s $ze=""
ERRZ	Q OK
	;
TETrap	; errortrap transactie : copy uit xxx.Tx.mac %ETrap
%ETrap	D LOG^dmERROR s $zt="",SQLCODE=-403,%msg="Error occuring during "_%oper_" :  $ZE="_$ze g %EExit
%EExit	If $zu(115,1)=1 { If $TLEVEL=1 { TROLLBACK  } Else { TCOMMIT  } }  q 0
	;
ZZ	; 18.05.04 - 15 u 49 * V8