- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXMSGS2 7356 printed Jan 18, 2025@03:15:19 Page 2
- XMXMSGS2 ;ISC-SF/GMB-Message APIs (cont.) ;03/25/2003 15:04
- +1 ;;8.0;MailMan;**16**;Jun 28, 2002
- DEL(XMDUZ,XMK,XMZ,XMCNT) ; For many messages, pass in XMCNT; for 1, don't
- XDEL ;
- +1 IF '$GET(XMK)
- SET XMK=$ORDER(^XMB(3.7,"M",XMZ,XMDUZ,""))
- if 'XMK
- QUIT
- +2 IF XMDUZ'=DUZ
- IF '$$DELETE^XMXSEC(XMDUZ,XMK,XMZ)
- QUIT
- +3 if $DATA(XMCNT)
- SET XMCNT=XMCNT+1
- +4 DO ZAPIT(XMDUZ,XMK,XMZ,.XMCNT)
- +5 DO WASTEIT(XMDUZ,XMK,XMZ)
- +6 QUIT
- FLTR(XMDUZ,XMK,XMKN,XMZ,XMCNT,XMKTO,XMKNTO) ; Filter message
- XFLTR ;
- +1 ; XMK (in) the basket # the message is currently in. (May be 0 if
- +2 ; the message isn't currently in a basket.)
- +3 ; XMKN (in) the name of basket XMK
- +4 ; XMKTO (out) the basket # this routine decides to put the message in
- +5 ; XMKNTO (out) the name of basket XMKTO
- +6 ; This routine decides which basket the message belongs in.
- +7 ; If this is the same basket it is currently in, it sets XMKTO and
- +8 ; XMKNTO to the current basket.
- +9 ; Otherwise, it moves the message (from the current basket) to the
- +10 ; decided-upon basket and sets XMKTO and XMKNTO to that basket.
- +11 ; If the message is in the WASTE basket, and no filters are defined,
- +12 ; it will be moved to the IN basket.
- +13 IF '$GET(XMK)
- Begin DoDot:1
- +14 SET XMK=$ORDER(^XMB(3.7,"M",XMZ,XMDUZ,""))
- +15 if XMK
- SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
- End DoDot:1
- +16 IF XMDUZ=.6
- IF XMK'=.5
- IF '$$MOVE^XMXSEC(XMDUZ,XMZ)
- QUIT
- +17 if $DATA(XMCNT)
- SET XMCNT=XMCNT+1
- +18 IF $DATA(^XMB(3.7,XMDUZ,15,"AF"))
- Begin DoDot:1
- +19 NEW XMZREC
- +20 SET XMZREC=$GET(^XMB(3.9,XMZ,0))
- +21 DO FILTER^XMTDF(XMDUZ,XMZ,$PIECE(XMZREC,U,1),$PIECE(XMZREC,U,2),.XMKTO,.XMKNTO)
- +22 IF XMKTO=1
- IF XMK>1
- SET XMKTO=XMK
- SET XMKNTO=XMKN
- End DoDot:1
- +23 IF '$TEST
- IF XMK>1
- SET XMKTO=XMK
- SET XMKNTO=XMKN
- +24 ; "IN"
- IF '$TEST
- SET XMKTO=1
- SET XMKNTO=$$EZBLD^DIALOG(37005)
- +25 if XMK=XMKTO
- QUIT
- +26 IF XMK
- DO MOVEIT(XMDUZ,XMK,XMZ,XMKTO,.XMCNT)
- QUIT
- +27 DO PUTMSG(XMDUZ,XMKTO,XMKNTO,XMZ)
- +28 QUIT
- LATER(XMDUZ,XMZ,XMWHEN,XMCNT) ;
- XLATER ;
- +1 if $DATA(XMCNT)
- SET XMCNT=XMCNT+1
- +2 DO LTRADD^XMJMD(XMDUZ,XMZ,XMWHEN)
- +3 QUIT
- MOVE(XMDUZ,XMK,XMZ,XMKTO,XMCNT) ;
- XMOVE ;
- +1 IF XMDUZ=.6
- IF '$$MOVE^XMXSEC(XMDUZ,XMZ)
- QUIT
- +2 ; If 2 users are reading the same msg at the same time, one may get an
- +3 ; abort if tries to save msg to another bskt, if the msg has already
- +4 ; been moved by the other user. So this next line makes sure no abort.
- +5 IF '$DATA(^XMB(3.7,"M",XMZ,XMDUZ,+$GET(XMK)))
- SET XMK=$ORDER(^XMB(3.7,"M",XMZ,XMDUZ,""))
- +6 if XMK=XMKTO
- QUIT
- +7 ; Can't save confidential to WASTE bskt.
- IF XMKTO=.5
- IF '$$DELETE^XMXSEC(XMDUZ,"",XMZ)
- QUIT
- +8 DO MOVEIT(XMDUZ,XMK,XMZ,XMKTO,.XMCNT)
- +9 if $DATA(XMCNT)
- SET XMCNT=XMCNT+1
- +10 QUIT
- MOVEIT(XMDUZ,XMK,XMZ,XMKTO,XMCNT) ;
- +1 IF XMK
- Begin DoDot:1
- +2 DO COPYIT(XMDUZ,XMK,XMZ,XMKTO,.XMCNT)
- +3 DO ZAPIT(XMDUZ,XMK,XMZ,.XMCNT)
- End DoDot:1
- +4 ; The message is not in the user's mailbox
- +5 IF '$TEST
- DO PUTMSG(XMDUZ,XMKTO,$PIECE(^XMB(3.7,XMDUZ,2,XMKTO,0),U),XMZ)
- +6 QUIT
- NTOGL(XMDUZ,XMK,XMKN,XMZ,XMCNT,XMKTO,XMKNTO) ;
- XNTOGL ;
- +1 ; If XMK>.5, then it's simple. Just toggle the 'new' flag.
- +2 ; If XMK<1, we know the message is not new, and we need to make it new.
- +3 ; Filter it, but if it filters to the WASTE basket put it in the IN.
- +4 ; Then make it new.
- +5 IF '$GET(XMK)
- Begin DoDot:1
- +6 SET XMK=$ORDER(^XMB(3.7,"M",XMZ,XMDUZ,""))
- +7 if XMK
- SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
- End DoDot:1
- +8 IF XMK<1
- Begin DoDot:1
- +9 IF $DATA(^XMB(3.7,XMDUZ,15,"AF"))
- Begin DoDot:2
- +10 NEW XMZREC
- +11 SET XMZREC=$GET(^XMB(3.9,XMZ,0))
- +12 DO FILTER^XMTDF(XMDUZ,XMZ,$PIECE(XMZREC,U,1),$PIECE(XMZREC,U,2),.XMKTO,.XMKNTO)
- +13 IF XMKTO=1
- IF XMK>1
- SET XMKTO=XMK
- SET XMKNTO=XMKN
- QUIT
- +14 ; "IN"
- IF XMKTO<1
- SET XMKTO=1
- SET XMKNTO=$$EZBLD^DIALOG(37005)
- End DoDot:2
- +15 IF '$TEST
- IF XMK>1
- SET XMKTO=XMK
- SET XMKNTO=XMKN
- +16 ; "IN"
- IF '$TEST
- SET XMKTO=1
- SET XMKNTO=$$EZBLD^DIALOG(37005)
- +17 if XMK=XMKTO
- QUIT
- +18 IF XMK
- DO MOVEIT(XMDUZ,XMK,XMZ,XMKTO,.XMCNT)
- QUIT
- +19 DO PUTMSG(XMDUZ,XMKTO,XMKNTO,XMZ)
- End DoDot:1
- +20 IF '$TEST
- SET XMKTO=XMK
- SET XMKNTO=XMKN
- +21 IF $DATA(XMCNT)
- Begin DoDot:1
- +22 NEW XMFDA
- +23 IF $$NEW^XMXUTIL2(XMDUZ,XMKTO,XMZ)
- Begin DoDot:2
- +24 ; no longer new
- SET XMFDA(3.702,XMZ_","_XMKTO_","_XMDUZ_",",3)="@"
- +25 SET XMCNT(XMKTO,"DECR")=$GET(XMCNT(XMKTO,"DECR"))+1
- End DoDot:2
- +26 IF '$TEST
- Begin DoDot:2
- +27 ; new
- SET XMFDA(3.702,XMZ_","_XMKTO_","_XMDUZ_",",3)="1"
- +28 SET XMCNT(XMKTO,"INCR")=$GET(XMCNT(XMKTO,"INCR"))+1
- End DoDot:2
- +29 DO FILE^DIE("","XMFDA")
- +30 SET XMCNT=XMCNT+1
- End DoDot:1
- QUIT
- +31 IF $$NEW^XMXUTIL2(XMDUZ,XMKTO,XMZ)
- DO NONEW^XMXUTIL(XMDUZ,XMKTO,XMZ)
- QUIT
- +32 DO MAKENEW^XMXUTIL(XMDUZ,XMKTO,XMZ)
- +33 QUIT
- TERM(XMDUZ,XMK,XMZ,XMCNT) ;
- XTERM ;
- +1 NEW XMIEN
- +2 if '$GET(XMK)
- SET XMK=$ORDER(^XMB(3.7,"M",XMZ,XMDUZ,""))
- +3 IF XMDUZ'=DUZ
- IF '$$DELETE^XMXSEC(XMDUZ,XMK,XMZ)
- QUIT
- +4 IF XMK
- Begin DoDot:1
- +5 DO ZAPIT(XMDUZ,XMK,XMZ,.XMCNT)
- +6 DO WASTEIT(XMDUZ,XMK,XMZ)
- End DoDot:1
- +7 SET XMIEN=+$ORDER(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
- +8 if XMIEN
- SET ^XMB(3.9,XMZ,1,XMIEN,"D")=DT
- +9 if $DATA(XMCNT)
- SET XMCNT=XMCNT+1
- +10 QUIT
- VAPOR(XMDUZ,XMK,XMZ,XMWHEN,XMCNT) ;
- XVAPOR ;
- +1 IF '$GET(XMK)
- SET XMK=$ORDER(^XMB(3.7,"M",XMZ,XMDUZ,""))
- if 'XMK
- QUIT
- +2 IF XMDUZ'=DUZ
- IF '$$DELETE^XMXSEC(XMDUZ,XMK,XMZ)
- QUIT
- +3 if $DATA(XMCNT)
- SET XMCNT=XMCNT+1
- +4 DO KVAPOR^XMXUTIL(XMDUZ,XMK,XMZ,XMWHEN)
- +5 QUIT
- PUTMSG(XMDUZ,XMK,XMKN,XMZ) ; For internal MM use only.
- +1 ; Replaces SETSB^XMA1C, SET^XMS1, & part of MAIL^XMR0B
- +2 ; Put a msg in the Postmaster's (or anyone else's) basket.
- +3 ; The msg is NOT made new.
- +4 ; The basket has a specific name and number.
- +5 ; If the basket doesn't exist, create it.
- +6 ; XMK Basket number
- +7 ; XMKN Basket name
- +8 ; XMZ Msg number
- +9 NEW XMFDA,XMIEN,XMTRIES
- +10 if $DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
- QUIT
- +11 IF XMDUZ'=.5
- DO RESURECT(XMDUZ,XMZ)
- +12 IF $DATA(^XMB(3.7,XMDUZ,2,XMK))
- Begin DoDot:1
- +13 SET XMFDA(3.702,"+1,"_XMK_","_XMDUZ_",",.01)=XMZ
- +14 SET XMIEN(1)=XMZ
- End DoDot:1
- +15 IF '$TEST
- Begin DoDot:1
- +16 SET XMFDA(3.701,"+1,"_XMDUZ_",",.01)=XMKN
- +17 SET XMFDA(3.702,"+2,+1,"_XMDUZ_",",.01)=XMZ
- +18 SET XMIEN(1)=XMK
- +19 SET XMIEN(2)=XMZ
- End DoDot:1
- PTRY DO UPDATE^DIE("S","XMFDA","XMIEN")
- if '$DATA(DIERR)
- QUIT
- +1 SET XMTRIES=$GET(XMTRIES)+1
- +2 ; Try again if can't lock
- IF $DATA(^TMP("DIERR",$JOB,"E",110))
- HANG 1
- GOTO PTRY
- +3 QUIT
- COPYIT(XMDUZ,XMK,XMZ,XMKTO,XMCNT) ;
- +1 ; Message already exists at destination
- if $DATA(^XMB(3.7,XMDUZ,2,XMKTO,1,XMZ))
- QUIT
- +2 NEW XMFDA,XMKREC,XMIENS,XMIEN,XMTRIES
- +3 SET XMKREC=^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)
- +4 SET XMIENS="+1,"_XMKTO_","_XMDUZ_","
- +5 SET XMIEN(1)=XMZ
- +6 SET XMFDA(3.702,XMIENS,.01)=XMZ
- +7 IF XMKTO'=.5
- Begin DoDot:1
- +8 ; new flag
- IF $PIECE(XMKREC,U,3)
- SET XMFDA(3.702,XMIENS,3)=$PIECE(XMKREC,U,3)
- +9 ; vapor date
- IF '$PIECE(XMKREC,U,7)
- IF $PIECE(XMKREC,U,5)
- SET XMFDA(3.702,XMIENS,5)=$PIECE(XMKREC,U,5)
- End DoDot:1
- +10 ; date last accessed
- if $PIECE(XMKREC,U,4)
- SET XMFDA(3.702,XMIENS,4)=$PIECE(XMKREC,U,4)
- +11 ; ntwk msg flag
- if $PIECE(XMKREC,U,6)
- SET XMFDA(3.702,XMIENS,6)=$PIECE(XMKREC,U,6)
- CTRY DO UPDATE^DIE("S","XMFDA","XMIEN")
- +1 IF '$DATA(DIERR)
- Begin DoDot:1
- +2 IF XMK=.5
- DO RESURECT(XMDUZ,XMZ)
- QUIT
- +3 ; quit if not new
- if '$GET(XMFDA(3.702,XMIENS,3))
- QUIT
- +4 IF $DATA(XMCNT)
- SET XMCNT(XMKTO,"INCR")=$GET(XMCNT(XMKTO,"INCR"))+1
- QUIT
- +5 ; Increment new counts
- DO INCRNEW^XMXUTIL(XMDUZ,XMKTO)
- End DoDot:1
- QUIT
- +6 SET XMTRIES=$GET(XMTRIES)+1
- +7 ; Try again if can't lock
- IF $DATA(^TMP("DIERR",$JOB,"E",110))
- HANG 1
- GOTO CTRY
- +8 QUIT
- RESURECT(XMDUZ,XMZ) ; If msg was terminated, "unterminate" it.
- +1 NEW XMIEN
- +2 SET XMIEN=+$ORDER(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
- +3 if $DATA(^XMB(3.9,XMZ,1,XMIEN,"D"))
- KILL ^XMB(3.9,XMZ,1,XMIEN,"D")
- +4 QUIT
- ZAPIT(XMDUZ,XMK,XMZ,XMCNT) ;
- +1 IF $DATA(^XMB(3.7,XMDUZ,"N0",XMK,XMZ))
- Begin DoDot:1
- +2 IF $DATA(XMCNT)
- SET XMCNT(XMK,"DECR")=$GET(XMCNT(XMK,"DECR"))+1
- QUIT
- +3 DO DECRNEW^XMXUTIL(XMDUZ,XMK)
- End DoDot:1
- +4 NEW DA,DIK
- +5 SET DA(2)=XMDUZ
- SET DA(1)=XMK
- SET DA=XMZ
- +6 SET DIK="^XMB(3.7,"_XMDUZ_",2,"_XMK_",1,"
- +7 DO ^DIK
- +8 QUIT
- WASTEIT(XMDUZ,XMK,XMZ) ;
- +1 if XMK=.5
- QUIT
- +2 ; Already in wastebasket
- if $DATA(^XMB(3.7,XMDUZ,2,.5,1,XMZ))
- QUIT
- +3 NEW XMFDA,XMIENS,XMIEN,XMTRIES
- +4 SET XMK=.5
- +5 ; WASTE
- if '$DATA(^XMB(3.7,XMDUZ,2,.5,0))
- DO MAKEBSKT^XMXBSKT(XMDUZ,.5,$$EZBLD^DIALOG(37004))
- +6 SET XMIENS="+1,"_XMK_","_XMDUZ_","
- +7 SET XMIEN(1)=XMZ
- +8 SET XMFDA(3.702,XMIENS,.01)=XMZ
- +9 ; date/time last accessed
- SET XMFDA(3.702,XMIENS,4)=$$NOW^XLFDT
- WTRY DO UPDATE^DIE("S","XMFDA","XMIEN")
- if '$DATA(DIERR)
- QUIT
- +1 SET XMTRIES=$GET(XMTRIES)+1
- +2 ; Try again if can't lock
- IF $DATA(^TMP("DIERR",$JOB,"E",110))
- HANG 1
- GOTO WTRY
- +3 QUIT