source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMXMSGS2.m@ 1073

XMXMSGS2 ;ISC-SF/GMB-Message APIs (cont.) ;03/25/2003  15:04

 ;;8.0;MailMan;**16**;Jun 28, 2002

DEL(XMDUZ,XMK,XMZ,XMCNT) ; For many messages, pass in XMCNT; for 1, don't

XDEL ;

 I '$G(XMK) S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,"")) Q:'XMK

 I XMDUZ'=DUZ,'$$DELETE^XMXSEC(XMDUZ,XMK,XMZ) Q

 S:$D(XMCNT) XMCNT=XMCNT+1

 D ZAPIT(XMDUZ,XMK,XMZ,.XMCNT)

 D WASTEIT(XMDUZ,XMK,XMZ)

 Q

FLTR(XMDUZ,XMK,XMKN,XMZ,XMCNT,XMKTO,XMKNTO) ; Filter message

XFLTR ;

 ; XMK    (in) the basket # the message is currently in.  (May be 0 if

 ;             the message isn't currently in a basket.)

 ; XMKN   (in) the name of basket XMK

 ; XMKTO  (out) the basket # this routine decides to put the message in

 ; XMKNTO (out) the name of basket XMKTO

 ; This routine decides which basket the message belongs in.

 ; If this is the same basket it is currently in, it sets XMKTO and

 ; XMKNTO to the current basket.

 ; Otherwise, it moves the message (from the current basket) to the

 ; decided-upon basket and sets XMKTO and XMKNTO to that basket.

 ; If the message is in the WASTE basket, and no filters are defined,

 ; it will be moved to the IN basket.

 I '$G(XMK) D

 . S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))

 . S:XMK XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)

 I XMDUZ=.6,XMK'=.5,'$$MOVE^XMXSEC(XMDUZ,XMZ) Q

 S:$D(XMCNT) XMCNT=XMCNT+1

 I $D(^XMB(3.7,XMDUZ,15,"AF")) D

 . N XMZREC

 . S XMZREC=$G(^XMB(3.9,XMZ,0))

 . D FILTER^XMTDF(XMDUZ,XMZ,$P(XMZREC,U,1),$P(XMZREC,U,2),.XMKTO,.XMKNTO)

 . I XMKTO=1,XMK>1 S XMKTO=XMK,XMKNTO=XMKN

 E  I XMK>1 S XMKTO=XMK,XMKNTO=XMKN

 E  S XMKTO=1,XMKNTO=$$EZBLD^DIALOG(37005) ; "IN"

 Q:XMK=XMKTO

 I XMK D MOVEIT(XMDUZ,XMK,XMZ,XMKTO,.XMCNT) Q

 D PUTMSG(XMDUZ,XMKTO,XMKNTO,XMZ)

 Q

LATER(XMDUZ,XMZ,XMWHEN,XMCNT) ;

XLATER ;

 S:$D(XMCNT) XMCNT=XMCNT+1

 D LTRADD^XMJMD(XMDUZ,XMZ,XMWHEN)

 Q

MOVE(XMDUZ,XMK,XMZ,XMKTO,XMCNT) ;

XMOVE ;

 I XMDUZ=.6,'$$MOVE^XMXSEC(XMDUZ,XMZ) Q

 ; If 2 users are reading the same msg at the same time, one may get an

 ; abort if tries to save msg to another bskt, if the msg has already

 ; been moved by the other user.  So this next line makes sure no abort.

 I '$D(^XMB(3.7,"M",XMZ,XMDUZ,+$G(XMK))) S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))

 Q:XMK=XMKTO

 I XMKTO=.5,'$$DELETE^XMXSEC(XMDUZ,"",XMZ) Q  ; Can't save confidential to WASTE bskt.

 D MOVEIT(XMDUZ,XMK,XMZ,XMKTO,.XMCNT)

 S:$D(XMCNT) XMCNT=XMCNT+1

 Q

MOVEIT(XMDUZ,XMK,XMZ,XMKTO,XMCNT) ;

 I XMK D

 . D COPYIT(XMDUZ,XMK,XMZ,XMKTO,.XMCNT)

 . D ZAPIT(XMDUZ,XMK,XMZ,.XMCNT)

 ; The message is not in the user's mailbox

 E  D PUTMSG(XMDUZ,XMKTO,$P(^XMB(3.7,XMDUZ,2,XMKTO,0),U),XMZ)

 Q

NTOGL(XMDUZ,XMK,XMKN,XMZ,XMCNT,XMKTO,XMKNTO) ;

XNTOGL ;

 ; If XMK>.5, then it's simple.  Just toggle the 'new' flag.

 ; If XMK<1, we know the message is not new, and we need to make it new.

 ; Filter it, but if it filters to the WASTE basket put it in the IN.

 ; Then make it new.

 I '$G(XMK) D

 . S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))

 . S:XMK XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)

 I XMK<1 D

 . I $D(^XMB(3.7,XMDUZ,15,"AF")) D

 . . N XMZREC

 . . S XMZREC=$G(^XMB(3.9,XMZ,0))

 . . D FILTER^XMTDF(XMDUZ,XMZ,$P(XMZREC,U,1),$P(XMZREC,U,2),.XMKTO,.XMKNTO)

 . . I XMKTO=1,XMK>1 S XMKTO=XMK,XMKNTO=XMKN Q

 . . I XMKTO<1 S XMKTO=1,XMKNTO=$$EZBLD^DIALOG(37005) ; "IN"

 . E  I XMK>1 S XMKTO=XMK,XMKNTO=XMKN

 . E  S XMKTO=1,XMKNTO=$$EZBLD^DIALOG(37005) ; "IN"

 . Q:XMK=XMKTO

 . I XMK D MOVEIT(XMDUZ,XMK,XMZ,XMKTO,.XMCNT) Q

 . D PUTMSG(XMDUZ,XMKTO,XMKNTO,XMZ)

 E  S XMKTO=XMK,XMKNTO=XMKN

 I $D(XMCNT) D  Q

 . N XMFDA

 . I $$NEW^XMXUTIL2(XMDUZ,XMKTO,XMZ) D

 . . S XMFDA(3.702,XMZ_","_XMKTO_","_XMDUZ_",",3)="@" ; no longer new

 . . S XMCNT(XMKTO,"DECR")=$G(XMCNT(XMKTO,"DECR"))+1

 . E  D

 . . S XMFDA(3.702,XMZ_","_XMKTO_","_XMDUZ_",",3)="1" ; new

 . . S XMCNT(XMKTO,"INCR")=$G(XMCNT(XMKTO,"INCR"))+1

 . D FILE^DIE("","XMFDA")

 . S XMCNT=XMCNT+1

 I $$NEW^XMXUTIL2(XMDUZ,XMKTO,XMZ) D NONEW^XMXUTIL(XMDUZ,XMKTO,XMZ) Q

 D MAKENEW^XMXUTIL(XMDUZ,XMKTO,XMZ)

 Q

TERM(XMDUZ,XMK,XMZ,XMCNT) ;

XTERM ;

 N XMIEN

 S:'$G(XMK) XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))

 I XMDUZ'=DUZ,'$$DELETE^XMXSEC(XMDUZ,XMK,XMZ) Q

 I XMK D

 . D ZAPIT(XMDUZ,XMK,XMZ,.XMCNT)

 . D WASTEIT(XMDUZ,XMK,XMZ)

 S XMIEN=+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))

 S:XMIEN ^XMB(3.9,XMZ,1,XMIEN,"D")=DT

 S:$D(XMCNT) XMCNT=XMCNT+1

 Q

VAPOR(XMDUZ,XMK,XMZ,XMWHEN,XMCNT) ;

XVAPOR ;

 I '$G(XMK) S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,"")) Q:'XMK

 I XMDUZ'=DUZ,'$$DELETE^XMXSEC(XMDUZ,XMK,XMZ) Q

 S:$D(XMCNT) XMCNT=XMCNT+1

 D KVAPOR^XMXUTIL(XMDUZ,XMK,XMZ,XMWHEN)

 Q

PUTMSG(XMDUZ,XMK,XMKN,XMZ) ; For internal MM use only.

 ; Replaces SETSB^XMA1C, SET^XMS1, & part of MAIL^XMR0B

 ; Put a msg in the Postmaster's (or anyone else's) basket.

 ; The msg is NOT made new.

 ; The basket has a specific name and number.

 ; If the basket doesn't exist, create it.

 ; XMK      Basket number

 ; XMKN     Basket name

 ; XMZ      Msg number

 N XMFDA,XMIEN,XMTRIES

 Q:$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))

 I XMDUZ'=.5 D RESURECT(XMDUZ,XMZ)

 I $D(^XMB(3.7,XMDUZ,2,XMK)) D

 . S XMFDA(3.702,"+1,"_XMK_","_XMDUZ_",",.01)=XMZ

 . S XMIEN(1)=XMZ

 E  D

 . S XMFDA(3.701,"+1,"_XMDUZ_",",.01)=XMKN

 . S XMFDA(3.702,"+2,+1,"_XMDUZ_",",.01)=XMZ

 . S XMIEN(1)=XMK

 . S XMIEN(2)=XMZ

PTRY D UPDATE^DIE("S","XMFDA","XMIEN") Q:'$D(DIERR)

 S XMTRIES=$G(XMTRIES)+1

 I $D(^TMP("DIERR",$J,"E",110)) H 1 G PTRY ; Try again if can't lock

 Q

COPYIT(XMDUZ,XMK,XMZ,XMKTO,XMCNT) ;

 Q:$D(^XMB(3.7,XMDUZ,2,XMKTO,1,XMZ))  ; Message already exists at destination

 N XMFDA,XMKREC,XMIENS,XMIEN,XMTRIES

 S XMKREC=^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)

 S XMIENS="+1,"_XMKTO_","_XMDUZ_","

 S XMIEN(1)=XMZ

 S XMFDA(3.702,XMIENS,.01)=XMZ

 I XMKTO'=.5 D

 . I $P(XMKREC,U,3) S XMFDA(3.702,XMIENS,3)=$P(XMKREC,U,3) ; new flag

 . I '$P(XMKREC,U,7),$P(XMKREC,U,5) S XMFDA(3.702,XMIENS,5)=$P(XMKREC,U,5) ; vapor date

 S:$P(XMKREC,U,4) XMFDA(3.702,XMIENS,4)=$P(XMKREC,U,4) ; date last accessed

 S:$P(XMKREC,U,6) XMFDA(3.702,XMIENS,6)=$P(XMKREC,U,6) ; ntwk msg flag

CTRY D UPDATE^DIE("S","XMFDA","XMIEN")

 I '$D(DIERR) D  Q

 . I XMK=.5 D RESURECT(XMDUZ,XMZ) Q

 . Q:'$G(XMFDA(3.702,XMIENS,3))  ; quit if not new

 . I $D(XMCNT) S XMCNT(XMKTO,"INCR")=$G(XMCNT(XMKTO,"INCR"))+1 Q

 . D INCRNEW^XMXUTIL(XMDUZ,XMKTO) ; Increment new counts

 S XMTRIES=$G(XMTRIES)+1

 I $D(^TMP("DIERR",$J,"E",110)) H 1 G CTRY ; Try again if can't lock

 Q

RESURECT(XMDUZ,XMZ) ; If msg was terminated, "unterminate" it.

 N XMIEN

 S XMIEN=+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))

 K:$D(^XMB(3.9,XMZ,1,XMIEN,"D")) ^XMB(3.9,XMZ,1,XMIEN,"D")

 Q

ZAPIT(XMDUZ,XMK,XMZ,XMCNT) ;

 I $D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) D

 . I $D(XMCNT) S XMCNT(XMK,"DECR")=$G(XMCNT(XMK,"DECR"))+1 Q

 . D DECRNEW^XMXUTIL(XMDUZ,XMK)

 N DA,DIK

 S DA(2)=XMDUZ,DA(1)=XMK,DA=XMZ

 S DIK="^XMB(3.7,"_XMDUZ_",2,"_XMK_",1,"

 D ^DIK

 Q

WASTEIT(XMDUZ,XMK,XMZ) ;

 Q:XMK=.5

 Q:$D(^XMB(3.7,XMDUZ,2,.5,1,XMZ))  ; Already in wastebasket

 N XMFDA,XMIENS,XMIEN,XMTRIES

 S XMK=.5

 D:'$D(^XMB(3.7,XMDUZ,2,.5,0)) MAKEBSKT^XMXBSKT(XMDUZ,.5,$$EZBLD^DIALOG(37004)) ; WASTE

 S XMIENS="+1,"_XMK_","_XMDUZ_","

 S XMIEN(1)=XMZ

 S XMFDA(3.702,XMIENS,.01)=XMZ

 S XMFDA(3.702,XMIENS,4)=$$NOW^XLFDT  ; date/time last accessed

WTRY D UPDATE^DIE("S","XMFDA","XMIEN") Q:'$D(DIERR)

 S XMTRIES=$G(XMTRIES)+1

 I $D(^TMP("DIERR",$J,"E",110)) H 1 G WTRY ; Try again if can't lock

 Q