- 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 Jan 18, 2025@03:15:32 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)