source: FOIAVistA/trunk/r/MAILMAN-XM/XMJMS.m@ 1608

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

initial load of FOIAVistA 6/30/08 version

File size: 6.5 KB
Line 
1XMJMS ;ISC-SF/GMB-Interactive Send ;08/24/2001 12:02
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Replaces ^XMA2,^XMA20 (ISC-WASH/CAP/THM)
4 ; Entry points used by MailMan options (not covered by DBIA):
5 ; PAKMAN XMPACK - Load PackMan message
6 ; SEND XMSEND - Send a message
7 ; *** BLOB^XMA2B (Imaging package) calls entry BLOB
8SEND ;
9 N XMSUBJ,XMZ,XMABORT
10 S XMABORT=0
11 D INIT(XMDUZ,.XMABORT) Q:XMABORT
12 D SUBJ(.XMSUBJ,.XMABORT) Q:XMABORT
13 D CRE8XMZ^XMXSEND(XMSUBJ,.XMZ,1) I XMZ<1 S XMABORT=1 Q
14 D:'$G(XMPAKMAN) EDITON(XMDUZ,XMZ,"",.XMBLOB)
15 D PROCESS(XMDUZ,XMZ,XMSUBJ,.XMABORT)
16 D:XMABORT=DTIME HALT($$EZBLD^DIALOG(34260)) ; sending
17 D:'$G(XMPAKMAN) EDITOFF(XMDUZ)
18 D:XMABORT KILLMSG^XMXUTIL(XMZ)
19 Q
20PAKMAN ;
21 N XMPAKMAN,XMLOAD,X,XMR
22 S (XMPAKMAN,XMLOAD)=1
23 D SEND
24 Q
25BLOB ;
26 N XMBLOB,XMOUT
27 S XMBLOB=1
28 D SEND
29 Q
30INIT(XMDUZ,XMABORT) ; Clean up and initialize for Sending a message
31 D CHECK^XMVVITAE
32 I XMDUZ'=DUZ,'$$WPRIV^XMXSEC D Q ; Replaces SUR^XMA22
33 . S XMABORT=1
34 . D SHOW^XMJERR
35 D CHKLOCK(XMDUZ,.XMABORT)
36 Q
37CHKLOCK(XMDUZ,XMABORT) ;
38 ; FYI, The menu system releases all locks upon exit from an option.
39 I $G(XMV("PRIV"),"W")["W" S XMV("NOSEND")=0
40 I 'XMV("NOSEND") D
41 . L +^XMB(3.7,"AD",XMDUZ):0 E S XMV("NOSEND")=1
42 I XMV("NOSEND") D Q ; Replaces TWO^XMA1E
43 . W !,$$EZBLD^DIALOG(37453) ; This session is concurrent with another. You may not do this.
44 . S XMABORT=1
45 Q
46PROCESS(XMDUZ,XMZ,XMSUBJ,XMABORT) ;
47 N XMINSTR,XMRESTR
48 I '$G(XMPAKMAN) D BODY(XMDUZ,XMZ,XMSUBJ,.XMRESTR,.XMABORT) Q:XMABORT
49 I $G(XMBLOB) D ADD^XMA2B K XMBLOB I $D(XMOUT) S XMABORT=1 Q
50 I $G(XMPAKMAN) D PACKIT(XMDUZ,XMZ,XMSUBJ,.XMABORT) Q:XMABORT
51 D INIT^XMXADDR
52 D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34110),.XMINSTR,.XMRESTR,.XMABORT) ; Send
53 I $G(XMPAKMAN),'XMABORT D PSECURE^XMPSEC(XMZ,.XMABORT)
54 D:'XMABORT SENDMSG^XMJMSO(XMDUZ,XMZ,XMSUBJ,.XMINSTR,.XMRESTR,.XMABORT)
55 D CLEANUP^XMXADDR
56 Q
57SUBJ(XMSUBJ,XMABORT) ; ask subject
58 N DIR,X,Y,XMY
59 S DIR("A")=$$EZBLD^DIALOG(34002) ; Subject:
60 S DIR(0)="FOU^3:65"
61 S:$D(XMSUBJ) DIR("B")=XMSUBJ
62 S DIR("?")=$$EZBLD^DIALOG(39403) ; Subject must be from 3 to 65 characters long.
63 S DIR("??")="^D QSUBJ^XMJMS"
64 F D Q:XMY'=""!XMABORT
65 . W !
66 . D ^DIR S XMY=Y
67 . I $D(DTOUT)!$D(DUOUT) S XMABORT=1 Q
68 . D VSUBJ^XMXPARM(.XMY)
69 . I $D(XMERR) D SHOW^XMJERR S XMY=""
70 Q:XMABORT
71 S XMSUBJ=$S(XMY[U:$$ENCODEUP^XMXUTIL1(XMY),1:XMY)
72 Q
73QSUBJ ;
74 ;This is the subject of the message, shown whenever the message is displayed.
75 ;Leading and trailing blanks are deleted.
76 ;Any sequence of 3 or more blanks is reduced to 2 blanks.
77 N XMTEXT
78 D BLD^DIALOG(34261,"","","XMTEXT","F")
79 D MSG^DIALOG("WH","",79,"","XMTEXT")
80 Q:$D(XMSUBJ)
81 W !!,$$EZBLD^DIALOG(34262) ; If you want to send a message with no subject, just press ENTER.
82 Q
83BODY(XMDUZ,XMZ,DIWESUB,XMRESTR,XMABORT) ; Replaces ENT1^XMA2
84 N DIC
85 ;W !,"You may ",$S($D(^XMB(3.9,XMZ,2,0)):"edit",1:"enter")," the ",$S($G(XMPAKMAN):"description of the PackMan",1:"text of the")," message..."
86 W !,$$EZBLD^DIALOG($S($D(^XMB(3.9,XMZ,2,0)):34263.1,1:34263)) ; You may edit/enter the text of the message...
87 S DWPK=1,DWLW=75,DIC="^XMB(3.9,"_XMZ_",2,"
88 D EN^DIWE
89 ; The following $D check is to recover from situations in which a user
90 ; is in the middle of replying to a message, then opens a 2nd session,
91 ; and somehow the reply message stub gets deleted in the 2nd session,
92 ; and when the user returns to the 1st session and sends the reply, it
93 ; says the reply is from * No Name *. A lock on ^XMB(3.7,"AD",XMDUZ)
94 ; is supposed to prevent the second session from doing this, but for
95 ; some reason, at some sites, the second session does not see the lock.
96 ; So we recreate the message stub here, in the 1st session, if it was
97 ; deleted in the 2nd session.
98 I '$D(^XMB(3.9,XMZ,0)) D
99 . N XMSUBJ
100 . S XMSUBJ=$S($D(XMRESTR("REPLYTO")):"R"_XMRESTR("REPLYTO"),1:DIWESUB)
101 . S ^XMB(3.9,XMZ,0)=XMSUBJ
102 . S ^XMB(3.9,"B",$E(XMSUBJ,1,30),XMZ)=""
103 . I '$D(^XMB(3.9,XMZ,.6)) S ^XMB(3.9,XMZ,.6)=DT,^XMB(3.9,"C",DT,XMZ)=""
104 I '$O(^XMB(3.9,XMZ,2,0)) S XMABORT=1 Q
105 D CHKLINES^XMXSEC1(XMDUZ,XMZ,.XMRESTR)
106 Q
107PACKIT(XMDUZ,XMZ,XMSUBJ,XMABORT) ;
108 N XCF,XCN,XMA,XMB0,XMP2,X,Y
109 D ^XMP
110 I X=U,Y=-1 S XMABORT=1
111 Q
112EDITON(XMDUZ,XMZ,XMZR,XMBLOB) ; Note that msg is being edited. Replaces D^XMA0A
113 N XMFDA,XMIENS
114 S XMIENS=XMDUZ_","
115 S XMFDA(3.7,XMIENS,5)=XMZ ; current message/response
116 S XMFDA(3.7,XMIENS,7)=$G(XMZR) ; original message for response
117 S XMFDA(3.7,XMIENS,7.5)=$G(XMBLOB) ; 0/1=BLOB yes/no
118 D FILE^DIE("","XMFDA")
119 Q
120EDITOFF(XMDUZ) ; Note that msg is no longer being edited.
121 N XMFDA,XMIENS
122 S XMIENS=XMDUZ_","
123 S XMFDA(3.7,XMIENS,5)="@"
124 S XMFDA(3.7,XMIENS,7)="@"
125 S XMFDA(3.7,XMIENS,7.5)="@"
126 D FILE^DIE("","XMFDA")
127 Q
128HALT(XMACTION) ;
129 W $C(7),!
130 ;You have timed out while _XMACTION_ a message.
131 ;You can resume when you log back on and re-enter MailMan.
132 ;Do it today, or your text may be purged this evening.
133 N XMTEXT
134 D BLD^DIALOG(34264,XMACTION,"","XMTEXT","F")
135 D MSG^DIALOG("WM","",79,"","XMTEXT")
136 G H^XUS
137RECOVER(XMDUZ,XMZ,XMBLOB) ;
138 N XMTEXT,XMSUBJ,XMABORT
139 S XMABORT=0
140 W $C(7),!
141 ;You have / |1| has an unsent message in your buffer.
142 D BLD^DIALOG($S(XMDUZ=DUZ:34265,1:34265.1),XMV("NAME"),"","XMTEXT","F")
143 I $G(XMV("PRIV"),"W")'["W" D Q
144 . ;Since you don't have 'send' privilege, you may not complete this
145 . ;message. If we delete this message, you'll be able to read and
146 . ;reply to messages in this mailbox. If we leave it alone, you'll
147 . ;be able to read messages, but you won't be able to reply to them.
148 . D BLD^DIALOG(34267,"","","XMTEXT","F")
149 . D MSG^DIALOG("WM","",79,"","XMTEXT")
150 . W !
151 . N DIR,X,Y
152 . S DIR(0)="Y"
153 . S DIR("A")=$$EZBLD^DIALOG(34267.1) ; Shall we delete the message?
154 . S DIR("B")=$$EZBLD^DIALOG(39054) ; YES
155 . D ^DIR
156 . I $D(DTOUT) D HALT($$EZBLD^DIALOG(34221)) ; recovering
157 . I Y D Q
158 . . D EDITOFF(XMDUZ)
159 . . D KILLMSG^XMXUTIL(XMZ)
160 . S XMV("NOSEND")=1
161 . W !
162 . ;OK, you'll be able to read messages,
163 . ;but you won't be able to reply to them.
164 . D BLD^DIALOG(34267.2,"","","XMTEXT","F")
165 . D MSG^DIALOG("WM","",79,"","XMTEXT")
166 S XMSUBJ=$P(^XMB(3.9,XMZ,0),U,1)
167 S:XMSUBJ["~U~" XMSUBJ=$$DECODEUP^XMXUTIL1(XMSUBJ)
168 ;Subj: _XMSUBJ
169 D BLD^DIALOG(34536,XMSUBJ,"","XMTEXT","FS")
170 ;Some of the text may have been lost.
171 ;You must re-enter recipients and any special handling instructions.
172 D BLD^DIALOG(34266,"","","XMTEXT","FS")
173 D MSG^DIALOG("WM","",79,"","XMTEXT")
174 W !
175 D INIT(XMDUZ,.XMABORT) Q:XMV("NOSEND")
176 D WAIT^XMXUTIL
177 I XMABORT D HALT($$EZBLD^DIALOG(34221)) ; recovering
178 D PROCESS(XMDUZ,XMZ,XMSUBJ,.XMABORT)
179 I XMABORT=DTIME D HALT($$EZBLD^DIALOG(34260)) ; sending
180 D EDITOFF(XMDUZ)
181 D:XMABORT KILLMSG^XMXUTIL(XMZ)
182 Q
Note: See TracBrowser for help on using the repository browser.