XMDIRRCV.m

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

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