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

XMTDL2.m

Go to the documentation of this file.
  1. XMTDL2 ;ISC-SF/GMB-Deliver local mail to mailbox (cont.) ;04/17/2002 11:31
  1. ;;8.0;MailMan;;Jun 28, 2002
  1. ; Replaces ^XMADJF1B (ISC-WASH/CAP)
  1. ; XMTO Recipient DUZ
  1. ; XMZ Original XMZ
  1. ; XMZSUBJ Msg subject
  1. ; XMZFROM Who sent the original message
  1. ; XMFROM Who sent the msg or reply, or who forwarded the msg
  1. ; XMREPLY 0=msg is not a reply; 1=msg is a reply
  1. ; XMK Basket number (or name) to deliver to (as specified by sender XMFROM)
  1. ; XMDEL Delete Date (as specified by sender XMZFROM)
  1. ; XMKCURR Basket the msg is currently in
  1. DELIVER(XMTO,XMZ,XMZSUBJ,XMZFROM,XMFROM,XMREPLY,XMK,XMDEL,XMZBSKT) ;
  1. N XMKCURR,XMACT
  1. I +XMTO'>0!'$D(^XMB(3.7,XMTO,2)) Q ; Do not deliver if invalid mailbox
  1. S XMFROM=+$G(XMFROM),XMREPLY=+$G(XMREPLY),XMK=$G(XMK),XMDEL=+$G(XMDEL),XMZBSKT=$G(XMZBSKT)
  1. I XMTO=.6,XMREPLY Q ; Do not deliver response to Shared,Mail
  1. S XMKCURR=$O(^XMB(3.7,"M",XMZ,XMTO,0)) ; Get basket it is in
  1. I XMKCURR D Q ; Already in a basket (ignore any basket sender may have specified)
  1. . Q:'XMREPLY ; If this is a reply, continue, else it must be a forwarded msg, so quit.
  1. . I XMKCURR=.5 D Q ; Msg is in waste basket
  1. . . D CHEKBSKT(XMTO,.XMK,XMZSUBJ,XMZFROM,XMZBSKT,.XMACT) ; Where should it go?
  1. . . Q:XMK=.5
  1. . . D MOVENEW(XMFROM,XMTO,XMK,XMZ,.XMACT) ; Move msg and make it new.
  1. . ; Msg is not in waste basket. Make the msg new.
  1. . Q:$D(^XMB(3.7,XMTO,"N0",XMKCURR,XMZ)) ; Already new.
  1. . D:XMFROM'=XMTO MAKENEW(XMTO,XMKCURR,XMZ)
  1. ; Not yet in a basket.
  1. ; Reinstated user may not see replies to old msgs which he doesn't already have.
  1. I XMREPLY,$P(^XMB(3.7,XMTO,0),U,7) Q:$$SECRET($P(^(0),U,7),XMZ)
  1. S:$G(XMK)="" XMK=0
  1. I +XMK=XMK D
  1. . D CHEKBSKT(XMTO,.XMK,XMZSUBJ,XMZFROM,XMZBSKT,.XMACT)
  1. E D
  1. . S XMK=$$NAMEBSKT(XMTO,XMK,"Y")
  1. D ADDNEW($S(XMREPLY:XMFROM,1:XMZFROM),XMTO,XMK,XMZ,XMDEL,.XMACT,XMREPLY)
  1. Q
  1. CHEKBSKT(XMTO,XMK,XMZSUBJ,XMZFROM,XMZBSKT,XMACT) ; Basket number (or no basket at all)
  1. N XMREC
  1. S XMREC=$G(^XMB(3.7,XMTO,16))
  1. ; If the message hasn't been sent to a specific basket for this user
  1. ; and the sender specified a delivery basket, and the recipient is
  1. ; OK with that, then use the delivery basket.
  1. ; Note: The IN basket is not considered a 'specific basket'.
  1. I XMK<2,XMZBSKT'="","^^N^"'[(U_$P(XMREC,U,2)_U) S XMK=$$NAMEBSKT(XMTO,XMZBSKT,$P(XMREC,U,2)) Q:XMK
  1. ; If the message hasn't been sent to a specific basket for this user
  1. ; and active filters exist, and filtering is turned on,
  1. ; then filter the message.
  1. I XMK<2,$D(^XMB(3.7,XMTO,15,"AF")),$P(XMREC,U,1)="Y" D FILTER^XMTDF(XMTO,XMZ,XMZSUBJ,XMZFROM,.XMK,"",.XMACT) Q
  1. ; The message was sent to a specific basket for this user.
  1. I XMK Q:$D(^XMB(3.7,XMTO,2,XMK,0)) ; Quit if the basket XMK exists.
  1. S XMK=1 ; Since the basket doesn't exist, force to the IN basket
  1. Q:$D(^XMB(3.7,XMTO,2,XMK,0)) ; Quit if the IN basket exists.
  1. D MAKEBSKT^XMXBSKT(XMTO,XMK,$$EZBLD^DIALOG(37005)) ; Create the "IN" basket
  1. Q
  1. NAMEBSKT(XMTO,XMKN,XMZBOK) ; Basket name (not number)
  1. N XMK
  1. S XMK=$O(^XMB(3.7,XMTO,2,"B",XMKN,0))
  1. S:'XMK XMK=$$FIND1^DIC(3.701,","_XMTO_",","X",$$LOW^XLFSTR(XMKN))
  1. I XMK D Q XMK
  1. . Q:XMZBOK'="S" ; 'YES' or 'EXISTING ONLY'
  1. . S:$P(^XMB(3.7,XMTO,2,XMK,0),U,3)'="Y" XMK=0 ; 'SELECTED ONLY'
  1. ; Basket not found
  1. Q:XMZBOK'="Y" 0 ; quit if not 'YES'
  1. I XMKN=$$EZBLD^DIALOG(37004) S XMK=.5 D MAKEBSKT^XMXBSKT(XMTO,XMK,XMKN) Q XMK ; "WASTE"
  1. I XMKN=$$EZBLD^DIALOG(37005) S XMK=1 D MAKEBSKT^XMXBSKT(XMTO,XMK,XMKN) Q XMK ; "IN"
  1. D MAKEBSKT^XMXBSKT(XMTO,.XMK,XMKN)
  1. Q XMK
  1. ADDNEW(XMFROM,XMTO,XMK,XMZ,XMDEL,XMACT,XMREPLY) ;
  1. N XMFDA,XMIENS,XMIEN,XMTRIES
  1. S XMIENS="+1,"_XMK_","_XMTO_","
  1. S XMIEN(1)=XMZ
  1. S XMFDA(3.702,XMIENS,.01)=XMZ
  1. I XMK'=.5 D
  1. . I XMFROM'=XMTO D
  1. . . I $G(XMACT("NONEW")),'$$RESP^XMXUTIL2(XMZ),$$ZREAD^XMXUTIL2(XMTO,XMZ)="" Q
  1. . . S XMFDA(3.702,XMIENS,3)=1 ; new flag
  1. . . D INCRNEW^XMXUTIL(XMTO,XMK) ; New counts
  1. . I $G(XMACT("VDAYS")) D Q
  1. . . S XMFDA(3.702,XMIENS,5)=$$FMADD^XLFDT(DT,XMACT("VDAYS")) ; vapor date
  1. . . S XMFDA(3.702,XMIENS,7)=0 ; vapor date set by user
  1. . I XMDEL S XMFDA(3.702,XMIENS,5)=XMDEL ; vapor date
  1. ; Basket sequence number (XMKZ), and priority & new xrefs are handled by FM triggers.
  1. ATRY D UPDATE^DIE("S","XMFDA","XMIEN")
  1. I '$D(DIERR) D Q
  1. . Q:'$D(XMACT("FWD"))
  1. . I 'XMREPLY,XMFROM'=XMTO D FORWARD(XMTO,XMZ,XMACT("FWD"))
  1. S XMTRIES=$G(XMTRIES)+1
  1. I $D(^TMP("DIERR",$J,"E",110)) H 1 G ATRY ; Try again if can't lock
  1. Q
  1. MAKENEW(XMTO,XMK,XMZ) ;
  1. ; We ignore any "vapor" date here because this is an existing msg
  1. N XMFDA,XMREC
  1. S XMREC=$G(^XMB(3.7,XMTO,2,XMK,1,XMZ,0))
  1. I XMREC="" D Q:XMREC=""
  1. . ; Message entry should have been there, but it wasn't. Add it.
  1. . D FIXBSKT(XMTO,XMK,XMZ)
  1. . S XMREC=$G(^XMB(3.7,XMTO,2,XMK,1,XMZ,0)) Q:XMREC'=""
  1. . D ADDNEW(0,XMTO,XMK,XMZ,0)
  1. S XMFDA(3.702,XMZ_","_XMK_","_XMTO_",",3)=1 ; new flag
  1. ; Delete 'automatic delete date' if it was set by the system
  1. ; (during IN BASKET PURGE).
  1. S:$P(XMREC,U,7) XMFDA(3.702,XMZ_","_XMK_","_XMTO_",",5)="@"
  1. L +^XMB(3.7,XMTO,2,XMK,1,XMZ,0):1 ; Lock message
  1. ; Priority & new xrefs are handled by FM triggers.
  1. D FILE^DIE("","XMFDA")
  1. L -^XMB(3.7,XMTO,2,XMK,1,XMZ,0)
  1. D INCRNEW^XMXUTIL(XMTO,XMK) ; New counts
  1. Q
  1. SECRET(XMDATE,XMZ) ;
  1. ; Don't need to check to see if the user already has the msg, because
  1. ; at this point, we already know that he doesn't.
  1. N XMCRE8
  1. S XMCRE8=$P($G(^XMB(3.9,XMZ,.6)),U)
  1. Q $S('XMCRE8:0,XMDATE>XMCRE8:1,1:0) ; 1 means user may NOT see the msg.
  1. MOVENEW(XMFROM,XMTO,XMK,XMZ,XMACT) ; Move msg from WASTE bskt and make new
  1. N XMFDA,XMREC,XMIENS,XMIEN,XMTRIES
  1. S XMREC=$G(^XMB(3.7,XMTO,2,.5,1,XMZ,0))
  1. I XMREC="" D Q:XMREC=""
  1. . ; Message entry should have been there, but it wasn't.
  1. . D FIXBSKT(XMTO,.5,XMZ)
  1. . S XMREC=$G(^XMB(3.7,XMTO,2,.5,1,XMZ,0)) Q:XMREC'=""
  1. . D ADDNEW(XMFROM,XMTO,XMK,XMZ,0)
  1. S XMIENS="+1,"_XMK_","_XMTO_","
  1. S XMIEN(1)=XMZ
  1. S XMFDA(3.702,XMIENS,.01)=XMZ
  1. S:XMFROM'=XMTO XMFDA(3.702,XMIENS,3)=1 ; new flag
  1. S:$P(XMREC,U,4) XMFDA(3.702,XMIENS,4)=$P(XMREC,U,4) ; date last accessed
  1. ;I '$P(XMREC,U,7),$P(XMREC,U,5)>DT S XMFDA(3.702,XMIENS,5)=$P(XMREC,U,5) ; vapor date set by user, not system
  1. I $G(XMACT("VDAYS")) D
  1. . S XMFDA(3.702,XMIENS,5)=$$FMADD^XLFDT(DT,XMACT("VDAYS")) ; vapor date
  1. . S XMFDA(3.702,XMIENS,7)=0 ; vapor date set by user
  1. MTRY D UPDATE^DIE("S","XMFDA","XMIEN")
  1. I '$D(DIERR) D Q
  1. . D:XMFROM'=XMTO INCRNEW^XMXUTIL(XMTO,XMK) ; Increment new counts
  1. . N DA,DIK
  1. . S DA(2)=XMTO,DA(1)=.5,DA=XMZ
  1. . S DIK="^XMB(3.7,"_XMTO_",2,.5,1,"
  1. . D ^DIK ; delete msg from waste bskt
  1. S XMTRIES=$G(XMTRIES)+1
  1. I $D(^TMP("DIERR",$J,"E",110)) H 1 G MTRY ; Try again if can't lock
  1. Q
  1. FIXBSKT(XMTO,XMK,XMZ) ; Basket integrity check
  1. N XMERROR ; (set in ^XMUT4)
  1. L +^XMB(3.7,XMTO,2,XMK):1
  1. K ^XMB(3.7,"M",XMZ,XMTO,XMK) ; This xref is wrong.
  1. D BSKT^XMUT4(XMTO,XMK)
  1. L -^XMB(3.7,XMTO,2,XMK)
  1. Q
  1. FORWARD(XMTO,XMZ,XMFIEN) ;
  1. ; XMFIEN IEN of the filter which activated.
  1. N XMUPTR
  1. S XMUPTR=+$O(^XMB(3.9,XMZ,1,"C",XMTO,0))
  1. Q:$P($G(^XMB(3.9,XMZ,1,XMUPTR,0)),U,13)'="" ; already forwarded once.
  1. N XMFDA
  1. S XMFDA(3.91,XMUPTR_","_XMZ_",",15)=XMFIEN
  1. D FILE^DIE("","XMFDA")
  1. Q