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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMKP 9385 printed Sep 23, 2025@19:48:23 Page 2
XMKP ;ISC-SF/GMB-Address and Post msg ;09/17/2002 12:52
+1 ;;8.0;MailMan;**1**;Jun 28, 2002
+2 ; Replaces ENT1^XMAD1,ENT^XMAD1,FINAL^XMAD1X (ISC-WASH/CAP)
SEND(XMDUZ,XMZ,XMINSTR) ;
+1 ; XMINSTR("SHARE DATE") Delete date for mail addressed to SHARED,MAIL
+2 ; XMINSTR("SHARE BSKT") Basket for mail addressed to SHARED,MAIL
+3 ; XMINSTR("SELF BSKT") Basket to deliver to if recipient is the sender
+4 NEW XMTOCNT,XMPRI,XMINST
+5 SET XMPRI=($GET(XMINSTR("FLAGS"))["P")
+6 ; Populate ADDRESSED TO multiple
DO SADDRTO(XMDUZ,XMZ)
+7 ; Populate RECIPIENT multiple
DO SRECIP(XMDUZ,XMZ,XMPRI,.XMTOCNT)
+8 IF XMTOCNT!$$BRODCAST
DO SPOST(XMDUZ,XMZ,XMTOCNT,.XMINSTR)
+9 SET XMINST=""
+10 FOR
SET XMINST=$ORDER(^XMB(3.9,XMZ,1,"AQUEUE",XMINST))
if 'XMINST
QUIT
Begin DoDot:1
+11 DO REMOTE^XMKPR(XMZ,XMINST)
End DoDot:1
+12 if $DATA(^XMB(3.9,XMZ,1,"AFAX"))
DO FAX^XMFAX(XMZ)
+13 QUIT
SPOST(XMDUZ,XMZ,XMTOCNT,XMINSTR) ;
+1 NEW XMTSTAMP,XMPREC
+2 SET XMTSTAMP=$$TSTAMP^XMXUTIL1
+3 SET XMPREC=XMTOCNT
+4 IF $DATA(^TMP("XMY",$JOB,XMDUZ))
Begin DoDot:1
+5 SET $PIECE(XMPREC,U,2)=$GET(XMINSTR("SELF BSKT"),1)
End DoDot:1
+6 IF $DATA(^TMP("XMY",$JOB,.6))
Begin DoDot:1
+7 SET $PIECE(XMPREC,U,3,4)=$GET(XMINSTR("SHARE BSKT"),1)_U_$GET(XMINSTR("SHARE DATE"),$$FMADD^XLFDT(DT,30))
End DoDot:1
+8 IF $$BRODCAST
Begin DoDot:1
+9 SET $PIECE(XMPREC,U,1)=$PIECE(^XMB(3.7,0),U,4)
+10 SET $PIECE(XMPREC,U,5)="*"
End DoDot:1
+11 SET ^XMBPOST("BOX",XMTSTAMP,"M",XMZ)=XMPREC
+12 QUIT
BRODCAST() ;
+1 ; * (Broadcast to all local users)
QUIT $DATA(^TMP("XMY",$JOB,$$EZBLD^DIALOG(39006)))
SRECIP(XMDUZ,XMZ,XMPRI,XMTOCNT) ; "Send" to recipients
+1 NEW XMTO,XMFDA,XMIEN,XMIENS,XMPREFIX,XMNOW
+2 ; Put addressees into RECIPIENT multiple
+3 SET XMTO=""
SET XMTOCNT=0
+4 FOR
SET XMTO=$ORDER(^TMP("XMY",$JOB,XMTO))
if XMTO=""
QUIT
Begin DoDot:1
+5 KILL XMPREFIX,XMIEN
+6 ; New recipient
DO NEW(XMZ,XMPRI,XMTO,$GET(^TMP("XMY",$JOB,XMTO,1)),.XMFDA,.XMIENS)
+7 IF $DATA(^TMP("XMY",$JOB,XMTO,"F"))
Begin DoDot:2
+8 if '$DATA(XMNOW)
SET XMNOW=$$MMDT^XMXUTIL1($PIECE(^XMB(3.9,XMZ,0),U,3))
+9 DO RCPTFWD^XMKP1("S",XMTO,.XMFDA,XMIENS,XMNOW)
End DoDot:2
+10 IF +XMTO=XMTO
SET XMTOCNT=XMTOCNT+1
+11 ; Transmission Status
IF '$TEST
DO STATUS(XMTO,.XMFDA,XMIENS,.XMPREFIX)
+12 DO UPDATE^DIE("","XMFDA","XMIEN")
+13 SET XMIENS=XMIEN(1)_","_XMZ_","
+14 IF ".D.H.S."[("."_$GET(XMPREFIX)_".")
DO OPOST(XMDUZ,XMZ,XMTO,XMIENS,XMPREFIX)
End DoDot:1
+15 QUIT
SADDRTO(XMDUZ,XMZ) ; Put addressees into ADDRESSED TO multiple
+1 NEW XMTO
+2 SET XMTO=""
+3 FOR
SET XMTO=$ORDER(^TMP("XMY0",$JOB,XMTO))
if XMTO=""
QUIT
DO ADDRTO(XMDUZ,XMZ,XMTO)
+4 QUIT
ADDRTO(XMDUZ,XMZ,XMTO) ;
+1 NEW XMFDA,XMPREFIX,XMMULT
+2 SET XMPREFIX=$GET(^TMP("XMY0",$JOB,XMTO,1))
+3 IF $DATA(^TMP("XMY0",$JOB,XMTO,"L"))
Begin DoDot:1
+4 IF XMTO=XMV("NAME")
Begin DoDot:2
+5 DO LTRADD^XMJMD(XMDUZ,XMZ,$GET(^TMP("XMY0",$JOB,XMTO,"L")))
+6 SET XMMULT=3.911
End DoDot:2
QUIT
+7 SET XMMULT=3.914
+8 SET XMFDA(3.914,"?+1,"_XMZ_",",2)=XMDUZ
+9 ; " (Surrogate: _x_)"
SET XMFDA(3.914,"?+1,"_XMZ_",",3)=XMV("NAME")_$SELECT(XMDUZ=DUZ:"",1:$$EZBLD^DIALOG(38008,XMV("DUZ NAME")))
+10 SET XMFDA(3.914,"?+1,"_XMZ_",",4)=^TMP("XMY0",$JOB,XMTO,"L")
End DoDot:1
+11 IF '$TEST
SET XMMULT=3.911
+12 SET XMFDA(XMMULT,"?+1,"_XMZ_",",.01)=XMTO
+13 if XMPREFIX'=""
SET XMFDA(XMMULT,"?+1,"_XMZ_",",1)=XMPREFIX
+14 DO UPDATE^DIE("","XMFDA")
+15 QUIT
NEW(XMZ,XMPRI,XMTO,XMTYPE,XMFDA,XMIENS) ;
+1 SET XMIENS="+1,"_XMZ_","
+2 SET XMFDA(3.91,XMIENS,.01)=XMTO
+3 ; If addressee is also the creator of the msg, then I: or C: does not
+4 ; apply.
+5 IF $GET(XMTYPE)'=""
SET XMFDA(3.91,XMIENS,6.5)=XMTYPE
+6 ; Priority response flag
IF XMPRI
IF XMTO=+XMTO
IF $PIECE($GET(^XMB(3.7,XMTO,0)),U,11)
SET XMFDA(3.91,XMIENS,10)=$PIECE(^(0),U,11)
+7 QUIT
STATUS(XMTO,XMFDA,XMIENS,XMPREFIX) ;
+1 IF $EXTRACT(XMTO,1,2)="F."
IF $PIECE(^XMB(1,1,0),U,19)
IF $DATA(^AKF("FAXR"))
IF $EXTRACT(XMTO,3,99)=$PIECE($GET(^AKF("FAXR",^TMP("XMY",$JOB,XMTO),0)),U)
Begin DoDot:1
+2 ; Awaiting Fax.
SET XMFDA(3.91,XMIENS,5)=$$EZBLD^DIALOG(39303.5)
+3 SET XMFDA(3.91,XMIENS,13)=^TMP("XMY",$JOB,XMTO)
End DoDot:1
QUIT
+4 IF XMTO["@"
Begin DoDot:1
+5 ; Awaiting transmission.
SET XMFDA(3.91,XMIENS,5)=$$EZBLD^DIALOG(39303.1)
+6 ; sets x-ref "AQUEUE"
SET XMFDA(3.91,XMIENS,6)=^TMP("XMY",$JOB,XMTO)
End DoDot:1
QUIT
+7 IF $EXTRACT(XMTO,2,2)="."
Begin DoDot:1
+8 ; We know it is upper case
SET XMPREFIX=$EXTRACT(XMTO,1,1)
+9 if "SDH"'[XMPREFIX
QUIT
+10 ; "Awaiting Server."/"Awaiting Device."/"Awaiting H.Device."
SET XMFDA(3.91,XMIENS,5)=$$EZBLD^DIALOG($SELECT(XMPREFIX="S":39303.2,XMPREFIX="D":39303.3,1:39303.4))
End DoDot:1
+11 QUIT
OPOST(XMDUZ,XMZ,XMTO,XMIENS,XMPREFIX) ;
+1 IF XMPREFIX="S"
DO SERVER^XMKPO(XMZ,XMTO,XMIENS)
QUIT
+2 IF XMPREFIX="D"
DO DEVICE^XMKPO(XMDUZ,XMZ,XMTO,XMIENS,1)
QUIT
+3 ; Headerless
IF XMPREFIX="H"
DO DEVICE^XMKPO(XMDUZ,XMZ,XMTO,XMIENS,0)
QUIT
+4 QUIT
FWD(XMDUZ,XMZ,XMINSTR) ;
+1 ; XMFWDTYP fwding person recipient type: I:, CC:
+2 ; XMPRI 1=msg is priority msg; 0=not
+3 ; XMINSTR("SHARE DATE") Delete date for mail addressed to SHARED,MAIL
+4 ; XMINSTR("SHARE BSKT") Basket for mail addressed to SHARED,MAIL
+5 ; XMINSTR("FWD BY") String to replace standard 'Forwarded by'
+6 ; XMTOLIST Array of local recipients
+7 ; XMTOCNT Number of valid recipients
+8 NEW XMTOLIST,XMPRI,XMFWDTYP,XMIEN,XMREMOTE,XMINST
+9 ; May have been fwd'd by a remote person
SET XMIEN=$ORDER(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
+10 SET XMFWDTYP=$SELECT('XMIEN:"",1:$PIECE($GET(^XMB(3.9,XMZ,1,XMIEN,"T")),U))
+11 SET XMPRI=($PIECE(^XMB(3.9,XMZ,0),U,7)["P")
+12 ; Populate ADDRESSED TO multiple
DO FADDRTO(XMDUZ,XMZ)
+13 DO FRECIP(XMDUZ,XMZ,.XMINSTR,XMFWDTYP,XMPRI,.XMTOLIST,.XMREMOTE)
+14 if XMTOLIST(1)'=""!$$BRODCAST
DO FPOST(XMDUZ,XMZ,.XMTOLIST,.XMINSTR)
+15 SET XMINST=""
+16 FOR
SET XMINST=$ORDER(XMREMOTE(XMINST))
if 'XMINST
QUIT
Begin DoDot:1
+17 DO REMOTE^XMKPR(XMZ,XMINST)
End DoDot:1
+18 if $DATA(^XMB(3.9,XMZ,1,"AFAX"))
DO FAX^XMFAX(XMZ)
+19 QUIT
FADDRTO(XMDUZ,XMZ) ; Put addressees into ADDRESSED TO multiple
+1 NEW XMTO
+2 SET XMTO=""
+3 FOR
SET XMTO=$ORDER(^TMP("XMY0",$JOB,XMTO))
if XMTO=""
QUIT
Begin DoDot:1
+4 IF '$$FIND1^DIC(3.911,","_XMZ_",","QX",XMTO,"B")
Begin DoDot:2
+5 DO ADDRTO(XMDUZ,XMZ,XMTO)
End DoDot:2
QUIT
+6 if '$DATA(^TMP("XMY0",$JOB,XMTO,"L"))
QUIT
+7 IF XMTO=XMV("NAME")
Begin DoDot:2
+8 DO LTRADD^XMJMD(XMDUZ,XMZ,$GET(^TMP("XMY0",$JOB,XMTO,"L")))
End DoDot:2
QUIT
+9 NEW XMFDA,XMIENS
+10 SET XMIENS="?+1,"_XMZ_","
+11 SET XMFDA(3.914,XMIENS,.01)=XMTO
+12 ; we ignore any 'prefix' because these addressees are already on the msg
+13 SET XMFDA(3.914,XMIENS,2)=XMDUZ
+14 ; " (Surrogate: _x_)"
SET XMFDA(3.914,XMIENS,3)=XMV("NAME")_$SELECT(XMDUZ=DUZ:"",1:$$EZBLD^DIALOG(38008,XMV("DUZ NAME")))
+15 SET XMFDA(3.914,XMIENS,4)=^TMP("XMY0",$JOB,XMTO,"L")
+16 DO UPDATE^DIE("","XMFDA")
End DoDot:1
+17 QUIT
FPOST(XMDUZ,XMZ,XMTOLIST,XMINSTR) ; For local delivery
+1 NEW XMTSTAMP,XMTOCNT,I,XMUID,XMPREC
+2 SET XMTSTAMP=$$TSTAMP^XMXUTIL1
+3 IF $DATA(^TMP("XMY",$JOB,XMDUZ))
Begin DoDot:1
+4 SET $PIECE(XMPREC,U,2)=$GET(XMINSTR("SELF BSKT"),1)
End DoDot:1
+5 IF $DATA(^TMP("XMY",$JOB,.6))
Begin DoDot:1
+6 SET $PIECE(XMPREC,U,3,4)=$GET(XMINSTR("SHARE BSKT"),1)_U_$GET(XMINSTR("SHARE DATE"),$$FMADD^XLFDT(DT,30))
End DoDot:1
+7 SET XMUID=XMZ_U_$SELECT(XMDUZ=.6:DUZ,1:XMDUZ)_U_$JOB
+8 SET (I,XMTOCNT)=0
+9 IF XMTOLIST(1)'=""
FOR
SET I=$ORDER(XMTOLIST(I))
if I=""
QUIT
Begin DoDot:1
+10 SET XMTOCNT=XMTOCNT+$LENGTH(XMTOLIST(I),U)-1
+11 SET ^XMBPOST("FWD",XMUID_U_XMTSTAMP,I)=$PIECE(XMTOLIST(I),U,2,999)
End DoDot:1
+12 IF $$BRODCAST
Begin DoDot:1
+13 SET $PIECE(XMPREC,U,1)=$PIECE(^XMB(3.7,0),U,4)
+14 SET $PIECE(XMPREC,U,5)="*"
+15 ; If not info only, make it so.
IF $PIECE(^XMB(3.9,XMZ,0),U,12)'="y"
SET $PIECE(^(0),U,12)="y"
End DoDot:1
+16 IF '$TEST
SET $PIECE(XMPREC,U,1)=XMTOCNT
+17 SET ^XMBPOST("BOX",XMTSTAMP,"M",XMUID)=XMPREC
+18 QUIT
FRECIP(XMDUZ,XMZ,XMINSTR,XMFWDTYP,XMPRI,XMTOLIST,XMREMOTE) ; "Forward" to recipients
+1 ; XMFWDBY Forwarded by: name (surrogate)
+2 NEW XMTO,XMX,XMIEN,XMFDA,XMIENS,XMPREFIX,XMFWDBY,XMNOW
+3 SET XMNOW=$$MMDT^XMXUTIL1($$NOW^XLFDT)
+4 ; " (Surrogate: _x_)"
SET XMFWDBY=$SELECT($DATA(XMINSTR("FWD BY")):XMINSTR("FWD BY"),1:XMV("NAME")_$SELECT(XMDUZ=DUZ:"",1:$$EZBLD^DIALOG(38008,XMV("DUZ NAME"))))
+5 ; Put addressees into RECIPIENT multiple
+6 SET XMTO=""
SET XMX=1
SET XMTOLIST(XMX)=""
+7 FOR
SET XMTO=$ORDER(^TMP("XMY",$JOB,XMTO))
if XMTO=""
QUIT
Begin DoDot:1
+8 KILL XMPREFIX
+9 IF +XMTO=XMTO
Begin DoDot:2
+10 SET XMIEN=$ORDER(^XMB(3.9,XMZ,1,"C",XMTO,0))
End DoDot:2
+11 IF '$TEST
SET XMIEN=$$FIND1^DIC(3.91,","_XMZ_",",$SELECT(XMTO["@":"O",1:"QX"),XMTO,"C")
+12 ; New recipient
IF +XMIEN=0
Begin DoDot:2
+13 NEW XMTYPE
+14 ; If you are an info only recipient, then so is anyone you fwd to.
+15 SET XMTYPE=$SELECT(XMFWDTYP'="":XMFWDTYP,1:$GET(^TMP("XMY",$JOB,XMTO,1)))
+16 ; New recipient
DO NEW(XMZ,XMPRI,XMTO,XMTYPE,.XMFDA,.XMIENS)
End DoDot:2
+17 IF '$TEST
Begin DoDot:2
+18 SET XMIENS=XMIEN_","_XMZ_","
+19 ; Unterminate
if $GET(^XMB(3.9,XMZ,1,XMIEN,"D"))
SET XMFDA(3.91,XMIENS,7)="@"
End DoDot:2
+20 IF +XMTO'=XMTO
Begin DoDot:2
+21 ; Transmission Status
DO STATUS(XMTO,.XMFDA,XMIENS,.XMPREFIX)
+22 if $DATA(XMFDA(3.91,XMIENS,6))
SET XMREMOTE(XMFDA(3.91,XMIENS,6))=""
End DoDot:2
+23 IF $DATA(^TMP("XMY",$JOB,XMTO,"F"))
Begin DoDot:2
+24 DO RCPTFWD^XMKP1("F",XMTO,.XMFDA,XMIENS,XMNOW,XMFWDBY)
End DoDot:2
+25 IF '$TEST
Begin DoDot:2
+26 ; fwd by name date time
SET XMFDA(3.91,XMIENS,8)=XMFWDBY_" "_XMNOW
+27 ; fwd by duz
IF '$DATA(XMINSTR("FWD BY"))!$DATA(XMINSTR("FWD BY XMDUZ"))
SET XMFDA(3.91,XMIENS,8.01)=XMDUZ
End DoDot:2
+28 ; Filter-Forward or Regular-Forward
IF '$DATA(XMFDA(3.91,XMIENS,8.02))
Begin DoDot:2
+29 SET XMFDA(3.91,XMIENS,8.02)=$SELECT($GET(XMINSTR("FWD BY XMDUZ"))="F":"F",1:"@")
End DoDot:2
+30 IF XMIEN
Begin DoDot:2
+31 IF '$DATA(XMFDA(3.91,XMIENS,8.03))
Begin DoDot:3
+32 SET XMFDA(3.91,XMIENS,8.03)="@"
+33 SET XMFDA(3.91,XMIENS,8.04)="@"
End DoDot:3
+34 DO FILE^DIE("","XMFDA")
End DoDot:2
+35 IF '$TEST
Begin DoDot:2
+36 KILL XMIEN
+37 DO UPDATE^DIE("","XMFDA","XMIEN")
+38 SET XMIENS=XMIEN(1)_","_XMZ_","
End DoDot:2
+39 if "^D^H^S^"[(U_$GET(XMPREFIX)_U)
DO OPOST(XMDUZ,XMZ,XMTO,XMIENS,XMPREFIX)
+40 ; Quit if addressee not local
if +XMTO'=XMTO
QUIT
+41 IF $LENGTH(XMTOLIST(XMX))+$LENGTH(XMTO)>244
SET XMX=XMX+1
SET XMTOLIST(XMX)=""
+42 SET XMTOLIST(XMX)=XMTOLIST(XMX)_U_XMTO
End DoDot:1
+43 QUIT
RPOST(XMDUZ,XMZ,XMZR) ;
+1 NEW XMFDA
RADD ; Add response to response multiple in original msg
+1 SET XMFDA(3.9001,"+1,"_XMZ_",",.01)=XMZR
+2 DO UPDATE^DIE("","XMFDA")
+3 IF $DATA(DIERR)
IF $PIECE(^XMB(3.9,XMZ,0),U,1)=""
Begin DoDot:1
+4 ; * No Subject *
SET $PIECE(^XMB(3.9,XMZ,0),U,1)=$$EZBLD^DIALOG(34012)
+5 SET ^XMB(3.9,"B",$$EZBLD^DIALOG(34012),XMZ)=""
End DoDot:1
GOTO RADD
+6 ; Now put the message in the post box to be delivered.
+7 ; (If this is not a locally generated reply, then XMDUZ is "NR".)
+8 SET ^XMBPOST("BOX",$$TSTAMP^XMXUTIL1,"R",XMZ_U_XMZR)=$PIECE(^XMB(3.9,XMZ,1,0),U,4)_U_$SELECT(XMDUZ=.6:DUZ,1:XMDUZ)
+9 QUIT
