source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMXGRP1.m@ 703

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

initial load of WorldVistAEHR

File size: 5.2 KB
Line 
1XMXGRP1 ;ISC-SF/GMB-Group creation/enrollment (cont.) ;04/17/2002 14:10
2 ;;8.0;MailMan;;Jun 28, 2002
3FAFMSGS(XMDUZ,XMGRP,XMTO,XMINSTR,ZTSK) ; Create task to find and forward messages
4 ; The following line can be deleted once we enable "A":
5 S XMINSTR("FLAGS")=$TR($G(XMINSTR("FLAGS")),"A") Q:$G(XMINSTR("FLAGS"))'["F"
6 N ZTSAVE,ZTDESC,ZTRTN,ZTDTH,ZTIO,I
7 S ZTDESC=$$EZBLD^DIALOG(38023.8) ; MailMan: Find & Forward mail group messages
8 S ZTIO="",ZTDTH=$H,ZTRTN="FAFTSK^XMXGRP1"
9 F I="DUZ","XMDUZ","XMGRP*","XMTO*","XMINSTR(" S ZTSAVE(I)=""
10 D ^%ZTLOAD
11 Q
12FAFTSK ; Find and add/forward messages
13 N XMFDATE,XMTDATE,XMGROUP,XMX,XMFIRST,XMABORT
14 S XMABORT=0
15 D INIT Q:XMABORT
16 D PROCESS
17 D CLEANUP^XMXADDR
18 K ^TMP("XM",$J,"SAVE")
19 Q
20PROCESS ;
21 I XMINSTR("FLAGS")["A",XMINSTR("FLAGS")["F" D Q ; Forward some of the messages to the users, and add the users to the rest of the messages.
22 . D SAVFWD(.XMX)
23 . I XMFIRST<XMFDATE D
24 . . D CHKADD(.XMX) Q:'$D(^TMP("XMY",$J))
25 . . D ADDFWD(XMDUZ,.XMGROUP,"A",XMFIRST,XMFDATE-1,.XMX) ; add
26 . . M ^TMP("XMY",$J)=^TMP("XM",$J,"SAVE")
27 . D ADDFWD(XMDUZ,.XMGROUP,"F",XMFDATE,XMTDATE,.XMX) ; forward
28 . I XMTDATE<DT D
29 . . I XMX("RESTORE") M ^TMP("XMY",$J)=^TMP("XM",$J,"SAVE") S XMX("RESTORE")=0
30 . . D CHKADD(.XMX) Q:'$D(^TMP("XMY",$J))
31 . . D ADDFWD(XMDUZ,.XMGROUP,"A",XMTDATE+.1,DT,.XMX) ; add
32 I XMINSTR("FLAGS")["F" D Q ; Just forward messages to users
33 . D SAVFWD(.XMX)
34 . D ADDFWD(XMDUZ,.XMGROUP,"F",XMFDATE,XMTDATE,.XMX) ; forward
35 I XMINSTR("FLAGS")["A" D Q ; Just add users to messages
36 . D CHKADD(.XMX) Q:'$D(^TMP("XMY",$J))
37 . D ADDFWD(XMDUZ,.XMGROUP,"A",XMFDATE,XMTDATE,.XMX) ; add
38 Q
39INIT ;
40 N XMPRIVAT,XMGN,XMI
41 S ZTREQ="@"
42 S XMPRIVAT=$$EZBLD^DIALOG(39135) ; " [Private Mail Group]"
43 S XMFIRST=$O(^XMB(3.9,"C",2500000)) ; earliest message date (after 1950!)
44 S XMFDATE=$G(XMINSTR("FDATE"),XMFIRST)
45 S XMTDATE=$G(XMINSTR("TDATE"),DT)
46 D INITAPI^XMVVITAE
47 D INIT^XMXADDR
48 D CHKADDR^XMXADDR(XMDUZ,.XMTO)
49 I '$$GOTADDR^XMXADDR S XMABORT=1 Q
50 I $G(XMGRP)]"" S XMGRP(XMGRP)=$O(^XMB(3.8,"B",XMGRP,0))
51 S XMGN=""
52 F S XMGN=$O(XMGRP(XMGN)) Q:XMGN="" D
53 . S XMI=XMGRP(XMGN)
54 . S XMGROUP("G."_XMGN_$S($P($G(^XMB(3.8,XMI,0)),U,2)="PR":XMPRIVAT,1:""))=XMI
55 K XMGRP
56 I $D(XMINSTR("SELF BSKT")) S XMX("SELF BSKT")=XMINSTR("SELF BSKT")
57 Q
58SAVFWD(XMX) ;
59 S XMX("RESTORE")=0
60 M ^TMP("XM",$J,"SAVE")=^TMP("XMY",$J)
61 S XMX("ONE")=$O(^TMP("XMY",$J,"")) ; First recipient. Is it the only one?
62 I $O(^TMP("XMY",$J,XMX("ONE")))'="" S XMX("ONE")=0 ; There's more than one recipient
63 Q
64CHKADD(XMX) ;
65 S XMX("FWDBY")=XMV("NAME")_$S(XMDUZ=DUZ:"",1:$$EZBLD^DIALOG(38008,XMV("DUZ NAME")))_" "_$$MMDT^XMXUTIL1($$NOW^XLFDT) ; " (Surrogate: _x_)"
66 S XMI=0 ; Delete any remote addresses - responses won't be forwarded.
67 F S XMI=$O(^TMP("XMY",$J,XMI)) Q:XMI="" K:+XMI'=XMI ^(XMI)
68 Q
69ADDFWD(XMDUZ,XMGROUP,XMWHAT,XMFDATE,XMTDATE,XMX) ;
70 N XMZ,XMCRE8,XMGN
71 S XMZ=0
72 S XMCRE8=XMFDATE-.1
73 F S XMCRE8=$O(^XMB(3.9,"C",XMCRE8)) Q:'XMCRE8 Q:XMCRE8>XMTDATE D Q:$G(ZTSTOP)
74 . I $$S^%ZTLOAD S ZTSTOP=1 Q
75 . F S XMZ=$O(^XMB(3.9,"C",XMCRE8,XMZ)) Q:'XMZ D
76 . . Q:$$ZCLOSED^XMXSEC(XMZ) ; Message is closed
77 . . S XMGN=""
78 . . F S XMGN=$O(XMGROUP(XMGN)) Q:XMGN="" Q:$S($L(XMGN)<31:$D(^XMB(3.9,XMZ,6,"B",XMGN)),$D(^XMB(3.9,XMZ,6,"B",$E(XMGN,1,30))):(XMGN=$P($G(^XMB(3.9,XMZ,6,+$O(^XMB(3.9,XMZ,6,"B",$E(XMGN,1,30),0)),0)),U,1)),1:0)
79 . . Q:XMGN="" ; Message is not addressed to any of the groups
80 . . I XMWHAT="F" D FWD(XMDUZ,XMZ,.XMX) Q
81 . . D ADD(XMDUZ,XMZ,.XMX)
82 Q
83FWD(XMDUZ,XMZ,XMX) ; Forward the message to the user
84 N XMINSTR
85 I $D(XMX("SELF BSKT")) S XMINSTR("SELF BSKT")=XMX("SELF BSKT")
86 I XMX("ONE")'=0 Q:$D(^XMB(3.9,XMZ,1,"C",XMX("ONE"))) ; User already on msg.
87 I XMX("ONE")=0 D Q:'$D(^TMP("XMY",$J))
88 . I XMX("RESTORE") M ^TMP("XMY",$J)=^TMP("XM",$J,"SAVE") S XMX("RESTORE")=0
89 . N XMI
90 . S XMI=""
91 . F S XMI=$O(^TMP("XMY",$J,XMI)) Q:XMI="" D
92 . . Q:'$D(^XMB(3.9,XMZ,1,"C",XMI)) ; User not yet on msg.
93 . . K ^TMP("XMY",$J,XMI) ; User on msg - don't forward to user.
94 . . S XMX("RESTORE")=1
95 D FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
96 Q
97ADD(XMDUZ,XMZ,XMX) ; Add user(s) to message.
98 ; XMX("FWDBY")
99 N XMI,XMFDA,XMIENS,XMPRI
100 S XMPRI=$$ZPRI^XMXUTIL2(XMZ) ; Is msg priority?
101 ; Put users into RECIPIENT multiple
102 S XMI=0
103 F S XMI=$O(^TMP("XMY",$J,XMI)) Q:'XMI D
104 . Q:$D(^XMB(3.9,XMZ,1,"C",XMI)) ; User already on msg - don't add.
105 . D NEW^XMKP(XMZ,XMPRI,XMI,$G(^TMP("XMY",$J,XMI,1)),.XMFDA,.XMIENS) ; New recipient
106 . S XMFDA(3.91,XMIENS,8)=XMX("FWDBY") ; fwd by name date time
107 . S XMFDA(3.91,XMIENS,8.01)=XMDUZ ; fwd by duz
108 . ; Need new field that says 'parked until next reply'.
109 . D UPDATE^DIE("","XMFDA")
110 Q
111NOTIFY(XMG,XMNEWMBR) ; If the group is restricted in any way,
112 ; notify the organizer & coordinator of the new members.
113 N XMREC,XMTO,I
114 S XMREC=^XMB(3.8,XMG,0)
115 I $P(XMREC,U,2)="PU",$P(XMREC,U,3)="y" Q
116 S I=$P($G(^XMB(3.8,XMG,3)),U) S:I XMTO(I)="" ; organizer
117 S I=$P(XMREC,U,7) S:I XMTO(I)="" ; coordinator
118 Q:$D(XMTO(DUZ))
119 N XMPARM,XMTEXT,XMINSTR,XMNAME,J
120 S I=0 F S I=$O(XMNEWMBR(I)) Q:'I S XMNAME($$NAME^XMXUTIL(I,1))=""
121 S J="" F I=1:1 S J=$O(XMNAME(J)) Q:J="" S XMTEXT(I)=J
122 S XMINSTR("FROM")=.5
123 S XMPARM(1)=$$NAME^XMXUTIL(DUZ),XMPARM(2)=$P(^XMB(3.8,XMG,0),U,1)
124 D TASKBULL^XMXBULL(DUZ,"XM GROUP EDIT NOTIFY",.XMPARM,"XMTEXT",.XMTO,.XMINSTR)
125 Q
Note: See TracBrowser for help on using the repository browser.