Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMKP

XMKP.m

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