source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMKP.m@ 1361

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

initial load of WorldVistAEHR
File size: 9.0 KB
RevLine 
[613]1XMKP ;ISC-SF/GMB-Address and Post msg ;09/17/2002 12:52
2 ;;8.0;MailMan;**1**;Jun 28, 2002
3 ; Replaces ENT1^XMAD1,ENT^XMAD1,FINAL^XMAD1X (ISC-WASH/CAP)
4SEND(XMDUZ,XMZ,XMINSTR) ;
5 ; XMINSTR("SHARE DATE") Delete date for mail addressed to SHARED,MAIL
6 ; XMINSTR("SHARE BSKT") Basket for mail addressed to SHARED,MAIL
7 ; XMINSTR("SELF BSKT") Basket to deliver to if recipient is the sender
8 N XMTOCNT,XMPRI,XMINST
9 S XMPRI=($G(XMINSTR("FLAGS"))["P")
10 D SADDRTO(XMDUZ,XMZ) ; Populate ADDRESSED TO multiple
11 D SRECIP(XMDUZ,XMZ,XMPRI,.XMTOCNT) ; Populate RECIPIENT multiple
12 I XMTOCNT!$$BRODCAST D SPOST(XMDUZ,XMZ,XMTOCNT,.XMINSTR)
13 S XMINST=""
14 F S XMINST=$O(^XMB(3.9,XMZ,1,"AQUEUE",XMINST)) Q:'XMINST D
15 . D REMOTE^XMKPR(XMZ,XMINST)
16 D:$D(^XMB(3.9,XMZ,1,"AFAX")) FAX^XMFAX(XMZ)
17 Q
18SPOST(XMDUZ,XMZ,XMTOCNT,XMINSTR) ;
19 N XMTSTAMP,XMPREC
20 S XMTSTAMP=$$TSTAMP^XMXUTIL1
21 S XMPREC=XMTOCNT
22 I $D(^TMP("XMY",$J,XMDUZ)) D
23 . S $P(XMPREC,U,2)=$G(XMINSTR("SELF BSKT"),1)
24 I $D(^TMP("XMY",$J,.6)) D
25 . S $P(XMPREC,U,3,4)=$G(XMINSTR("SHARE BSKT"),1)_U_$G(XMINSTR("SHARE DATE"),$$FMADD^XLFDT(DT,30))
26 I $$BRODCAST D
27 . S $P(XMPREC,U,1)=$P(^XMB(3.7,0),U,4)
28 . S $P(XMPREC,U,5)="*"
29 S ^XMBPOST("BOX",XMTSTAMP,"M",XMZ)=XMPREC
30 Q
31BRODCAST() ;
32 Q $D(^TMP("XMY",$J,$$EZBLD^DIALOG(39006))) ; * (Broadcast to all local users)
33SRECIP(XMDUZ,XMZ,XMPRI,XMTOCNT) ; "Send" to recipients
34 N XMTO,XMFDA,XMIEN,XMIENS,XMPREFIX,XMNOW
35 ; Put addressees into RECIPIENT multiple
36 S XMTO="",XMTOCNT=0
37 F S XMTO=$O(^TMP("XMY",$J,XMTO)) Q:XMTO="" D
38 . K XMPREFIX,XMIEN
39 . D NEW(XMZ,XMPRI,XMTO,$G(^TMP("XMY",$J,XMTO,1)),.XMFDA,.XMIENS) ; New recipient
40 . I $D(^TMP("XMY",$J,XMTO,"F")) D
41 . . S:'$D(XMNOW) XMNOW=$$MMDT^XMXUTIL1($P(^XMB(3.9,XMZ,0),U,3))
42 . . D RCPTFWD^XMKP1("S",XMTO,.XMFDA,XMIENS,XMNOW)
43 . I +XMTO=XMTO S XMTOCNT=XMTOCNT+1
44 . E D STATUS(XMTO,.XMFDA,XMIENS,.XMPREFIX) ; Transmission Status
45 . D UPDATE^DIE("","XMFDA","XMIEN")
46 . S XMIENS=XMIEN(1)_","_XMZ_","
47 . I ".D.H.S."[("."_$G(XMPREFIX)_".") D OPOST(XMDUZ,XMZ,XMTO,XMIENS,XMPREFIX)
48 Q
49SADDRTO(XMDUZ,XMZ) ; Put addressees into ADDRESSED TO multiple
50 N XMTO
51 S XMTO=""
52 F S XMTO=$O(^TMP("XMY0",$J,XMTO)) Q:XMTO="" D ADDRTO(XMDUZ,XMZ,XMTO)
53 Q
54ADDRTO(XMDUZ,XMZ,XMTO) ;
55 N XMFDA,XMPREFIX,XMMULT
56 S XMPREFIX=$G(^TMP("XMY0",$J,XMTO,1))
57 I $D(^TMP("XMY0",$J,XMTO,"L")) D
58 . I XMTO=XMV("NAME") D Q
59 . . D LTRADD^XMJMD(XMDUZ,XMZ,$G(^TMP("XMY0",$J,XMTO,"L")))
60 . . S XMMULT=3.911
61 . S XMMULT=3.914
62 . S XMFDA(3.914,"?+1,"_XMZ_",",2)=XMDUZ
63 . S XMFDA(3.914,"?+1,"_XMZ_",",3)=XMV("NAME")_$S(XMDUZ=DUZ:"",1:$$EZBLD^DIALOG(38008,XMV("DUZ NAME"))) ; " (Surrogate: _x_)"
64 . S XMFDA(3.914,"?+1,"_XMZ_",",4)=^TMP("XMY0",$J,XMTO,"L")
65 E S XMMULT=3.911
66 S XMFDA(XMMULT,"?+1,"_XMZ_",",.01)=XMTO
67 S:XMPREFIX'="" XMFDA(XMMULT,"?+1,"_XMZ_",",1)=XMPREFIX
68 D UPDATE^DIE("","XMFDA")
69 Q
70NEW(XMZ,XMPRI,XMTO,XMTYPE,XMFDA,XMIENS) ;
71 S XMIENS="+1,"_XMZ_","
72 S XMFDA(3.91,XMIENS,.01)=XMTO
73 ; If addressee is also the creator of the msg, then I: or C: does not
74 ; apply.
75 I $G(XMTYPE)'="" S XMFDA(3.91,XMIENS,6.5)=XMTYPE
76 I XMPRI,XMTO=+XMTO,$P($G(^XMB(3.7,XMTO,0)),U,11) S XMFDA(3.91,XMIENS,10)=$P(^(0),U,11) ; Priority response flag
77 Q
78STATUS(XMTO,XMFDA,XMIENS,XMPREFIX) ;
79 I $E(XMTO,1,2)="F.",$P(^XMB(1,1,0),U,19),$D(^AKF("FAXR")),$E(XMTO,3,99)=$P($G(^AKF("FAXR",^TMP("XMY",$J,XMTO),0)),U) D Q
80 . S XMFDA(3.91,XMIENS,5)=$$EZBLD^DIALOG(39303.5) ; Awaiting Fax.
81 . S XMFDA(3.91,XMIENS,13)=^TMP("XMY",$J,XMTO)
82 I XMTO["@" D Q
83 . S XMFDA(3.91,XMIENS,5)=$$EZBLD^DIALOG(39303.1) ; Awaiting transmission.
84 . S XMFDA(3.91,XMIENS,6)=^TMP("XMY",$J,XMTO) ; sets x-ref "AQUEUE"
85 I $E(XMTO,2,2)="." D
86 . S XMPREFIX=$E(XMTO,1,1) ; We know it is upper case
87 . Q:"SDH"'[XMPREFIX
88 . S XMFDA(3.91,XMIENS,5)=$$EZBLD^DIALOG($S(XMPREFIX="S":39303.2,XMPREFIX="D":39303.3,1:39303.4)) ; "Awaiting Server."/"Awaiting Device."/"Awaiting H.Device."
89 Q
90OPOST(XMDUZ,XMZ,XMTO,XMIENS,XMPREFIX) ;
91 I XMPREFIX="S" D SERVER^XMKPO(XMZ,XMTO,XMIENS) Q
92 I XMPREFIX="D" D DEVICE^XMKPO(XMDUZ,XMZ,XMTO,XMIENS,1) Q
93 I XMPREFIX="H" D DEVICE^XMKPO(XMDUZ,XMZ,XMTO,XMIENS,0) Q ; Headerless
94 Q
95FWD(XMDUZ,XMZ,XMINSTR) ;
96 ; XMFWDTYP fwding person recipient type: I:, CC:
97 ; XMPRI 1=msg is priority msg; 0=not
98 ; XMINSTR("SHARE DATE") Delete date for mail addressed to SHARED,MAIL
99 ; XMINSTR("SHARE BSKT") Basket for mail addressed to SHARED,MAIL
100 ; XMINSTR("FWD BY") String to replace standard 'Forwarded by'
101 ; XMTOLIST Array of local recipients
102 ; XMTOCNT Number of valid recipients
103 N XMTOLIST,XMPRI,XMFWDTYP,XMIEN,XMREMOTE,XMINST
104 S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0)) ; May have been fwd'd by a remote person
105 S XMFWDTYP=$S('XMIEN:"",1:$P($G(^XMB(3.9,XMZ,1,XMIEN,"T")),U))
106 S XMPRI=($P(^XMB(3.9,XMZ,0),U,7)["P")
107 D FADDRTO(XMDUZ,XMZ) ; Populate ADDRESSED TO multiple
108 D FRECIP(XMDUZ,XMZ,.XMINSTR,XMFWDTYP,XMPRI,.XMTOLIST,.XMREMOTE)
109 D:XMTOLIST(1)'=""!$$BRODCAST FPOST(XMDUZ,XMZ,.XMTOLIST,.XMINSTR)
110 S XMINST=""
111 F S XMINST=$O(XMREMOTE(XMINST)) Q:'XMINST D
112 . D REMOTE^XMKPR(XMZ,XMINST)
113 D:$D(^XMB(3.9,XMZ,1,"AFAX")) FAX^XMFAX(XMZ)
114 Q
115FADDRTO(XMDUZ,XMZ) ; Put addressees into ADDRESSED TO multiple
116 N XMTO
117 S XMTO=""
118 F S XMTO=$O(^TMP("XMY0",$J,XMTO)) Q:XMTO="" D
119 . I '$$FIND1^DIC(3.911,","_XMZ_",","QX",XMTO,"B") D Q
120 . . D ADDRTO(XMDUZ,XMZ,XMTO)
121 . Q:'$D(^TMP("XMY0",$J,XMTO,"L"))
122 . I XMTO=XMV("NAME") D Q
123 . . D LTRADD^XMJMD(XMDUZ,XMZ,$G(^TMP("XMY0",$J,XMTO,"L")))
124 . N XMFDA,XMIENS
125 . S XMIENS="?+1,"_XMZ_","
126 . S XMFDA(3.914,XMIENS,.01)=XMTO
127 . ; we ignore any 'prefix' because these addressees are already on the msg
128 . S XMFDA(3.914,XMIENS,2)=XMDUZ
129 . S XMFDA(3.914,XMIENS,3)=XMV("NAME")_$S(XMDUZ=DUZ:"",1:$$EZBLD^DIALOG(38008,XMV("DUZ NAME"))) ; " (Surrogate: _x_)"
130 . S XMFDA(3.914,XMIENS,4)=^TMP("XMY0",$J,XMTO,"L")
131 . D UPDATE^DIE("","XMFDA")
132 Q
133FPOST(XMDUZ,XMZ,XMTOLIST,XMINSTR) ; For local delivery
134 N XMTSTAMP,XMTOCNT,I,XMUID,XMPREC
135 S XMTSTAMP=$$TSTAMP^XMXUTIL1
136 I $D(^TMP("XMY",$J,XMDUZ)) D
137 . S $P(XMPREC,U,2)=$G(XMINSTR("SELF BSKT"),1)
138 I $D(^TMP("XMY",$J,.6)) D
139 . S $P(XMPREC,U,3,4)=$G(XMINSTR("SHARE BSKT"),1)_U_$G(XMINSTR("SHARE DATE"),$$FMADD^XLFDT(DT,30))
140 S XMUID=XMZ_U_$S(XMDUZ=.6:DUZ,1:XMDUZ)_U_$J
141 S (I,XMTOCNT)=0
142 I XMTOLIST(1)'="" F S I=$O(XMTOLIST(I)) Q:I="" D
143 . S XMTOCNT=XMTOCNT+$L(XMTOLIST(I),U)-1
144 . S ^XMBPOST("FWD",XMUID_U_XMTSTAMP,I)=$P(XMTOLIST(I),U,2,999)
145 I $$BRODCAST D
146 . S $P(XMPREC,U,1)=$P(^XMB(3.7,0),U,4)
147 . S $P(XMPREC,U,5)="*"
148 . I $P(^XMB(3.9,XMZ,0),U,12)'="y" S $P(^(0),U,12)="y" ; If not info only, make it so.
149 E S $P(XMPREC,U,1)=XMTOCNT
150 S ^XMBPOST("BOX",XMTSTAMP,"M",XMUID)=XMPREC
151 Q
152FRECIP(XMDUZ,XMZ,XMINSTR,XMFWDTYP,XMPRI,XMTOLIST,XMREMOTE) ; "Forward" to recipients
153 ; XMFWDBY Forwarded by: name (surrogate)
154 N XMTO,XMX,XMIEN,XMFDA,XMIENS,XMPREFIX,XMFWDBY,XMNOW
155 S XMNOW=$$MMDT^XMXUTIL1($$NOW^XLFDT)
156 S XMFWDBY=$S($D(XMINSTR("FWD BY")):XMINSTR("FWD BY"),1:XMV("NAME")_$S(XMDUZ=DUZ:"",1:$$EZBLD^DIALOG(38008,XMV("DUZ NAME")))) ; " (Surrogate: _x_)"
157 ; Put addressees into RECIPIENT multiple
158 S XMTO="",XMX=1,XMTOLIST(XMX)=""
159 F S XMTO=$O(^TMP("XMY",$J,XMTO)) Q:XMTO="" D
160 . K XMPREFIX
161 . I +XMTO=XMTO D
162 . . S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMTO,0))
163 . E S XMIEN=$$FIND1^DIC(3.91,","_XMZ_",",$S(XMTO["@":"O",1:"QX"),XMTO,"C")
164 . I +XMIEN=0 D ; New recipient
165 . . N XMTYPE
166 . . ; If you are an info only recipient, then so is anyone you fwd to.
167 . . S XMTYPE=$S(XMFWDTYP'="":XMFWDTYP,1:$G(^TMP("XMY",$J,XMTO,1)))
168 . . D NEW(XMZ,XMPRI,XMTO,XMTYPE,.XMFDA,.XMIENS) ; New recipient
169 . E D
170 . . S XMIENS=XMIEN_","_XMZ_","
171 . . S:$G(^XMB(3.9,XMZ,1,XMIEN,"D")) XMFDA(3.91,XMIENS,7)="@" ; Unterminate
172 . I +XMTO'=XMTO D
173 . . D STATUS(XMTO,.XMFDA,XMIENS,.XMPREFIX) ; Transmission Status
174 . . S:$D(XMFDA(3.91,XMIENS,6)) XMREMOTE(XMFDA(3.91,XMIENS,6))=""
175 . I $D(^TMP("XMY",$J,XMTO,"F")) D
176 . . D RCPTFWD^XMKP1("F",XMTO,.XMFDA,XMIENS,XMNOW,XMFWDBY)
177 . E D
178 . . S XMFDA(3.91,XMIENS,8)=XMFWDBY_" "_XMNOW ; fwd by name date time
179 . . I '$D(XMINSTR("FWD BY"))!$D(XMINSTR("FWD BY XMDUZ")) S XMFDA(3.91,XMIENS,8.01)=XMDUZ ; fwd by duz
180 . I '$D(XMFDA(3.91,XMIENS,8.02)) D ; Filter-Forward or Regular-Forward
181 . . S XMFDA(3.91,XMIENS,8.02)=$S($G(XMINSTR("FWD BY XMDUZ"))="F":"F",1:"@")
182 . I XMIEN D
183 . . I '$D(XMFDA(3.91,XMIENS,8.03)) D
184 . . . S XMFDA(3.91,XMIENS,8.03)="@"
185 . . . S XMFDA(3.91,XMIENS,8.04)="@"
186 . . D FILE^DIE("","XMFDA")
187 . E D
188 . . K XMIEN
189 . . D UPDATE^DIE("","XMFDA","XMIEN")
190 . . S XMIENS=XMIEN(1)_","_XMZ_","
191 . D:"^D^H^S^"[(U_$G(XMPREFIX)_U) OPOST(XMDUZ,XMZ,XMTO,XMIENS,XMPREFIX)
192 . Q:+XMTO'=XMTO ; Quit if addressee not local
193 . I $L(XMTOLIST(XMX))+$L(XMTO)>244 S XMX=XMX+1,XMTOLIST(XMX)=""
194 . S XMTOLIST(XMX)=XMTOLIST(XMX)_U_XMTO
195 Q
196RPOST(XMDUZ,XMZ,XMZR) ;
197 N XMFDA
198RADD ; Add response to response multiple in original msg
199 S XMFDA(3.9001,"+1,"_XMZ_",",.01)=XMZR
200 D UPDATE^DIE("","XMFDA")
201 I $D(DIERR),$P(^XMB(3.9,XMZ,0),U,1)="" D G RADD
202 . S $P(^XMB(3.9,XMZ,0),U,1)=$$EZBLD^DIALOG(34012) ; * No Subject *
203 . S ^XMB(3.9,"B",$$EZBLD^DIALOG(34012),XMZ)=""
204 ; Now put the message in the post box to be delivered.
205 ; (If this is not a locally generated reply, then XMDUZ is "NR".)
206 S ^XMBPOST("BOX",$$TSTAMP^XMXUTIL1,"R",XMZ_U_XMZR)=$P(^XMB(3.9,XMZ,1,0),U,4)_U_$S(XMDUZ=.6:DUZ,1:XMDUZ)
207 Q
Note: See TracBrowser for help on using the repository browser.