- 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 Feb 18, 2025@23:38:33 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