cA350 ;Mail via SMTP ; %A350 [ 06/14/01  5:19 PM ]
 ;
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,",",";")
 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="$ZA="_ZA_",$ZB="_ZB_",$ZC="_ZC G EMAILZ
 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(FROM,";"),"@",2),OK="250 " D SND,READ I E G EMAILZ
 F I=1:1:$L(FROM,";") S C="MAIL FROM: "_$P(FROM,";",I) D SND,READ I E G EMAILZ
 F B=TO,CC,BCC I $L(B) F I=1:1:$L(B,";") S C="RCPT TO: "_$P(B,";",I) D SND,READ I E G EMAILZ
 S C="DATA",OK="354 " D SND,READ I E G EMAILZ
 D ^cA105
 I $ZV["MSM" D INT^cD
 I $ZV'["MSM" S %DAT1=$ZD($H,2)
 S C="Date: "_$TR(%DAT1,"-"," ")_" "_$TR(TD,"uh ","::")_":00 "_$$TZOF^cQ8 D SND
 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)        ; 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" F I=1:1 S TO=$P(@DEST,U,I) Q:TO=""  D
 . N A,B,I,J,K,ULOG
 . S UI1=$$NR^cAN000
 . S HOST=$$HOST^cA351($P(TO,"@",2))
 . I 'HOST Q
 . S TCPIP=$$SIG^cAFA1("HOSTS",HOST,103)
 . S B(1)=UI1_D_TO_D_VAN_D_$P(AAN,U)_D_$P(CC,U)_D_TCPIP_D_ONDERW_D_$G(REFDATA)_D_DT_D_TD_D_QU_D_1_D,$P(B(1),D,28,29)=QU_D_$H
 . S J=2 I $L($G(REFDATA)) S K="" F J=2:1 S K=$O(@REFDATA@(K)) Q:K=""  S B(J)=@REFDATA@(K)
 . S SW3=J-1,SW2=1,UFU="O" D U^cAN000
 . D OPEN("AAN",AAN,UI1)
 . D OPEN("CC",CC,UI1)
 Q
 ;
SEND(UQC,USC,Q) 
 ;background-programma versturen mail vanuit ^MAIL
 N MAX,MAXP,I,UI1,UREF,IREF,QT,QTU,QU
 L +MAIL:5 E  Q
 D MASTER^cQ5,^cA604 S QU="AUTO"
 S MAX=$$SIG^cAFA1("PAR","MAIL",103)   ; maximum aantal pogingen
 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=""
 F  S I=$O(@IREF@(112,I)) Q:I=""  D
 . S UI1=^(I)
 . N I
 . I $$SIG^cAFA1("MAIL",UI1,116)<MAX  D SMTP(UI1,UQC,USC)
 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="system@datam.be"
 S AUTOMAIL=1
 I '$D(UQC) D DMS^cAN000("UQC","USC","MAIL")
 S UREF=^DMC(UQC,USC,"DATA","REF"),UI1=MAILNR
 S B=@UREF@(0)
 ; 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
 ;
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")
 S 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="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
19980430 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
 ;
DBG(K,L) U 0 W ! S K=$G(K),L=$G(L)
 I $ZV["MSM" W $ZHL(2,"hh:mm:ss")
 I $ZV'["MSM" W $ZT($P($H,",",2),1)
 W K,L Q
 ;
TST(S,T) ; test email
 ; S = server, T =to
 S S=$G(S),T=$G(T) I S=""!(T="") W !,"Usage:   D TST^"_$T(+0),"(smtp-server,email-adres)",! Q
 S SERVER=S,FROM="Test@datam.be",TO=T,CC="",BCC="",SUB="Test E-mail"
 S DATA(1)="Test lijn 1",DATA(2)="Test lijn 2",DFROM=FROM,DTO=TO,DCC="",DBCC=""
 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
 ;
ZZ ; 06.08.01 - 17 u 28 * V7.87