source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMAI2.m@ 949

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1XMAI2 ;ISC-SF/GMB -Send a message if too many messages ;04/19/2002 12:41
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Was (WASH ISC)/CAP/L.RHODE
4 ; Entry points used by MailMan options (not covered by DBIA):
5 ; ENTER XMMGR-DISK-MANY-MESSAGE-MAINT
6ENTER ;
7 N XMMAX,XMSAVE,XMABORT,I
8 S XMABORT=0
9 D INIT(.XMMAX,.XMABORT) Q:XMABORT
10 I $D(ZTQUEUED) D PROCESS Q
11 F I="XMMAX" S XMSAVE(I)="" ;MailMan: Many Msg Maint Request
12 D EN^XUTMDEVQ("PROCESS^XMAI2",$$EZBLD^DIALOG(36600),.XMSAVE)
13 Q
14INIT(XMMAX,XMABORT) ;
15 S XMMAX=500 ; Threshold number of messages a user can own
16 Q:$D(ZTQUEUED)
17 N DIR,Y,DIRUT,XMTEXT
18 W !
19 ;This option sends a message to every user who has more than a
20 ;certain number of messages in his or her mailbox, asking the user
21 ;to terminate unnecessary messages.
22 D BLD^DIALOG(36601,"","","XMTEXT","F")
23 D MSG^DIALOG("WM","","","","XMTEXT")
24 W !
25 S DIR(0)="N^10::"
26 S DIR("A")=$$EZBLD^DIALOG(36602) ;Enter the 'many message' threshold
27 S DIR("B")=XMMAX
28 D BLD^DIALOG(36603,"","","DIR(""?"")") ;How many messages may a user have before MailMan sends a nastygram?
29 D ^DIR I $D(DIRUT) S XMABORT=1 Q
30 S XMMAX=Y
31 W !
32 ;Messages will be sent to owners of more than |1| messages.
33 ;This option may take awhile - you may wish to queue it.
34 D BLD^DIALOG(36604,XMMAX,"","XMTEXT","F")
35 D MSG^DIALOG("WM","","","","XMTEXT")
36 Q
37PROCESS ; (Requires XMMAX)
38 N XMUSER,XMCNT
39 S XMUSER=.9999
40 F S XMUSER=$O(^XMB(3.7,XMUSER)) Q:XMUSER'>0 D
41 . S XMCNT=$$TMSGCT^XMXUTIL(XMUSER)
42 . D:XMCNT>XMMAX MESSAGE(XMUSER,XMCNT)
43 S:$D(ZTQUEUED) ZTREQ="@"
44 Q
45MESSAGE(XMTO,XMCNT) ; Send message
46 N XMPARM,XMINSTR
47 S XMINSTR("FROM")=.5,XMINSTR("FLAGS")="I"
48 S XMPARM(1)=XMCNT,XMPARM(2)=$$BMSGCT^XMXUTIL(XMTO,1)
49 D TASKBULL^XMXBULL(.5,"XM TOO MANY MESSAGES",.XMPARM,"",XMTO,.XMINSTR)
50 Q
Note: See TracBrowser for help on using the repository browser.