208 lines
9.0 KiB
Mathematica
208 lines
9.0 KiB
Mathematica
XMKP ;ISC-SF/GMB-Address and Post msg ;09/17/2002 12:52
|
|
;;8.0;MailMan;**1**;Jun 28, 2002
|
|
; Replaces ENT1^XMAD1,ENT^XMAD1,FINAL^XMAD1X (ISC-WASH/CAP)
|
|
SEND(XMDUZ,XMZ,XMINSTR) ;
|
|
; XMINSTR("SHARE DATE") Delete date for mail addressed to SHARED,MAIL
|
|
; XMINSTR("SHARE BSKT") Basket for mail addressed to SHARED,MAIL
|
|
; XMINSTR("SELF BSKT") Basket to deliver to if recipient is the sender
|
|
N XMTOCNT,XMPRI,XMINST
|
|
S XMPRI=($G(XMINSTR("FLAGS"))["P")
|
|
D SADDRTO(XMDUZ,XMZ) ; Populate ADDRESSED TO multiple
|
|
D SRECIP(XMDUZ,XMZ,XMPRI,.XMTOCNT) ; Populate RECIPIENT multiple
|
|
I XMTOCNT!$$BRODCAST D SPOST(XMDUZ,XMZ,XMTOCNT,.XMINSTR)
|
|
S XMINST=""
|
|
F S XMINST=$O(^XMB(3.9,XMZ,1,"AQUEUE",XMINST)) Q:'XMINST D
|
|
. D REMOTE^XMKPR(XMZ,XMINST)
|
|
D:$D(^XMB(3.9,XMZ,1,"AFAX")) FAX^XMFAX(XMZ)
|
|
Q
|
|
SPOST(XMDUZ,XMZ,XMTOCNT,XMINSTR) ;
|
|
N XMTSTAMP,XMPREC
|
|
S XMTSTAMP=$$TSTAMP^XMXUTIL1
|
|
S XMPREC=XMTOCNT
|
|
I $D(^TMP("XMY",$J,XMDUZ)) D
|
|
. S $P(XMPREC,U,2)=$G(XMINSTR("SELF BSKT"),1)
|
|
I $D(^TMP("XMY",$J,.6)) D
|
|
. S $P(XMPREC,U,3,4)=$G(XMINSTR("SHARE BSKT"),1)_U_$G(XMINSTR("SHARE DATE"),$$FMADD^XLFDT(DT,30))
|
|
I $$BRODCAST D
|
|
. S $P(XMPREC,U,1)=$P(^XMB(3.7,0),U,4)
|
|
. S $P(XMPREC,U,5)="*"
|
|
S ^XMBPOST("BOX",XMTSTAMP,"M",XMZ)=XMPREC
|
|
Q
|
|
BRODCAST() ;
|
|
Q $D(^TMP("XMY",$J,$$EZBLD^DIALOG(39006))) ; * (Broadcast to all local users)
|
|
SRECIP(XMDUZ,XMZ,XMPRI,XMTOCNT) ; "Send" to recipients
|
|
N XMTO,XMFDA,XMIEN,XMIENS,XMPREFIX,XMNOW
|
|
; Put addressees into RECIPIENT multiple
|
|
S XMTO="",XMTOCNT=0
|
|
F S XMTO=$O(^TMP("XMY",$J,XMTO)) Q:XMTO="" D
|
|
. K XMPREFIX,XMIEN
|
|
. D NEW(XMZ,XMPRI,XMTO,$G(^TMP("XMY",$J,XMTO,1)),.XMFDA,.XMIENS) ; New recipient
|
|
. I $D(^TMP("XMY",$J,XMTO,"F")) D
|
|
. . S:'$D(XMNOW) XMNOW=$$MMDT^XMXUTIL1($P(^XMB(3.9,XMZ,0),U,3))
|
|
. . D RCPTFWD^XMKP1("S",XMTO,.XMFDA,XMIENS,XMNOW)
|
|
. I +XMTO=XMTO S XMTOCNT=XMTOCNT+1
|
|
. E D STATUS(XMTO,.XMFDA,XMIENS,.XMPREFIX) ; Transmission Status
|
|
. D UPDATE^DIE("","XMFDA","XMIEN")
|
|
. S XMIENS=XMIEN(1)_","_XMZ_","
|
|
. I ".D.H.S."[("."_$G(XMPREFIX)_".") D OPOST(XMDUZ,XMZ,XMTO,XMIENS,XMPREFIX)
|
|
Q
|
|
SADDRTO(XMDUZ,XMZ) ; Put addressees into ADDRESSED TO multiple
|
|
N XMTO
|
|
S XMTO=""
|
|
F S XMTO=$O(^TMP("XMY0",$J,XMTO)) Q:XMTO="" D ADDRTO(XMDUZ,XMZ,XMTO)
|
|
Q
|
|
ADDRTO(XMDUZ,XMZ,XMTO) ;
|
|
N XMFDA,XMPREFIX,XMMULT
|
|
S XMPREFIX=$G(^TMP("XMY0",$J,XMTO,1))
|
|
I $D(^TMP("XMY0",$J,XMTO,"L")) D
|
|
. I XMTO=XMV("NAME") D Q
|
|
. . D LTRADD^XMJMD(XMDUZ,XMZ,$G(^TMP("XMY0",$J,XMTO,"L")))
|
|
. . S XMMULT=3.911
|
|
. S XMMULT=3.914
|
|
. S XMFDA(3.914,"?+1,"_XMZ_",",2)=XMDUZ
|
|
. S XMFDA(3.914,"?+1,"_XMZ_",",3)=XMV("NAME")_$S(XMDUZ=DUZ:"",1:$$EZBLD^DIALOG(38008,XMV("DUZ NAME"))) ; " (Surrogate: _x_)"
|
|
. S XMFDA(3.914,"?+1,"_XMZ_",",4)=^TMP("XMY0",$J,XMTO,"L")
|
|
E S XMMULT=3.911
|
|
S XMFDA(XMMULT,"?+1,"_XMZ_",",.01)=XMTO
|
|
S:XMPREFIX'="" XMFDA(XMMULT,"?+1,"_XMZ_",",1)=XMPREFIX
|
|
D UPDATE^DIE("","XMFDA")
|
|
Q
|
|
NEW(XMZ,XMPRI,XMTO,XMTYPE,XMFDA,XMIENS) ;
|
|
S XMIENS="+1,"_XMZ_","
|
|
S XMFDA(3.91,XMIENS,.01)=XMTO
|
|
; If addressee is also the creator of the msg, then I: or C: does not
|
|
; apply.
|
|
I $G(XMTYPE)'="" S XMFDA(3.91,XMIENS,6.5)=XMTYPE
|
|
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
|
|
Q
|
|
STATUS(XMTO,XMFDA,XMIENS,XMPREFIX) ;
|
|
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
|
|
. S XMFDA(3.91,XMIENS,5)=$$EZBLD^DIALOG(39303.5) ; Awaiting Fax.
|
|
. S XMFDA(3.91,XMIENS,13)=^TMP("XMY",$J,XMTO)
|
|
I XMTO["@" D Q
|
|
. S XMFDA(3.91,XMIENS,5)=$$EZBLD^DIALOG(39303.1) ; Awaiting transmission.
|
|
. S XMFDA(3.91,XMIENS,6)=^TMP("XMY",$J,XMTO) ; sets x-ref "AQUEUE"
|
|
I $E(XMTO,2,2)="." D
|
|
. S XMPREFIX=$E(XMTO,1,1) ; We know it is upper case
|
|
. Q:"SDH"'[XMPREFIX
|
|
. 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."
|
|
Q
|
|
OPOST(XMDUZ,XMZ,XMTO,XMIENS,XMPREFIX) ;
|
|
I XMPREFIX="S" D SERVER^XMKPO(XMZ,XMTO,XMIENS) Q
|
|
I XMPREFIX="D" D DEVICE^XMKPO(XMDUZ,XMZ,XMTO,XMIENS,1) Q
|
|
I XMPREFIX="H" D DEVICE^XMKPO(XMDUZ,XMZ,XMTO,XMIENS,0) Q ; Headerless
|
|
Q
|
|
FWD(XMDUZ,XMZ,XMINSTR) ;
|
|
; XMFWDTYP fwding person recipient type: I:, CC:
|
|
; XMPRI 1=msg is priority msg; 0=not
|
|
; XMINSTR("SHARE DATE") Delete date for mail addressed to SHARED,MAIL
|
|
; XMINSTR("SHARE BSKT") Basket for mail addressed to SHARED,MAIL
|
|
; XMINSTR("FWD BY") String to replace standard 'Forwarded by'
|
|
; XMTOLIST Array of local recipients
|
|
; XMTOCNT Number of valid recipients
|
|
N XMTOLIST,XMPRI,XMFWDTYP,XMIEN,XMREMOTE,XMINST
|
|
S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0)) ; May have been fwd'd by a remote person
|
|
S XMFWDTYP=$S('XMIEN:"",1:$P($G(^XMB(3.9,XMZ,1,XMIEN,"T")),U))
|
|
S XMPRI=($P(^XMB(3.9,XMZ,0),U,7)["P")
|
|
D FADDRTO(XMDUZ,XMZ) ; Populate ADDRESSED TO multiple
|
|
D FRECIP(XMDUZ,XMZ,.XMINSTR,XMFWDTYP,XMPRI,.XMTOLIST,.XMREMOTE)
|
|
D:XMTOLIST(1)'=""!$$BRODCAST FPOST(XMDUZ,XMZ,.XMTOLIST,.XMINSTR)
|
|
S XMINST=""
|
|
F S XMINST=$O(XMREMOTE(XMINST)) Q:'XMINST D
|
|
. D REMOTE^XMKPR(XMZ,XMINST)
|
|
D:$D(^XMB(3.9,XMZ,1,"AFAX")) FAX^XMFAX(XMZ)
|
|
Q
|
|
FADDRTO(XMDUZ,XMZ) ; Put addressees into ADDRESSED TO multiple
|
|
N XMTO
|
|
S XMTO=""
|
|
F S XMTO=$O(^TMP("XMY0",$J,XMTO)) Q:XMTO="" D
|
|
. I '$$FIND1^DIC(3.911,","_XMZ_",","QX",XMTO,"B") D Q
|
|
. . D ADDRTO(XMDUZ,XMZ,XMTO)
|
|
. Q:'$D(^TMP("XMY0",$J,XMTO,"L"))
|
|
. I XMTO=XMV("NAME") D Q
|
|
. . D LTRADD^XMJMD(XMDUZ,XMZ,$G(^TMP("XMY0",$J,XMTO,"L")))
|
|
. N XMFDA,XMIENS
|
|
. S XMIENS="?+1,"_XMZ_","
|
|
. S XMFDA(3.914,XMIENS,.01)=XMTO
|
|
. ; we ignore any 'prefix' because these addressees are already on the msg
|
|
. S XMFDA(3.914,XMIENS,2)=XMDUZ
|
|
. S XMFDA(3.914,XMIENS,3)=XMV("NAME")_$S(XMDUZ=DUZ:"",1:$$EZBLD^DIALOG(38008,XMV("DUZ NAME"))) ; " (Surrogate: _x_)"
|
|
. S XMFDA(3.914,XMIENS,4)=^TMP("XMY0",$J,XMTO,"L")
|
|
. D UPDATE^DIE("","XMFDA")
|
|
Q
|
|
FPOST(XMDUZ,XMZ,XMTOLIST,XMINSTR) ; For local delivery
|
|
N XMTSTAMP,XMTOCNT,I,XMUID,XMPREC
|
|
S XMTSTAMP=$$TSTAMP^XMXUTIL1
|
|
I $D(^TMP("XMY",$J,XMDUZ)) D
|
|
. S $P(XMPREC,U,2)=$G(XMINSTR("SELF BSKT"),1)
|
|
I $D(^TMP("XMY",$J,.6)) D
|
|
. S $P(XMPREC,U,3,4)=$G(XMINSTR("SHARE BSKT"),1)_U_$G(XMINSTR("SHARE DATE"),$$FMADD^XLFDT(DT,30))
|
|
S XMUID=XMZ_U_$S(XMDUZ=.6:DUZ,1:XMDUZ)_U_$J
|
|
S (I,XMTOCNT)=0
|
|
I XMTOLIST(1)'="" F S I=$O(XMTOLIST(I)) Q:I="" D
|
|
. S XMTOCNT=XMTOCNT+$L(XMTOLIST(I),U)-1
|
|
. S ^XMBPOST("FWD",XMUID_U_XMTSTAMP,I)=$P(XMTOLIST(I),U,2,999)
|
|
I $$BRODCAST D
|
|
. S $P(XMPREC,U,1)=$P(^XMB(3.7,0),U,4)
|
|
. S $P(XMPREC,U,5)="*"
|
|
. I $P(^XMB(3.9,XMZ,0),U,12)'="y" S $P(^(0),U,12)="y" ; If not info only, make it so.
|
|
E S $P(XMPREC,U,1)=XMTOCNT
|
|
S ^XMBPOST("BOX",XMTSTAMP,"M",XMUID)=XMPREC
|
|
Q
|
|
FRECIP(XMDUZ,XMZ,XMINSTR,XMFWDTYP,XMPRI,XMTOLIST,XMREMOTE) ; "Forward" to recipients
|
|
; XMFWDBY Forwarded by: name (surrogate)
|
|
N XMTO,XMX,XMIEN,XMFDA,XMIENS,XMPREFIX,XMFWDBY,XMNOW
|
|
S XMNOW=$$MMDT^XMXUTIL1($$NOW^XLFDT)
|
|
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_)"
|
|
; Put addressees into RECIPIENT multiple
|
|
S XMTO="",XMX=1,XMTOLIST(XMX)=""
|
|
F S XMTO=$O(^TMP("XMY",$J,XMTO)) Q:XMTO="" D
|
|
. K XMPREFIX
|
|
. I +XMTO=XMTO D
|
|
. . S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMTO,0))
|
|
. E S XMIEN=$$FIND1^DIC(3.91,","_XMZ_",",$S(XMTO["@":"O",1:"QX"),XMTO,"C")
|
|
. I +XMIEN=0 D ; New recipient
|
|
. . N XMTYPE
|
|
. . ; If you are an info only recipient, then so is anyone you fwd to.
|
|
. . S XMTYPE=$S(XMFWDTYP'="":XMFWDTYP,1:$G(^TMP("XMY",$J,XMTO,1)))
|
|
. . D NEW(XMZ,XMPRI,XMTO,XMTYPE,.XMFDA,.XMIENS) ; New recipient
|
|
. E D
|
|
. . S XMIENS=XMIEN_","_XMZ_","
|
|
. . S:$G(^XMB(3.9,XMZ,1,XMIEN,"D")) XMFDA(3.91,XMIENS,7)="@" ; Unterminate
|
|
. I +XMTO'=XMTO D
|
|
. . D STATUS(XMTO,.XMFDA,XMIENS,.XMPREFIX) ; Transmission Status
|
|
. . S:$D(XMFDA(3.91,XMIENS,6)) XMREMOTE(XMFDA(3.91,XMIENS,6))=""
|
|
. I $D(^TMP("XMY",$J,XMTO,"F")) D
|
|
. . D RCPTFWD^XMKP1("F",XMTO,.XMFDA,XMIENS,XMNOW,XMFWDBY)
|
|
. E D
|
|
. . S XMFDA(3.91,XMIENS,8)=XMFWDBY_" "_XMNOW ; fwd by name date time
|
|
. . I '$D(XMINSTR("FWD BY"))!$D(XMINSTR("FWD BY XMDUZ")) S XMFDA(3.91,XMIENS,8.01)=XMDUZ ; fwd by duz
|
|
. I '$D(XMFDA(3.91,XMIENS,8.02)) D ; Filter-Forward or Regular-Forward
|
|
. . S XMFDA(3.91,XMIENS,8.02)=$S($G(XMINSTR("FWD BY XMDUZ"))="F":"F",1:"@")
|
|
. I XMIEN D
|
|
. . I '$D(XMFDA(3.91,XMIENS,8.03)) D
|
|
. . . S XMFDA(3.91,XMIENS,8.03)="@"
|
|
. . . S XMFDA(3.91,XMIENS,8.04)="@"
|
|
. . D FILE^DIE("","XMFDA")
|
|
. E D
|
|
. . K XMIEN
|
|
. . D UPDATE^DIE("","XMFDA","XMIEN")
|
|
. . S XMIENS=XMIEN(1)_","_XMZ_","
|
|
. D:"^D^H^S^"[(U_$G(XMPREFIX)_U) OPOST(XMDUZ,XMZ,XMTO,XMIENS,XMPREFIX)
|
|
. Q:+XMTO'=XMTO ; Quit if addressee not local
|
|
. I $L(XMTOLIST(XMX))+$L(XMTO)>244 S XMX=XMX+1,XMTOLIST(XMX)=""
|
|
. S XMTOLIST(XMX)=XMTOLIST(XMX)_U_XMTO
|
|
Q
|
|
RPOST(XMDUZ,XMZ,XMZR) ;
|
|
N XMFDA
|
|
RADD ; Add response to response multiple in original msg
|
|
S XMFDA(3.9001,"+1,"_XMZ_",",.01)=XMZR
|
|
D UPDATE^DIE("","XMFDA")
|
|
I $D(DIERR),$P(^XMB(3.9,XMZ,0),U,1)="" D G RADD
|
|
. S $P(^XMB(3.9,XMZ,0),U,1)=$$EZBLD^DIALOG(34012) ; * No Subject *
|
|
. S ^XMB(3.9,"B",$$EZBLD^DIALOG(34012),XMZ)=""
|
|
; Now put the message in the post box to be delivered.
|
|
; (If this is not a locally generated reply, then XMDUZ is "NR".)
|
|
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)
|
|
Q
|