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

XMXUTIL2.m

Go to the documentation of this file.
  1. XMXUTIL2 ;ISC-SF/GMB-Message info ;04/19/2002 13:34
  1. ;;8.0;MailMan;;Jun 28, 2002
  1. ; All entry points covered by DBIA 2736.
  1. QRESP(XMZ,XMZREC,XMWHICH) ; Function returns 0 if message XMZ is a message.
  1. ; If message XMZ is a response, returns XMZ of original message
  1. ; and, optionally, the response number as the second piece.
  1. ; in:
  1. ; XMZ XMZ of the message to be checked
  1. ; XMZREC (optional) 0-node of the message
  1. ; XMWHICH (optional) If the message is a response, should MailMan also
  1. ; return the response number as the second piece?
  1. ; (0=no (default); 1=yes)
  1. N XMZO
  1. I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
  1. S XMZO=$S($P(XMZREC,U,8):$P(XMZREC,U,8),$P(XMZREC,U)?1"R"1.N:+$E(XMZREC,2,99),1:"")
  1. ; The following test (XMZO'=XMZ) is necessary,
  1. ; because some old messages point to themselves as responses.
  1. I XMZO,XMZO'=XMZ Q:'$G(XMWHICH) XMZO D Q XMZO_U_XMWHICH
  1. . S XMWHICH=0 ; This is a response to message XMZO.
  1. . F S XMWHICH=$O(^XMB(3.9,XMZO,3,XMWHICH)) Q:'XMWHICH Q:^(XMWHICH,0)=XMZ
  1. Q 0 ; This is a message.
  1. INMSG(XMDUZ,XMK,XMZ,XMZREC,XMFLAGS,XMIM,XMINSTR,XMIU) ;
  1. ; Should NOT be called for responses!
  1. ; XMFLAGS If XMFLAGS["I" return internal only
  1. ; ["F" return FM date
  1. ; XMIU("KVAPOR") If applicable, user-specified vaporize date for message in basket
  1. ; XMIU("NEW") Is message new? (0=no; 1=yes; 2=yes, and priority, too)
  1. D INMSG1(XMDUZ,XMZ,.XMZREC,.XMFLAGS,.XMIM,.XMIU)
  1. D INMSG2(XMDUZ,XMZ,XMZREC,.XMIM,.XMINSTR,.XMIU)
  1. Q:'XMK
  1. N XMKREC
  1. S XMKREC=$G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
  1. I $P(XMKREC,U,5) S XMIU("KVAPOR")=$P(XMKREC,U,5)
  1. S XMIU("NEW")=$$NEW(XMDUZ,XMK,XMZ)
  1. Q
  1. INMSG1(XMDUZ,XMZ,XMZREC,XMFLAGS,XMIM,XMIU) ; (Should NOT be called for responses!)
  1. ; XMIM("RESPS")
  1. ; XMIU("IEN")
  1. ; XMIU("RESP")
  1. I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
  1. S XMFLAGS=$G(XMFLAGS)
  1. D INM(XMZ,XMZREC,XMFLAGS,.XMIM)
  1. I $D(XMIU) K XMIU
  1. S XMIU("IEN")=+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
  1. D INRESPS(XMZ,.XMIM,.XMIU)
  1. Q
  1. INM(XMZ,XMZREC,XMFLAGS,XMIM) ; For internal MailMan use only.
  1. ; XMIM and XMIU are killed first
  1. ; out:
  1. ; Always returned:
  1. ; XMIM("XMZ")
  1. ; XMIM("SUBJ")
  1. ; XMIM("FROM")
  1. ; XMIM("DATE")
  1. ; XMIM("CRE8")
  1. ; XMIM("SENDR")
  1. ; XMIM("LINES")
  1. ; XMIM("ENV FROM") 'Envelope From' returned only if it exists
  1. ; Returned if XMFLAGS'["I":
  1. ; XMIM("FROM DUZ")
  1. ; XMIM("FROM NAME")
  1. ; XMIM("DATE FM") Returned if XMFLAGS["F"
  1. ; XMIM("DATE MM") Returned if XMFLAGS'["F"
  1. ; XMIM("CRE8 MM") Returned if XMFLAGS'["F"
  1. ; XMIM("SENDR DUZ")
  1. ; XMIM("SENDR NAME")
  1. I $D(XMIM) K XMIM
  1. S XMIM("XMZ")=XMZ
  1. I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
  1. S XMIM("SUBJ")=$$SUBJ^XMXUTIL2(XMZREC)
  1. S XMIM("FROM")=$P(XMZREC,U,2)
  1. S XMIM("DATE")=$P(XMZREC,U,3)
  1. S XMIM("SENDR")=$P(XMZREC,U,4)
  1. S XMIM("CRE8")=$P($G(^XMB(3.9,XMZ,.6)),U)
  1. S XMIM("LINES")=+$P($G(^XMB(3.9,XMZ,2,0)),U,4)
  1. I $D(^XMB(3.9,XMZ,.7)) D
  1. . N XMNVFROM
  1. . S XMNVFROM=$P($G(^XMB(3.9,XMZ,.7)),U,1)
  1. . I XMNVFROM'="" S XMIM("ENV FROM")=XMNVFROM
  1. Q:XMFLAGS["I"
  1. I +XMIM("FROM")'=XMIM("FROM") S XMIM("FROM NAME")=XMIM("FROM")
  1. E S XMIM("FROM DUZ")=XMIM("FROM"),XMIM("FROM NAME")=$$NAME^XMXUTIL(XMIM("FROM"))
  1. I XMIM("SENDR")'="" D
  1. . I +XMIM("SENDR")'=XMIM("SENDR") S XMIM("SENDR NAME")=XMIM("SENDR")
  1. . E S XMIM("SENDR DUZ")=XMIM("SENDR"),XMIM("SENDR NAME")=$$NAME^XMXUTIL(XMIM("SENDR"))
  1. I XMFLAGS["F" D Q
  1. . I XMIM("DATE")?7N.E S XMIM("DATE FM")=XMIM("DATE") Q
  1. . S XMIM("DATE FM")=$$CONVERT^XMXUTIL1(XMIM("DATE"),1)
  1. S XMIM("DATE MM")=$$DATE(XMZREC,1) ; MailMan date
  1. S XMIM("CRE8 MM")=$$MMDT^XMXUTIL1(XMIM("CRE8")) ; MailMan date
  1. Q
  1. INRESPS(XMZ,XMIM,XMIU) ; How many responses? What's the user read?
  1. ; In:
  1. ; XMZ
  1. ; XMIU("IEN") ien of user's record in recipient multiple
  1. ; Out:
  1. ; XMIM("RESPS") message has this many responses
  1. ; XMIU("RESP") last response read by the user
  1. ; (null=not read at all; 0=original msg only; number=resp)
  1. S XMIM("RESPS")=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
  1. S XMIU("RESP")=$P($G(^XMB(3.9,XMZ,1,XMIU("IEN"),0)),U,2)
  1. Q
  1. INRESP(XMZ,XMIEN,XMFLAGS,XMIR) ; Get info on a response to a message.
  1. ; In:
  1. ; XMZ XMZ of original message
  1. ; XMIEN Which response (1 thru # of responses)
  1. ; XMFLAGS If XMFLAGS["I" return internal only
  1. ; ["F" return FM date
  1. ; Out:
  1. ; XMIR
  1. N XMZREC,XMZR
  1. K XMIR
  1. I '$D(^XMB(3.9,XMZ,3,XMIEN)) Q
  1. S XMZR=$G(^XMB(3.9,XMZ,3,XMIEN,0)) Q:'XMZR
  1. S XMZREC=$G(^XMB(3.9,XMZR,0))
  1. D INM(XMZR,XMZREC,XMFLAGS,.XMIR)
  1. ;Q:XMIR("SUBJ")'?1"R".N
  1. ;Q:XMFLAGS["I"
  1. ;S XMZREC=$G(^XMB(3.9,XMZ,0)) Q:XMZREC=""
  1. ;S XMIR("SUBJ X")="Re: "_$P(XMZREC,U,1)
  1. ;I XMIR("SUBJ X")["~U~" S XMIR("SUBJ")=$$DECODEUP^XMXUTIL1(XMIR("SUBJ X"))
  1. Q
  1. INMSG2(XMDUZ,XMZ,XMZREC,XMIM,XMINSTR,XMIU) ;
  1. ; Should NOT be called for responses!
  1. ; Does not kill XMIM, XMINSTR, or XMIU first
  1. ; XMIM("RECIPS") number of recipients of the message
  1. ; XMIU("ORIGN8") user sent message (0=no; 1=yes)
  1. ; The following are set only if applicable:
  1. ; XMINSTR("FLAGS")
  1. ; XMINSTR("RCPT BSKT")
  1. ; XMINSTR("TYPE")
  1. ; XMINSTR("VAPOR")
  1. ; XMINSTR("SCR HINT")
  1. S XMIM("RECIPS")=$P($G(^XMB(3.9,XMZ,1,0)),U,4)
  1. I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
  1. S XMIU("ORIGN8")=$$ORIGIN8R^XMXSEC(XMDUZ,XMZREC)
  1. S:$P(XMZREC,U,6)'="" XMINSTR("VAPOR")=$P(XMZREC,U,6)
  1. S XMINSTR("TYPE")=$P(XMZREC,U,7) ; Msg type (regular, KIDS, etc.)
  1. I $$PAKMAN^XMXSEC1(XMZ,XMZREC) D
  1. . Q:XMINSTR("TYPE")["K" ; KIDS
  1. . S:XMINSTR("TYPE")'["X" XMINSTR("TYPE")=XMINSTR("TYPE")_"X" ; PackMan
  1. S XMINSTR("FLAGS")=""
  1. S:"^Y^y^"[(U_$P(XMZREC,U,5)_U) XMINSTR("FLAGS")=XMINSTR("FLAGS")_"R" ; confirmation requested
  1. S:"^Y^y^"[(U_$P(XMZREC,U,9)_U) XMINSTR("FLAGS")=XMINSTR("FLAGS")_"X" ; closed
  1. S:"^Y^y^"[(U_$P(XMZREC,U,11)_U) XMINSTR("FLAGS")=XMINSTR("FLAGS")_"C" ; confidential
  1. S:"^Y^y^"[(U_$P(XMZREC,U,12)_U) XMINSTR("FLAGS")=XMINSTR("FLAGS")_"I" ; information only
  1. I $P(XMZREC,U,10)'="" S XMINSTR("SCR HINT")=$P(XMZREC,U,10)
  1. I $D(^XMB(3.9,XMZ,.5)) D
  1. . N XMZBSKT
  1. . S XMZBSKT=$P(^XMB(3.9,XMZ,.5),U,1)
  1. . S:XMZBSKT'="" XMINSTR("RCPT BSKT")=XMZBSKT
  1. Q:XMINSTR("TYPE")'["P"
  1. S XMINSTR("FLAGS")=XMINSTR("FLAGS")_"P" ; priority
  1. S XMINSTR("TYPE")=$TR(XMINSTR("TYPE"),"P")
  1. S:'$P($G(^XMB(3.9,XMZ,1,XMIU("IEN"),0)),U,9) XMINSTR("FLAGS")=XMINSTR("FLAGS")_"K" ; priority responses
  1. Q
  1. ZNODE(XMZ) ; Returns the zero node of the message.
  1. Q $G(^XMB(3.9,XMZ,0))
  1. ZDATE(XMZ,XMTIME) ; What is the message date? (Formatted by $$MMDT^XMXUTIL1)
  1. ; XMTIME =0 Date only
  1. ; =1 Date and time (default)
  1. Q $$DATE($G(^XMB(3.9,XMZ,0)),.XMTIME)
  1. DATE(XMZREC,XMTIME) ; What is the message date? (Formatted by $$MMDT^XMXUTIL1)
  1. ; XMTIME =0 Date only
  1. ; =1 Date and time (default)
  1. N XMDATE
  1. S XMDATE=$P(XMZREC,U,3)
  1. S XMTIME=+$G(XMTIME,1)
  1. I XMDATE?7N.E Q $$MMDT^XMXUTIL1($S(XMTIME:XMDATE,1:$E(XMDATE,1,7)))
  1. N XMFM
  1. S XMFM=$$CONVERT^XMXUTIL1(XMDATE,XMTIME)
  1. I XMFM=-1 Q XMDATE
  1. Q $$MMDT^XMXUTIL1(XMFM)
  1. ZSUBJ(XMZ) ; What is the message subject?
  1. Q $$SUBJ($G(^XMB(3.9,XMZ,0)))
  1. SUBJ(XMZREC) ; What is the message subject?
  1. N XMSUBJ
  1. S XMSUBJ=$P(XMZREC,U,1)
  1. I XMSUBJ="" Q $$EZBLD^DIALOG(34012) ;* No Subject *
  1. I XMSUBJ["~U~" Q $$DECODEUP^XMXUTIL1(XMSUBJ)
  1. Q XMSUBJ
  1. ZFROM(XMZ) ; Who sent the message?
  1. Q $$FROM($G(^XMB(3.9,XMZ,0)))
  1. FROM(XMZREC) ; Who sent the message?
  1. Q $$NAME^XMXUTIL($P(XMZREC,U,2))
  1. ZPRI(XMZ) ; Is the message priority?
  1. Q $$PRI($G(^XMB(3.9,XMZ,0)))
  1. PRI(XMZREC) ; Is the message priority?
  1. Q $P(XMZREC,U,7)["P"
  1. LINE(XMZ) ; How many lines does the message have?
  1. Q +$P($G(^XMB(3.9,XMZ,2,0)),U,4)
  1. RESP(XMZ) ; How many responses does this message have?
  1. Q +$P($G(^XMB(3.9,XMZ,3,0)),U,4)
  1. ZREAD(XMDUZ,XMZ) ; How many responses has the user read?
  1. ; null = the user has not read the message
  1. ; 0 = the user has read the original message only
  1. ; number = the user has read through this response
  1. N XMUPTR
  1. ;S XMUPTR=$O(^XMB(3.9,XMZ,1,"C",$S(XMDUZ=.6:DUZ,1:XMDUZ),0))
  1. S XMUPTR=+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
  1. ;Q:'XMUPTR ""
  1. Q $$READ($G(^XMB(3.9,XMZ,1,XMUPTR,0)))
  1. READ(XMZUREC) ; How many responses has the user read?
  1. ; null = the user has not read the message
  1. ; 0 = the user has read the original message only
  1. ; number = the user has read through this response
  1. Q $P(XMZUREC,U,2)
  1. BSKT(XMDUZ,XMZ,XMNAME) ; Which basket is the message in for this user?
  1. ; in:
  1. ; XMDUZ,XMZ
  1. ; XMNAME Return basket name as second piece? 0=no (default); 1=yes
  1. ; returns:
  1. ; 0 = it's not in any basket
  1. ; number = it's in this basket ien ($G(XMNAME)=0)
  1. ; number^name = it's in this basket ien^name (XMNAME=1)
  1. N XMK
  1. S XMK=+$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
  1. I 'XMK Q XMK
  1. I '$G(XMNAME) Q XMK
  1. Q XMK_U_$P($G(^XMB(3.7,XMDUZ,2,XMK,0)),U,1)
  1. NEW(XMDUZ,XMK,XMZ) ; Is the message new for this user?
  1. ; 0 = no; 1 = yes; 2 = yes, and it's priority, too.
  1. Q:$D(^XMB(3.7,XMDUZ,"N",XMK,XMZ)) 2
  1. Q:$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) 1
  1. Q 0
  1. KSEQN(XMDUZ,XMK,XMZ) ; What's the seqence number for this message in this user's basket?
  1. Q $$SEQN($G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)))
  1. SEQN(XMKZREC) ; What's the seqence number for this message in this user's basket?
  1. Q $P(XMKZREC,U,2)