| [613] | 1 | XMDIRRCV ;(WASH ISC)/CWU-Receive Email Directory ;04/18/2002 07:32
|
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
|---|
| 3 | ; Entry points used by MailMan options (not covered by DBIA):
|
|---|
| 4 | ; RECEIVE XMMGR-DIRECTORY-RECV
|
|---|
| 5 | RECEIVE ;
|
|---|
| 6 | S XMA=0
|
|---|
| 7 | ;
|
|---|
| 8 | ;Get pointer to domain data is coming from
|
|---|
| 9 | S %=$P($P($P(^XMB(3.9,XMZ,0),U,2),"@",2),">")
|
|---|
| 10 | S XMDIR1A("CODE")=$S(%="":^XMB("NETNAME"),1:%)
|
|---|
| 11 | N DIK S DA=0,DIK="^XMD(4.2997,"
|
|---|
| 12 | F S DA=$O(^XMD(4.2997,"E",XMDIR1A("CODE"),DA)) Q:+DA'=DA D ^DIK
|
|---|
| 13 | ;
|
|---|
| 14 | ;Begin main loop
|
|---|
| 15 | ;
|
|---|
| 16 | A ;X XMREC
|
|---|
| 17 | ;I $D(XMER) G Q:XMER<0
|
|---|
| 18 | ;S XMA=XMA+1
|
|---|
| 19 | ;S XMTXT(XMA)=XMRG
|
|---|
| 20 | ;G A
|
|---|
| 21 | Q ; SET UP FOR RECEIVING EMAIL DIRECTORY
|
|---|
| 22 | N %,%1,%5,%6
|
|---|
| 23 | S XMDIR1=$E(DT,1,5)-200
|
|---|
| 24 | S %=.999999
|
|---|
| 25 | F S %=$O(^XMB(3.9,XMZ,2,%)) Q:%="" S %1=$G(^XMB(3.9,XMZ,2,%,0)) D
|
|---|
| 26 | . Q:%1=""
|
|---|
| 27 | . 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)
|
|---|
| 28 | . Q:X("LN")=""
|
|---|
| 29 | . 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)
|
|---|
| 30 | . D FILE^XMDIR1A(.X)
|
|---|
| 31 | ;
|
|---|
| 32 | ;FINISH UP
|
|---|
| 33 | ;
|
|---|
| 34 | ;Set up for call to MailMan programmer interface
|
|---|
| 35 | S XMTEXT="XMTXT(",^TMP("XMY",$J,.5)=""
|
|---|
| 36 | S XMTXT(XMA+1)=" "
|
|---|
| 37 | S XMTXT(XMA+2)="This message arrived through a server routine."
|
|---|
| 38 | ;
|
|---|
| 39 | ;Call MailMan programmer interface
|
|---|
| 40 | D ^XMD
|
|---|
| 41 | D ZAPSERV^XMXMSGS1("S."_XQSOP,XQMSG)
|
|---|
| 42 | Q
|
|---|
