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

XMTDT.m

Go to the documentation of this file. 
  1. XMTDT ;ISC-SF/GMB-Deliver later'd msgs & delete inactive msgs ;04/15/2003  12:48
  1.  ;;8.0;MailMan;**18**;Jun 28, 2002
  1.  ; Replaces ^XMADJ999,LATER^XMAD2 (ISC-WASH/CAP)
  1. GO ;
  1.  N XMWAIT
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  L +^XMBPOST("POST_Tickler"):1 E  Q
  1.  I $D(ZTQUEUED) S %=$$PSET^%ZTLOAD(ZTSK)
  1.  F  Q:$P($G(^XMB(1,1,0)),U,16)  D
  1.  . D LATERNEW
  1.  . D LATERFWD
  1.  . D PURGEOLD
  1.  . D FILTRFWD
  1.  . S XMWAIT=$$TSTAMP^XMXUTIL1      ; Why can't we just H 60?
  1.  . F  D  Q:$$TSTAMP^XMXUTIL1-XMWAIT>60
  1.  . . H XMHANG
  1.  L -^XMBPOST("POST_Tickler")
  1.  I $D(ZTQUEUED) D PCLEAR^%ZTLOAD(ZTSK)
  1.  Q
  1. LATERNEW ; This routine takes care of 'new'ing messages which the user
  1.  ; had previously 'later'ed for himself.
  1.  N XMNOW,XMLATER,DIK,XMDUZ,XMZ,DA,XMZREC,XMINACT
  1.  S XMNOW=$$NOW^XLFDT
  1.  S XMLATER=0
  1.  F  S XMLATER=$O(^XMB(3.73,"AB",XMLATER)) Q:XMLATER'>0!(XMLATER>XMNOW)  D
  1.  . S DIK="^XMB(3.73,"
  1.  . S XMDUZ=0
  1.  . F  S XMDUZ=$O(^XMB(3.73,"AB",XMLATER,XMDUZ)) Q:'XMDUZ  D
  1.  . . S XMINACT=$S($P($G(^VA(200,XMDUZ,0)),U,3)="":1,$P($G(^(.1)),U,2)="":1,$P($G(^(201)),U)="":1,1:0)  ; user is inactive if no access code, or verify code, or primary menu
  1.  . . S XMZ=0
  1.  . . F  S XMZ=$O(^XMB(3.73,"AB",XMLATER,XMDUZ,XMZ)) Q:'XMZ  D
  1.  . . . S DA=$O(^XMB(3.73,"AB",XMLATER,XMDUZ,XMZ,0)) Q:'DA
  1.  . . . I '$D(^XMB(3.73,DA,0)) D  Q  ; *** This should not be necessary
  1.  . . . . K ^XMB(3.73,"AB",XMLATER,XMDUZ,XMZ,DA)
  1.  . . . . K ^XMB(3.73,"AC",XMZ,XMDUZ,DA)
  1.  . . . . K ^XMB(3.73,"C",XMDUZ,DA)
  1.  . . . D ^DIK
  1.  . . . Q:XMINACT
  1.  . . . S XMZREC=$G(^XMB(3.9,XMZ,0)) Q:XMZREC=""
  1.  . . . D RESURECT^XMXMSGS2(XMDUZ,XMZ)
  1.  . . . D DELIVER^XMTDL2(XMDUZ,XMZ,$P(XMZREC,U,1),$P(XMZREC,U,2),0,1)
  1.  Q
  1. LATERFWD ; This routine takes care of forwarding messages which a user
  1.  ; had previously scheduled for 'later' delivery to other users.
  1.  N XMDUZ,XMNOW,XMLATER,DIK,XMIEN,XMZ,DA,XMREC,XMV,XMINSTR,XMTO,XMPRIVAT
  1.  K XMERR,^TMP("XMERR",$J)
  1.  S XMPRIVAT=$$EZBLD^DIALOG(39135) ; " [Private Mail Group]"
  1.  S XMINSTR("FWD BY XMDUZ")=""
  1.  S XMNOW=$$NOW^XLFDT
  1.  S XMLATER=0
  1.  F  S XMLATER=$O(^XMB(3.9,"AL",XMLATER)) Q:XMLATER'>0!(XMLATER>XMNOW)  D
  1.  . S XMZ=0
  1.  . F  S XMZ=$O(^XMB(3.9,"AL",XMLATER,XMZ)) Q:'XMZ  D
  1.  . . S DA(1)=XMZ
  1.  . . S DIK="^XMB(3.9,"_DA(1)_",7,"
  1.  . . S XMIEN=0
  1.  . . F  S XMIEN=$O(^XMB(3.9,"AL",XMLATER,XMZ,XMIEN)) Q:'XMIEN  D
  1.  . . . S XMREC=$G(^XMB(3.9,XMZ,7,XMIEN,0))
  1.  . . . I XMREC="" K ^XMB(3.9,"AL",XMLATER,XMZ,XMIEN) Q
  1.  . . . S XMDUZ=$P(XMREC,U,3)
  1.  . . . S XMTO=$P(XMREC,U,1)
  1.  . . . I XMTO[XMPRIVAT S XMTO=$P(XMTO,XMPRIVAT,1) ; " [Private Mail Group]" (set in ^XMXADDRG)
  1.  . . . I $P(XMREC,U,2)'="" S XMTO=$P(XMREC,U,2)_":"_XMTO
  1.  . . . D INIT^XMXADDR
  1.  . . . D CHKADDR^XMXADDR(XMDUZ,XMTO) K:$D(XMERR) XMERR,^TMP("XMERR",$J)
  1.  . . . S XMINSTR("FWD BY")=$P(XMREC,U,4)
  1.  . . . D:$D(^TMP("XMY",$J)) FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
  1.  . . . D CLEANUP^XMXADDR
  1.  . . . S DA=XMIEN
  1.  . . . D ^DIK
  1.  Q
  1. PURGEOLD ; This routine deletes msgs marked for automatic deletion,
  1.  ; whether marked by the user, or marked by the 'in basket purge'
  1.  ; because they hadn't been accessed for a certain number of days.
  1.  ; Replaces ^XMAI0 (ISC-WASH/CAP/RJ)
  1.  ; XMDDATE  Message delete date
  1.  N XMDDATE,XMDUZ,XMK,XMZ,XMNOW
  1.  S XMNOW=$$NOW^XLFDT
  1.  S (XMDDATE,XMDUZ,XMK,XMZ)=""
  1.  F  S XMDDATE=$O(^XMB(3.7,"AC",XMDDATE)) Q:XMDDATE=""!(XMDDATE>XMNOW)  D
  1.  . F  S XMDUZ=$O(^XMB(3.7,"AC",XMDDATE,XMDUZ)) Q:XMDUZ=""  D
  1.  . . F  S XMK=$O(^XMB(3.7,"AC",XMDDATE,XMDUZ,XMK)) Q:XMK=""  D
  1.  . . . F  S XMZ=$O(^XMB(3.7,"AC",XMDDATE,XMDUZ,XMK,XMZ)) Q:XMZ=""  D
  1.  . . . . I $D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
  1.  . . . . K ^XMB(3.7,"AC",XMDDATE,XMDUZ,XMK,XMZ)
  1.  Q
  1. FILTRFWD ; This routine forwards messages for a user when a filter
  1.  ; with 'forward to' recipients has activated during message delivery.
  1.  N XMDUZ,XMUPTR,XMZ,XMREC,XMV,XMINSTR,XMTO,XMPRIVAT,XMFIEN,XMFWDIEN
  1.  S XMPRIVAT=$$EZBLD^DIALOG(39135) ; " [Private Mail Group]"
  1.  S XMINSTR("FWD BY XMDUZ")="F"
  1.  S XMFIEN=0
  1.  F  S XMFIEN=$O(^XMB(3.9,"AF",XMFIEN)) Q:'XMFIEN  D
  1.  . S XMZ=0
  1.  . F  S XMZ=$O(^XMB(3.9,"AF",XMFIEN,XMZ)) Q:'XMZ  D
  1.  . . S XMUPTR=0
  1.  . . F  S XMUPTR=$O(^XMB(3.9,"AF",XMFIEN,XMZ,XMUPTR)) Q:'XMUPTR  D
  1.  . . . S XMREC=$G(^XMB(3.9,XMZ,1,XMUPTR,0))
  1.  . . . S XMDUZ=$P(XMREC,U,1)
  1.  . . . I XMREC=""!'XMDUZ!($P(XMREC,U,13)'=XMFIEN) K ^XMB(3.9,"AF",XMFIEN,XMZ,XMUPTR) Q
  1.  . . . S XMFWDIEN=0
  1.  . . . D INIT^XMXADDR
  1.  . . . F  S XMFWDIEN=$O(^XMB(3.7,XMDUZ,15,XMFIEN,1,XMFWDIEN)) Q:'XMFWDIEN  S XMREC=$G(^(XMFWDIEN,0)) D
  1.  . . . . S XMTO=$P(XMREC,U,1) Q:XMTO=""
  1.  . . . . N XMERROR,XMFULL,XMFWDADD
  1.  . . . . I XMTO[XMPRIVAT S XMTO=$P(XMTO,XMPRIVAT,1) ; " [Private Mail Group]" (set in ^XMXADDRG)
  1.  . . . . ;I $P(XMREC,U,2)'="" S XMTO=$P(XMREC,U,2)_":"_XMTO
  1.  . . . . D ADDRESS^XMXADDR(XMDUZ,XMTO,.XMFULL,.XMERROR) Q:'$D(XMERROR)
  1.  . . . . D DELFWDTO^XMTDF(XMDUZ,XMFIEN,XMFWDIEN,XMTO,$$GETERR^XMXADDR4)
  1.  . . . S XMINSTR("FWD BY")=$$NAME^XMXUTIL(XMDUZ)
  1.  . . . D:$D(^TMP("XMY",$J)) FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
  1.  . . . D CLEANUP^XMXADDR
  1.  . . . N XMFDA
  1.  . . . S XMFDA(3.91,XMUPTR_","_XMZ_",",15)=0 ; filter forward completed
  1.  . . . D FILE^DIE("","XMFDA")
  1.  Q