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

XMXMSGS2.m

Go to the documentation of this file.
  1. XMXMSGS2 ;ISC-SF/GMB-Message APIs (cont.) ;03/25/2003 15:04
  1. ;;8.0;MailMan;**16**;Jun 28, 2002
  1. DEL(XMDUZ,XMK,XMZ,XMCNT) ; For many messages, pass in XMCNT; for 1, don't
  1. XDEL ;
  1. I '$G(XMK) S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,"")) Q:'XMK
  1. I XMDUZ'=DUZ,'$$DELETE^XMXSEC(XMDUZ,XMK,XMZ) Q
  1. S:$D(XMCNT) XMCNT=XMCNT+1
  1. D ZAPIT(XMDUZ,XMK,XMZ,.XMCNT)
  1. D WASTEIT(XMDUZ,XMK,XMZ)
  1. Q
  1. FLTR(XMDUZ,XMK,XMKN,XMZ,XMCNT,XMKTO,XMKNTO) ; Filter message
  1. XFLTR ;
  1. ; XMK (in) the basket # the message is currently in. (May be 0 if
  1. ; the message isn't currently in a basket.)
  1. ; XMKN (in) the name of basket XMK
  1. ; XMKTO (out) the basket # this routine decides to put the message in
  1. ; XMKNTO (out) the name of basket XMKTO
  1. ; This routine decides which basket the message belongs in.
  1. ; If this is the same basket it is currently in, it sets XMKTO and
  1. ; XMKNTO to the current basket.
  1. ; Otherwise, it moves the message (from the current basket) to the
  1. ; decided-upon basket and sets XMKTO and XMKNTO to that basket.
  1. ; If the message is in the WASTE basket, and no filters are defined,
  1. ; it will be moved to the IN basket.
  1. I '$G(XMK) D
  1. . S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
  1. . S:XMK XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
  1. I XMDUZ=.6,XMK'=.5,'$$MOVE^XMXSEC(XMDUZ,XMZ) Q
  1. S:$D(XMCNT) XMCNT=XMCNT+1
  1. I $D(^XMB(3.7,XMDUZ,15,"AF")) D
  1. . N XMZREC
  1. . S XMZREC=$G(^XMB(3.9,XMZ,0))
  1. . D FILTER^XMTDF(XMDUZ,XMZ,$P(XMZREC,U,1),$P(XMZREC,U,2),.XMKTO,.XMKNTO)
  1. . I XMKTO=1,XMK>1 S XMKTO=XMK,XMKNTO=XMKN
  1. E I XMK>1 S XMKTO=XMK,XMKNTO=XMKN
  1. E S XMKTO=1,XMKNTO=$$EZBLD^DIALOG(37005) ; "IN"
  1. Q:XMK=XMKTO
  1. I XMK D MOVEIT(XMDUZ,XMK,XMZ,XMKTO,.XMCNT) Q
  1. D PUTMSG(XMDUZ,XMKTO,XMKNTO,XMZ)
  1. Q
  1. LATER(XMDUZ,XMZ,XMWHEN,XMCNT) ;
  1. XLATER ;
  1. S:$D(XMCNT) XMCNT=XMCNT+1
  1. D LTRADD^XMJMD(XMDUZ,XMZ,XMWHEN)
  1. Q
  1. MOVE(XMDUZ,XMK,XMZ,XMKTO,XMCNT) ;
  1. XMOVE ;
  1. I XMDUZ=.6,'$$MOVE^XMXSEC(XMDUZ,XMZ) Q
  1. ; If 2 users are reading the same msg at the same time, one may get an
  1. ; abort if tries to save msg to another bskt, if the msg has already
  1. ; been moved by the other user. So this next line makes sure no abort.
  1. I '$D(^XMB(3.7,"M",XMZ,XMDUZ,+$G(XMK))) S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
  1. Q:XMK=XMKTO
  1. I XMKTO=.5,'$$DELETE^XMXSEC(XMDUZ,"",XMZ) Q ; Can't save confidential to WASTE bskt.
  1. D MOVEIT(XMDUZ,XMK,XMZ,XMKTO,.XMCNT)
  1. S:$D(XMCNT) XMCNT=XMCNT+1
  1. Q
  1. MOVEIT(XMDUZ,XMK,XMZ,XMKTO,XMCNT) ;
  1. I XMK D
  1. . D COPYIT(XMDUZ,XMK,XMZ,XMKTO,.XMCNT)
  1. . D ZAPIT(XMDUZ,XMK,XMZ,.XMCNT)
  1. ; The message is not in the user's mailbox
  1. E D PUTMSG(XMDUZ,XMKTO,$P(^XMB(3.7,XMDUZ,2,XMKTO,0),U),XMZ)
  1. Q
  1. NTOGL(XMDUZ,XMK,XMKN,XMZ,XMCNT,XMKTO,XMKNTO) ;
  1. XNTOGL ;
  1. ; If XMK>.5, then it's simple. Just toggle the 'new' flag.
  1. ; If XMK<1, we know the message is not new, and we need to make it new.
  1. ; Filter it, but if it filters to the WASTE basket put it in the IN.
  1. ; Then make it new.
  1. I '$G(XMK) D
  1. . S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
  1. . S:XMK XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
  1. I XMK<1 D
  1. . I $D(^XMB(3.7,XMDUZ,15,"AF")) D
  1. . . N XMZREC
  1. . . S XMZREC=$G(^XMB(3.9,XMZ,0))
  1. . . D FILTER^XMTDF(XMDUZ,XMZ,$P(XMZREC,U,1),$P(XMZREC,U,2),.XMKTO,.XMKNTO)
  1. . . I XMKTO=1,XMK>1 S XMKTO=XMK,XMKNTO=XMKN Q
  1. . . I XMKTO<1 S XMKTO=1,XMKNTO=$$EZBLD^DIALOG(37005) ; "IN"
  1. . E I XMK>1 S XMKTO=XMK,XMKNTO=XMKN
  1. . E S XMKTO=1,XMKNTO=$$EZBLD^DIALOG(37005) ; "IN"
  1. . Q:XMK=XMKTO
  1. . I XMK D MOVEIT(XMDUZ,XMK,XMZ,XMKTO,.XMCNT) Q
  1. . D PUTMSG(XMDUZ,XMKTO,XMKNTO,XMZ)
  1. E S XMKTO=XMK,XMKNTO=XMKN
  1. I $D(XMCNT) D Q
  1. . N XMFDA
  1. . I $$NEW^XMXUTIL2(XMDUZ,XMKTO,XMZ) D
  1. . . S XMFDA(3.702,XMZ_","_XMKTO_","_XMDUZ_",",3)="@" ; no longer new
  1. . . S XMCNT(XMKTO,"DECR")=$G(XMCNT(XMKTO,"DECR"))+1
  1. . E D
  1. . . S XMFDA(3.702,XMZ_","_XMKTO_","_XMDUZ_",",3)="1" ; new
  1. . . S XMCNT(XMKTO,"INCR")=$G(XMCNT(XMKTO,"INCR"))+1
  1. . D FILE^DIE("","XMFDA")
  1. . S XMCNT=XMCNT+1
  1. I $$NEW^XMXUTIL2(XMDUZ,XMKTO,XMZ) D NONEW^XMXUTIL(XMDUZ,XMKTO,XMZ) Q
  1. D MAKENEW^XMXUTIL(XMDUZ,XMKTO,XMZ)
  1. Q
  1. TERM(XMDUZ,XMK,XMZ,XMCNT) ;
  1. XTERM ;
  1. N XMIEN
  1. S:'$G(XMK) XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
  1. I XMDUZ'=DUZ,'$$DELETE^XMXSEC(XMDUZ,XMK,XMZ) Q
  1. I XMK D
  1. . D ZAPIT(XMDUZ,XMK,XMZ,.XMCNT)
  1. . D WASTEIT(XMDUZ,XMK,XMZ)
  1. S XMIEN=+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
  1. S:XMIEN ^XMB(3.9,XMZ,1,XMIEN,"D")=DT
  1. S:$D(XMCNT) XMCNT=XMCNT+1
  1. Q
  1. VAPOR(XMDUZ,XMK,XMZ,XMWHEN,XMCNT) ;
  1. XVAPOR ;
  1. I '$G(XMK) S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,"")) Q:'XMK
  1. I XMDUZ'=DUZ,'$$DELETE^XMXSEC(XMDUZ,XMK,XMZ) Q
  1. S:$D(XMCNT) XMCNT=XMCNT+1
  1. D KVAPOR^XMXUTIL(XMDUZ,XMK,XMZ,XMWHEN)
  1. Q
  1. PUTMSG(XMDUZ,XMK,XMKN,XMZ) ; For internal MM use only.
  1. ; Replaces SETSB^XMA1C, SET^XMS1, & part of MAIL^XMR0B
  1. ; Put a msg in the Postmaster's (or anyone else's) basket.
  1. ; The msg is NOT made new.
  1. ; The basket has a specific name and number.
  1. ; If the basket doesn't exist, create it.
  1. ; XMK Basket number
  1. ; XMKN Basket name
  1. ; XMZ Msg number
  1. N XMFDA,XMIEN,XMTRIES
  1. Q:$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
  1. I XMDUZ'=.5 D RESURECT(XMDUZ,XMZ)
  1. I $D(^XMB(3.7,XMDUZ,2,XMK)) D
  1. . S XMFDA(3.702,"+1,"_XMK_","_XMDUZ_",",.01)=XMZ
  1. . S XMIEN(1)=XMZ
  1. E D
  1. . S XMFDA(3.701,"+1,"_XMDUZ_",",.01)=XMKN
  1. . S XMFDA(3.702,"+2,+1,"_XMDUZ_",",.01)=XMZ
  1. . S XMIEN(1)=XMK
  1. . S XMIEN(2)=XMZ
  1. PTRY D UPDATE^DIE("S","XMFDA","XMIEN") Q:'$D(DIERR)
  1. S XMTRIES=$G(XMTRIES)+1
  1. I $D(^TMP("DIERR",$J,"E",110)) H 1 G PTRY ; Try again if can't lock
  1. Q
  1. COPYIT(XMDUZ,XMK,XMZ,XMKTO,XMCNT) ;
  1. Q:$D(^XMB(3.7,XMDUZ,2,XMKTO,1,XMZ)) ; Message already exists at destination
  1. N XMFDA,XMKREC,XMIENS,XMIEN,XMTRIES
  1. S XMKREC=^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)
  1. S XMIENS="+1,"_XMKTO_","_XMDUZ_","
  1. S XMIEN(1)=XMZ
  1. S XMFDA(3.702,XMIENS,.01)=XMZ
  1. I XMKTO'=.5 D
  1. . I $P(XMKREC,U,3) S XMFDA(3.702,XMIENS,3)=$P(XMKREC,U,3) ; new flag
  1. . I '$P(XMKREC,U,7),$P(XMKREC,U,5) S XMFDA(3.702,XMIENS,5)=$P(XMKREC,U,5) ; vapor date
  1. S:$P(XMKREC,U,4) XMFDA(3.702,XMIENS,4)=$P(XMKREC,U,4) ; date last accessed
  1. S:$P(XMKREC,U,6) XMFDA(3.702,XMIENS,6)=$P(XMKREC,U,6) ; ntwk msg flag
  1. CTRY D UPDATE^DIE("S","XMFDA","XMIEN")
  1. I '$D(DIERR) D Q
  1. . I XMK=.5 D RESURECT(XMDUZ,XMZ) Q
  1. . Q:'$G(XMFDA(3.702,XMIENS,3)) ; quit if not new
  1. . I $D(XMCNT) S XMCNT(XMKTO,"INCR")=$G(XMCNT(XMKTO,"INCR"))+1 Q
  1. . D INCRNEW^XMXUTIL(XMDUZ,XMKTO) ; Increment new counts
  1. S XMTRIES=$G(XMTRIES)+1
  1. I $D(^TMP("DIERR",$J,"E",110)) H 1 G CTRY ; Try again if can't lock
  1. Q
  1. RESURECT(XMDUZ,XMZ) ; If msg was terminated, "unterminate" it.
  1. N XMIEN
  1. S XMIEN=+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
  1. K:$D(^XMB(3.9,XMZ,1,XMIEN,"D")) ^XMB(3.9,XMZ,1,XMIEN,"D")
  1. Q
  1. ZAPIT(XMDUZ,XMK,XMZ,XMCNT) ;
  1. I $D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) D
  1. . I $D(XMCNT) S XMCNT(XMK,"DECR")=$G(XMCNT(XMK,"DECR"))+1 Q
  1. . D DECRNEW^XMXUTIL(XMDUZ,XMK)
  1. N DA,DIK
  1. S DA(2)=XMDUZ,DA(1)=XMK,DA=XMZ
  1. S DIK="^XMB(3.7,"_XMDUZ_",2,"_XMK_",1,"
  1. D ^DIK
  1. Q
  1. WASTEIT(XMDUZ,XMK,XMZ) ;
  1. Q:XMK=.5
  1. Q:$D(^XMB(3.7,XMDUZ,2,.5,1,XMZ)) ; Already in wastebasket
  1. N XMFDA,XMIENS,XMIEN,XMTRIES
  1. S XMK=.5
  1. D:'$D(^XMB(3.7,XMDUZ,2,.5,0)) MAKEBSKT^XMXBSKT(XMDUZ,.5,$$EZBLD^DIALOG(37004)) ; WASTE
  1. S XMIENS="+1,"_XMK_","_XMDUZ_","
  1. S XMIEN(1)=XMZ
  1. S XMFDA(3.702,XMIENS,.01)=XMZ
  1. S XMFDA(3.702,XMIENS,4)=$$NOW^XLFDT ; date/time last accessed
  1. WTRY D UPDATE^DIE("S","XMFDA","XMIEN") Q:'$D(DIERR)
  1. S XMTRIES=$G(XMTRIES)+1
  1. I $D(^TMP("DIERR",$J,"E",110)) H 1 G WTRY ; Try again if can't lock
  1. Q