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

XMXUTIL.m

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