| [613] | 1 | XMXUTIL2 ;ISC-SF/GMB-Message info ;04/19/2002 13:34
|
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
|---|
| 3 | ; All entry points covered by DBIA 2736.
|
|---|
| 4 | QRESP(XMZ,XMZREC,XMWHICH) ; Function returns 0 if message XMZ is a message.
|
|---|
| 5 | ; If message XMZ is a response, returns XMZ of original message
|
|---|
| 6 | ; and, optionally, the response number as the second piece.
|
|---|
| 7 | ; in:
|
|---|
| 8 | ; XMZ XMZ of the message to be checked
|
|---|
| 9 | ; XMZREC (optional) 0-node of the message
|
|---|
| 10 | ; XMWHICH (optional) If the message is a response, should MailMan also
|
|---|
| 11 | ; return the response number as the second piece?
|
|---|
| 12 | ; (0=no (default); 1=yes)
|
|---|
| 13 | N XMZO
|
|---|
| 14 | I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|---|
| 15 | S XMZO=$S($P(XMZREC,U,8):$P(XMZREC,U,8),$P(XMZREC,U)?1"R"1.N:+$E(XMZREC,2,99),1:"")
|
|---|
| 16 | ; The following test (XMZO'=XMZ) is necessary,
|
|---|
| 17 | ; because some old messages point to themselves as responses.
|
|---|
| 18 | I XMZO,XMZO'=XMZ Q:'$G(XMWHICH) XMZO D Q XMZO_U_XMWHICH
|
|---|
| 19 | . S XMWHICH=0 ; This is a response to message XMZO.
|
|---|
| 20 | . F S XMWHICH=$O(^XMB(3.9,XMZO,3,XMWHICH)) Q:'XMWHICH Q:^(XMWHICH,0)=XMZ
|
|---|
| 21 | Q 0 ; This is a message.
|
|---|
| 22 | INMSG(XMDUZ,XMK,XMZ,XMZREC,XMFLAGS,XMIM,XMINSTR,XMIU) ;
|
|---|
| 23 | ; Should NOT be called for responses!
|
|---|
| 24 | ; XMFLAGS If XMFLAGS["I" return internal only
|
|---|
| 25 | ; ["F" return FM date
|
|---|
| 26 | ; XMIU("KVAPOR") If applicable, user-specified vaporize date for message in basket
|
|---|
| 27 | ; XMIU("NEW") Is message new? (0=no; 1=yes; 2=yes, and priority, too)
|
|---|
| 28 | D INMSG1(XMDUZ,XMZ,.XMZREC,.XMFLAGS,.XMIM,.XMIU)
|
|---|
| 29 | D INMSG2(XMDUZ,XMZ,XMZREC,.XMIM,.XMINSTR,.XMIU)
|
|---|
| 30 | Q:'XMK
|
|---|
| 31 | N XMKREC
|
|---|
| 32 | S XMKREC=$G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
|
|---|
| 33 | I $P(XMKREC,U,5) S XMIU("KVAPOR")=$P(XMKREC,U,5)
|
|---|
| 34 | S XMIU("NEW")=$$NEW(XMDUZ,XMK,XMZ)
|
|---|
| 35 | Q
|
|---|
| 36 | INMSG1(XMDUZ,XMZ,XMZREC,XMFLAGS,XMIM,XMIU) ; (Should NOT be called for responses!)
|
|---|
| 37 | ; XMIM("RESPS")
|
|---|
| 38 | ; XMIU("IEN")
|
|---|
| 39 | ; XMIU("RESP")
|
|---|
| 40 | I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|---|
| 41 | S XMFLAGS=$G(XMFLAGS)
|
|---|
| 42 | D INM(XMZ,XMZREC,XMFLAGS,.XMIM)
|
|---|
| 43 | I $D(XMIU) K XMIU
|
|---|
| 44 | S XMIU("IEN")=+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
|
|---|
| 45 | D INRESPS(XMZ,.XMIM,.XMIU)
|
|---|
| 46 | Q
|
|---|
| 47 | INM(XMZ,XMZREC,XMFLAGS,XMIM) ; For internal MailMan use only.
|
|---|
| 48 | ; XMIM and XMIU are killed first
|
|---|
| 49 | ; out:
|
|---|
| 50 | ; Always returned:
|
|---|
| 51 | ; XMIM("XMZ")
|
|---|
| 52 | ; XMIM("SUBJ")
|
|---|
| 53 | ; XMIM("FROM")
|
|---|
| 54 | ; XMIM("DATE")
|
|---|
| 55 | ; XMIM("CRE8")
|
|---|
| 56 | ; XMIM("SENDR")
|
|---|
| 57 | ; XMIM("LINES")
|
|---|
| 58 | ; XMIM("ENV FROM") 'Envelope From' returned only if it exists
|
|---|
| 59 | ; Returned if XMFLAGS'["I":
|
|---|
| 60 | ; XMIM("FROM DUZ")
|
|---|
| 61 | ; XMIM("FROM NAME")
|
|---|
| 62 | ; XMIM("DATE FM") Returned if XMFLAGS["F"
|
|---|
| 63 | ; XMIM("DATE MM") Returned if XMFLAGS'["F"
|
|---|
| 64 | ; XMIM("CRE8 MM") Returned if XMFLAGS'["F"
|
|---|
| 65 | ; XMIM("SENDR DUZ")
|
|---|
| 66 | ; XMIM("SENDR NAME")
|
|---|
| 67 | I $D(XMIM) K XMIM
|
|---|
| 68 | S XMIM("XMZ")=XMZ
|
|---|
| 69 | I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|---|
| 70 | S XMIM("SUBJ")=$$SUBJ^XMXUTIL2(XMZREC)
|
|---|
| 71 | S XMIM("FROM")=$P(XMZREC,U,2)
|
|---|
| 72 | S XMIM("DATE")=$P(XMZREC,U,3)
|
|---|
| 73 | S XMIM("SENDR")=$P(XMZREC,U,4)
|
|---|
| 74 | S XMIM("CRE8")=$P($G(^XMB(3.9,XMZ,.6)),U)
|
|---|
| 75 | S XMIM("LINES")=+$P($G(^XMB(3.9,XMZ,2,0)),U,4)
|
|---|
| 76 | I $D(^XMB(3.9,XMZ,.7)) D
|
|---|
| 77 | . N XMNVFROM
|
|---|
| 78 | . S XMNVFROM=$P($G(^XMB(3.9,XMZ,.7)),U,1)
|
|---|
| 79 | . I XMNVFROM'="" S XMIM("ENV FROM")=XMNVFROM
|
|---|
| 80 | Q:XMFLAGS["I"
|
|---|
| 81 | I +XMIM("FROM")'=XMIM("FROM") S XMIM("FROM NAME")=XMIM("FROM")
|
|---|
| 82 | E S XMIM("FROM DUZ")=XMIM("FROM"),XMIM("FROM NAME")=$$NAME^XMXUTIL(XMIM("FROM"))
|
|---|
| 83 | I XMIM("SENDR")'="" D
|
|---|
| 84 | . I +XMIM("SENDR")'=XMIM("SENDR") S XMIM("SENDR NAME")=XMIM("SENDR")
|
|---|
| 85 | . E S XMIM("SENDR DUZ")=XMIM("SENDR"),XMIM("SENDR NAME")=$$NAME^XMXUTIL(XMIM("SENDR"))
|
|---|
| 86 | I XMFLAGS["F" D Q
|
|---|
| 87 | . I XMIM("DATE")?7N.E S XMIM("DATE FM")=XMIM("DATE") Q
|
|---|
| 88 | . S XMIM("DATE FM")=$$CONVERT^XMXUTIL1(XMIM("DATE"),1)
|
|---|
| 89 | S XMIM("DATE MM")=$$DATE(XMZREC,1) ; MailMan date
|
|---|
| 90 | S XMIM("CRE8 MM")=$$MMDT^XMXUTIL1(XMIM("CRE8")) ; MailMan date
|
|---|
| 91 | Q
|
|---|
| 92 | INRESPS(XMZ,XMIM,XMIU) ; How many responses? What's the user read?
|
|---|
| 93 | ; In:
|
|---|
| 94 | ; XMZ
|
|---|
| 95 | ; XMIU("IEN") ien of user's record in recipient multiple
|
|---|
| 96 | ; Out:
|
|---|
| 97 | ; XMIM("RESPS") message has this many responses
|
|---|
| 98 | ; XMIU("RESP") last response read by the user
|
|---|
| 99 | ; (null=not read at all; 0=original msg only; number=resp)
|
|---|
| 100 | S XMIM("RESPS")=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
|
|---|
| 101 | S XMIU("RESP")=$P($G(^XMB(3.9,XMZ,1,XMIU("IEN"),0)),U,2)
|
|---|
| 102 | Q
|
|---|
| 103 | INRESP(XMZ,XMIEN,XMFLAGS,XMIR) ; Get info on a response to a message.
|
|---|
| 104 | ; In:
|
|---|
| 105 | ; XMZ XMZ of original message
|
|---|
| 106 | ; XMIEN Which response (1 thru # of responses)
|
|---|
| 107 | ; XMFLAGS If XMFLAGS["I" return internal only
|
|---|
| 108 | ; ["F" return FM date
|
|---|
| 109 | ; Out:
|
|---|
| 110 | ; XMIR
|
|---|
| 111 | N XMZREC,XMZR
|
|---|
| 112 | K XMIR
|
|---|
| 113 | I '$D(^XMB(3.9,XMZ,3,XMIEN)) Q
|
|---|
| 114 | S XMZR=$G(^XMB(3.9,XMZ,3,XMIEN,0)) Q:'XMZR
|
|---|
| 115 | S XMZREC=$G(^XMB(3.9,XMZR,0))
|
|---|
| 116 | D INM(XMZR,XMZREC,XMFLAGS,.XMIR)
|
|---|
| 117 | ;Q:XMIR("SUBJ")'?1"R".N
|
|---|
| 118 | ;Q:XMFLAGS["I"
|
|---|
| 119 | ;S XMZREC=$G(^XMB(3.9,XMZ,0)) Q:XMZREC=""
|
|---|
| 120 | ;S XMIR("SUBJ X")="Re: "_$P(XMZREC,U,1)
|
|---|
| 121 | ;I XMIR("SUBJ X")["~U~" S XMIR("SUBJ")=$$DECODEUP^XMXUTIL1(XMIR("SUBJ X"))
|
|---|
| 122 | Q
|
|---|
| 123 | INMSG2(XMDUZ,XMZ,XMZREC,XMIM,XMINSTR,XMIU) ;
|
|---|
| 124 | ; Should NOT be called for responses!
|
|---|
| 125 | ; Does not kill XMIM, XMINSTR, or XMIU first
|
|---|
| 126 | ; XMIM("RECIPS") number of recipients of the message
|
|---|
| 127 | ; XMIU("ORIGN8") user sent message (0=no; 1=yes)
|
|---|
| 128 | ; The following are set only if applicable:
|
|---|
| 129 | ; XMINSTR("FLAGS")
|
|---|
| 130 | ; XMINSTR("RCPT BSKT")
|
|---|
| 131 | ; XMINSTR("TYPE")
|
|---|
| 132 | ; XMINSTR("VAPOR")
|
|---|
| 133 | ; XMINSTR("SCR HINT")
|
|---|
| 134 | S XMIM("RECIPS")=$P($G(^XMB(3.9,XMZ,1,0)),U,4)
|
|---|
| 135 | I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|---|
| 136 | S XMIU("ORIGN8")=$$ORIGIN8R^XMXSEC(XMDUZ,XMZREC)
|
|---|
| 137 | S:$P(XMZREC,U,6)'="" XMINSTR("VAPOR")=$P(XMZREC,U,6)
|
|---|
| 138 | S XMINSTR("TYPE")=$P(XMZREC,U,7) ; Msg type (regular, KIDS, etc.)
|
|---|
| 139 | I $$PAKMAN^XMXSEC1(XMZ,XMZREC) D
|
|---|
| 140 | . Q:XMINSTR("TYPE")["K" ; KIDS
|
|---|
| 141 | . S:XMINSTR("TYPE")'["X" XMINSTR("TYPE")=XMINSTR("TYPE")_"X" ; PackMan
|
|---|
| 142 | S XMINSTR("FLAGS")=""
|
|---|
| 143 | S:"^Y^y^"[(U_$P(XMZREC,U,5)_U) XMINSTR("FLAGS")=XMINSTR("FLAGS")_"R" ; confirmation requested
|
|---|
| 144 | S:"^Y^y^"[(U_$P(XMZREC,U,9)_U) XMINSTR("FLAGS")=XMINSTR("FLAGS")_"X" ; closed
|
|---|
| 145 | S:"^Y^y^"[(U_$P(XMZREC,U,11)_U) XMINSTR("FLAGS")=XMINSTR("FLAGS")_"C" ; confidential
|
|---|
| 146 | S:"^Y^y^"[(U_$P(XMZREC,U,12)_U) XMINSTR("FLAGS")=XMINSTR("FLAGS")_"I" ; information only
|
|---|
| 147 | I $P(XMZREC,U,10)'="" S XMINSTR("SCR HINT")=$P(XMZREC,U,10)
|
|---|
| 148 | I $D(^XMB(3.9,XMZ,.5)) D
|
|---|
| 149 | . N XMZBSKT
|
|---|
| 150 | . S XMZBSKT=$P(^XMB(3.9,XMZ,.5),U,1)
|
|---|
| 151 | . S:XMZBSKT'="" XMINSTR("RCPT BSKT")=XMZBSKT
|
|---|
| 152 | Q:XMINSTR("TYPE")'["P"
|
|---|
| 153 | S XMINSTR("FLAGS")=XMINSTR("FLAGS")_"P" ; priority
|
|---|
| 154 | S XMINSTR("TYPE")=$TR(XMINSTR("TYPE"),"P")
|
|---|
| 155 | S:'$P($G(^XMB(3.9,XMZ,1,XMIU("IEN"),0)),U,9) XMINSTR("FLAGS")=XMINSTR("FLAGS")_"K" ; priority responses
|
|---|
| 156 | Q
|
|---|
| 157 | ZNODE(XMZ) ; Returns the zero node of the message.
|
|---|
| 158 | Q $G(^XMB(3.9,XMZ,0))
|
|---|
| 159 | ZDATE(XMZ,XMTIME) ; What is the message date? (Formatted by $$MMDT^XMXUTIL1)
|
|---|
| 160 | ; XMTIME =0 Date only
|
|---|
| 161 | ; =1 Date and time (default)
|
|---|
| 162 | Q $$DATE($G(^XMB(3.9,XMZ,0)),.XMTIME)
|
|---|
| 163 | DATE(XMZREC,XMTIME) ; What is the message date? (Formatted by $$MMDT^XMXUTIL1)
|
|---|
| 164 | ; XMTIME =0 Date only
|
|---|
| 165 | ; =1 Date and time (default)
|
|---|
| 166 | N XMDATE
|
|---|
| 167 | S XMDATE=$P(XMZREC,U,3)
|
|---|
| 168 | S XMTIME=+$G(XMTIME,1)
|
|---|
| 169 | I XMDATE?7N.E Q $$MMDT^XMXUTIL1($S(XMTIME:XMDATE,1:$E(XMDATE,1,7)))
|
|---|
| 170 | N XMFM
|
|---|
| 171 | S XMFM=$$CONVERT^XMXUTIL1(XMDATE,XMTIME)
|
|---|
| 172 | I XMFM=-1 Q XMDATE
|
|---|
| 173 | Q $$MMDT^XMXUTIL1(XMFM)
|
|---|
| 174 | ZSUBJ(XMZ) ; What is the message subject?
|
|---|
| 175 | Q $$SUBJ($G(^XMB(3.9,XMZ,0)))
|
|---|
| 176 | SUBJ(XMZREC) ; What is the message subject?
|
|---|
| 177 | N XMSUBJ
|
|---|
| 178 | S XMSUBJ=$P(XMZREC,U,1)
|
|---|
| 179 | I XMSUBJ="" Q $$EZBLD^DIALOG(34012) ;* No Subject *
|
|---|
| 180 | I XMSUBJ["~U~" Q $$DECODEUP^XMXUTIL1(XMSUBJ)
|
|---|
| 181 | Q XMSUBJ
|
|---|
| 182 | ZFROM(XMZ) ; Who sent the message?
|
|---|
| 183 | Q $$FROM($G(^XMB(3.9,XMZ,0)))
|
|---|
| 184 | FROM(XMZREC) ; Who sent the message?
|
|---|
| 185 | Q $$NAME^XMXUTIL($P(XMZREC,U,2))
|
|---|
| 186 | ZPRI(XMZ) ; Is the message priority?
|
|---|
| 187 | Q $$PRI($G(^XMB(3.9,XMZ,0)))
|
|---|
| 188 | PRI(XMZREC) ; Is the message priority?
|
|---|
| 189 | Q $P(XMZREC,U,7)["P"
|
|---|
| 190 | LINE(XMZ) ; How many lines does the message have?
|
|---|
| 191 | Q +$P($G(^XMB(3.9,XMZ,2,0)),U,4)
|
|---|
| 192 | RESP(XMZ) ; How many responses does this message have?
|
|---|
| 193 | Q +$P($G(^XMB(3.9,XMZ,3,0)),U,4)
|
|---|
| 194 | ZREAD(XMDUZ,XMZ) ; How many responses has the user read?
|
|---|
| 195 | ; null = the user has not read the message
|
|---|
| 196 | ; 0 = the user has read the original message only
|
|---|
| 197 | ; number = the user has read through this response
|
|---|
| 198 | N XMUPTR
|
|---|
| 199 | ;S XMUPTR=$O(^XMB(3.9,XMZ,1,"C",$S(XMDUZ=.6:DUZ,1:XMDUZ),0))
|
|---|
| 200 | S XMUPTR=+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
|
|---|
| 201 | ;Q:'XMUPTR ""
|
|---|
| 202 | Q $$READ($G(^XMB(3.9,XMZ,1,XMUPTR,0)))
|
|---|
| 203 | READ(XMZUREC) ; How many responses has the user read?
|
|---|
| 204 | ; null = the user has not read the message
|
|---|
| 205 | ; 0 = the user has read the original message only
|
|---|
| 206 | ; number = the user has read through this response
|
|---|
| 207 | Q $P(XMZUREC,U,2)
|
|---|
| 208 | BSKT(XMDUZ,XMZ,XMNAME) ; Which basket is the message in for this user?
|
|---|
| 209 | ; in:
|
|---|
| 210 | ; XMDUZ,XMZ
|
|---|
| 211 | ; XMNAME Return basket name as second piece? 0=no (default); 1=yes
|
|---|
| 212 | ; returns:
|
|---|
| 213 | ; 0 = it's not in any basket
|
|---|
| 214 | ; number = it's in this basket ien ($G(XMNAME)=0)
|
|---|
| 215 | ; number^name = it's in this basket ien^name (XMNAME=1)
|
|---|
| 216 | N XMK
|
|---|
| 217 | S XMK=+$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
|
|---|
| 218 | I 'XMK Q XMK
|
|---|
| 219 | I '$G(XMNAME) Q XMK
|
|---|
| 220 | Q XMK_U_$P($G(^XMB(3.7,XMDUZ,2,XMK,0)),U,1)
|
|---|
| 221 | NEW(XMDUZ,XMK,XMZ) ; Is the message new for this user?
|
|---|
| 222 | ; 0 = no; 1 = yes; 2 = yes, and it's priority, too.
|
|---|
| 223 | Q:$D(^XMB(3.7,XMDUZ,"N",XMK,XMZ)) 2
|
|---|
| 224 | Q:$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) 1
|
|---|
| 225 | Q 0
|
|---|
| 226 | KSEQN(XMDUZ,XMK,XMZ) ; What's the seqence number for this message in this user's basket?
|
|---|
| 227 | Q $$SEQN($G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)))
|
|---|
| 228 | SEQN(XMKZREC) ; What's the seqence number for this message in this user's basket?
|
|---|
| 229 | Q $P(XMKZREC,U,2)
|
|---|
