- 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 Feb 18, 2025@23:38:34 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