source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMJMT.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.7 KB
RevLine 
[613]1XMJMT ;ISC-SF/GMB-Interactive Send to whom ;07/17/2003 13:06
2 ;;8.0;MailMan;**20**;Jun 28, 2002
3 ; Entry points used by MailMan options (not covered by DBIA):
4 ; R XMHELPLNK - Get help on remote addresses (mail link)
5TOWHOM(XMDUZ,XMTYPE,XMINSTR,XMRESTR,XMABORT) ;
6 N DIR,X,Y,XMTO
7 S XMTO="?"
8 F D Q:XMTO=""!XMABORT
9 . K DIR
10 . I $D(^TMP("XMY0",$J)) D
11 . . S DIR("A")=$$EZBLD^DIALOG(34113,XMTYPE) ;And |1| to
12 . . S DIR(0)="FrO^1:100" ; ('r' means no 'replace...with...' prompt)
13 . E D
14 . . S DIR("A")=$$EZBLD^DIALOG(34112,XMTYPE) ;|1| mail to
15 . . I XMTYPE=$$EZBLD^DIALOG(34110) S DIR("B")=$G(XMINSTR("TO PROMPT"),XMV("NAME")) ;Send
16 . . E I $G(XMINSTR("TO PROMPT")) S DIR("B")=XMINSTR("TO PROMPT")
17 . . S DIR(0)="Fr^1:100"
18 . D BLD^DIALOG(34114,"","","DIR(""?"")") ;Enter the name(s) of the recipient(s)
19 . S DIR("??")="^D QQ^XMJMT"
20 . D ^DIR I $D(DTOUT) S XMABORT=DTIME Q
21 . I $D(DUOUT) D Q
22 . . I XMTYPE=$$EZBLD^DIALOG(34111) S XMABORT=1 Q ;Forward
23 . . N DIR,DIRUT,X,Y
24 . . S DIR("A")=$$EZBLD^DIALOG(34115) ;Shall we forget the whole thing
25 . . S DIR("B")=$$EZBLD^DIALOG(39053) ;No
26 . . S DIR(0)="Y"
27 . . D BLD^DIALOG(34116,"","","DIR(""?"")") ;Enter YES to abort this message.
28 . . D ^DIR
29 . . I Y=1!$D(DIRUT) S XMABORT=1
30 . S XMTO=Y Q:XMTO=""
31 . I $G(XMRESTR("NOFPG")),$E(XMTO,1,2)="G." D Q
32 . . ;Only the message originator or XM GROUP PRIORITY key
33 . . ;holders may forward priority messages to Mail Groups.
34 . . N XMTEXT
35 . . D BLD^DIALOG(34117,"","","XMTEXT","F")
36 . . D MSG^DIALOG("WE","","","","XMTEXT")
37 . I $G(XMRESTR("NONET")),XMTO["@" D Q
38 . . N XMTEXT
39 . . W $C(7)
40 . . ;Messages longer than |1| lines may not be sent across the network.
41 . . D BLD^DIALOG(39001,XMRESTR("NONET"),"","XMTEXT","F")
42 . . D MSG^DIALOG("WE","","","","XMTEXT")
43 . I XMTO=XMV("NAME"),$G(DIR("B"))=XMV("NAME") S XMTO="`"_XMDUZ ; to avoid ambiguity in case 2 users have the same name.
44 . D ADDR^XMXADDR(XMDUZ,XMTO,.XMINSTR,.XMRESTR)
45 Q
46QQ ; "??" help
47 N DIR,X,Y,XMCHOICE,I
48 S DIR("A")=$$EZBLD^DIALOG(34120) ;Enter the kind of help you'd like
49 S I=$$EZBLD^DIALOG(34126),XMCHOICE($P(I,":"))="U" ;U:User information
50 S DIR(0)="SO^"_I
51 S I=$$EZBLD^DIALOG(34121),XMCHOICE($P(I,":"))="G" ;G:Mail Group information
52 S DIR(0)=DIR(0)_";"_I
53 S I=$$EZBLD^DIALOG(34122),XMCHOICE($P(I,":"))="D" ;D:Domain information
54 S DIR(0)=DIR(0)_";"_I
55 I $O(^XMD(4.2997,0)) D
56 . S I=$$EZBLD^DIALOG(34123),XMCHOICE($P(I,":"))="R" ;R:Remote user information
57 . S DIR(0)=DIR(0)_";"_I
58 I $D(^TMP("XMY0",$J)) D
59 . S I=$$EZBLD^DIALOG(34124),XMCHOICE($P(I,":"))="S" ;S:Show current recipients of this message
60 . S DIR(0)=DIR(0)_";"_I
61 S I=$$EZBLD^DIALOG(34125),XMCHOICE($P(I,":"))="M" ;M:More help
62 S DIR(0)=DIR(0)_";"_I
63 F D ^DIR Q:$D(DIRUT) D @XMCHOICE(Y)
64 Q
65S ; Show Current Recipients
66 N XMTO,XMABORT,DIR,X,Y
67 I '$D(^TMP("XMY0",$J)) W !,$$EZBLD^DIALOG(34130) Q ;There aren't any recipients so far.
68 W @IOF,$$EZBLD^DIALOG(34131) ;Current recipients are:
69 S XMTO="",XMABORT=0
70 F S XMTO=$O(^TMP("XMY0",$J,XMTO)) Q:XMTO="" D Q:XMABORT
71 . D:$Y+3>IOSL PAGE(.XMABORT)
72 . W !,?3,$S($D(^TMP("XMY0",$J,XMTO,1)):^(1)_":",1:""),XMTO
73 . W:$D(^TMP("XMY0",$J,XMTO,"L")) ?40,$$EZBLD^DIALOG(34132),$$MMDT^XMXUTIL1(^("L")) ;Deliver:
74 Q:XMABORT
75 Q:'$D(^TMP("XMY",$J))
76 S DIR(0)="Y"
77 S DIR("A")=$$EZBLD^DIALOG(34133) ;Like more detail
78 S DIR("B")=$$EZBLD^DIALOG(39054) ;Yes
79 D ^DIR
80 Q:Y'=1
81 ;Expanded Recipient List
82 S XMTO=""
83 F S XMTO=$O(^TMP("XMY",$J,XMTO)) Q:XMTO="" D Q:XMABORT
84 . I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
85 . W !,?3,$S($D(^TMP("XMY",$J,XMTO,1)):^(1)_":",1:""),$$NAME^XMXUTIL(XMTO)
86 D PAGE(.XMABORT)
87 Q
88PAGE(XMABORT) ;
89 D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
90 W @IOF
91 Q
92U ; User Info
93 D HELP^XMHIU
94 Q
95G ; Group Info
96 N DIR
97 D HELP^XMHIG
98 Q
99D ; Domain Info (Replaces QQ2^XMA50)
100 N DIC,X,Y,XMSTATE,XMREC
101 S DIC="^DIC(4.2,",DIC(0)="AEQMZ"
102 F W ! D ^DIC Q:Y<0 D
103 . S XMREC=Y(0)
104 . W:$L($P(XMREC,U,14)) !,$$EZBLD^DIALOG(34140),$P(XMREC,U,14) ;Routing indicator:
105 . I $D(^XUSEC("XMMGR",DUZ)) D
106 . . W:$L($P(XMREC,U,12)) !,$$EZBLD^DIALOG(34141),$P(XMREC,U,12) ;MailMan Host Number:
107 . . W:$L($P(XMREC,U,11)) !,$$EZBLD^DIALOG(34142),$P(XMREC,U,11) ;Security Key:
108 . W:$P(XMREC,U,3) !,$$EZBLD^DIALOG(34143),$P(^DIC(4.2,$P(XMREC,U,3),0),U,1) ;Relay Domain:
109 . S XMSTATE=$P(XMREC,U,2)
110 . W !,$$EZBLD^DIALOG($S(XMSTATE["C":34144,XMSTATE'["S":34145,1:34146))
111 . ; 34144 - Messages cannot be sent, because this domain is CLOSED
112 . ; 34145 - Messages are QUEUED for later transmission
113 . ; 34146 - Messages are SENT immediately
114 Q
115R ; Remote User Info (Replaces QQ3A,QQ3B^XMA5)
116 N DIC,X,Y,DR,DA
117 S DIC="^XMD(4.2997,",DIC(0)="AEFMQ"
118 S DIC("A")=$$EZBLD^DIALOG(34149) ; Enter LASTNAME, MAIL CODE, or LOCATION
119 F W ! D ^DIC Q:Y<0 D
120 . S DA=+Y,DR=0 D EN^DIQ
121 Q
122M ;
123 N XQH,DIR,X,Y
124 S XQH="XM-U-A-ADDRESS"
125 D EN^XQH
126 Q
Note: See TracBrowser for help on using the repository browser.