XMJMT ;ISC-SF/GMB-Interactive Send to whom ;07/17/2003 13:06
;;8.0;MailMan;**20,49**;Jun 28, 2002;Build 2
; Entry points used by MailMan options (not covered by DBIA):
; R XMHELPLNK - Get help on remote addresses (mail link)
TOWHOM(XMDUZ,XMTYPE,XMINSTR,XMRESTR,XMABORT) ;
N DIR,X,Y,XMTO,DIRUT,DUOUT,DTOUT ;*49
S XMTO="?"
F D Q:XMTO=""!XMABORT
. K DIR
. I $D(^TMP("XMY0",$J)) D
. . S DIR("A")=$$EZBLD^DIALOG(34113,XMTYPE) ;And |1| to
. . S DIR(0)="FrO^1:100" ; ('r' means no 'replace...with...' prompt)
. E D
. . S DIR("A")=$$EZBLD^DIALOG(34112,XMTYPE) ;|1| mail to
. . I XMTYPE=$$EZBLD^DIALOG(34110) S DIR("B")=$G(XMINSTR("TO PROMPT"),XMV("NAME")) ;Send
. . E I $G(XMINSTR("TO PROMPT")) S DIR("B")=XMINSTR("TO PROMPT")
. . S DIR(0)="Fr^1:100"
. D BLD^DIALOG(34114,"","","DIR(""?"")") ;Enter the name(s) of the recipient(s)
. S DIR("??")="^D QQ^XMJMT"
. D ^DIR I $D(DTOUT) S XMABORT=DTIME Q
. I $D(DUOUT) D Q
. . I XMTYPE=$$EZBLD^DIALOG(34111) S XMABORT=1 Q ;Forward
. . N DIR,DIRUT,X,Y
. . S DIR("A")=$$EZBLD^DIALOG(34115) ;Shall we forget the whole thing
. . S DIR("B")=$$EZBLD^DIALOG(39053) ;No
. . S DIR(0)="Y"
. . D BLD^DIALOG(34116,"","","DIR(""?"")") ;Enter YES to abort this message.
. . D ^DIR
. . I Y=1!$D(DIRUT) S XMABORT=1
. S XMTO=Y Q:XMTO=""
. I $G(XMRESTR("NOFPG")),$E(XMTO,1,2)="G." D Q
. . ;Only the message originator or XM GROUP PRIORITY key
. . ;holders may forward priority messages to Mail Groups.
. . N XMTEXT
. . D BLD^DIALOG(34117,"","","XMTEXT","F")
. . D MSG^DIALOG("WE","","","","XMTEXT")
. I $G(XMRESTR("NONET")),XMTO["@" D Q
. . N XMTEXT
. . W $C(7)
. . ;Messages longer than |1| lines may not be sent across the network.
. . D BLD^DIALOG(39001,XMRESTR("NONET"),"","XMTEXT","F")
. . D MSG^DIALOG("WE","","","","XMTEXT")
. I XMTO=XMV("NAME"),$G(DIR("B"))=XMV("NAME") S XMTO="`"_XMDUZ ; to avoid ambiguity in case 2 users have the same name.
. D ADDR^XMXADDR(XMDUZ,XMTO,.XMINSTR,.XMRESTR)
Q
QQ ; "??" help
N DIR,X,Y,XMCHOICE,I,DIRUT,DUOUT,DTOUT ;*49
S DIR("A")=$$EZBLD^DIALOG(34120) ;Enter the kind of help you'd like
S I=$$EZBLD^DIALOG(34126),XMCHOICE($P(I,":"))="U" ;U:User information
S DIR(0)="SO^"_I
S I=$$EZBLD^DIALOG(34121),XMCHOICE($P(I,":"))="G" ;G:Mail Group information
S DIR(0)=DIR(0)_";"_I
S I=$$EZBLD^DIALOG(34122),XMCHOICE($P(I,":"))="D" ;D:Domain information
S DIR(0)=DIR(0)_";"_I
I $O(^XMD(4.2997,0)) D
. S I=$$EZBLD^DIALOG(34123),XMCHOICE($P(I,":"))="R" ;R:Remote user information
. S DIR(0)=DIR(0)_";"_I
I $D(^TMP("XMY0",$J)) D
. S I=$$EZBLD^DIALOG(34124),XMCHOICE($P(I,":"))="S" ;S:Show current recipients of this message
. S DIR(0)=DIR(0)_";"_I
S I=$$EZBLD^DIALOG(34125),XMCHOICE($P(I,":"))="M" ;M:More help
S DIR(0)=DIR(0)_";"_I
F D ^DIR Q:$D(DIRUT) D @XMCHOICE(Y)
Q
S ; Show Current Recipients
N XMTO,XMABORT,DIR,X,Y,DIRUT,DUOUT,DTOUT ;49
I '$D(^TMP("XMY0",$J)) W !,$$EZBLD^DIALOG(34130) Q ;There aren't any recipients so far.
W @IOF,$$EZBLD^DIALOG(34131) ;Current recipients are:
S XMTO="",XMABORT=0
F S XMTO=$O(^TMP("XMY0",$J,XMTO)) Q:XMTO="" D Q:XMABORT
. D:$Y+3>IOSL PAGE(.XMABORT)
. W !,?3,$S($D(^TMP("XMY0",$J,XMTO,1)):^(1)_":",1:""),XMTO
. W:$D(^TMP("XMY0",$J,XMTO,"L")) ?40,$$EZBLD^DIALOG(34132),$$MMDT^XMXUTIL1(^("L")) ;Deliver:
Q:XMABORT
Q:'$D(^TMP("XMY",$J))
S DIR(0)="Y"
S DIR("A")=$$EZBLD^DIALOG(34133) ;Like more detail
S DIR("B")=$$EZBLD^DIALOG(39054) ;Yes
D ^DIR
Q:Y'=1
;Expanded Recipient List
S XMTO=""
F S XMTO=$O(^TMP("XMY",$J,XMTO)) Q:XMTO="" D Q:XMABORT
. I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
. W !,?3,$S($D(^TMP("XMY",$J,XMTO,1)):^(1)_":",1:""),$$NAME^XMXUTIL(XMTO)
D PAGE(.XMABORT)
Q
PAGE(XMABORT) ;
D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
W @IOF
Q
U ; User Info
D HELP^XMHIU
Q
G ; Group Info
N DIR
D HELP^XMHIG
Q
D ; Domain Info (Replaces QQ2^XMA50)
N DIC,X,Y,XMSTATE,XMREC
S DIC="^DIC(4.2,",DIC(0)="AEQMZ"
F W ! D ^DIC Q:Y<0 D
. S XMREC=Y(0)
. W:$L($P(XMREC,U,14)) !,$$EZBLD^DIALOG(34140),$P(XMREC,U,14) ;Routing indicator:
. I $D(^XUSEC("XMMGR",DUZ)) D
. . W:$L($P(XMREC,U,12)) !,$$EZBLD^DIALOG(34141),$P(XMREC,U,12) ;MailMan Host Number:
. . W:$L($P(XMREC,U,11)) !,$$EZBLD^DIALOG(34142),$P(XMREC,U,11) ;Security Key:
. W:$P(XMREC,U,3) !,$$EZBLD^DIALOG(34143),$P(^DIC(4.2,$P(XMREC,U,3),0),U,1) ;Relay Domain:
. S XMSTATE=$P(XMREC,U,2)
. W !,$$EZBLD^DIALOG($S(XMSTATE["C":34144,XMSTATE'["S":34145,1:34146))
. ; 34144 - Messages cannot be sent, because this domain is CLOSED
. ; 34145 - Messages are QUEUED for later transmission
. ; 34146 - Messages are SENT immediately
Q
R ; Remote User Info (Replaces QQ3A,QQ3B^XMA5)
N DIC,X,Y,DR,DA
S DIC="^XMD(4.2997,",DIC(0)="AEFMQ"
S DIC("A")=$$EZBLD^DIALOG(34149) ; Enter LASTNAME, MAIL CODE, or LOCATION
F W ! D ^DIC Q:Y<0 D
. S DA=+Y,DR=0 D EN^DIQ
Q
M ;
N XQH,DIR,X,Y
S XQH="XM-U-A-ADDRESS"
D EN^XQH
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJMT 4986 printed Oct 16, 2024@18:13:06 Page 2
XMJMT ;ISC-SF/GMB-Interactive Send to whom ;07/17/2003 13:06
+1 ;;8.0;MailMan;**20,49**;Jun 28, 2002;Build 2
+2 ; Entry points used by MailMan options (not covered by DBIA):
+3 ; R XMHELPLNK - Get help on remote addresses (mail link)
TOWHOM(XMDUZ,XMTYPE,XMINSTR,XMRESTR,XMABORT) ;
+1 ;*49
NEW DIR,X,Y,XMTO,DIRUT,DUOUT,DTOUT
+2 SET XMTO="?"
+3 FOR
Begin DoDot:1
+4 KILL DIR
+5 IF $DATA(^TMP("XMY0",$JOB))
Begin DoDot:2
+6 ;And |1| to
SET DIR("A")=$$EZBLD^DIALOG(34113,XMTYPE)
+7 ; ('r' means no 'replace...with...' prompt)
SET DIR(0)="FrO^1:100"
End DoDot:2
+8 IF '$TEST
Begin DoDot:2
+9 ;|1| mail to
SET DIR("A")=$$EZBLD^DIALOG(34112,XMTYPE)
+10 ;Send
IF XMTYPE=$$EZBLD^DIALOG(34110)
SET DIR("B")=$GET(XMINSTR("TO PROMPT"),XMV("NAME"))
+11 IF '$TEST
IF $GET(XMINSTR("TO PROMPT"))
SET DIR("B")=XMINSTR("TO PROMPT")
+12 SET DIR(0)="Fr^1:100"
End DoDot:2
+13 ;Enter the name(s) of the recipient(s)
DO BLD^DIALOG(34114,"","","DIR(""?"")")
+14 SET DIR("??")="^D QQ^XMJMT"
+15 DO ^DIR
IF $DATA(DTOUT)
SET XMABORT=DTIME
QUIT
+16 IF $DATA(DUOUT)
Begin DoDot:2
+17 ;Forward
IF XMTYPE=$$EZBLD^DIALOG(34111)
SET XMABORT=1
QUIT
+18 NEW DIR,DIRUT,X,Y
+19 ;Shall we forget the whole thing
SET DIR("A")=$$EZBLD^DIALOG(34115)
+20 ;No
SET DIR("B")=$$EZBLD^DIALOG(39053)
+21 SET DIR(0)="Y"
+22 ;Enter YES to abort this message.
DO BLD^DIALOG(34116,"","","DIR(""?"")")
+23 DO ^DIR
+24 IF Y=1!$DATA(DIRUT)
SET XMABORT=1
End DoDot:2
QUIT
+25 SET XMTO=Y
if XMTO=""
QUIT
+26 IF $GET(XMRESTR("NOFPG"))
IF $EXTRACT(XMTO,1,2)="G."
Begin DoDot:2
+27 ;Only the message originator or XM GROUP PRIORITY key
+28 ;holders may forward priority messages to Mail Groups.
+29 NEW XMTEXT
+30 DO BLD^DIALOG(34117,"","","XMTEXT","F")
+31 DO MSG^DIALOG("WE","","","","XMTEXT")
End DoDot:2
QUIT
+32 IF $GET(XMRESTR("NONET"))
IF XMTO["@"
Begin DoDot:2
+33 NEW XMTEXT
+34 WRITE $CHAR(7)
+35 ;Messages longer than |1| lines may not be sent across the network.
+36 DO BLD^DIALOG(39001,XMRESTR("NONET"),"","XMTEXT","F")
+37 DO MSG^DIALOG("WE","","","","XMTEXT")
End DoDot:2
QUIT
+38 ; to avoid ambiguity in case 2 users have the same name.
IF XMTO=XMV("NAME")
IF $GET(DIR("B"))=XMV("NAME")
SET XMTO="`"_XMDUZ
+39 DO ADDR^XMXADDR(XMDUZ,XMTO,.XMINSTR,.XMRESTR)
End DoDot:1
if XMTO=""!XMABORT
QUIT
+40 QUIT
QQ ; "??" help
+1 ;*49
NEW DIR,X,Y,XMCHOICE,I,DIRUT,DUOUT,DTOUT
+2 ;Enter the kind of help you'd like
SET DIR("A")=$$EZBLD^DIALOG(34120)
+3 ;U:User information
SET I=$$EZBLD^DIALOG(34126)
SET XMCHOICE($PIECE(I,":"))="U"
+4 SET DIR(0)="SO^"_I
+5 ;G:Mail Group information
SET I=$$EZBLD^DIALOG(34121)
SET XMCHOICE($PIECE(I,":"))="G"
+6 SET DIR(0)=DIR(0)_";"_I
+7 ;D:Domain information
SET I=$$EZBLD^DIALOG(34122)
SET XMCHOICE($PIECE(I,":"))="D"
+8 SET DIR(0)=DIR(0)_";"_I
+9 IF $ORDER(^XMD(4.2997,0))
Begin DoDot:1
+10 ;R:Remote user information
SET I=$$EZBLD^DIALOG(34123)
SET XMCHOICE($PIECE(I,":"))="R"
+11 SET DIR(0)=DIR(0)_";"_I
End DoDot:1
+12 IF $DATA(^TMP("XMY0",$JOB))
Begin DoDot:1
+13 ;S:Show current recipients of this message
SET I=$$EZBLD^DIALOG(34124)
SET XMCHOICE($PIECE(I,":"))="S"
+14 SET DIR(0)=DIR(0)_";"_I
End DoDot:1
+15 ;M:More help
SET I=$$EZBLD^DIALOG(34125)
SET XMCHOICE($PIECE(I,":"))="M"
+16 SET DIR(0)=DIR(0)_";"_I
+17 FOR
DO ^DIR
if $DATA(DIRUT)
QUIT
DO @XMCHOICE(Y)
+18 QUIT
S ; Show Current Recipients
+1 ;49
NEW XMTO,XMABORT,DIR,X,Y,DIRUT,DUOUT,DTOUT
+2 ;There aren't any recipients so far.
IF '$DATA(^TMP("XMY0",$JOB))
WRITE !,$$EZBLD^DIALOG(34130)
QUIT
+3 ;Current recipients are:
WRITE @IOF,$$EZBLD^DIALOG(34131)
+4 SET XMTO=""
SET XMABORT=0
+5 FOR
SET XMTO=$ORDER(^TMP("XMY0",$JOB,XMTO))
if XMTO=""
QUIT
Begin DoDot:1
+6 if $Y+3>IOSL
DO PAGE(.XMABORT)
+7 WRITE !,?3,$SELECT($DATA(^TMP("XMY0",$JOB,XMTO,1)):^(1)_":",1:""),XMTO
+8 ;Deliver:
if $DATA(^TMP("XMY0",$JOB,XMTO,"L"))
WRITE ?40,$$EZBLD^DIALOG(34132),$$MMDT^XMXUTIL1(^("L"))
End DoDot:1
if XMABORT
QUIT
+9 if XMABORT
QUIT
+10 if '$DATA(^TMP("XMY",$JOB))
QUIT
+11 SET DIR(0)="Y"
+12 ;Like more detail
SET DIR("A")=$$EZBLD^DIALOG(34133)
+13 ;Yes
SET DIR("B")=$$EZBLD^DIALOG(39054)
+14 DO ^DIR
+15 if Y'=1
QUIT
+16 ;Expanded Recipient List
+17 SET XMTO=""
+18 FOR
SET XMTO=$ORDER(^TMP("XMY",$JOB,XMTO))
if XMTO=""
QUIT
Begin DoDot:1
+19 IF $Y+3>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+20 WRITE !,?3,$SELECT($DATA(^TMP("XMY",$JOB,XMTO,1)):^(1)_":",1:""),$$NAME^XMXUTIL(XMTO)
End DoDot:1
if XMABORT
QUIT
+21 DO PAGE(.XMABORT)
+22 QUIT
PAGE(XMABORT) ;
+1 DO PAGE^XMXUTIL(.XMABORT)
if XMABORT
QUIT
+2 WRITE @IOF
+3 QUIT
U ; User Info
+1 DO HELP^XMHIU
+2 QUIT
G ; Group Info
+1 NEW DIR
+2 DO HELP^XMHIG
+3 QUIT
D ; Domain Info (Replaces QQ2^XMA50)
+1 NEW DIC,X,Y,XMSTATE,XMREC
+2 SET DIC="^DIC(4.2,"
SET DIC(0)="AEQMZ"
+3 FOR
WRITE !
DO ^DIC
if Y<0
QUIT
Begin DoDot:1
+4 SET XMREC=Y(0)
+5 ;Routing indicator:
if $LENGTH($PIECE(XMREC,U,14))
WRITE !,$$EZBLD^DIALOG(34140),$PIECE(XMREC,U,14)
+6 IF $DATA(^XUSEC("XMMGR",DUZ))
Begin DoDot:2
+7 ;MailMan Host Number:
if $LENGTH($PIECE(XMREC,U,12))
WRITE !,$$EZBLD^DIALOG(34141),$PIECE(XMREC,U,12)
+8 ;Security Key:
if $LENGTH($PIECE(XMREC,U,11))
WRITE !,$$EZBLD^DIALOG(34142),$PIECE(XMREC,U,11)
End DoDot:2
+9 ;Relay Domain:
if $PIECE(XMREC,U,3)
WRITE !,$$EZBLD^DIALOG(34143),$PIECE(^DIC(4.2,$PIECE(XMREC,U,3),0),U,1)
+10 SET XMSTATE=$PIECE(XMREC,U,2)
+11 WRITE !,$$EZBLD^DIALOG($SELECT(XMSTATE["C":34144,XMSTATE'["S":34145,1:34146))
+12 ; 34144 - Messages cannot be sent, because this domain is CLOSED
+13 ; 34145 - Messages are QUEUED for later transmission
+14 ; 34146 - Messages are SENT immediately
End DoDot:1
+15 QUIT
R ; Remote User Info (Replaces QQ3A,QQ3B^XMA5)
+1 NEW DIC,X,Y,DR,DA
+2 SET DIC="^XMD(4.2997,"
SET DIC(0)="AEFMQ"
+3 ; Enter LASTNAME, MAIL CODE, or LOCATION
SET DIC("A")=$$EZBLD^DIALOG(34149)
+4 FOR
WRITE !
DO ^DIC
if Y<0
QUIT
Begin DoDot:1
+5 SET DA=+Y
SET DR=0
DO EN^DIQ
End DoDot:1
+6 QUIT
M ;
+1 NEW XQH,DIR,X,Y
+2 SET XQH="XM-U-A-ADDRESS"
+3 DO EN^XQH
+4 QUIT
