XMJMQ1.m

XMJMQ1 ;ISC-SF/GMB-Q,QD,QN Query recipients (cont.) ;04/17/2002  10:11

 ;;8.0;MailMan;;Jun 28, 2002

 ; Replaces ^XMA5,^XMA5A (ISC-WASH/THM/CAP)

QINIT(XMDUZ,XMK,XMKN,XMZ,XMRESPM,XMABORT) ;

 N XMZSTR,XMSUBJ,XMRESPS

 S XMABORT=0

 S XMZSTR=$$EZBLD^DIALOG(34537,XMZ) ; [#_XMZ_]

 S XMSUBJ=$P(^XMB(3.9,XMZ,0),U)

 S:XMSUBJ["~U~" XMSUBJ=$$DECODEUP^XMXUTIL1(XMSUBJ)

 S XMSUBJ=$$EZBLD^DIALOG(34536,XMSUBJ) ; Subj: _XMSUBJ

 S XMRESPS=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)

 S XMRESPM=$$EZBLD^DIALOG($S(XMRESPS=1:34557.1,1:34557),XMRESPS) ; XMRESPS_ response / responses

 W @IOF

 D PAGE1HDR^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMRESPS,^XMB(3.9,XMZ,0),XMSUBJ,XMZSTR)

 D INFO(XMDUZ,XMK,XMZ,0,"","","",.XMABORT)

 Q

INFO(XMDUZ,XMK,XMZ,XMPHDR,XMSUBJ,XMZSTR,XMPAGE,XMABORT) ;

 N XMREC,XMRECIPS,XMDIALOG

 S XMREC=^XMB(3.9,XMZ,0)

 I $Y+4>IOSL D  Q:XMABORT

 . D PAGE^XMJMQ(.XMABORT)

 E  W !

 W !,$$EZBLD^DIALOG(34559,XMZ_"@"_^XMB("NETNAME")) ; Local Message-ID:

 S XMDIALOG=$S($P(XMREC,U,7)["P":34543,$P(XMREC,U,7)["S":34560,$P(XMREC,U,8):34561,1:0) I XMDIALOG D W(XMDIALOG) ; Priority! / [SPOOL] / <RESPONSE>

 S XMRECIPS=+$P($G(^XMB(3.9,XMZ,1,0)),U,4)

 I XMRECIPS D W($S(XMRECIPS=1:34562.1,1:34562),XMRECIPS) ; (_XMRECIPS_ Recipient(s))

 I "^Y^y^"[(U_$P(XMREC,U,5)_U) D W(34564) ; Confirmation requested.

 I $D(^XMB(3.9,XMZ,"K")) D W($S(" "[$P(XMREC,U,10):34565,1:34566),$P(XMREC,U,10)) ; Scramble Hint:

 I $O(^XMB(3.9,XMZ,2005,0)) D LIST^XMA2B ; MIME body parts

 I "^Y^y^"[(U_$P(XMREC,U,9)_U) D W(34567) ; Closed.

 I "^Y^y^"[(U_$P(XMREC,U,11)_U) D W(34568) ; Confidential.

 I "^Y^y^"[(U_$P(XMREC,U,12)_U) D W(34570) ; 'Information only' for all recipients.

 I $D(^XMB(3.9,XMZ,.5)) D

 . S XMREC=^XMB(3.9,XMZ,.5)

 . I $P(XMREC,U,1)'="" D W(34571,$P(XMREC,U,1)) ; Delivery basket:

 ; The following is already listed in the message header:

 ;I $D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D

 ;. N XMVAPOR

 ;. S XMVAPOR=$P($G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,5)

 ;. I XMVAPOR D W(34572,$$MMDT^XMXUTIL1(XMVAPOR)) ; Automatic Deletion Date:

 D LATER(XMDUZ,XMZ,XMPHDR,XMSUBJ,XMZSTR,.XMPAGE,.XMABORT)

 Q

LATER(XMDUZ,XMZ,XMPHDR,XMSUBJ,XMZSTR,XMPAGE,XMABORT) ; List dates message will be new on 'later'

 Q:'$O(^XMB(3.73,"AC",XMZ,XMDUZ,0))

 N XMIEN,XMSEP

 I $Y+3>IOSL D PAGE^XMJMQ(.XMABORT) Q:XMABORT

 W !,$$EZBLD^DIALOG(34595) ; Message will be NEW on:

 S XMIEN="",XMSEP=" "

 F  S XMIEN=$O(^XMB(3.73,"AC",XMZ,XMDUZ,XMIEN)) Q:XMIEN=""  D

 . D W2(XMSEP,$$FMTE^XLFDT($E($P(^XMB(3.73,XMIEN,0),U),1,12)),.XMABORT)

 . S XMSEP=", "

 Q

W(XMPIECE,XMPARM) ;

 S XMPIECE=$$EZBLD^DIALOG(XMPIECE,.XMPARM)

 I 1+$L(XMPIECE)+$X>IOM D  Q:XMABORT

 . I $Y+3>IOSL D PAGE^XMJMQ(.XMABORT) Q:XMABORT

 . W !

 W " ",XMPIECE

 Q

W2(XMSEP,XMPIECE,XMABORT) ;

 I $X+$L(XMSEP)+$L(XMPIECE)>IOM D  Q:XMABORT

 . I $Y+3>IOSL D PAGE^XMJMQ(.XMABORT) Q:XMABORT

 . W !,XMPIECE

 E  W XMSEP,XMPIECE

 Q

NETWORK(XMZ,XMABORT) ;

 N I,J,XMLINE,XMPOS,XMPHDR

 I $O(^XMB(3.9,XMZ,2,0))'<1 D  Q

 . W !!,$$EZBLD^DIALOG(34550) ; This message originated locally.  There is no network header.

 I $D(^XMB(3.9,XMZ,.7)) W !!,$$EZBLD^DIALOG(34551,$P(^XMB(3.9,XMZ,.7),U,1)) ; Envelope From:

 W !!,$$EZBLD^DIALOG(34552),! ; Network header:

 S (I,XMPHDR)=0

 F  S I=$O(^XMB(3.9,XMZ,2,I)) Q:I=""!(I'<1)  D  Q:XMABORT

 . S XMLINE=^XMB(3.9,XMZ,2,I,0)

 . I $Y+3>IOSL D PAGE^XMJMQ(.XMABORT) Q:XMABORT

 . I $L(XMLINE)<IOM W !,XMLINE Q

 . S XMPOS=0

 . F  D  Q:XMLINE=""!XMABORT

 . . I $L(XMLINE)+XMPOS+1>IOM F J=IOM-XMPOS-1:-1:IOM-XMPOS-20 Q:", -;)"[$E(XMLINE,J)

 . . I $Y+3>IOSL D PAGE^XMJMQ(.XMABORT) Q:XMABORT

 . . W !,?XMPOS,$E(XMLINE,1,J)

 . . S XMPOS=10

 . . S XMLINE=$E(XMLINE,J+1,999)

 Q

SUMMARY(XMZ,XMPHDR,XMSUBJ,XMZSTR,XMPAGE,XMABORT) ;

 N XMTYPE

 I $Y+3>IOSL D PAGE^XMJMQ(.XMABORT) Q:XMABORT

 W !

 I '$O(^XMB(3.9,XMZ,6,0)),'$O(^XMB(3.9,XMZ,7,0)) D  Q

 . N XMTEXT

 . D BLD^DIALOG(34596,"","","XMTEXT","F")

 . D MSG^DIALOG("WM","","","","XMTEXT")

 . ;This is an old message which has no summary recipient list.

 . ;Only the Detail Query (QD) is available.

 W !,$$EZBLD^DIALOG(34597),! ; This message was addressed as follows:

 D PRTADDR(XMZ,6,.XMTYPE,.XMABORT) Q:XMABORT  ; addressed to

 D PRTADDR(XMZ,7,.XMTYPE,.XMABORT)            ; deliver later to

 Q

PRTADDR(XMZ,XMNODE,XMTYPE,XMABORT) ;

 N XMTO

 S XMTO="*" ; List Broadcasts first

 F  S XMTO=$O(^XMB(3.9,XMZ,XMNODE,"B",XMTO)) Q:$E(XMTO,1,1)'="*"  D PRTSUMRY(XMZ,XMNODE,XMTO,.XMTYPE,.XMABORT)  Q:XMABORT

 Q:XMABORT

 S XMTO="G." ; List Groups next

 F  S XMTO=$O(^XMB(3.9,XMZ,XMNODE,"B",XMTO)) Q:$E(XMTO,1,2)'="G."  D PRTSUMRY(XMZ,XMNODE,XMTO,.XMTYPE,.XMABORT)  Q:XMABORT

 Q:XMABORT

 S XMTO=""  ; Now list the rest

 F  S XMTO=$O(^XMB(3.9,XMZ,XMNODE,"B",XMTO)) Q:XMTO=""  D  Q:XMABORT

 . Q:$E(XMTO,1,2)="G."

 . Q:$E(XMTO,1,1)="*"

 . D PRTSUMRY(XMZ,XMNODE,XMTO,.XMTYPE,.XMABORT)

 Q

PRTSUMRY(XMZ,XMNODE,XMTO,XMTYPE,XMABORT) ;

 N XMIEN,XMREC

 S XMIEN=$O(^XMB(3.9,XMZ,XMNODE,"B",XMTO,0)) Q:'XMIEN

 S XMREC=$G(^XMB(3.9,XMZ,XMNODE,XMIEN,0)) Q:XMREC=""

 I $Y+3>IOSL D PAGE^XMJMQ(.XMABORT) Q:XMABORT

 I $P(XMREC,U,2)'="" D

 . S XMTYPE=$P(XMREC,U,2)

 . I '$D(XMTYPE(XMTYPE)) S XMTYPE(XMTYPE)=$$EXTERNAL^DILFD(3.91,6.5,"",XMTYPE) I $D(DIERR) S XMTYPE(XMTYPE)=XMTYPE

 . W !,XMTYPE(XMTYPE),":",$P(XMREC,U,1)

 E  W !,$P(XMREC,U,1)

 Q:XMNODE=6

 N XMPARM

 S XMPARM(1)=$$MMDT^XMXUTIL1($P(XMREC,U,5)),XMPARM(2)=$P(XMREC,U,4)

 D W(34598,.XMPARM) ; for delivery x by y

 Q

SEARCH(XMZ,XMNAME,XMRESPM) ;

 N XMPHDR,XMUSER,XMSITE

 S XMPHDR=0

 I $Y+5>IOSL D  Q:XMABORT

 . D PAGE^XMJMQ(.XMABORT)

 E  W !

 W !,$$EZBLD^DIALOG(34554,XMNAME),! ; Searching for recipients that match '_XMNAME_'.

 I XMNAME["@" D

 . S XMSITE=$$UP^XLFSTR($P(XMNAME,"@",2,99))

 . ;S XMUSER=$P(XMNAME,"@",1)_$S(XMNAME[",":"@",1:",")

 . S XMUSER=$P($P(XMNAME,"@",1),",",1)_","

 . S XMNAME=XMUSER_XMSITE

 E  D  Q:XMABORT

 . D FIND^DIC(200,"","@;.01","AP",XMNAME,"","B^BB^C^D","I $D(^XMB(3.9,XMZ,1,""C"",+Y))")

 . I '$D(DIERR) D PSEARCH(200,XMZ,XMRESPM,.XMABORT) Q:XMABORT

 Q:$O(^XMB(3.9,XMZ,1,"C",":"))=""  ; Quit if there aren't any non-local addressees

 N XMSCREEN

 S XMSCREEN=$S(+XMNAME=XMNAME:"I '$D(^XMB(3.9,XMZ,1,""C"",XMNAME))",1:"")

 D FIND^DIC(3.91,","_XMZ_",","","CP",XMNAME,"","C",XMSCREEN)

 I '$D(DIERR) D PSEARCH(3.91,XMZ,XMRESPM,.XMABORT)

 Q:$E(XMNAME)'?1U  ; Quit if the search string does not begin with an upper case letter

 Q:$O(^XMB(3.9,XMZ,1,"C","`"))=""  ; Quit if there aren't any lower case addressees

 ; FM will translate lower case to upper case in its search, but won't

 ; translate upper to lower, so we do it here.

 S XMSCREEN="I ^(0)]""`""" ; Limit search to lower case addresses

 S XMNAME=$S($D(XMSITE):$$LOW^XLFSTR(XMUSER)_XMSITE,1:$$LOW^XLFSTR(XMNAME))

 D FIND^DIC(3.91,","_XMZ_",","","CP",XMNAME,"","C",XMSCREEN)

 I '$D(DIERR) D PSEARCH(3.91,XMZ,XMRESPM,.XMABORT)

 Q

PSEARCH(XMFILE,XMZ,XMRESPM,XMABORT) ; Print search results

 N XMI,XMIEN,XMTYPE,XMREC

 S XMI=0

 F  S XMI=$O(^TMP("DILIST",$J,XMI)) Q:'XMI  S XMREC=^(XMI,0) D  Q:XMABORT

 . S XMIEN=$S(XMFILE=200:$O(^XMB(3.9,XMZ,1,"C",$P(XMREC,U,1),0)),1:$P(XMREC,U,1))

 . D WNAME^XMJMQ(XMZ,$P(XMREC,U,2),XMIEN,XMRESPM,.XMTYPE,.XMABORT)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XMJMQ1   7157     printed  Mar 13, 2025@21:16:52                                                                                                                                                                                                      Page 2

XMJMQ1    ;ISC-SF/GMB-Q,QD,QN Query recipients (cont.) ;04/17/2002  10:11

 +1       ;;8.0;MailMan;;Jun 28, 2002

 +2       ; Replaces ^XMA5,^XMA5A (ISC-WASH/THM/CAP)

QINIT(XMDUZ,XMK,XMKN,XMZ,XMRESPM,XMABORT) ;

 +1        NEW XMZSTR,XMSUBJ,XMRESPS

 +2        SET XMABORT=0

 +3       ; [#_XMZ_]

           SET XMZSTR=$$EZBLD^DIALOG(34537,XMZ)

 +4        SET XMSUBJ=$PIECE(^XMB(3.9,XMZ,0),U)

 +5        if XMSUBJ["~U~"

               SET XMSUBJ=$$DECODEUP^XMXUTIL1(XMSUBJ)

 +6       ; Subj: _XMSUBJ

           SET XMSUBJ=$$EZBLD^DIALOG(34536,XMSUBJ)

 +7        SET XMRESPS=+$PIECE($GET(^XMB(3.9,XMZ,3,0)),U,4)

 +8       ; XMRESPS_ response / responses

           SET XMRESPM=$$EZBLD^DIALOG($SELECT(XMRESPS=1:34557.1,1:34557),XMRESPS)

 +9        WRITE @IOF

 +10       DO PAGE1HDR^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMRESPS,^XMB(3.9,XMZ,0),XMSUBJ,XMZSTR)

 +11       DO INFO(XMDUZ,XMK,XMZ,0,"","","",.XMABORT)

 +12       QUIT 

INFO(XMDUZ,XMK,XMZ,XMPHDR,XMSUBJ,XMZSTR,XMPAGE,XMABORT) ;

 +1        NEW XMREC,XMRECIPS,XMDIALOG

 +2        SET XMREC=^XMB(3.9,XMZ,0)

 +3        IF $Y+4>IOSL

               Begin DoDot:1

 +4                DO PAGE^XMJMQ(.XMABORT)

               End DoDot:1

               if XMABORT

                   QUIT 

 +5       IF '$TEST

               WRITE !

 +6       ; Local Message-ID:

           WRITE !,$$EZBLD^DIALOG(34559,XMZ_"@"_^XMB("NETNAME"))

 +7       ; Priority! / [SPOOL] / <RESPONSE>

           SET XMDIALOG=$SELECT($PIECE(XMREC,U,7)["P":34543,$PIECE(XMREC,U,7)["S":34560,$PIECE(XMREC,U,8):34561,1:0)

           IF XMDIALOG

               DO W(XMDIALOG)

 +8        SET XMRECIPS=+$PIECE($GET(^XMB(3.9,XMZ,1,0)),U,4)

 +9       ; (_XMRECIPS_ Recipient(s))

           IF XMRECIPS

               DO W($SELECT(XMRECIPS=1:34562.1,1:34562),XMRECIPS)

 +10      ; Confirmation requested.

           IF "^Y^y^"[(U_$PIECE(XMREC,U,5)_U)

               DO W(34564)

 +11      ; Scramble Hint:

           IF $DATA(^XMB(3.9,XMZ,"K"))

               DO W($SELECT(" "[$PIECE(XMREC,U,10):34565,1:34566),$PIECE(XMREC,U,10))

 +12      ; MIME body parts

           IF $ORDER(^XMB(3.9,XMZ,2005,0))

               DO LIST^XMA2B

 +13      ; Closed.

           IF "^Y^y^"[(U_$PIECE(XMREC,U,9)_U)

               DO W(34567)

 +14      ; Confidential.

           IF "^Y^y^"[(U_$PIECE(XMREC,U,11)_U)

               DO W(34568)

 +15      ; 'Information only' for all recipients.

           IF "^Y^y^"[(U_$PIECE(XMREC,U,12)_U)

               DO W(34570)

 +16       IF $DATA(^XMB(3.9,XMZ,.5))

               Begin DoDot:1

 +17               SET XMREC=^XMB(3.9,XMZ,.5)

 +18      ; Delivery basket:

                   IF $PIECE(XMREC,U,1)'=""

                       DO W(34571,$PIECE(XMREC,U,1))

               End DoDot:1

 +19      ; The following is already listed in the message header:

 +20      ;I $D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D

 +21      ;. N XMVAPOR

 +22      ;. S XMVAPOR=$P($G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,5)

 +23      ;. I XMVAPOR D W(34572,$$MMDT^XMXUTIL1(XMVAPOR)) ; Automatic Deletion Date:

 +24       DO LATER(XMDUZ,XMZ,XMPHDR,XMSUBJ,XMZSTR,.XMPAGE,.XMABORT)

 +25       QUIT 

LATER(XMDUZ,XMZ,XMPHDR,XMSUBJ,XMZSTR,XMPAGE,XMABORT) ; List dates message will be new on 'later'

 +1        if '$ORDER(^XMB(3.73,"AC",XMZ,XMDUZ,0))

               QUIT 

 +2        NEW XMIEN,XMSEP

 +3        IF $Y+3>IOSL

               DO PAGE^XMJMQ(.XMABORT)

               if XMABORT

                   QUIT 

 +4       ; Message will be NEW on:

           WRITE !,$$EZBLD^DIALOG(34595)

 +5        SET XMIEN=""

           SET XMSEP=" "

 +6        FOR 

               SET XMIEN=$ORDER(^XMB(3.73,"AC",XMZ,XMDUZ,XMIEN))

               if XMIEN=""

                   QUIT 

               Begin DoDot:1

 +7                DO W2(XMSEP,$$FMTE^XLFDT($EXTRACT($PIECE(^XMB(3.73,XMIEN,0),U),1,12)),.XMABORT)

 +8                SET XMSEP=", "

               End DoDot:1

 +9        QUIT 

W(XMPIECE,XMPARM) ;

 +1        SET XMPIECE=$$EZBLD^DIALOG(XMPIECE,.XMPARM)

 +2        IF 1+$LENGTH(XMPIECE)+$X>IOM

               Begin DoDot:1

 +3                IF $Y+3>IOSL

                       DO PAGE^XMJMQ(.XMABORT)

                       if XMABORT

                           QUIT 

 +4                WRITE !

               End DoDot:1

               if XMABORT

                   QUIT 

 +5        WRITE " ",XMPIECE

 +6        QUIT 

W2(XMSEP,XMPIECE,XMABORT) ;

 +1        IF $X+$LENGTH(XMSEP)+$LENGTH(XMPIECE)>IOM

               Begin DoDot:1

 +2                IF $Y+3>IOSL

                       DO PAGE^XMJMQ(.XMABORT)

                       if XMABORT

                           QUIT 

 +3                WRITE !,XMPIECE

               End DoDot:1

               if XMABORT

                   QUIT 

 +4       IF '$TEST

               WRITE XMSEP,XMPIECE

 +5        QUIT 

NETWORK(XMZ,XMABORT) ;

 +1        NEW I,J,XMLINE,XMPOS,XMPHDR

 +2        IF $ORDER(^XMB(3.9,XMZ,2,0))'<1

               Begin DoDot:1

 +3       ; This message originated locally.  There is no network header.

                   WRITE !!,$$EZBLD^DIALOG(34550)

               End DoDot:1

               QUIT 

 +4       ; Envelope From:

           IF $DATA(^XMB(3.9,XMZ,.7))

               WRITE !!,$$EZBLD^DIALOG(34551,$PIECE(^XMB(3.9,XMZ,.7),U,1))

 +5       ; Network header:

           WRITE !!,$$EZBLD^DIALOG(34552),!

 +6        SET (I,XMPHDR)=0

 +7        FOR 

               SET I=$ORDER(^XMB(3.9,XMZ,2,I))

               if I=""!(I'<1)

                   QUIT 

               Begin DoDot:1

 +8                SET XMLINE=^XMB(3.9,XMZ,2,I,0)

 +9                IF $Y+3>IOSL

                       DO PAGE^XMJMQ(.XMABORT)

                       if XMABORT

                           QUIT 

 +10               IF $LENGTH(XMLINE)<IOM

                       WRITE !,XMLINE

                       QUIT 

 +11               SET XMPOS=0

 +12               FOR 

                       Begin DoDot:2

 +13                       IF $LENGTH(XMLINE)+XMPOS+1>IOM

                               FOR J=IOM-XMPOS-1:-1:IOM-XMPOS-20

                                   if ", -;)"[$EXTRACT(XMLINE,J)

                                       QUIT 

 +14                       IF $Y+3>IOSL

                               DO PAGE^XMJMQ(.XMABORT)

                               if XMABORT

                                   QUIT 

 +15                       WRITE !,?XMPOS,$EXTRACT(XMLINE,1,J)

 +16                       SET XMPOS=10

 +17                       SET XMLINE=$EXTRACT(XMLINE,J+1,999)

                       End DoDot:2

                       if XMLINE=""!XMABORT

                           QUIT 

               End DoDot:1

               if XMABORT

                   QUIT 

 +18       QUIT 

SUMMARY(XMZ,XMPHDR,XMSUBJ,XMZSTR,XMPAGE,XMABORT) ;

 +1        NEW XMTYPE

 +2        IF $Y+3>IOSL

               DO PAGE^XMJMQ(.XMABORT)

               if XMABORT

                   QUIT 

 +3        WRITE !

 +4        IF '$ORDER(^XMB(3.9,XMZ,6,0))

               IF '$ORDER(^XMB(3.9,XMZ,7,0))

                   Begin DoDot:1

 +5                    NEW XMTEXT

 +6                    DO BLD^DIALOG(34596,"","","XMTEXT","F")

 +7                    DO MSG^DIALOG("WM","","","","XMTEXT")

 +8       ;This is an old message which has no summary recipient list.

 +9       ;Only the Detail Query (QD) is available.

                   End DoDot:1

                   QUIT 

 +10      ; This message was addressed as follows:

           WRITE !,$$EZBLD^DIALOG(34597),!

 +11      ; addressed to

           DO PRTADDR(XMZ,6,.XMTYPE,.XMABORT)

           if XMABORT

               QUIT 

 +12      ; deliver later to

           DO PRTADDR(XMZ,7,.XMTYPE,.XMABORT)

 +13       QUIT 

PRTADDR(XMZ,XMNODE,XMTYPE,XMABORT) ;

 +1        NEW XMTO

 +2       ; List Broadcasts first

           SET XMTO="*"

 +3        FOR 

               SET XMTO=$ORDER(^XMB(3.9,XMZ,XMNODE,"B",XMTO))

               if $EXTRACT(XMTO,1,1)'="*"

                   QUIT 

               DO PRTSUMRY(XMZ,XMNODE,XMTO,.XMTYPE,.XMABORT)

               if XMABORT

                   QUIT 

 +4        if XMABORT

               QUIT 

 +5       ; List Groups next

           SET XMTO="G."

 +6        FOR 

               SET XMTO=$ORDER(^XMB(3.9,XMZ,XMNODE,"B",XMTO))

               if $EXTRACT(XMTO,1,2)'="G."

                   QUIT 

               DO PRTSUMRY(XMZ,XMNODE,XMTO,.XMTYPE,.XMABORT)

               if XMABORT

                   QUIT 

 +7        if XMABORT

               QUIT 

 +8       ; Now list the rest

           SET XMTO=""

 +9        FOR 

               SET XMTO=$ORDER(^XMB(3.9,XMZ,XMNODE,"B",XMTO))

               if XMTO=""

                   QUIT 

               Begin DoDot:1

 +10               if $EXTRACT(XMTO,1,2)="G."

                       QUIT 

 +11               if $EXTRACT(XMTO,1,1)="*"

                       QUIT 

 +12               DO PRTSUMRY(XMZ,XMNODE,XMTO,.XMTYPE,.XMABORT)

               End DoDot:1

               if XMABORT

                   QUIT 

 +13       QUIT 

PRTSUMRY(XMZ,XMNODE,XMTO,XMTYPE,XMABORT) ;

 +1        NEW XMIEN,XMREC

 +2        SET XMIEN=$ORDER(^XMB(3.9,XMZ,XMNODE,"B",XMTO,0))

           if 'XMIEN

               QUIT 

 +3        SET XMREC=$GET(^XMB(3.9,XMZ,XMNODE,XMIEN,0))

           if XMREC=""

               QUIT 

 +4        IF $Y+3>IOSL

               DO PAGE^XMJMQ(.XMABORT)

               if XMABORT

                   QUIT 

 +5        IF $PIECE(XMREC,U,2)'=""

               Begin DoDot:1

 +6                SET XMTYPE=$PIECE(XMREC,U,2)

 +7                IF '$DATA(XMTYPE(XMTYPE))

                       SET XMTYPE(XMTYPE)=$$EXTERNAL^DILFD(3.91,6.5,"",XMTYPE)

                       IF $DATA(DIERR)

                           SET XMTYPE(XMTYPE)=XMTYPE

 +8                WRITE !,XMTYPE(XMTYPE),":",$PIECE(XMREC,U,1)

               End DoDot:1

 +9       IF '$TEST

               WRITE !,$PIECE(XMREC,U,1)

 +10       if XMNODE=6

               QUIT 

 +11       NEW XMPARM

 +12       SET XMPARM(1)=$$MMDT^XMXUTIL1($PIECE(XMREC,U,5))

           SET XMPARM(2)=$PIECE(XMREC,U,4)

 +13      ; for delivery x by y

           DO W(34598,.XMPARM)

 +14       QUIT 

SEARCH(XMZ,XMNAME,XMRESPM) ;

 +1        NEW XMPHDR,XMUSER,XMSITE

 +2        SET XMPHDR=0

 +3        IF $Y+5>IOSL

               Begin DoDot:1

 +4                DO PAGE^XMJMQ(.XMABORT)

               End DoDot:1

               if XMABORT

                   QUIT 

 +5       IF '$TEST

               WRITE !

 +6       ; Searching for recipients that match '_XMNAME_'.

           WRITE !,$$EZBLD^DIALOG(34554,XMNAME),!

 +7        IF XMNAME["@"

               Begin DoDot:1

 +8                SET XMSITE=$$UP^XLFSTR($PIECE(XMNAME,"@",2,99))

 +9       ;S XMUSER=$P(XMNAME,"@",1)_$S(XMNAME[",":"@",1:",")

 +10               SET XMUSER=$PIECE($PIECE(XMNAME,"@",1),",",1)_","

 +11               SET XMNAME=XMUSER_XMSITE

               End DoDot:1

 +12      IF '$TEST

               Begin DoDot:1

 +13               DO FIND^DIC(200,"","@;.01","AP",XMNAME,"","B^BB^C^D","I $D(^XMB(3.9,XMZ,1,""C"",+Y))")

 +14               IF '$DATA(DIERR)

                       DO PSEARCH(200,XMZ,XMRESPM,.XMABORT)

                       if XMABORT

                           QUIT 

               End DoDot:1

               if XMABORT

                   QUIT 

 +15      ; Quit if there aren't any non-local addressees

           if $ORDER(^XMB(3.9,XMZ,1,"C","

               QUIT 

 +16       NEW XMSCREEN

 +17       SET XMSCREEN=$SELECT(+XMNAME=XMNAME:"I '$D(^XMB(3.9,XMZ,1,""C"",XMNAME))",1:"")

 +18       DO FIND^DIC(3.91,","_XMZ_",","","CP",XMNAME,"","C",XMSCREEN)

 +19       IF '$DATA(DIERR)

               DO PSEARCH(3.91,XMZ,XMRESPM,.XMABORT)

 +20      ; Quit if the search string does not begin with an upper case letter

           if $EXTRACT(XMNAME)'?1U

               QUIT 

 +21      ; Quit if there aren't any lower case addressees

           if $ORDER(^XMB(3.9,XMZ,1,"C","`"))=""

               QUIT 

 +22      ; FM will translate lower case to upper case in its search, but won't

 +23      ; translate upper to lower, so we do it here.

 +24      ; Limit search to lower case addresses

           SET XMSCREEN="I ^(0)]""`"""

 +25       SET XMNAME=$SELECT($DATA(XMSITE):$$LOW^XLFSTR(XMUSER)_XMSITE,1:$$LOW^XLFSTR(XMNAME))

 +26       DO FIND^DIC(3.91,","_XMZ_",","","CP",XMNAME,"","C",XMSCREEN)

 +27       IF '$DATA(DIERR)

               DO PSEARCH(3.91,XMZ,XMRESPM,.XMABORT)

 +28       QUIT 

PSEARCH(XMFILE,XMZ,XMRESPM,XMABORT) ; Print search results

 +1        NEW XMI,XMIEN,XMTYPE,XMREC

 +2        SET XMI=0

 +3        FOR 

               SET XMI=$ORDER(^TMP("DILIST",$JOB,XMI))

               if 'XMI

                   QUIT 

               SET XMREC=^(XMI,0)

               Begin DoDot:1

 +4                SET XMIEN=$SELECT(XMFILE=200:$ORDER(^XMB(3.9,XMZ,1,"C",$PIECE(XMREC,U,1),0)),1:$PIECE(XMREC,U,1))

 +5                DO WNAME^XMJMQ(XMZ,$PIECE(XMREC,U,2),XMIEN,XMRESPM,.XMTYPE,.XMABORT)

               End DoDot:1

               if XMABORT

                   QUIT 

 +6        QUIT