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