XMTDL2 ;ISC-SF/GMB-Deliver local mail to mailbox (cont.) ;04/17/2002 11:31
;;8.0;MailMan;;Jun 28, 2002
; Replaces ^XMADJF1B (ISC-WASH/CAP)
; XMTO Recipient DUZ
; XMZ Original XMZ
; XMZSUBJ Msg subject
; XMZFROM Who sent the original message
; XMFROM Who sent the msg or reply, or who forwarded the msg
; XMREPLY 0=msg is not a reply; 1=msg is a reply
; XMK Basket number (or name) to deliver to (as specified by sender XMFROM)
; XMDEL Delete Date (as specified by sender XMZFROM)
; XMKCURR Basket the msg is currently in
DELIVER(XMTO,XMZ,XMZSUBJ,XMZFROM,XMFROM,XMREPLY,XMK,XMDEL,XMZBSKT) ;
N XMKCURR,XMACT
I +XMTO'>0!'$D(^XMB(3.7,XMTO,2)) Q ; Do not deliver if invalid mailbox
S XMFROM=+$G(XMFROM),XMREPLY=+$G(XMREPLY),XMK=$G(XMK),XMDEL=+$G(XMDEL),XMZBSKT=$G(XMZBSKT)
I XMTO=.6,XMREPLY Q ; Do not deliver response to Shared,Mail
S XMKCURR=$O(^XMB(3.7,"M",XMZ,XMTO,0)) ; Get basket it is in
I XMKCURR D Q ; Already in a basket (ignore any basket sender may have specified)
. Q:'XMREPLY ; If this is a reply, continue, else it must be a forwarded msg, so quit.
. I XMKCURR=.5 D Q ; Msg is in waste basket
. . D CHEKBSKT(XMTO,.XMK,XMZSUBJ,XMZFROM,XMZBSKT,.XMACT) ; Where should it go?
. . Q:XMK=.5
. . D MOVENEW(XMFROM,XMTO,XMK,XMZ,.XMACT) ; Move msg and make it new.
. ; Msg is not in waste basket. Make the msg new.
. Q:$D(^XMB(3.7,XMTO,"N0",XMKCURR,XMZ)) ; Already new.
. D:XMFROM'=XMTO MAKENEW(XMTO,XMKCURR,XMZ)
; Not yet in a basket.
; Reinstated user may not see replies to old msgs which he doesn't already have.
I XMREPLY,$P(^XMB(3.7,XMTO,0),U,7) Q:$$SECRET($P(^(0),U,7),XMZ)
S:$G(XMK)="" XMK=0
I +XMK=XMK D
. D CHEKBSKT(XMTO,.XMK,XMZSUBJ,XMZFROM,XMZBSKT,.XMACT)
E D
. S XMK=$$NAMEBSKT(XMTO,XMK,"Y")
D ADDNEW($S(XMREPLY:XMFROM,1:XMZFROM),XMTO,XMK,XMZ,XMDEL,.XMACT,XMREPLY)
Q
CHEKBSKT(XMTO,XMK,XMZSUBJ,XMZFROM,XMZBSKT,XMACT) ; Basket number (or no basket at all)
N XMREC
S XMREC=$G(^XMB(3.7,XMTO,16))
; If the message hasn't been sent to a specific basket for this user
; and the sender specified a delivery basket, and the recipient is
; OK with that, then use the delivery basket.
; Note: The IN basket is not considered a 'specific basket'.
I XMK<2,XMZBSKT'="","^^N^"'[(U_$P(XMREC,U,2)_U) S XMK=$$NAMEBSKT(XMTO,XMZBSKT,$P(XMREC,U,2)) Q:XMK
; If the message hasn't been sent to a specific basket for this user
; and active filters exist, and filtering is turned on,
; then filter the message.
I XMK<2,$D(^XMB(3.7,XMTO,15,"AF")),$P(XMREC,U,1)="Y" D FILTER^XMTDF(XMTO,XMZ,XMZSUBJ,XMZFROM,.XMK,"",.XMACT) Q
; The message was sent to a specific basket for this user.
I XMK Q:$D(^XMB(3.7,XMTO,2,XMK,0)) ; Quit if the basket XMK exists.
S XMK=1 ; Since the basket doesn't exist, force to the IN basket
Q:$D(^XMB(3.7,XMTO,2,XMK,0)) ; Quit if the IN basket exists.
D MAKEBSKT^XMXBSKT(XMTO,XMK,$$EZBLD^DIALOG(37005)) ; Create the "IN" basket
Q
NAMEBSKT(XMTO,XMKN,XMZBOK) ; Basket name (not number)
N XMK
S XMK=$O(^XMB(3.7,XMTO,2,"B",XMKN,0))
S:'XMK XMK=$$FIND1^DIC(3.701,","_XMTO_",","X",$$LOW^XLFSTR(XMKN))
I XMK D Q XMK
. Q:XMZBOK'="S" ; 'YES' or 'EXISTING ONLY'
. S:$P(^XMB(3.7,XMTO,2,XMK,0),U,3)'="Y" XMK=0 ; 'SELECTED ONLY'
; Basket not found
Q:XMZBOK'="Y" 0 ; quit if not 'YES'
I XMKN=$$EZBLD^DIALOG(37004) S XMK=.5 D MAKEBSKT^XMXBSKT(XMTO,XMK,XMKN) Q XMK ; "WASTE"
I XMKN=$$EZBLD^DIALOG(37005) S XMK=1 D MAKEBSKT^XMXBSKT(XMTO,XMK,XMKN) Q XMK ; "IN"
D MAKEBSKT^XMXBSKT(XMTO,.XMK,XMKN)
Q XMK
ADDNEW(XMFROM,XMTO,XMK,XMZ,XMDEL,XMACT,XMREPLY) ;
N XMFDA,XMIENS,XMIEN,XMTRIES
S XMIENS="+1,"_XMK_","_XMTO_","
S XMIEN(1)=XMZ
S XMFDA(3.702,XMIENS,.01)=XMZ
I XMK'=.5 D
. I XMFROM'=XMTO D
. . I $G(XMACT("NONEW")),'$$RESP^XMXUTIL2(XMZ),$$ZREAD^XMXUTIL2(XMTO,XMZ)="" Q
. . S XMFDA(3.702,XMIENS,3)=1 ; new flag
. . D INCRNEW^XMXUTIL(XMTO,XMK) ; New counts
. I $G(XMACT("VDAYS")) D Q
. . S XMFDA(3.702,XMIENS,5)=$$FMADD^XLFDT(DT,XMACT("VDAYS")) ; vapor date
. . S XMFDA(3.702,XMIENS,7)=0 ; vapor date set by user
. I XMDEL S XMFDA(3.702,XMIENS,5)=XMDEL ; vapor date
; Basket sequence number (XMKZ), and priority & new xrefs are handled by FM triggers.
ATRY D UPDATE^DIE("S","XMFDA","XMIEN")
I '$D(DIERR) D Q
. Q:'$D(XMACT("FWD"))
. I 'XMREPLY,XMFROM'=XMTO D FORWARD(XMTO,XMZ,XMACT("FWD"))
S XMTRIES=$G(XMTRIES)+1
I $D(^TMP("DIERR",$J,"E",110)) H 1 G ATRY ; Try again if can't lock
Q
MAKENEW(XMTO,XMK,XMZ) ;
; We ignore any "vapor" date here because this is an existing msg
N XMFDA,XMREC
S XMREC=$G(^XMB(3.7,XMTO,2,XMK,1,XMZ,0))
I XMREC="" D Q:XMREC=""
. ; Message entry should have been there, but it wasn't. Add it.
. D FIXBSKT(XMTO,XMK,XMZ)
. S XMREC=$G(^XMB(3.7,XMTO,2,XMK,1,XMZ,0)) Q:XMREC'=""
. D ADDNEW(0,XMTO,XMK,XMZ,0)
S XMFDA(3.702,XMZ_","_XMK_","_XMTO_",",3)=1 ; new flag
; Delete 'automatic delete date' if it was set by the system
; (during IN BASKET PURGE).
S:$P(XMREC,U,7) XMFDA(3.702,XMZ_","_XMK_","_XMTO_",",5)="@"
L +^XMB(3.7,XMTO,2,XMK,1,XMZ,0):1 ; Lock message
; Priority & new xrefs are handled by FM triggers.
D FILE^DIE("","XMFDA")
L -^XMB(3.7,XMTO,2,XMK,1,XMZ,0)
D INCRNEW^XMXUTIL(XMTO,XMK) ; New counts
Q
SECRET(XMDATE,XMZ) ;
; Don't need to check to see if the user already has the msg, because
; at this point, we already know that he doesn't.
N XMCRE8
S XMCRE8=$P($G(^XMB(3.9,XMZ,.6)),U)
Q $S('XMCRE8:0,XMDATE>XMCRE8:1,1:0) ; 1 means user may NOT see the msg.
MOVENEW(XMFROM,XMTO,XMK,XMZ,XMACT) ; Move msg from WASTE bskt and make new
N XMFDA,XMREC,XMIENS,XMIEN,XMTRIES
S XMREC=$G(^XMB(3.7,XMTO,2,.5,1,XMZ,0))
I XMREC="" D Q:XMREC=""
. ; Message entry should have been there, but it wasn't.
. D FIXBSKT(XMTO,.5,XMZ)
. S XMREC=$G(^XMB(3.7,XMTO,2,.5,1,XMZ,0)) Q:XMREC'=""
. D ADDNEW(XMFROM,XMTO,XMK,XMZ,0)
S XMIENS="+1,"_XMK_","_XMTO_","
S XMIEN(1)=XMZ
S XMFDA(3.702,XMIENS,.01)=XMZ
S:XMFROM'=XMTO XMFDA(3.702,XMIENS,3)=1 ; new flag
S:$P(XMREC,U,4) XMFDA(3.702,XMIENS,4)=$P(XMREC,U,4) ; date last accessed
;I '$P(XMREC,U,7),$P(XMREC,U,5)>DT S XMFDA(3.702,XMIENS,5)=$P(XMREC,U,5) ; vapor date set by user, not system
I $G(XMACT("VDAYS")) D
. S XMFDA(3.702,XMIENS,5)=$$FMADD^XLFDT(DT,XMACT("VDAYS")) ; vapor date
. S XMFDA(3.702,XMIENS,7)=0 ; vapor date set by user
MTRY D UPDATE^DIE("S","XMFDA","XMIEN")
I '$D(DIERR) D Q
. D:XMFROM'=XMTO INCRNEW^XMXUTIL(XMTO,XMK) ; Increment new counts
. N DA,DIK
. S DA(2)=XMTO,DA(1)=.5,DA=XMZ
. S DIK="^XMB(3.7,"_XMTO_",2,.5,1,"
. D ^DIK ; delete msg from waste bskt
S XMTRIES=$G(XMTRIES)+1
I $D(^TMP("DIERR",$J,"E",110)) H 1 G MTRY ; Try again if can't lock
Q
FIXBSKT(XMTO,XMK,XMZ) ; Basket integrity check
N XMERROR ; (set in ^XMUT4)
L +^XMB(3.7,XMTO,2,XMK):1
K ^XMB(3.7,"M",XMZ,XMTO,XMK) ; This xref is wrong.
D BSKT^XMUT4(XMTO,XMK)
L -^XMB(3.7,XMTO,2,XMK)
Q
FORWARD(XMTO,XMZ,XMFIEN) ;
; XMFIEN IEN of the filter which activated.
N XMUPTR
S XMUPTR=+$O(^XMB(3.9,XMZ,1,"C",XMTO,0))
Q:$P($G(^XMB(3.9,XMZ,1,XMUPTR,0)),U,13)'="" ; already forwarded once.
N XMFDA
S XMFDA(3.91,XMUPTR_","_XMZ_",",15)=XMFIEN
D FILE^DIE("","XMFDA")
Q
XMTDL2 ;ISC-SF/GMB-Deliver local mail to mailbox (cont.) ;04/17/2002 11:31
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Replaces ^XMADJF1B (ISC-WASH/CAP)
+3 ; XMTO Recipient DUZ
+4 ; XMZ Original XMZ
+5 ; XMZSUBJ Msg subject
+6 ; XMZFROM Who sent the original message
+7 ; XMFROM Who sent the msg or reply, or who forwarded the msg
+8 ; XMREPLY 0=msg is not a reply; 1=msg is a reply
+9 ; XMK Basket number (or name) to deliver to (as specified by sender XMFROM)
+10 ; XMDEL Delete Date (as specified by sender XMZFROM)
+11 ; XMKCURR Basket the msg is currently in
DELIVER(XMTO,XMZ,XMZSUBJ,XMZFROM,XMFROM,XMREPLY,XMK,XMDEL,XMZBSKT) ;
+1 NEW XMKCURR,XMACT
+2 ; Do not deliver if invalid mailbox
IF +XMTO'>0!'$DATA(^XMB(3.7,XMTO,2))
QUIT
+3 SET XMFROM=+$GET(XMFROM)
SET XMREPLY=+$GET(XMREPLY)
SET XMK=$GET(XMK)
SET XMDEL=+$GET(XMDEL)
SET XMZBSKT=$GET(XMZBSKT)
+4 ; Do not deliver response to Shared,Mail
IF XMTO=.6
IF XMREPLY
QUIT
+5 ; Get basket it is in
SET XMKCURR=$ORDER(^XMB(3.7,"M",XMZ,XMTO,0))
+6 ; Already in a basket (ignore any basket sender may have specified)
IF XMKCURR
Begin DoDot:1
+7 ; If this is a reply, continue, else it must be a forwarded msg, so quit.
IF 'XMREPLY
QUIT
+8 ; Msg is in waste basket
IF XMKCURR=.5
Begin DoDot:2
+9 ; Where should it go?
DO CHEKBSKT(XMTO,.XMK,XMZSUBJ,XMZFROM,XMZBSKT,.XMACT)
+10 IF XMK=.5
QUIT
+11 ; Move msg and make it new.
DO MOVENEW(XMFROM,XMTO,XMK,XMZ,.XMACT)
End DoDot:2
QUIT
+12 ; Msg is not in waste basket. Make the msg new.
+13 ; Already new.
IF $DATA(^XMB(3.7,XMTO,"N0",XMKCURR,XMZ))
QUIT
+14 IF XMFROM'=XMTO
DO MAKENEW(XMTO,XMKCURR,XMZ)
End DoDot:1
QUIT
+15 ; Not yet in a basket.
+16 ; Reinstated user may not see replies to old msgs which he doesn't already have.
+17 IF XMREPLY
IF $PIECE(^XMB(3.7,XMTO,0),U,7)
IF $$SECRET($PIECE(^(0),U,7),XMZ)
QUIT
+18 IF $GET(XMK)=""
SET XMK=0
+19 IF +XMK=XMK
Begin DoDot:1
+20 DO CHEKBSKT(XMTO,.XMK,XMZSUBJ,XMZFROM,XMZBSKT,.XMACT)
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 SET XMK=$$NAMEBSKT(XMTO,XMK,"Y")
End DoDot:1
+23 DO ADDNEW($SELECT(XMREPLY:XMFROM,1:XMZFROM),XMTO,XMK,XMZ,XMDEL,.XMACT,XMREPLY)
+24 QUIT
CHEKBSKT(XMTO,XMK,XMZSUBJ,XMZFROM,XMZBSKT,XMACT) ; Basket number (or no basket at all)
+1 NEW XMREC
+2 SET XMREC=$GET(^XMB(3.7,XMTO,16))
+3 ; If the message hasn't been sent to a specific basket for this user
+4 ; and the sender specified a delivery basket, and the recipient is
+5 ; OK with that, then use the delivery basket.
+6 ; Note: The IN basket is not considered a 'specific basket'.
+7 IF XMK<2
IF XMZBSKT'=""
IF "^^N^"'[(U_$PIECE(XMREC,U,2)_U)
SET XMK=$$NAMEBSKT(XMTO,XMZBSKT,$PIECE(XMREC,U,2))
IF XMK
QUIT
+8 ; If the message hasn't been sent to a specific basket for this user
+9 ; and active filters exist, and filtering is turned on,
+10 ; then filter the message.
+11 IF XMK<2
IF $DATA(^XMB(3.7,XMTO,15,"AF"))
IF $PIECE(XMREC,U,1)="Y"
DO FILTER^XMTDF(XMTO,XMZ,XMZSUBJ,XMZFROM,.XMK,"",.XMACT)
QUIT
+12 ; The message was sent to a specific basket for this user.
+13 ; Quit if the basket XMK exists.
IF XMK
IF $DATA(^XMB(3.7,XMTO,2,XMK,0))
QUIT
+14 ; Since the basket doesn't exist, force to the IN basket
SET XMK=1
+15 ; Quit if the IN basket exists.
IF $DATA(^XMB(3.7,XMTO,2,XMK,0))
QUIT
+16 ; Create the "IN" basket
DO MAKEBSKT^XMXBSKT(XMTO,XMK,$$EZBLD^DIALOG(37005))
+17 QUIT
NAMEBSKT(XMTO,XMKN,XMZBOK) ; Basket name (not number)
+1 NEW XMK
+2 SET XMK=$ORDER(^XMB(3.7,XMTO,2,"B",XMKN,0))
+3 IF 'XMK
SET XMK=$$FIND1^DIC(3.701,","_XMTO_",","X",$$LOW^XLFSTR(XMKN))
+4 IF XMK
Begin DoDot:1
+5 ; 'YES' or 'EXISTING ONLY'
IF XMZBOK'="S"
QUIT
+6 ; 'SELECTED ONLY'
IF $PIECE(^XMB(3.7,XMTO,2,XMK,0),U,3)'="Y"
SET XMK=0
End DoDot:1
QUIT XMK
+7 ; Basket not found
+8 ; quit if not 'YES'
IF XMZBOK'="Y"
QUIT 0
+9 ; "WASTE"
IF XMKN=$$EZBLD^DIALOG(37004)
SET XMK=.5
DO MAKEBSKT^XMXBSKT(XMTO,XMK,XMKN)
QUIT XMK
+10 ; "IN"
IF XMKN=$$EZBLD^DIALOG(37005)
SET XMK=1
DO MAKEBSKT^XMXBSKT(XMTO,XMK,XMKN)
QUIT XMK
+11 DO MAKEBSKT^XMXBSKT(XMTO,.XMK,XMKN)
+12 QUIT XMK
ADDNEW(XMFROM,XMTO,XMK,XMZ,XMDEL,XMACT,XMREPLY) ;
+1 NEW XMFDA,XMIENS,XMIEN,XMTRIES
+2 SET XMIENS="+1,"_XMK_","_XMTO_","
+3 SET XMIEN(1)=XMZ
+4 SET XMFDA(3.702,XMIENS,.01)=XMZ
+5 IF XMK'=.5
Begin DoDot:1
+6 IF XMFROM'=XMTO
Begin DoDot:2
+7 IF $GET(XMACT("NONEW"))
IF '$$RESP^XMXUTIL2(XMZ)
IF $$ZREAD^XMXUTIL2(XMTO,XMZ)=""
QUIT
+8 ; new flag
SET XMFDA(3.702,XMIENS,3)=1
+9 ; New counts
DO INCRNEW^XMXUTIL(XMTO,XMK)
End DoDot:2
+10 IF $GET(XMACT("VDAYS"))
Begin DoDot:2
+11 ; vapor date
SET XMFDA(3.702,XMIENS,5)=$$FMADD^XLFDT(DT,XMACT("VDAYS"))
+12 ; vapor date set by user
SET XMFDA(3.702,XMIENS,7)=0
End DoDot:2
QUIT
+13 ; vapor date
IF XMDEL
SET XMFDA(3.702,XMIENS,5)=XMDEL
End DoDot:1
+14 ; Basket sequence number (XMKZ), and priority & new xrefs are handled by FM triggers.
ATRY DO UPDATE^DIE("S","XMFDA","XMIEN")
+1 IF '$DATA(DIERR)
Begin DoDot:1
+2 IF '$DATA(XMACT("FWD"))
QUIT
+3 IF 'XMREPLY
IF XMFROM'=XMTO
DO FORWARD(XMTO,XMZ,XMACT("FWD"))
End DoDot:1
QUIT
+4 SET XMTRIES=$GET(XMTRIES)+1
+5 ; Try again if can't lock
IF $DATA(^TMP("DIERR",$JOB,"E",110))
HANG 1
GOTO ATRY
+6 QUIT
MAKENEW(XMTO,XMK,XMZ) ;
+1 ; We ignore any "vapor" date here because this is an existing msg
+2 NEW XMFDA,XMREC
+3 SET XMREC=$GET(^XMB(3.7,XMTO,2,XMK,1,XMZ,0))
+4 IF XMREC=""
Begin DoDot:1
+5 ; Message entry should have been there, but it wasn't. Add it.
+6 DO FIXBSKT(XMTO,XMK,XMZ)
+7 SET XMREC=$GET(^XMB(3.7,XMTO,2,XMK,1,XMZ,0))
IF XMREC'=""
QUIT
+8 DO ADDNEW(0,XMTO,XMK,XMZ,0)
End DoDot:1
IF XMREC=""
QUIT
+9 ; new flag
SET XMFDA(3.702,XMZ_","_XMK_","_XMTO_",",3)=1
+10 ; Delete 'automatic delete date' if it was set by the system
+11 ; (during IN BASKET PURGE).
+12 IF $PIECE(XMREC,U,7)
SET XMFDA(3.702,XMZ_","_XMK_","_XMTO_",",5)="@"
+13 ; Lock message
LOCK +^XMB(3.7,XMTO,2,XMK,1,XMZ,0):1
+14 ; Priority & new xrefs are handled by FM triggers.
+15 DO FILE^DIE("","XMFDA")
+16 LOCK -^XMB(3.7,XMTO,2,XMK,1,XMZ,0)
+17 ; New counts
DO INCRNEW^XMXUTIL(XMTO,XMK)
+18 QUIT
SECRET(XMDATE,XMZ) ;
+1 ; Don't need to check to see if the user already has the msg, because
+2 ; at this point, we already know that he doesn't.
+3 NEW XMCRE8
+4 SET XMCRE8=$PIECE($GET(^XMB(3.9,XMZ,.6)),U)
+5 ; 1 means user may NOT see the msg.
QUIT $SELECT('XMCRE8:0,XMDATE>XMCRE8:1,1:0)
MOVENEW(XMFROM,XMTO,XMK,XMZ,XMACT) ; Move msg from WASTE bskt and make new
+1 NEW XMFDA,XMREC,XMIENS,XMIEN,XMTRIES
+2 SET XMREC=$GET(^XMB(3.7,XMTO,2,.5,1,XMZ,0))
+3 IF XMREC=""
Begin DoDot:1
+4 ; Message entry should have been there, but it wasn't.
+5 DO FIXBSKT(XMTO,.5,XMZ)
+6 SET XMREC=$GET(^XMB(3.7,XMTO,2,.5,1,XMZ,0))
IF XMREC'=""
QUIT
+7 DO ADDNEW(XMFROM,XMTO,XMK,XMZ,0)
End DoDot:1
IF XMREC=""
QUIT
+8 SET XMIENS="+1,"_XMK_","_XMTO_","
+9 SET XMIEN(1)=XMZ
+10 SET XMFDA(3.702,XMIENS,.01)=XMZ
+11 ; new flag
IF XMFROM'=XMTO
SET XMFDA(3.702,XMIENS,3)=1
+12 ; date last accessed
IF $PIECE(XMREC,U,4)
SET XMFDA(3.702,XMIENS,4)=$PIECE(XMREC,U,4)
+13 ;I '$P(XMREC,U,7),$P(XMREC,U,5)>DT S XMFDA(3.702,XMIENS,5)=$P(XMREC,U,5) ; vapor date set by user, not system
+14 IF $GET(XMACT("VDAYS"))
Begin DoDot:1
+15 ; vapor date
SET XMFDA(3.702,XMIENS,5)=$$FMADD^XLFDT(DT,XMACT("VDAYS"))
+16 ; vapor date set by user
SET XMFDA(3.702,XMIENS,7)=0
End DoDot:1
MTRY DO UPDATE^DIE("S","XMFDA","XMIEN")
+1 IF '$DATA(DIERR)
Begin DoDot:1
+2 ; Increment new counts
IF XMFROM'=XMTO
DO INCRNEW^XMXUTIL(XMTO,XMK)
+3 NEW DA,DIK
+4 SET DA(2)=XMTO
SET DA(1)=.5
SET DA=XMZ
+5 SET DIK="^XMB(3.7,"_XMTO_",2,.5,1,"
+6 ; delete msg from waste bskt
DO ^DIK
End DoDot:1
QUIT
+7 SET XMTRIES=$GET(XMTRIES)+1
+8 ; Try again if can't lock
IF $DATA(^TMP("DIERR",$JOB,"E",110))
HANG 1
GOTO MTRY
+9 QUIT
FIXBSKT(XMTO,XMK,XMZ) ; Basket integrity check
+1 ; (set in ^XMUT4)
NEW XMERROR
+2 LOCK +^XMB(3.7,XMTO,2,XMK):1
+3 ; This xref is wrong.
KILL ^XMB(3.7,"M",XMZ,XMTO,XMK)
+4 DO BSKT^XMUT4(XMTO,XMK)
+5 LOCK -^XMB(3.7,XMTO,2,XMK)
+6 QUIT
FORWARD(XMTO,XMZ,XMFIEN) ;
+1 ; XMFIEN IEN of the filter which activated.
+2 NEW XMUPTR
+3 SET XMUPTR=+$ORDER(^XMB(3.9,XMZ,1,"C",XMTO,0))
+4 ; already forwarded once.
IF $PIECE($GET(^XMB(3.9,XMZ,1,XMUPTR,0)),U,13)'=""
QUIT
+5 NEW XMFDA
+6 SET XMFDA(3.91,XMUPTR_","_XMZ_",",15)=XMFIEN
+7 DO FILE^DIE("","XMFDA")
+8 QUIT
