cA350	;Mail via SMTP ; %A350 [ 26/05/03 - 16:40:32 - 59315,60032 ]
	;
T1	;No extern mail program in parameters;
T2	;Extern mail program cannot be scheduled;
	;
YZ	Q
	;
	; versturen E-mail
EMAIL(SERVER,FROM,TO,CC,BCC,SUB,DATA,DFROM,DTO,DCC,DBCC)	
	; SERVER = IP-adres
	; FROM, TO, CC, BCC : van wie, naar wie, copy naar wie, blind-copy naar wie 
	; DFROM, DTO, DCC, DBCC : zelfde maar voor in de data
	; DATA : wordt doorgegeven als .DATA
	;
	S $ZT="TRAP^cAN000"
	N A,B,C,DEV,E,I,MSG,OK,ZC,ZA,ZB
	S SERVER=$G(SERVER),FROM=$G(FROM),TO=$G(TO),SUB=$G(SUB),DATA=$G(DATA),CC=$G(CC),BCC=$G(BCC),DFROM=$G(DFROM,FROM),DTO=$G(DTO,TO),DCC=$G(DCC,CC),DBCC=$G(DBCC,BCC)
	I $ZV["MSM" S SUB=$$D2NT^cQCV(SUB)
	F I="FROM","TO","CC","BCC","DFROM","DTO","DCC","DBCC" S @I=$TR(@I,",",";")
	I $G(debug) D DBG("DFROM:",DFROM)
	F I=1:1:$L(DFROM,";") S $P(DFROM,";",I)=$$EAC($P(DFROM,";",I))
	I $G(debug) D DBG("DFROM:",DFROM)
	S MSG=0
	I SERVER="" S MSG="1 No server defined" G EMAILZ
	I $ZV["MSM" G EMAILB
EMAILA	; Caché
	S DEV="|TCP|4" C DEV
	I $G(debug) D DBG("open connection")
	O DEV:(SERVER:25:"CST"):30 I '$T S MSG="2 No connection established" G EMAILZ
	U DEV S ZC=$ZA I ZC=2!(ZC=4)!(ZC=256) S MSG="2 No connection established" G EMAILZ
	I $G(debug) D DBG("connection opened")
	G EMAILC
EMAILB	; MSM
	S DEV=56
	I $G(debug) D DBG("open connection")
	O DEV U DEV:(:8):"TCP" W /SOCKET(SERVER,25) S ZA=$ZA,ZB=$ZB,ZC=$ZC
	I ZC S MSG="2 No connection established" G EMAILZ
	I $G(debug) D DBG("connection opened")
	; Gemeenschappelijk
EMAILC	S C="Listen for Connection",OK="220 " D READ I E G EMAILZ
	S C="HELO "_$P($P($P(FROM,";"),"@",2),">"),OK="250 " D SND,READ I E G EMAILZ
	F I=1:1:$L(FROM,";") S C=$P(FROM,";",I),C=$$EC(C),C=$$EAC(C),C="MAIL FROM: "_C D SND,READ I E G EMAILZ
	F B=TO,CC,BCC I $L(B) F I=1:1:$L(B,";") S C=$P(B,";",I),C=$$EC(C),C=$$EAC(C),C="RCPT TO: "_C D SND,READ I E G EMAILZ
	S C="DATA",OK="354 " D SND,READ I E G EMAILZ
	I $ZV["MSM" D INT^cD,^cA105 S K=$P($H,",",2)#3600#60,K=$E("0"_K,$L(K),3),%TIM=$TR(TD,"uh ","::")_":"_K
	I $ZV'["MSM" S %DAT1=$ZD($H,2),%TIM=$ZT($P($H,",",2),1)
	S %DAT1=$P("Thu,Fri,Sat,Sun,Mon,Tue,Wed",",",$H#7+1)_", "_%DAT1
	S C="Date: "_$TR(%DAT1,"-"," ")_" "_%TIM_" "_$$TZOF^cQ8 D SND
	F I=1:1:$L(DFROM,";") S B=$P(DFROM,";",I),B=$$EAC(B) S $P(DFROM,";",I)=B
	S C="From: "_DFROM D SND
	S C="To: "_DTO D SND
	S C="CC: "_DCC D SND
	I $L(DBCC) S C="BCC: "_DBCC D SND
	S C="Subject: "_SUB D SND
	S C="" D SND
	S I="" F  S I=$O(DATA(I)) Q:I=""  S C=DATA(I) S:C="." C=" ." S:$ZV["MSM" C=$$D2NT^cQCV(C) D SND
	S C=".",OK="250 " H 1 D SND,READ I E G EMAILZ
	S C="quit",OK="221 " D SND,READ I E G EMAILZ
EMAILZ	C:$D(DEV) DEV Q MSG
	;
MAIL(VAN,AAN,CC,ONDERW,REFDATA,Q,ATTREF,TYPE)	       ; omzetten aanvraag in ^MAIL
	S $ZT="TRAP^cAN000"
	N DEST,TCPIP,TO,UI1,UQC,USC,UFU,SW3,HOST
	D ^cA105,^cA106
	D DMS^cAN000("UQC","USC","MAIL",1)
	F DEST="AAN","CC" D  Q:$G(TYPE)
	. F I=1:1 S TO=$P(@DEST,U,I) Q:TO=""  D  Q:$G(TYPE)  ;  Q:$G(TYPE) -> 19.05.03 JV	slechts 1 email nodig indien er een type is
	.. N A,B,I,J,K,ULOG
	.. S UI1=$$NR^cAN000
	.. ; check op te veel emails per minuut
	.. I '$D(^MAIL(0,0)) S ^MAIL(0,0)=UI1_"\"_$H
	.. S %("prev")=+$P(^MAIL(0,0),"\",1),%("$H")=$P(^MAIL(0,0),"\",2)
	.. S %("%H")=$P(%("$H"),",",2)/86400+%("$H")
	.. S %("%I")=$P($H,",",2)/86400+$H-%("%H")*86400
	.. I (%("%I")<0)!(%("%I")>60) S ^MAIL(0,0)=UI1_"\"_$H
	.. E  I (UI1-%("prev"))>600 D D1021^cANEM0($T(+0),$P($T(@("T0"_$G(QT))),";",2)) I $ZV'["MSM" S X=$ZU(143,$J,1)    ; suspend this job
	.. ; ophalen TCPIP adres
	.. S TCPIP=$$HOST^cA351($P(TO,"@",2),1)
	.. I '$L(TCPIP) Q
	.. L +^MAIL(0,"MAIL",UI1)
	.. S B(1)=UI1_D_TO_D_VAN_D_$P(AAN,U)_D_$P(CC,U)_D_TCPIP_D_$TR(ONDERW,D,"/")_D_$G(REFDATA)_D_DT_D_TD_D_QU_D_1_D,$P(B(1),D,28,29)=$H_D_QU
	.. I $G(TYPE) S $P(B(1),D,19)=TYPE I $L(TYPE) S $P(B(1),D,20)=$$SIG^cAFA1("CODE.9007",TYPE,103)
	.. S J=2 I $L($G(REFDATA)) S K="" F J=2:1 S K=$O(@REFDATA@(K)) Q:K=""  S B(J)=$TR(@REFDATA@(K),D,"/")
	.. S SW3=J-1,SW2=1,UFU="O" D U^cAN000
	.. D OPEN("AAN",AAN,UI1)
	.. D OPEN("CC",CC,UI1)
	.. I $D(ATTREF) D OATT^cA352(UI1,.ATTREF)
	.. L -^MAIL(0,"MAIL",UI1)
	Q
	;
SEND(UQC,USC,Q,debug)	
	;background-programma versturen mail vanuit ^MAIL
	N MAX,MAXP,I,UI1,UREF,IREF,QT,QTU,QU,CMD,CMDOK
	L +MAIL:5 E  Q
	D
	. N UQC,USC,debug
	. D MASTER^cQ5,^cA604 S QU="AUTO"
	; maximum aantal pogingen + ext. prg. mails
	S MAX=$$SIG^cAFA1("PAR","MAIL",103),CMD=$G(^(1)) S:'$P(^(0),D,7) CMD=""
	I 'MAX S MAX=1
	I '$D(UQC) D DMS^cAN000("UQC","USC","MAIL",1)
	I '$L($G(UQC))!'$L($G(USC)) Q
	S IREF=^DMC(UQC,USC,"DATA","INDEX"),UREF=^("REF")
	I '$D(@IREF@(112)) Q
	S I="",CMDOK=0
	F  S I=$O(@IREF@(112,I)) Q:I=""  D
	. S UI1=^(I)
	. N I
	. I $$SIG^cAFA1("MAIL",UI1,116)<MAX D
	.. ; via SMTP : enkel diegene die geen type hebben
	.. I '$L($P($G(^(0)),D,19)) D SMTP(UI1,UQC,USC) Q
	.. ; externe email
	.. I '$L(CMD) Q
	.. L +MAILEXT:2 E  Q   ; als MAILEXT gelocked is, is extern prog. mails de mails aan het verwerken
	.. L -MAILEXT
	.. S CMDOK=$$WINMAIL(CMD)  ; starten extern prog. mails : slechts 1 maal, prog. doet de rest
	.. S CMD=""  ; dit moet gebeuren zodat in 1 loop WINMAIL maar 1 maal opgestart wordt
	L -MAIL
	Q
	;
SMTP(MAILNR,UQC,USC)	; versturen via SMTP (vanuit SND)
	; MAILNR is volgnummer in ^MAIL (veld 101)
	S $ZT="TRAP^cAN000" ;voorlopig
	N A,B,C,MSG,OK,ZA,ZB,ZC,UQC,USC,IREF,UREF,UI1,AUTOMAIL,UFU,I,DATA,TO,CC,I4,FROM
	S FROM=$$FROM
	S AUTOMAIL=1
	I '$D(UQC) D DMS^cAN000("UQC","USC","MAIL")
	S UREF=^DMC(UQC,USC,"DATA","REF"),UI1=MAILNR
	S B=$G(@UREF@(0)) I '$L(B) G SMTPZ
	; als de'van' ingevuld is en van de vorm xxxx@xxxx dan de FROM met dit invullen
	I $P(B,D,3)?1.e1"@"1.e S FROM=$P(B,D,3)
	S TO=$$TOCC("MAIL.AAN",MAILNR)
	S CC=$$TOCC("MAIL.CC",MAILNR)
	S I4=0 F I=1:1 S I4=$O(@UREF@(I4)) Q:I4=""  S DATA(I)=^(I4)
	; S MSG=$$EMAIL($P(B,D,6),$P(B,D,3),$P(B,D,2),,,$P(B,D,7),.DATA,$P(B,D,3),TO,CC,)
	S MSG=$$EMAIL($P(B,D,6),FROM,$P(B,D,2),,,$P(B,D,7),.DATA,$P(B,D,3)_" <"_FROM_">",TO,CC,)
	I $G(MSG) D ER(MSG) G SMTPZ
	S AUTOMAIL=1
	D W^cAN220("MAIL",0,MAILNR,112,""),W^cAN220("MAIL",0,MAILNR,117,$$SIG^cAFA1("MAIL",MAILNR,117)+1)
	D ^cA105,^cA106 D W^cAN220("MAIL",0,MAILNR,113,DT),W^cAN220("MAIL",0,MAILNR,114,TD)
SMTPZ	Q
	;
FROM()	; opzetten FROM
	N R S $ZT="TRAP^cAN000",R=$$SIG^cAFA1("PAR","MAIL",106) I R="" S R="system@datam.be"
	Q R
	;
TOCC(DMS,MAILNR)	         ;
	N UQC,USC,UI1,K,UREF,i,U3
	D DMS^cAN000("UQC","USC",DMS) I '$L(UQC)!'$L(USC) Q ""
	S IREF=^DMC(UQC,USC,"DATA","INDEX"),K="",i=MAILNR_" "
	F  S i=$O(@IREF@(101,i)) Q:$P(i," ")'=MAILNR  S UI1=@IREF@(101,i),K=K_$S($L(K):U,1:"")_$$SIG^cAFA1(DMS,UI1,102)
	Q K
	;
READ	S E=0
	I $G(debug) D DBG("Start reading answer for:",C)
	I $ZV["MSM" U DEV R A:10 I '$T S MSG="3 No answer : "_C,E=1 Q
	I $ZV'["MSM" U DEV R A:10 I '$L(A) S MSG="3 No answer : "_C,E=1 Q
	I $G(debug) D DBG("Data read:",A)
	I $E(A,1,$L(OK))'=OK S MSG=$TR(A,$C(13,10)),E=1 Q
	Q
	;
SND	I $G(debug) D DBG("Send:",C)
	I $ZV["MSM" U DEV W C_$C(13,10)
	I $ZV'["MSM" U DEV W C,!
	Q
	;
ER(MSG)	D W^cAN220("MAIL",0,MAILNR,115,MSG),W^cAN220("MAIL",0,MAILNR,116,$$SIG^cAFA1("MAIL",MAILNR,116)+1)
	; U 0 W !,"error : ",MSG
	Q
	;
OPEN(SRT,ADRES,UI1MAIL)	       ;
	N UQC,USC,SW3,SW2,UFU,B,UI1,i
	D DMS^cAN000("UQC","USC","MAIL."_SRT)
	I '$L(UQC)!'$L(USC) Q
	F i=1:1:$L(ADRES,U) I $L($P(ADRES,U,i)) D
	. S UI1=$$UI1(UQC,USC,UI1MAIL)
	. S B(1)=UI1MAIL_D_$P(ADRES,U,i)
	. S SW3=1,SW2=1,UFU="O" D U^cAN000
	Q
	;
UI1(UQC,USC,UI1MAIL)	     ; toekennen UI1 van adressen 'aan' en 'Cc'
	N UI1
	S UI1=$$NR^cAN000
	S UI1=UI1MAIL_" "_UI1
	Q UI1
	;
DEL(Q,UQA,USA)	;Verwijderen logboek mail
	N AANTD,DAT,UQC,USC,UREF,IREF,UI1,IND,SW3,UXX
	D
	. N UQA,USA
	. D MASTER^cQ5,^cA604 S QU="AUTO"
	G DELZ:$G(USA)="",DELZ:$G(UQA)="",DELZ:'$D(^DMA(UQA,USA,0,"DMS"))
	S C=^("DMS") D DMS^cAN000("UQC","USC",C) I UQC=""!(USC="") G DELZ
	S UXX=$G(^DMA(UQA,USA,0,4))
	S AANTD=$$SIG^cAFA1("PAR","MAIL",104)
	I 'AANTD Q
	S DAT=$$DC^cAFD1($$HD^cAFD1($H-AANTD))
	S UREF=$G(^DMC(UQC,USC,"DATA","REF")) Q:'$L(UREF)
	S UI1="",SW3=1,UFU="V"
	F  S UI1=$O(@UREF) Q:UI1=""  D
	. K B D R^cAN000 M A=B
	. I $$DC^cAFA1($P(B(1),D,9))'<DAT Q
	. B
	. D B^cAN000(130,2) ; set niveau = 2
	. I $L($P(UXX,D,2)) X $P(UXX,D,2)
	. D U^cAN000,K^cAN000 ; effectief verwijderen
DELZ	Q
	;
EC(K)	; get e-mail address from between < >
	I K["<" S K=$P($P(K,"<",2),">")
	Q K
	;
EAC(K)	; format e-mail address
	I K["@",K'["<" S K="<"_K
	I K[">" S K=$TR(K,">","")
	I K["@",$E(K,$L(K))'=">" S K=K_">" 
	Q K
	;
DBG(K,L)	U 0 W !,$$HT^cAFD1($H,1),"  ",$G(K)," ",$G(L)
	Q
	;
TST(S,T,debug)	    ; test e-mail
	; S = server, T = to, debug = optional
	S S=$G(S),T=$G(T) I S=""!(T="") D  Q
	. W !,"Usage:   D TST^"_$T(+0),"(smtp-server , to , debug)",!
	. W !,"         smtp-server = FQDN or IP-address"
	. W !,"         to = e-mail address of recipient"
	. W !,"         debug = 0 or 1 (show debug info)",!
	S SERVER=S,FROM=$$FROM,TO=T,CC="",BCC="",SUB="Test E-mail"
	S DATA(1)="Test line 1",DATA(2)="Test line 2",DTO=TO,DCC="",DBCC=""
	S DFROM=$$SIG^cAFA1("PAR","MAIL",105) I DFROM="" S DFROM=$ZU(110)
	S MSG=$$EMAIL(SERVER,FROM,TO,CC,BCC,SUB,.DATA,DFROM,DTO,DCC,DBCC)
	W !,"Test-email has ",$S(MSG=0:"succesfully",1:"not")," been sent",!
	I MSG'=0 W !,"Message: ",MSG
	Q
	;
WINMAIL(CMD)	; start versturen mail op via commando met extern programma 
	N OK,TIME,DELAY,i,TODAY,VAR
	S $ZT="TRAP^cAN000"
	I '$L($G(CMD)) S OK=0_D_$P($T(T1),U,2) G WINMAILZ
	D VAR^cANEM1(.VAR)  ; ophalen tabel met variabelen
	S CMD=$$CONV^cANEM1(CMD)  ; variabelen vervangen door waarden
	; AT-commando
	I $$UC^cAFA1($E(CMD,1,3))="AT "!($$UC^cAFA1($E(CMD,1,9))="SCHTASKS ") D
	. S i=$F(CMD,"%TIME%+") I 'i Q
	. s j=0 I i F j=0:1 Q:$e(CMD,i+j)'?1.N
	. S DELAY=$E(CMD,i,i+j-1),DELAY=$$DELAY^cAFD1(DELAY)
	. S CMD=$E(CMD,1,i-$L("%TIME%+")-1)_DELAY_$E(CMD,i+j,$L(CMD))
	S OK=$$JN^cA710(CMD),OK=1
 	; I 'OK S OK=0_D_$P($T(T2),U,2)  ; enkel geldig indien JW^cA710
WINMAILZ	Q OK
	;
ZZ	; 15.12.05 - 12 u 16 * V8.05