XMXUTIL ;ISC-SF/GMB-Message & Mailbox Utilities ;06/19/2002 07:39
;;8.0;MailMan;;Jun 28, 2002
; All entry points covered by DBIA 2734.
WAIT ;
N DIR,Y,DIRUT S DIR(0)="E",DIR("A")=$$EZBLD^DIALOG(37003) D ^DIR ; Press RETURN to continue
Q
PAGE(XMABORT) ;
N DIR,Y,DIRUT S DIR(0)="E" D ^DIR I $D(DIRUT) S XMABORT=1
Q
NEWS(XMDUZ,XMTEST) ;
; Given:
; XMDUZ User's DUZ
; XMTEST 0=this is not a test. (DEFAULT)
; (Field 1.12 LAST NEW MSG NOTIFY DATE/TIME may be updated)
; 1=this is just a test.
; (Field 1.12 will not be updated)
; Returns:
; -1 If no record of this user
; 0 If no new mail
; Otherwise, if the user has new mail, returns an ^-delimited string:
; Piece 1: # New Msgs
; Piece 2: Does the user have new priority mail? (1=yes;0=no)
; Piece 3: # New Msgs in IN basket
; Piece 4: Date/Time (FileMan) that the last msg was received
; Piece 5: Have there been any new messages since the last time
; this function was called? (1=yes;0=no)
; And for the first priority read basket with new messages in it:
; (If none has new messages, then first priority read basket)
; Piece 6: # New Msgs in basket
; Piece 7: Basket IEN
; Piece 8: Basket name
N XMREC,XMNEW,XMRECEIV,XMNOTIFY
S XMREC=$G(^XMB(3.7,XMDUZ,0))
Q:XMREC="" -1
S XMNEW=+$P(XMREC,U,6)
Q:'XMNEW 0
S XMRECEIV=$P(XMREC,U,14) ; date/time last msg received
S XMNOTIFY=$P(XMREC,U,15) ; date/time user last notified
I XMRECEIV>XMNOTIFY,'$G(XMTEST) S $P(^XMB(3.7,XMDUZ,0),U,15)=XMRECEIV
Q XMNEW_U_($D(^XMB(3.7,XMDUZ,"N"))>0)_U_+$P(^XMB(3.7,XMDUZ,2,1,0),U,2)_U_XMRECEIV_U_(XMRECEIV>XMNOTIFY)_U_$$NPBSKT^XMJBN(XMDUZ)
TNMSGCT(XMDUZ) ; Total new msg count
Q +$P(^XMB(3.7,XMDUZ,0),U,6)
BNMSGCT(XMDUZ,XMK) ; Basket new msg count
Q +$P(^XMB(3.7,XMDUZ,2,XMK,0),U,2)
TPMSGCT(XMDUZ) ; Total new priority msg count
I '$D(^XMB(3.7,XMDUZ,"N")) Q 0
N XMK,I,XMZ
S (XMK,I,XMZ)=0
F S XMK=$O(^XMB(3.7,XMDUZ,"N",XMK)) Q:'XMK D
. F I=I:1 S XMZ=$O(^XMB(3.7,XMDUZ,"N",XMK,XMZ)) Q:'XMZ
Q I
BPMSGCT(XMDUZ,XMK) ; Basket new priority msg count
I '$D(^XMB(3.7,XMDUZ,"N",XMK)) Q 0
N I,XMZ
S XMZ=0
F I=0:1 S XMZ=$O(^XMB(3.7,XMDUZ,"N",XMK,XMZ)) Q:'XMZ
Q I
TMSGCT(XMDUZ) ; Total msg count
N I,XMK
S I=0,XMK=.99
F S XMK=$O(^XMB(3.7,XMDUZ,2,XMK)) Q:XMK'>0 S I=I+$$BMSGCT(XMDUZ,XMK)
Q I
BMSGCT(XMDUZ,XMK) ; Basket msg count
Q +$P($G(^XMB(3.7,XMDUZ,2,XMK,1,0)),U,4)
KVAPOR(XMDUZ,XMK,XMZ,XMVAPOR,XMIU) ; Set/delete a message's vaporize date in user's basket
; XMVAPOR ="@" delete it
; =FM date/time set/change it
N XMFDA,XMIENS
S XMIENS=XMZ_","_XMK_","_XMDUZ_","
S XMFDA(3.702,XMIENS,5)=XMVAPOR
I XMVAPOR="@" D
. K XMIU("KVAPOR")
. S XMFDA(3.702,XMIENS,7)="@"
E D
. S XMIU("KVAPOR")=XMVAPOR
. S XMFDA(3.702,XMIENS,7)=0
D FILE^DIE("","XMFDA")
Q
BSKTNAME(XMDUZ,XMK) ; What's the name of this basket for this user?
Q $P($G(^XMB(3.7,XMDUZ,2,XMK,0)),U,1)
NAME(XMID,XMIT) ; Given a name or DUZ, return the name
; XMID user's DUZ or name
; XMIT 1=if DUZ, return institution and title, too, if needed
; 0=just return the name (default)
Q:+XMID'=XMID $S(XMID'="":XMID,1:$$EZBLD^DIALOG(34009)) ; * No Name *
N XMNAME,XMTITLE,XMINST
I '$D(^VA(200,XMID,0)) Q $$EZBLD^DIALOG(34010,XMID) ; * User #|1| * (not in NEW PERSON file)
S XMNAME("FILE")=200,XMNAME("IENS")=XMID_",",XMNAME("FIELD")=.01
S XMNAME=$$NAMEFMT^XLFNAME(.XMNAME,"F","C")
Q:'$G(XMIT) XMNAME
I XMV("SHOW TITL") D
. I XMV("TITL SRC")="S" S XMTITLE=$P($G(^VA(200,XMID,20)),U,3) ; field 20.3, SIGNATURE BLOCK TITLE
. I $G(XMTITLE)="",$P(^VA(200,XMID,0),U,9) S XMTITLE=$P($G(^DIC(3.1,$P(^(0),U,9),0)),U) ; field 8, TITLE
. S:$G(XMTITLE)'="" XMNAME=XMNAME_" - "_XMTITLE
I XMV("SHOW INST"),$D(^XMB(3.7,XMID,6000)) D
. S XMINST=$P(^XMB(3.7,XMID,6000),U)
. S:XMINST'="" XMNAME=XMNAME_" ("_XMINST_")"
Q XMNAME
NETNAME(XMDUZ) ; Given a DUZ or a string, return an internet name @ site name.
N XMNETNAM
Q:XMDUZ["@" XMDUZ
I +XMDUZ=XMDUZ!(XMDUZ="") D
. S:'XMDUZ XMDUZ=.5
. ; Use Mail Name. Lacking that, use real name.
. S XMNETNAM=$S($L($P($G(^XMB(3.7,XMDUZ,.3)),U)):$P(^(.3),U),1:$$NAME(XMDUZ))
. I $E(XMNETNAM)=$C(34),$E(XMNETNAM,$L(XMNETNAM))=$C(34) Q ; Ignore if quoted
. I XMNETNAM?.E1C.E!($TR(XMNETNAM,$C(34)_"<>()[];:")'=XMNETNAM) S XMNETNAM=$C(34)_XMNETNAM_$C(34) Q ; Quote if illegal
. I XMNETNAM[","!(XMNETNAM[" ") S XMNETNAM=$TR(XMNETNAM,", .","._+") ; Translate
E D
. S XMNETNAM=XMDUZ
. I $E(XMNETNAM)'=$C(34),$E(XMNETNAM,$L(XMNETNAM))'=$C(34) D
. . I $E(XMNETNAM)="<",$E(XMNETNAM,$L(XMNETNAM))=">" D I $E(XMNETNAM)=$C(34),$E(XMNETNAM,$L(XMNETNAM))=$C(34) Q
. . . S XMNETNAM=$E(XMNETNAM,2,$L(XMNETNAM)-1)
. . I XMNETNAM?.E1C.E!($TR(XMNETNAM,$C(34)_" ,<>()[];:")'=XMNETNAM) S XMNETNAM=$C(34)_XMNETNAM_$C(34) ; Quote if illegal
Q XMNETNAM_"@"_^XMB("NETNAME")
LOCK(XMDOOR,XMLOCKED,XMWAIT) ; Lock a global (** NOT USED **)
L +@XMDOOR:$G(XMWAIT,0) E S XMLOCKED=0 Q
S XMLOCKED=1
Q
MAKENEW(XMDUZ,XMK,XMZ,XMLOCKIT) ; Make a message new
; Should lock before calling AND unlock after.
; If you set XMLOCKIT=1, I'll do the locking for you.
Q:$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ))
Q:'$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ))
N XMFDA
S XMFDA(3.702,XMZ_","_XMK_","_XMDUZ_",",3)="1" ; new
I $G(XMLOCKIT) L +^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0):1
D FILE^DIE("","XMFDA")
I $G(XMLOCKIT) L -^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)
D INCRNEW(XMDUZ,XMK)
Q
INCRNEW(XMDUZ,XMK,XMCNT) ; Increment the number of new messages in a basket
; For internal use only!
S:'$D(XMCNT) XMCNT=1
L +^XMB(3.7,XMDUZ,0):1
S $P(^(0),U,2)=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,2)+XMCNT ; New msgs in bskt
S $P(^(0),U,6)=$P(^XMB(3.7,XMDUZ,0),U,6)+XMCNT ; New msgs for user
S $P(^XMB(3.7,XMDUZ,0),U,14)=$$NOW^XLFDT ; When last msg rec'd
L -^XMB(3.7,XMDUZ,0)
Q
NONEW(XMDUZ,XMK,XMZ,XMLOCKIT) ; Make a message not new
; Should lock before calling AND unlock after.
; If you set XMLOCKIT=1, I'll do the locking for you.
Q:'$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ))
N XMFDA
S XMFDA(3.702,XMZ_","_XMK_","_XMDUZ_",",3)="@" ; no longer new
I $G(XMLOCKIT) L +^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0):1
D FILE^DIE("","XMFDA")
I $G(XMLOCKIT) L -^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)
D DECRNEW(XMDUZ,XMK)
Q
DECRNEW(XMDUZ,XMK,XMCNT) ; Decrement the number of new messages in a basket
; For internal use only!
S:'$D(XMCNT) XMCNT=1
L +^XMB(3.7,XMDUZ,0):1
I $P(^XMB(3.7,XMDUZ,2,XMK,0),U,2) S $P(^(0),U,2)=$P(^(0),U,2)-XMCNT ; New msgs in bskt
I $P(^XMB(3.7,XMDUZ,0),U,6) S $P(^(0),U,6)=$P(^(0),U,6)-XMCNT ; New msgs for user
L -^XMB(3.7,XMDUZ,0)
Q
KILLMSG(DA) ; For internal MM use only. Kill a msg in ^XMB(3.9
N DIK
S DIK="^XMB(3.9,"
L +^XMB(3.9,0):1
D ^DIK
L -^XMB(3.9,0)
Q
LASTACC(XMDUZ,XMK,XMZ,XMRESP,XMIM,XMINSTR,XMIU,XMCONFRM) ; Note first, last accesses, number of responses read
; in:
; XMDUZ,XMK,XMZ the usual. If message not in basket, set XMK=0.
; XMRESP last response read this time
; XMIM "SUBJ", "FROM"
; XMINSTR "FLAGS"
; XMIU "IEN", "RESP"
; out:
; XMCONFRM Confirmation message was sent to message sender (0=no; 1=yes)
N XMNOW,XMREC,XMFDA,XMIENS
I XMRESP D
. N XMRESPS ; User can't read more responses than there are.
. S XMRESPS=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
. I XMRESP>XMRESPS S XMRESP=XMRESPS
S XMCONFRM=0
I 'XMIU("IEN") D Q
. I XMRESP>XMIU("RESP")!(XMIU("RESP")="") S XMIU("RESP")=XMRESP
S XMNOW=$$NOW^XLFDT
S XMREC=^XMB(3.9,XMZ,1,XMIU("IEN"),0)
I $P(XMREC,U,10)="" D
. S $P(XMREC,U,10)=XMNOW ; first access
. ; If confirmation requested, and user is not sender, send confirmation
. I XMINSTR("FLAGS")["R",XMDUZ'=XMIM("FROM") D CONFIRM^XMXUTIL1(XMDUZ,XMZ,.XMIM) S XMCONFRM=1
S $P(XMREC,U,3)=XMNOW ; last access
I $S(XMRESP>$P(XMREC,U,2):1,1:$P(XMREC,U,2)="") S XMIU("RESP")=XMRESP,$P(XMREC,U,2)=XMRESP ; last response read
S ^XMB(3.9,XMZ,1,XMIU("IEN"),0)=XMREC
I XMDUZ'=DUZ,XMDUZ'=.6 S ^XMB(3.9,XMZ,1,XMIU("IEN"),"S")=XMV("DUZ NAME")
Q:'XMK
S XMREC=$G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
Q:XMREC="" ; Message is not in the user's basket
I '$P(XMREC,U,7) D Q
. S $P(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0),U,4)=XMNOW ; last access (for MailMan's auto-vaporize)
; MailMan has set an automatic delete date. Since this message was
; just accessed, we must delete that date.
S XMIENS=XMZ_","_XMK_","_XMDUZ_","
S XMFDA(3.702,XMIENS,4)=XMNOW ; last access (for MailMan's auto-vaporize)
S XMFDA(3.702,XMIENS,5)="@" ; automatic delete date
S XMFDA(3.702,XMIENS,7)="@" ; delete date set by MailMan?
D FILE^DIE("","XMFDA")
Q
ERRSET(XMID,XMPARM,XMZ) ; For internal MailMan use only.
S XMERR=$G(XMERR)+1
S ^TMP("XMERR",$J,XMERR)=XMID
I $D(XMZ) S ^TMP("XMERR",$J,XMERR,"XMZ")=XMZ
I $D(XMPARM("PARAM")) M ^TMP("XMERR",$J,XMERR,"PARAM")=XMPARM("PARAM")
D BLD^DIALOG(XMID,.XMPARM,"","^TMP(""XMERR"",$J,"_XMERR_",""TEXT"")")
S ^TMP("XMERR",$J,"E",XMID,XMERR)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXUTIL 9044 printed Apr 09, 2024@21:16:23 Page 2
XMXUTIL ;ISC-SF/GMB-Message & Mailbox Utilities ;06/19/2002 07:39
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; All entry points covered by DBIA 2734.
WAIT ;
+1 ; Press RETURN to continue
NEW DIR,Y,DIRUT
SET DIR(0)="E"
SET DIR("A")=$$EZBLD^DIALOG(37003)
DO ^DIR
+2 QUIT
PAGE(XMABORT) ;
+1 NEW DIR,Y,DIRUT
SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)
SET XMABORT=1
+2 QUIT
NEWS(XMDUZ,XMTEST) ;
+1 ; Given:
+2 ; XMDUZ User's DUZ
+3 ; XMTEST 0=this is not a test. (DEFAULT)
+4 ; (Field 1.12 LAST NEW MSG NOTIFY DATE/TIME may be updated)
+5 ; 1=this is just a test.
+6 ; (Field 1.12 will not be updated)
+7 ; Returns:
+8 ; -1 If no record of this user
+9 ; 0 If no new mail
+10 ; Otherwise, if the user has new mail, returns an ^-delimited string:
+11 ; Piece 1: # New Msgs
+12 ; Piece 2: Does the user have new priority mail? (1=yes;0=no)
+13 ; Piece 3: # New Msgs in IN basket
+14 ; Piece 4: Date/Time (FileMan) that the last msg was received
+15 ; Piece 5: Have there been any new messages since the last time
+16 ; this function was called? (1=yes;0=no)
+17 ; And for the first priority read basket with new messages in it:
+18 ; (If none has new messages, then first priority read basket)
+19 ; Piece 6: # New Msgs in basket
+20 ; Piece 7: Basket IEN
+21 ; Piece 8: Basket name
+22 NEW XMREC,XMNEW,XMRECEIV,XMNOTIFY
+23 SET XMREC=$GET(^XMB(3.7,XMDUZ,0))
+24 if XMREC=""
QUIT -1
+25 SET XMNEW=+$PIECE(XMREC,U,6)
+26 if 'XMNEW
QUIT 0
+27 ; date/time last msg received
SET XMRECEIV=$PIECE(XMREC,U,14)
+28 ; date/time user last notified
SET XMNOTIFY=$PIECE(XMREC,U,15)
+29 IF XMRECEIV>XMNOTIFY
IF '$GET(XMTEST)
SET $PIECE(^XMB(3.7,XMDUZ,0),U,15)=XMRECEIV
+30 QUIT XMNEW_U_($DATA(^XMB(3.7,XMDUZ,"N"))>0)_U_+$PIECE(^XMB(3.7,XMDUZ,2,1,0),U,2)_U_XMRECEIV_U_(XMRECEIV>XMNOTIFY)_U_$$NPBSKT^XMJBN(XMDUZ)
TNMSGCT(XMDUZ) ; Total new msg count
+1 QUIT +$PIECE(^XMB(3.7,XMDUZ,0),U,6)
BNMSGCT(XMDUZ,XMK) ; Basket new msg count
+1 QUIT +$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,2)
TPMSGCT(XMDUZ) ; Total new priority msg count
+1 IF '$DATA(^XMB(3.7,XMDUZ,"N"))
QUIT 0
+2 NEW XMK,I,XMZ
+3 SET (XMK,I,XMZ)=0
+4 FOR
SET XMK=$ORDER(^XMB(3.7,XMDUZ,"N",XMK))
if 'XMK
QUIT
Begin DoDot:1
+5 FOR I=I:1
SET XMZ=$ORDER(^XMB(3.7,XMDUZ,"N",XMK,XMZ))
if 'XMZ
QUIT
End DoDot:1
+6 QUIT I
BPMSGCT(XMDUZ,XMK) ; Basket new priority msg count
+1 IF '$DATA(^XMB(3.7,XMDUZ,"N",XMK))
QUIT 0
+2 NEW I,XMZ
+3 SET XMZ=0
+4 FOR I=0:1
SET XMZ=$ORDER(^XMB(3.7,XMDUZ,"N",XMK,XMZ))
if 'XMZ
QUIT
+5 QUIT I
TMSGCT(XMDUZ) ; Total msg count
+1 NEW I,XMK
+2 SET I=0
SET XMK=.99
+3 FOR
SET XMK=$ORDER(^XMB(3.7,XMDUZ,2,XMK))
if XMK'>0
QUIT
SET I=I+$$BMSGCT(XMDUZ,XMK)
+4 QUIT I
BMSGCT(XMDUZ,XMK) ; Basket msg count
+1 QUIT +$PIECE($GET(^XMB(3.7,XMDUZ,2,XMK,1,0)),U,4)
KVAPOR(XMDUZ,XMK,XMZ,XMVAPOR,XMIU) ; Set/delete a message's vaporize date in user's basket
+1 ; XMVAPOR ="@" delete it
+2 ; =FM date/time set/change it
+3 NEW XMFDA,XMIENS
+4 SET XMIENS=XMZ_","_XMK_","_XMDUZ_","
+5 SET XMFDA(3.702,XMIENS,5)=XMVAPOR
+6 IF XMVAPOR="@"
Begin DoDot:1
+7 KILL XMIU("KVAPOR")
+8 SET XMFDA(3.702,XMIENS,7)="@"
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 SET XMIU("KVAPOR")=XMVAPOR
+11 SET XMFDA(3.702,XMIENS,7)=0
End DoDot:1
+12 DO FILE^DIE("","XMFDA")
+13 QUIT
BSKTNAME(XMDUZ,XMK) ; What's the name of this basket for this user?
+1 QUIT $PIECE($GET(^XMB(3.7,XMDUZ,2,XMK,0)),U,1)
NAME(XMID,XMIT) ; Given a name or DUZ, return the name
+1 ; XMID user's DUZ or name
+2 ; XMIT 1=if DUZ, return institution and title, too, if needed
+3 ; 0=just return the name (default)
+4 ; * No Name *
if +XMID'=XMID
QUIT $SELECT(XMID'="":XMID,1:$$EZBLD^DIALOG(34009))
+5 NEW XMNAME,XMTITLE,XMINST
+6 ; * User #|1| * (not in NEW PERSON file)
IF '$DATA(^VA(200,XMID,0))
QUIT $$EZBLD^DIALOG(34010,XMID)
+7 SET XMNAME("FILE")=200
SET XMNAME("IENS")=XMID_","
SET XMNAME("FIELD")=.01
+8 SET XMNAME=$$NAMEFMT^XLFNAME(.XMNAME,"F","C")
+9 if '$GET(XMIT)
QUIT XMNAME
+10 IF XMV("SHOW TITL")
Begin DoDot:1
+11 ; field 20.3, SIGNATURE BLOCK TITLE
IF XMV("TITL SRC")="S"
SET XMTITLE=$PIECE($GET(^VA(200,XMID,20)),U,3)
+12 ; field 8, TITLE
IF $GET(XMTITLE)=""
IF $PIECE(^VA(200,XMID,0),U,9)
SET XMTITLE=$PIECE($GET(^DIC(3.1,$PIECE(^(0),U,9),0)),U)
+13 if $GET(XMTITLE)'=""
SET XMNAME=XMNAME_" - "_XMTITLE
End DoDot:1
+14 IF XMV("SHOW INST")
IF $DATA(^XMB(3.7,XMID,6000))
Begin DoDot:1
+15 SET XMINST=$PIECE(^XMB(3.7,XMID,6000),U)
+16 if XMINST'=""
SET XMNAME=XMNAME_" ("_XMINST_")"
End DoDot:1
+17 QUIT XMNAME
NETNAME(XMDUZ) ; Given a DUZ or a string, return an internet name @ site name.
+1 NEW XMNETNAM
+2 if XMDUZ["@"
QUIT XMDUZ
+3 IF +XMDUZ=XMDUZ!(XMDUZ="")
Begin DoDot:1
+4 if 'XMDUZ
SET XMDUZ=.5
+5 ; Use Mail Name. Lacking that, use real name.
+6 SET XMNETNAM=$SELECT($LENGTH($PIECE($GET(^XMB(3.7,XMDUZ,.3)),U)):$PIECE(^(.3),U),1:$$NAME(XMDUZ))
+7 ; Ignore if quoted
IF $EXTRACT(XMNETNAM)=$CHAR(34)
IF $EXTRACT(XMNETNAM,$LENGTH(XMNETNAM))=$CHAR(34)
QUIT
+8 ; Quote if illegal
IF XMNETNAM?.E1C.E!($TRANSLATE(XMNETNAM,$CHAR(34)_"<>()[];:")'=XMNETNAM)
SET XMNETNAM=$CHAR(34)_XMNETNAM_$CHAR(34)
QUIT
+9 ; Translate
IF XMNETNAM[","!(XMNETNAM[" ")
SET XMNETNAM=$TRANSLATE(XMNETNAM,", .","._+")
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 SET XMNETNAM=XMDUZ
+12 IF $EXTRACT(XMNETNAM)'=$CHAR(34)
IF $EXTRACT(XMNETNAM,$LENGTH(XMNETNAM))'=$CHAR(34)
Begin DoDot:2
+13 IF $EXTRACT(XMNETNAM)="<"
IF $EXTRACT(XMNETNAM,$LENGTH(XMNETNAM))=">"
Begin DoDot:3
+14 SET XMNETNAM=$EXTRACT(XMNETNAM,2,$LENGTH(XMNETNAM)-1)
End DoDot:3
IF $EXTRACT(XMNETNAM)=$CHAR(34)
IF $EXTRACT(XMNETNAM,$LENGTH(XMNETNAM))=$CHAR(34)
QUIT
+15 ; Quote if illegal
IF XMNETNAM?.E1C.E!($TRANSLATE(XMNETNAM,$CHAR(34)_" ,<>()[];:")'=XMNETNAM)
SET XMNETNAM=$CHAR(34)_XMNETNAM_$CHAR(34)
End DoDot:2
End DoDot:1
+16 QUIT XMNETNAM_"@"_^XMB("NETNAME")
LOCK(XMDOOR,XMLOCKED,XMWAIT) ; Lock a global (** NOT USED **)
+1 LOCK +@XMDOOR:$GET(XMWAIT,0)
IF '$TEST
SET XMLOCKED=0
QUIT
+2 SET XMLOCKED=1
+3 QUIT
MAKENEW(XMDUZ,XMK,XMZ,XMLOCKIT) ; Make a message new
+1 ; Should lock before calling AND unlock after.
+2 ; If you set XMLOCKIT=1, I'll do the locking for you.
+3 if $DATA(^XMB(3.7,XMDUZ,"N0",XMK,XMZ))
QUIT
+4 if '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ))
QUIT
+5 NEW XMFDA
+6 ; new
SET XMFDA(3.702,XMZ_","_XMK_","_XMDUZ_",",3)="1"
+7 IF $GET(XMLOCKIT)
LOCK +^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0):1
+8 DO FILE^DIE("","XMFDA")
+9 IF $GET(XMLOCKIT)
LOCK -^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)
+10 DO INCRNEW(XMDUZ,XMK)
+11 QUIT
INCRNEW(XMDUZ,XMK,XMCNT) ; Increment the number of new messages in a basket
+1 ; For internal use only!
+2 if '$DATA(XMCNT)
SET XMCNT=1
+3 LOCK +^XMB(3.7,XMDUZ,0):1
+4 ; New msgs in bskt
SET $PIECE(^(0),U,2)=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,2)+XMCNT
+5 ; New msgs for user
SET $PIECE(^(0),U,6)=$PIECE(^XMB(3.7,XMDUZ,0),U,6)+XMCNT
+6 ; When last msg rec'd
SET $PIECE(^XMB(3.7,XMDUZ,0),U,14)=$$NOW^XLFDT
+7 LOCK -^XMB(3.7,XMDUZ,0)
+8 QUIT
NONEW(XMDUZ,XMK,XMZ,XMLOCKIT) ; Make a message not new
+1 ; Should lock before calling AND unlock after.
+2 ; If you set XMLOCKIT=1, I'll do the locking for you.
+3 if '$DATA(^XMB(3.7,XMDUZ,"N0",XMK,XMZ))
QUIT
+4 NEW XMFDA
+5 ; no longer new
SET XMFDA(3.702,XMZ_","_XMK_","_XMDUZ_",",3)="@"
+6 IF $GET(XMLOCKIT)
LOCK +^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0):1
+7 DO FILE^DIE("","XMFDA")
+8 IF $GET(XMLOCKIT)
LOCK -^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)
+9 DO DECRNEW(XMDUZ,XMK)
+10 QUIT
DECRNEW(XMDUZ,XMK,XMCNT) ; Decrement the number of new messages in a basket
+1 ; For internal use only!
+2 if '$DATA(XMCNT)
SET XMCNT=1
+3 LOCK +^XMB(3.7,XMDUZ,0):1
+4 ; New msgs in bskt
IF $PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,2)
SET $PIECE(^(0),U,2)=$PIECE(^(0),U,2)-XMCNT
+5 ; New msgs for user
IF $PIECE(^XMB(3.7,XMDUZ,0),U,6)
SET $PIECE(^(0),U,6)=$PIECE(^(0),U,6)-XMCNT
+6 LOCK -^XMB(3.7,XMDUZ,0)
+7 QUIT
KILLMSG(DA) ; For internal MM use only. Kill a msg in ^XMB(3.9
+1 NEW DIK
+2 SET DIK="^XMB(3.9,"
+3 LOCK +^XMB(3.9,0):1
+4 DO ^DIK
+5 LOCK -^XMB(3.9,0)
+6 QUIT
LASTACC(XMDUZ,XMK,XMZ,XMRESP,XMIM,XMINSTR,XMIU,XMCONFRM) ; Note first, last accesses, number of responses read
+1 ; in:
+2 ; XMDUZ,XMK,XMZ the usual. If message not in basket, set XMK=0.
+3 ; XMRESP last response read this time
+4 ; XMIM "SUBJ", "FROM"
+5 ; XMINSTR "FLAGS"
+6 ; XMIU "IEN", "RESP"
+7 ; out:
+8 ; XMCONFRM Confirmation message was sent to message sender (0=no; 1=yes)
+9 NEW XMNOW,XMREC,XMFDA,XMIENS
+10 IF XMRESP
Begin DoDot:1
+11 ; User can't read more responses than there are.
NEW XMRESPS
+12 SET XMRESPS=+$PIECE($GET(^XMB(3.9,XMZ,3,0)),U,4)
+13 IF XMRESP>XMRESPS
SET XMRESP=XMRESPS
End DoDot:1
+14 SET XMCONFRM=0
+15 IF 'XMIU("IEN")
Begin DoDot:1
+16 IF XMRESP>XMIU("RESP")!(XMIU("RESP")="")
SET XMIU("RESP")=XMRESP
End DoDot:1
QUIT
+17 SET XMNOW=$$NOW^XLFDT
+18 SET XMREC=^XMB(3.9,XMZ,1,XMIU("IEN"),0)
+19 IF $PIECE(XMREC,U,10)=""
Begin DoDot:1
+20 ; first access
SET $PIECE(XMREC,U,10)=XMNOW
+21 ; If confirmation requested, and user is not sender, send confirmation
+22 IF XMINSTR("FLAGS")["R"
IF XMDUZ'=XMIM("FROM")
DO CONFIRM^XMXUTIL1(XMDUZ,XMZ,.XMIM)
SET XMCONFRM=1
End DoDot:1
+23 ; last access
SET $PIECE(XMREC,U,3)=XMNOW
+24 ; last response read
IF $SELECT(XMRESP>$PIECE(XMREC,U,2):1,1:$PIECE(XMREC,U,2)="")
SET XMIU("RESP")=XMRESP
SET $PIECE(XMREC,U,2)=XMRESP
+25 SET ^XMB(3.9,XMZ,1,XMIU("IEN"),0)=XMREC
+26 IF XMDUZ'=DUZ
IF XMDUZ'=.6
SET ^XMB(3.9,XMZ,1,XMIU("IEN"),"S")=XMV("DUZ NAME")
+27 if 'XMK
QUIT
+28 SET XMREC=$GET(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
+29 ; Message is not in the user's basket
if XMREC=""
QUIT
+30 IF '$PIECE(XMREC,U,7)
Begin DoDot:1
+31 ; last access (for MailMan's auto-vaporize)
SET $PIECE(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0),U,4)=XMNOW
End DoDot:1
QUIT
+32 ; MailMan has set an automatic delete date. Since this message was
+33 ; just accessed, we must delete that date.
+34 SET XMIENS=XMZ_","_XMK_","_XMDUZ_","
+35 ; last access (for MailMan's auto-vaporize)
SET XMFDA(3.702,XMIENS,4)=XMNOW
+36 ; automatic delete date
SET XMFDA(3.702,XMIENS,5)="@"
+37 ; delete date set by MailMan?
SET XMFDA(3.702,XMIENS,7)="@"
+38 DO FILE^DIE("","XMFDA")
+39 QUIT
ERRSET(XMID,XMPARM,XMZ) ; For internal MailMan use only.
+1 SET XMERR=$GET(XMERR)+1
+2 SET ^TMP("XMERR",$JOB,XMERR)=XMID
+3 IF $DATA(XMZ)
SET ^TMP("XMERR",$JOB,XMERR,"XMZ")=XMZ
+4 IF $DATA(XMPARM("PARAM"))
MERGE ^TMP("XMERR",$JOB,XMERR,"PARAM")=XMPARM("PARAM")
+5 DO BLD^DIALOG(XMID,.XMPARM,"","^TMP(""XMERR"",$J,"_XMERR_",""TEXT"")")
+6 SET ^TMP("XMERR",$JOB,"E",XMID,XMERR)=""
+7 QUIT
