XMDIRRCV ;(WASH ISC)/CWU-Receive Email Directory ;04/18/2002 07:32
;;8.0;MailMan;;Jun 28, 2002
; Entry points used by MailMan options (not covered by DBIA):
; RECEIVE XMMGR-DIRECTORY-RECV
RECEIVE ;
S XMA=0
;
;Get pointer to domain data is coming from
S %=$P($P($P(^XMB(3.9,XMZ,0),U,2),"@",2),">")
S XMDIR1A("CODE")=$S(%="":^XMB("NETNAME"),1:%)
N DIK S DA=0,DIK="^XMD(4.2997,"
F S DA=$O(^XMD(4.2997,"E",XMDIR1A("CODE"),DA)) Q:+DA'=DA D ^DIK
;
;Begin main loop
;
A ;X XMREC
;I $D(XMER) G Q:XMER<0
;S XMA=XMA+1
;S XMTXT(XMA)=XMRG
;G A
Q ; SET UP FOR RECEIVING EMAIL DIRECTORY
N %,%1,%5,%6
S XMDIR1=$E(DT,1,5)-200
S %=.999999
F S %=$O(^XMB(3.9,XMZ,2,%)) Q:%="" S %1=$G(^XMB(3.9,XMZ,2,%,0)) D
. Q:%1=""
. S X("LN")=$P(%1,U),X("FN")=$P(%1,U,2),X("RN")=$P(%1,U,3),X("MC")=$P(%1,U,4),X("EMC")=$P(%1,U,5),X("L")=$P(%1,U,6),X("NET")=$P(%1,U,7)
. Q:X("LN")=""
. I $D(^XMD(4.2997,"B",X("LN"))) S %5="" F S %5=$O(^XMD(4.2997,"B",X("LN"),%5)) Q:%5="" I $D(^XMD(4.2997,%5,0)) S %6=^XMD(4.2997,%5,0) Q:X("NET")=$P(%6,U,7)
. D FILE^XMDIR1A(.X)
;
;FINISH UP
;
;Set up for call to MailMan programmer interface
S XMTEXT="XMTXT(",^TMP("XMY",$J,.5)=""
S XMTXT(XMA+1)=" "
S XMTXT(XMA+2)="This message arrived through a server routine."
;
;Call MailMan programmer interface
D ^XMD
D ZAPSERV^XMXMSGS1("S."_XQSOP,XQMSG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMDIRRCV 1384 printed Dec 13, 2024@02:11:35 Page 2
XMDIRRCV ;(WASH ISC)/CWU-Receive Email Directory ;04/18/2002 07:32
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Entry points used by MailMan options (not covered by DBIA):
+3 ; RECEIVE XMMGR-DIRECTORY-RECV
RECEIVE ;
+1 SET XMA=0
+2 ;
+3 ;Get pointer to domain data is coming from
+4 SET %=$PIECE($PIECE($PIECE(^XMB(3.9,XMZ,0),U,2),"@",2),">")
+5 SET XMDIR1A("CODE")=$SELECT(%="":^XMB("NETNAME"),1:%)
+6 NEW DIK
SET DA=0
SET DIK="^XMD(4.2997,"
+7 FOR
SET DA=$ORDER(^XMD(4.2997,"E",XMDIR1A("CODE"),DA))
if +DA'=DA
QUIT
DO ^DIK
+8 ;
+9 ;Begin main loop
+10 ;
A ;X XMREC
+1 ;I $D(XMER) G Q:XMER<0
+2 ;S XMA=XMA+1
+3 ;S XMTXT(XMA)=XMRG
+4 ;G A
Q ; SET UP FOR RECEIVING EMAIL DIRECTORY
+1 NEW %,%1,%5,%6
+2 SET XMDIR1=$EXTRACT(DT,1,5)-200
+3 SET %=.999999
+4 FOR
SET %=$ORDER(^XMB(3.9,XMZ,2,%))
if %=""
QUIT
SET %1=$GET(^XMB(3.9,XMZ,2,%,0))
Begin DoDot:1
+5 if %1=""
QUIT
+6 SET X("LN")=$PIECE(%1,U)
SET X("FN")=$PIECE(%1,U,2)
SET X("RN")=$PIECE(%1,U,3)
SET X("MC")=$PIECE(%1,U,4)
SET X("EMC")=$PIECE(%1,U,5)
SET X("L")=$PIECE(%1,U,6)
SET X("NET")=$PIECE(%1,U,7)
+7 if X("LN")=""
QUIT
+8 IF $DATA(^XMD(4.2997,"B",X("LN")))
SET %5=""
FOR
SET %5=$ORDER(^XMD(4.2997,"B",X("LN"),%5))
if %5=""
QUIT
IF $DATA(^XMD(4.2997,%5,0))
SET %6=^XMD(4.2997,%5,0)
if X("NET")=$PIECE(%6,U,7)
QUIT
+9 DO FILE^XMDIR1A(.X)
End DoDot:1
+10 ;
+11 ;FINISH UP
+12 ;
+13 ;Set up for call to MailMan programmer interface
+14 SET XMTEXT="XMTXT("
SET ^TMP("XMY",$JOB,.5)=""
+15 SET XMTXT(XMA+1)=" "
+16 SET XMTXT(XMA+2)="This message arrived through a server routine."
+17 ;
+18 ;Call MailMan programmer interface
+19 DO ^XMD
+20 DO ZAPSERV^XMXMSGS1("S."_XQSOP,XQMSG)
+21 QUIT
