XMJMOR ;ISC-SF/GMB-Range actions ;12/04/2002 10:10
;;8.0;MailMan;**9**;Jun 28, 2002
; Replaces ^XMA0,^XMA01 (ISC-WASH/CAP)
DELETE(XMDUZ,XMK) ; Delete a range of messages
N XMWHICH,XMMSG,XMABORT
S XMABORT=0
I $D(^TMP("XM",$J,".")) D
. D SELMSG^XMJMORX1(XMDUZ,0,0,XMK,"XDEL",34302,34303,.XMMSG,.XMABORT)
. ;K ^TMP("XM",$J,".")
E D
. D WHICH(XMDUZ,XMK,34301,34303.1,.XMWHICH,.XMABORT) Q:XMABORT
. D DELMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,.XMMSG)
. D:$D(XMERR) ZSHOW^XMJERR
Q:XMABORT
W:$D(XMMSG) !,XMMSG
Q
FILTER(XMDUZ,XMK) ; Filter a range of messages
N XMWHICH,XMMSG,XMABORT
S XMABORT=0
I $D(^TMP("XM",$J,".")) D
. N XMKZ
. D SELMSG(XMDUZ,XMK,"XFLTR^XMXMSGS2",34306,.XMMSG)
. S XMKZ=""
. F S XMKZ=$O(^TMP("XM",$J,".",XMKZ)) Q:'XMKZ K:'$D(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) ^TMP("XM",$J,".",XMKZ)
E D
. D WHICH(XMDUZ,XMK,34305,0,.XMWHICH,.XMABORT) Q:XMABORT
. D FLTRMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,.XMMSG)
. D:$D(XMERR) ZSHOW^XMJERR
Q:XMABORT
W:$D(XMMSG) !,XMMSG
Q
FORWARD(XMDUZ,XMK) ; Forward a range of messages
N XMWHICH,XMMSG,XMABORT,XMINSTR
S XMABORT=0
I $D(^TMP("XM",$J,".")) D Q
. N XMKZ
. D INIT^XMXADDR
. S XMKZ=$O(^TMP("XM",$J,".",""))
. I '$O(^TMP("XM",$J,".",XMKZ)) D Q
. . D FWDONE(XMDUZ,$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,"")),.XMINSTR,.XMABORT)
. D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,"",.XMABORT) Q:XMABORT ; Forward
. D SELMSG(XMDUZ,XMK,"XFWD^XMXMSGS1",34309,.XMMSG)
. D CLEANUP^XMXADDR
. D:$D(XMERR) ZSHOW^XMJERR
. W:$D(XMMSG) !,XMMSG
D WHICH(XMDUZ,XMK,34308,0,.XMWHICH,.XMABORT) Q:XMABORT
D INIT^XMXADDR
I $P(XMWHICH,",",2,99)="",$P(XMWHICH,",",1)=+XMWHICH D Q
. N XMZ
. S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",+XMWHICH,""))
. I 'XMZ W !,$$EZBLD^DIALOG(34309.3) Q ; No messages forwarded.
. D FWDONE(XMDUZ,XMZ,.XMINSTR,.XMABORT)
D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,"",.XMABORT) Q:XMABORT ; Forward
S XMINSTR("ADDR FLAGS")="I"
D FWDMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,"",.XMINSTR,.XMMSG)
D:$D(XMERR) ZSHOW^XMJERR
W:$D(XMMSG) !,XMMSG
Q
FWDONE(XMDUZ,XMZ,XMINSTR,XMABORT) ; Forward just one message
N XMZREC,XMRESTR
S XMZREC=^XMB(3.9,XMZ,0)
I '$$FORWARD^XMXSEC(XMDUZ,XMZ,XMZREC) D SHOW^XMJERR Q
D GETRESTR^XMXSEC1(XMDUZ,XMZ,XMZREC,"",.XMRESTR) ; Get restrictions on the msg
D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,.XMRESTR,.XMABORT) Q:XMABORT ; Forward
D FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
D CLEANUP^XMXADDR
W !,$$EZBLD^DIALOG(34309.2) ; Message forwarded.
Q
LATER(XMDUZ,XMK) ; Later a range of messages
N XMWHICH,XMMSG,XMABORT,XMWHEN
S XMABORT=0
I $D(^TMP("XM",$J,".")) D
. D LTRDATE^XMJMD(.XMWHEN,.XMABORT) Q:XMABORT
. D SELMSG(XMDUZ,XMK,"XLATER^XMXMSGS2",34312,.XMMSG)
E D
. D WHICH(XMDUZ,XMK,34311,0,.XMWHICH,.XMABORT) Q:XMABORT
. D LTRDATE^XMJMD(.XMWHEN,.XMABORT) Q:XMABORT
. D LATERMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,XMWHEN,.XMMSG)
. D:$D(XMERR) ZSHOW^XMJERR
Q:XMABORT
W:$D(XMMSG) !,XMMSG
Q
NEWTOGL(XMDUZ,XMK) ; New Toggle a range of messages
N XMWHICH,XMMSG,XMABORT
S XMABORT=0
I $D(^TMP("XM",$J,".")) D
. N XMKZ
. D SELMSG(XMDUZ,XMK,"XNTOGL^XMXMSGS2",34315,.XMMSG)
. S XMKZ=""
. F S XMKZ=$O(^TMP("XM",$J,".",XMKZ)) Q:'XMKZ K:'$D(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) ^TMP("XM",$J,".",XMKZ)
E D
. D WHICH(XMDUZ,XMK,34314,0,.XMWHICH,.XMABORT) Q:XMABORT
. D NTOGLMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,.XMMSG)
. D:$D(XMERR) ZSHOW^XMJERR
Q:XMABORT
W:$D(XMMSG) !,XMMSG
Q
PRINT(XMDUZ,XMK,XMPRTHDR) ; Print a range of messages
N XMWHICH,XMMSG,XMRECIPS,XMABORT
; XMPRTHDR 1=Print header
; 0=don't (headerless print)
; XMRECIPS 0=Don't print recipients
; 1=Print summary recipients
; 2=Print detail recipients
N XMSAVE,XMMSG,XMZLIST,I
S XMABORT=0
S:$G(XMPRTHDR)="" XMPRTHDR=1 ; default is to print with headers
I $D(^TMP("XM",$J,".")) D
. D LISTSEL(XMDUZ,XMK,.XMZLIST)
E D Q:XMABORT
. N XMWHICH
. D WHICH(XMDUZ,XMK,$S(XMPRTHDR:34317,1:34317.1),0,.XMWHICH,.XMABORT) Q:XMABORT
. D LIST(XMDUZ,XMK,.XMWHICH,.XMZLIST)
I '$D(XMZLIST) W !!,$$EZBLD^DIALOG(34319) Q ; No valid messages selected.
I +XMZLIST(1)=XMZLIST(1) D PRTONE(XMDUZ,XMK,XMZLIST(1),XMPRTHDR,.XMABORT) Q
D QRECIP^XMJMP(.XMRECIPS,.XMABORT) Q:XMABORT
F I="DUZ","XMDUZ","XMV(","XMZLIST(","XMRECIPS","XMPRTHDR" S XMSAVE(I)=""
D EN^XUTMDEVQ("PLISTX^XMJMP",$$EZBLD^DIALOG(34501),.XMSAVE) ; MailMan: Print
Q:XMABORT!$G(POP)
W:$D(XMMSG) !!,XMMSG
Q
LISTSEL(XMDUZ,XMK,XMZLIST) ;
N XMKZ,J,XMZ
S (XMKZ,J)=0
F S XMKZ=$O(^TMP("XM",$J,".",XMKZ)) Q:'XMKZ D
. S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,"")) Q:'XMZ
. I J=0 S J=1,XMZLIST(1)=XMZ Q
. I $L(XMZLIST(J))+$L(XMZ)>240 S J=J+1,XMZLIST(J)=XMZ Q
. S XMZLIST(J)=XMZLIST(J)_","_XMZ
Q
LIST(XMDUZ,XMK,XMWHICH,XMZLIST) ;
N I,J,XMRANGE,XMKZ,XMZ,XMLAST
S J=0
F I=1:1:$L(XMWHICH,",") D
. S XMRANGE=$P(XMWHICH,",",I)
. Q:'XMRANGE
. S XMKZ=$P(XMRANGE,"-",1)-.1
. S XMLAST=$S(XMRANGE["-":$P(XMRANGE,"-",2),1:XMRANGE)
. F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:'XMKZ!(XMKZ>XMLAST) D
. . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,"")) Q:'XMZ
. . I J=0 S J=1,XMZLIST(1)=XMZ Q
. . I $L(XMZLIST(J))+$L(XMZ)>240 S J=J+1,XMZLIST(J)=XMZ Q
. . S XMZLIST(J)=XMZLIST(J)_","_XMZ
Q
PRTONE(XMDUZ,XMK,XMZ,XMPRTHDR,XMABORT) ;
D PONE^XMJMP(XMDUZ,XMK,XMZ,XMPRTHDR,.XMABORT)
W !!,$$EZBLD^DIALOG($S(XMABORT:34318.4,1:34318.1)) ; Message (not) printed.
Q
SAVE(XMDUZ,XMK) ; Save a range of messages to another basket
N XMWHICH,XMMSG,XMABORT,XMKTO,XMDIC
S XMABORT=0
S XMDIC("B")="@" ; no default basket
I $D(^TMP("XM",$J,".")) D
. D SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(34325),"L",.XMDIC,.XMKTO) ; Save messages to which basket?
. I XMKTO=U S XMMSG=$$EZBLD^DIALOG(34324.3) Q ; No messages saved.
. I XMKTO=XMK S XMMSG=$$EZBLD^DIALOG(34326) Q ; Same basket. No messages saved.
. D SELMSG(XMDUZ,XMK,"XMOVE^XMXMSGS2",34324,.XMMSG)
. K ^TMP("XM",$J,".")
E D
. D WHICH(XMDUZ,XMK,34323,0,.XMWHICH,.XMABORT) Q:XMABORT
. D SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(34325),"L",.XMDIC,.XMKTO) ; Save messages to which basket?
. I XMKTO=U S XMMSG=$$EZBLD^DIALOG(34324.3) Q ; No messages saved.
. I XMKTO=XMK S XMMSG=$$EZBLD^DIALOG(34326) Q ; Same basket. No messages saved.
. D MOVEMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,XMKTO,.XMMSG)
. D:$D(XMERR) ZSHOW^XMJERR
Q:XMABORT
W:$D(XMMSG) !,XMMSG
Q
TERM(XMDUZ,XMK) ; Terminate a range of messages
N XMWHICH,XMMSG,XMABORT
S XMABORT=0
I $D(^TMP("XM",$J,".")) D
. D SELMSG^XMJMORX1(XMDUZ,0,0,XMK,"XTERM",34329,34330,.XMMSG,.XMABORT)
. ;K ^TMP("XM",$J,".")
E D
. D WHICH(XMDUZ,XMK,34328,34330.1,.XMWHICH,.XMABORT) Q:XMABORT
. D TERMMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,.XMMSG)
. D:$D(XMERR) ZSHOW^XMJERR
Q:XMABORT
Q:'$D(XMMSG)
W !,XMMSG
I XMMSG W !,$$EZBLD^DIALOG($S(XMK<1:34331.1,1:34331)) ; You won't see future responses. (In WASTE basket)
Q
VAPOR(XMDUZ,XMK) ; Set Vaporize date for a range of messages
N XMWHICH,XMMSG,XMABORT,XMWHEN
S XMABORT=0
I $D(^TMP("XM",$J,".")) D
. D VAPRDATE(.XMWHEN,.XMABORT) Q:XMABORT
. D SELMSG^XMJMORX1(XMDUZ,0,0,XMK,"XVAPOR^XMXMSGS2",$S(XMWHEN="@":34337.2,1:34337),$S(XMWHEN="@":34338.2,1:34338),.XMMSG,.XMABORT)
E D
. D VAPRDATE(.XMWHEN,.XMABORT) Q:XMABORT
. D WHICH(XMDUZ,XMK,$S(XMWHEN="@":34336.1,1:34336),$S(XMWHEN="@":34338.3,1:34338.1),.XMWHICH,.XMABORT) Q:XMABORT
. D VAPORMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,XMWHEN,.XMMSG)
. D:$D(XMERR) ZSHOW^XMJERR
Q:XMABORT
W:$D(XMMSG) !,XMMSG
Q
VAPRDATE(XMWHEN,XMABORT) ;
N DIR,X,Y
S DIR(0)="DO^NOW::EFT"
D BLD^DIALOG(37317.1,"","","DIR(""A"")")
D BLD^DIALOG(34339,"","","DIR(""?"")")
D ^DIR
I X="@" S XMWHEN="@" Q
I $D(DIRUT) S XMABORT=1 Q
S XMWHEN=Y
Q
XMTPRI(XMDUZ,XMK) ; Toggle transmission priority for a range of msgs
; XMDUZ better be .5 and XMK better be > 999!
N XMTPRI,XMWHICH,XMMSG,XMABORT
S XMABORT=0
I $D(^TMP("XM",$J,".")) D
. D ASKPRI^XMJMORX(.XMTPRI,.XMABORT) Q:XMABORT
. D SELMSG^XMJMORX1(XMDUZ,0,0,XMK,"XXP^XMXMSGS1",34334,34335,.XMMSG,.XMABORT)
E D
. D WHICH(XMDUZ,XMK,34333,34335.1,.XMWHICH,.XMABORT) Q:XMABORT
. D ASKPRI^XMJMORX(.XMTPRI,.XMABORT) Q:XMABORT
. D XPMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,XMTPRI,.XMMSG)
. D:$D(XMERR) ZSHOW^XMJERR
Q:XMABORT
W:$D(XMMSG) !,XMMSG
Q
WHICH(XMDUZ,XMK,XMPROMPT,XMCONFRM,XMWHICH,XMABORT) ;
N DIR,X,Y,XMHI,XMLO
S XMLO=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""))
S XMHI=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1)
S DIR("A")=$$EZBLD^DIALOG(XMPROMPT) ; ... which messages?
S DIR("??")="XM-U-M-CHOOSE RANGE"
S DIR(0)="LC^"_XMLO_":"_XMHI
D ^DIR I $D(DIRUT) S XMABORT=1 Q
S XMWHICH=Y
I XMCONFRM D CONFIRM(XMCONFRM,.XMABORT)
Q
CONFIRM(XMCONFRM,XMABORT) ;
N DIR
D BLD^DIALOG(XMCONFRM,"","","DIR(""A"")") ; Do you really want to ... these messages?
S DIR("B")=$$EZBLD^DIALOG(39053) ; No
S DIR(0)="Y"
D ^DIR I $D(DIRUT)!'Y S XMABORT=1
Q
POSTPRIV() ;
Q:$$POSTPRIV^XMXSEC 1
D SHOW^XMJERR
Q 0
SELMSG(XMDUZ,XMK,XMRTN,XMSUM,XMMSG) ;
N XMCNT,XMKZ,XMZ,XMKALL
S (XMCNT,XMKZ)=0
F S XMKZ=$O(^TMP("XM",$J,".",XMKZ)) Q:'XMKZ D
. S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,"")) Q:'XMZ
. D @XMRTN
S XMMSG=$$EZBLD^DIALOG($S(XMCNT=1:XMSUM+.1,1:XMSUM),XMCNT)
D INCRDECR^XMXMSGS(XMDUZ,.XMCNT)
Q
XMJMOR ;ISC-SF/GMB-Range actions ;12/04/2002 10:10
+1 ;;8.0;MailMan;**9**;Jun 28, 2002
+2 ; Replaces ^XMA0,^XMA01 (ISC-WASH/CAP)
DELETE(XMDUZ,XMK) ; Delete a range of messages
+1 NEW XMWHICH,XMMSG,XMABORT
+2 SET XMABORT=0
+3 IF $DATA(^TMP("XM",$JOB,"."))
Begin DoDot:1
+4 DO SELMSG^XMJMORX1(XMDUZ,0,0,XMK,"XDEL",34302,34303,.XMMSG,.XMABORT)
+5 ;K ^TMP("XM",$J,".")
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 DO WHICH(XMDUZ,XMK,34301,34303.1,.XMWHICH,.XMABORT)
IF XMABORT
QUIT
+8 DO DELMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,.XMMSG)
+9 IF $DATA(XMERR)
DO ZSHOW^XMJERR
End DoDot:1
+10 IF XMABORT
QUIT
+11 IF $DATA(XMMSG)
WRITE !,XMMSG
+12 QUIT
FILTER(XMDUZ,XMK) ; Filter a range of messages
+1 NEW XMWHICH,XMMSG,XMABORT
+2 SET XMABORT=0
+3 IF $DATA(^TMP("XM",$JOB,"."))
Begin DoDot:1
+4 NEW XMKZ
+5 DO SELMSG(XMDUZ,XMK,"XFLTR^XMXMSGS2",34306,.XMMSG)
+6 SET XMKZ=""
+7 FOR
SET XMKZ=$ORDER(^TMP("XM",$JOB,".",XMKZ))
IF 'XMKZ
QUIT
IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ))
KILL ^TMP("XM",$JOB,".",XMKZ)
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 DO WHICH(XMDUZ,XMK,34305,0,.XMWHICH,.XMABORT)
IF XMABORT
QUIT
+10 DO FLTRMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,.XMMSG)
+11 IF $DATA(XMERR)
DO ZSHOW^XMJERR
End DoDot:1
+12 IF XMABORT
QUIT
+13 IF $DATA(XMMSG)
WRITE !,XMMSG
+14 QUIT
FORWARD(XMDUZ,XMK) ; Forward a range of messages
+1 NEW XMWHICH,XMMSG,XMABORT,XMINSTR
+2 SET XMABORT=0
+3 IF $DATA(^TMP("XM",$JOB,"."))
Begin DoDot:1
+4 NEW XMKZ
+5 DO INIT^XMXADDR
+6 SET XMKZ=$ORDER(^TMP("XM",$JOB,".",""))
+7 IF '$ORDER(^TMP("XM",$JOB,".",XMKZ))
Begin DoDot:2
+8 DO FWDONE(XMDUZ,$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,"")),.XMINSTR,.XMABORT)
End DoDot:2
QUIT
+9 ; Forward
DO TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,"",.XMABORT)
IF XMABORT
QUIT
+10 DO SELMSG(XMDUZ,XMK,"XFWD^XMXMSGS1",34309,.XMMSG)
+11 DO CLEANUP^XMXADDR
+12 IF $DATA(XMERR)
DO ZSHOW^XMJERR
+13 IF $DATA(XMMSG)
WRITE !,XMMSG
End DoDot:1
QUIT
+14 DO WHICH(XMDUZ,XMK,34308,0,.XMWHICH,.XMABORT)
IF XMABORT
QUIT
+15 DO INIT^XMXADDR
+16 IF $PIECE(XMWHICH,",",2,99)=""
IF $PIECE(XMWHICH,",",1)=+XMWHICH
Begin DoDot:1
+17 NEW XMZ
+18 SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",+XMWHICH,""))
+19 ; No messages forwarded.
IF 'XMZ
WRITE !,$$EZBLD^DIALOG(34309.3)
QUIT
+20 DO FWDONE(XMDUZ,XMZ,.XMINSTR,.XMABORT)
End DoDot:1
QUIT
+21 ; Forward
DO TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,"",.XMABORT)
IF XMABORT
QUIT
+22 SET XMINSTR("ADDR FLAGS")="I"
+23 DO FWDMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,"",.XMINSTR,.XMMSG)
+24 IF $DATA(XMERR)
DO ZSHOW^XMJERR
+25 IF $DATA(XMMSG)
WRITE !,XMMSG
+26 QUIT
FWDONE(XMDUZ,XMZ,XMINSTR,XMABORT) ; Forward just one message
+1 NEW XMZREC,XMRESTR
+2 SET XMZREC=^XMB(3.9,XMZ,0)
+3 IF '$$FORWARD^XMXSEC(XMDUZ,XMZ,XMZREC)
DO SHOW^XMJERR
QUIT
+4 ; Get restrictions on the msg
DO GETRESTR^XMXSEC1(XMDUZ,XMZ,XMZREC,"",.XMRESTR)
+5 ; Forward
DO TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,.XMRESTR,.XMABORT)
IF XMABORT
QUIT
+6 DO FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
+7 DO CLEANUP^XMXADDR
+8 ; Message forwarded.
WRITE !,$$EZBLD^DIALOG(34309.2)
+9 QUIT
LATER(XMDUZ,XMK) ; Later a range of messages
+1 NEW XMWHICH,XMMSG,XMABORT,XMWHEN
+2 SET XMABORT=0
+3 IF $DATA(^TMP("XM",$JOB,"."))
Begin DoDot:1
+4 DO LTRDATE^XMJMD(.XMWHEN,.XMABORT)
IF XMABORT
QUIT
+5 DO SELMSG(XMDUZ,XMK,"XLATER^XMXMSGS2",34312,.XMMSG)
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 DO WHICH(XMDUZ,XMK,34311,0,.XMWHICH,.XMABORT)
IF XMABORT
QUIT
+8 DO LTRDATE^XMJMD(.XMWHEN,.XMABORT)
IF XMABORT
QUIT
+9 DO LATERMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,XMWHEN,.XMMSG)
+10 IF $DATA(XMERR)
DO ZSHOW^XMJERR
End DoDot:1
+11 IF XMABORT
QUIT
+12 IF $DATA(XMMSG)
WRITE !,XMMSG
+13 QUIT
NEWTOGL(XMDUZ,XMK) ; New Toggle a range of messages
+1 NEW XMWHICH,XMMSG,XMABORT
+2 SET XMABORT=0
+3 IF $DATA(^TMP("XM",$JOB,"."))
Begin DoDot:1
+4 NEW XMKZ
+5 DO SELMSG(XMDUZ,XMK,"XNTOGL^XMXMSGS2",34315,.XMMSG)
+6 SET XMKZ=""
+7 FOR
SET XMKZ=$ORDER(^TMP("XM",$JOB,".",XMKZ))
IF 'XMKZ
QUIT
IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ))
KILL ^TMP("XM",$JOB,".",XMKZ)
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 DO WHICH(XMDUZ,XMK,34314,0,.XMWHICH,.XMABORT)
IF XMABORT
QUIT
+10 DO NTOGLMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,.XMMSG)
+11 IF $DATA(XMERR)
DO ZSHOW^XMJERR
End DoDot:1
+12 IF XMABORT
QUIT
+13 IF $DATA(XMMSG)
WRITE !,XMMSG
+14 QUIT
PRINT(XMDUZ,XMK,XMPRTHDR) ; Print a range of messages
+1 NEW XMWHICH,XMMSG,XMRECIPS,XMABORT
+2 ; XMPRTHDR 1=Print header
+3 ; 0=don't (headerless print)
+4 ; XMRECIPS 0=Don't print recipients
+5 ; 1=Print summary recipients
+6 ; 2=Print detail recipients
+7 NEW XMSAVE,XMMSG,XMZLIST,I
+8 SET XMABORT=0
+9 ; default is to print with headers
IF $GET(XMPRTHDR)=""
SET XMPRTHDR=1
+10 IF $DATA(^TMP("XM",$JOB,"."))
Begin DoDot:1
+11 DO LISTSEL(XMDUZ,XMK,.XMZLIST)
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 NEW XMWHICH
+14 DO WHICH(XMDUZ,XMK,$SELECT(XMPRTHDR:34317,1:34317.1),0,.XMWHICH,.XMABORT)
IF XMABORT
QUIT
+15 DO LIST(XMDUZ,XMK,.XMWHICH,.XMZLIST)
End DoDot:1
IF XMABORT
QUIT
+16 ; No valid messages selected.
IF '$DATA(XMZLIST)
WRITE !!,$$EZBLD^DIALOG(34319)
QUIT
+17 IF +XMZLIST(1)=XMZLIST(1)
DO PRTONE(XMDUZ,XMK,XMZLIST(1),XMPRTHDR,.XMABORT)
QUIT
+18 DO QRECIP^XMJMP(.XMRECIPS,.XMABORT)
IF XMABORT
QUIT
+19 FOR I="DUZ","XMDUZ","XMV(","XMZLIST(","XMRECIPS","XMPRTHDR"
SET XMSAVE(I)=""
+20 ; MailMan: Print
DO EN^XUTMDEVQ("PLISTX^XMJMP",$$EZBLD^DIALOG(34501),.XMSAVE)
+21 IF XMABORT!$GET(POP)
QUIT
+22 IF $DATA(XMMSG)
WRITE !!,XMMSG
+23 QUIT
LISTSEL(XMDUZ,XMK,XMZLIST) ;
+1 NEW XMKZ,J,XMZ
+2 SET (XMKZ,J)=0
+3 FOR
SET XMKZ=$ORDER(^TMP("XM",$JOB,".",XMKZ))
IF 'XMKZ
QUIT
Begin DoDot:1
+4 SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
IF 'XMZ
QUIT
+5 IF J=0
SET J=1
SET XMZLIST(1)=XMZ
QUIT
+6 IF $LENGTH(XMZLIST(J))+$LENGTH(XMZ)>240
SET J=J+1
SET XMZLIST(J)=XMZ
QUIT
+7 SET XMZLIST(J)=XMZLIST(J)_","_XMZ
End DoDot:1
+8 QUIT
LIST(XMDUZ,XMK,XMWHICH,XMZLIST) ;
+1 NEW I,J,XMRANGE,XMKZ,XMZ,XMLAST
+2 SET J=0
+3 FOR I=1:1:$LENGTH(XMWHICH,",")
Begin DoDot:1
+4 SET XMRANGE=$PIECE(XMWHICH,",",I)
+5 IF 'XMRANGE
QUIT
+6 SET XMKZ=$PIECE(XMRANGE,"-",1)-.1
+7 SET XMLAST=$SELECT(XMRANGE["-":$PIECE(XMRANGE,"-",2),1:XMRANGE)
+8 FOR
SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ))
IF 'XMKZ!(XMKZ>XMLAST)
QUIT
Begin DoDot:2
+9 SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
IF 'XMZ
QUIT
+10 IF J=0
SET J=1
SET XMZLIST(1)=XMZ
QUIT
+11 IF $LENGTH(XMZLIST(J))+$LENGTH(XMZ)>240
SET J=J+1
SET XMZLIST(J)=XMZ
QUIT
+12 SET XMZLIST(J)=XMZLIST(J)_","_XMZ
End DoDot:2
End DoDot:1
+13 QUIT
PRTONE(XMDUZ,XMK,XMZ,XMPRTHDR,XMABORT) ;
+1 DO PONE^XMJMP(XMDUZ,XMK,XMZ,XMPRTHDR,.XMABORT)
+2 ; Message (not) printed.
WRITE !!,$$EZBLD^DIALOG($SELECT(XMABORT:34318.4,1:34318.1))
+3 QUIT
SAVE(XMDUZ,XMK) ; Save a range of messages to another basket
+1 NEW XMWHICH,XMMSG,XMABORT,XMKTO,XMDIC
+2 SET XMABORT=0
+3 ; no default basket
SET XMDIC("B")="@"
+4 IF $DATA(^TMP("XM",$JOB,"."))
Begin DoDot:1
+5 ; Save messages to which basket?
DO SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(34325),"L",.XMDIC,.XMKTO)
+6 ; No messages saved.
IF XMKTO=U
SET XMMSG=$$EZBLD^DIALOG(34324.3)
QUIT
+7 ; Same basket. No messages saved.
IF XMKTO=XMK
SET XMMSG=$$EZBLD^DIALOG(34326)
QUIT
+8 DO SELMSG(XMDUZ,XMK,"XMOVE^XMXMSGS2",34324,.XMMSG)
+9 KILL ^TMP("XM",$JOB,".")
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 DO WHICH(XMDUZ,XMK,34323,0,.XMWHICH,.XMABORT)
IF XMABORT
QUIT
+12 ; Save messages to which basket?
DO SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(34325),"L",.XMDIC,.XMKTO)
+13 ; No messages saved.
IF XMKTO=U
SET XMMSG=$$EZBLD^DIALOG(34324.3)
QUIT
+14 ; Same basket. No messages saved.
IF XMKTO=XMK
SET XMMSG=$$EZBLD^DIALOG(34326)
QUIT
+15 DO MOVEMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,XMKTO,.XMMSG)
+16 IF $DATA(XMERR)
DO ZSHOW^XMJERR
End DoDot:1
+17 IF XMABORT
QUIT
+18 IF $DATA(XMMSG)
WRITE !,XMMSG
+19 QUIT
TERM(XMDUZ,XMK) ; Terminate a range of messages
+1 NEW XMWHICH,XMMSG,XMABORT
+2 SET XMABORT=0
+3 IF $DATA(^TMP("XM",$JOB,"."))
Begin DoDot:1
+4 DO SELMSG^XMJMORX1(XMDUZ,0,0,XMK,"XTERM",34329,34330,.XMMSG,.XMABORT)
+5 ;K ^TMP("XM",$J,".")
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 DO WHICH(XMDUZ,XMK,34328,34330.1,.XMWHICH,.XMABORT)
IF XMABORT
QUIT
+8 DO TERMMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,.XMMSG)
+9 IF $DATA(XMERR)
DO ZSHOW^XMJERR
End DoDot:1
+10 IF XMABORT
QUIT
+11 IF '$DATA(XMMSG)
QUIT
+12 WRITE !,XMMSG
+13 ; You won't see future responses. (In WASTE basket)
IF XMMSG
WRITE !,$$EZBLD^DIALOG($SELECT(XMK<1:34331.1,1:34331))
+14 QUIT
VAPOR(XMDUZ,XMK) ; Set Vaporize date for a range of messages
+1 NEW XMWHICH,XMMSG,XMABORT,XMWHEN
+2 SET XMABORT=0
+3 IF $DATA(^TMP("XM",$JOB,"."))
Begin DoDot:1
+4 DO VAPRDATE(.XMWHEN,.XMABORT)
IF XMABORT
QUIT
+5 DO SELMSG^XMJMORX1(XMDUZ,0,0,XMK,"XVAPOR^XMXMSGS2",$SELECT(XMWHEN="@":34337.2,1:34337),$SELECT(XMWHEN="@":34338.2,1:34338),.XMMSG,.XMABORT)
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 DO VAPRDATE(.XMWHEN,.XMABORT)
IF XMABORT
QUIT
+8 DO WHICH(XMDUZ,XMK,$SELECT(XMWHEN="@":34336.1,1:34336),$SELECT(XMWHEN="@":34338.3,1:34338.1),.XMWHICH,.XMABORT)
IF XMABORT
QUIT
+9 DO VAPORMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,XMWHEN,.XMMSG)
+10 IF $DATA(XMERR)
DO ZSHOW^XMJERR
End DoDot:1
+11 IF XMABORT
QUIT
+12 IF $DATA(XMMSG)
WRITE !,XMMSG
+13 QUIT
VAPRDATE(XMWHEN,XMABORT) ;
+1 NEW DIR,X,Y
+2 SET DIR(0)="DO^NOW::EFT"
+3 DO BLD^DIALOG(37317.1,"","","DIR(""A"")")
+4 DO BLD^DIALOG(34339,"","","DIR(""?"")")
+5 DO ^DIR
+6 IF X="@"
SET XMWHEN="@"
QUIT
+7 IF $DATA(DIRUT)
SET XMABORT=1
QUIT
+8 SET XMWHEN=Y
+9 QUIT
XMTPRI(XMDUZ,XMK) ; Toggle transmission priority for a range of msgs
+1 ; XMDUZ better be .5 and XMK better be > 999!
+2 NEW XMTPRI,XMWHICH,XMMSG,XMABORT
+3 SET XMABORT=0
+4 IF $DATA(^TMP("XM",$JOB,"."))
Begin DoDot:1
+5 DO ASKPRI^XMJMORX(.XMTPRI,.XMABORT)
IF XMABORT
QUIT
+6 DO SELMSG^XMJMORX1(XMDUZ,0,0,XMK,"XXP^XMXMSGS1",34334,34335,.XMMSG,.XMABORT)
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 DO WHICH(XMDUZ,XMK,34333,34335.1,.XMWHICH,.XMABORT)
IF XMABORT
QUIT
+9 DO ASKPRI^XMJMORX(.XMTPRI,.XMABORT)
IF XMABORT
QUIT
+10 DO XPMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,XMTPRI,.XMMSG)
+11 IF $DATA(XMERR)
DO ZSHOW^XMJERR
End DoDot:1
+12 IF XMABORT
QUIT
+13 IF $DATA(XMMSG)
WRITE !,XMMSG
+14 QUIT
WHICH(XMDUZ,XMK,XMPROMPT,XMCONFRM,XMWHICH,XMABORT) ;
+1 NEW DIR,X,Y,XMHI,XMLO
+2 SET XMLO=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",""))
+3 SET XMHI=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1)
+4 ; ... which messages?
SET DIR("A")=$$EZBLD^DIALOG(XMPROMPT)
+5 SET DIR("??")="XM-U-M-CHOOSE RANGE"
+6 SET DIR(0)="LC^"_XMLO_":"_XMHI
+7 DO ^DIR
IF $DATA(DIRUT)
SET XMABORT=1
QUIT
+8 SET XMWHICH=Y
+9 IF XMCONFRM
DO CONFIRM(XMCONFRM,.XMABORT)
+10 QUIT
CONFIRM(XMCONFRM,XMABORT) ;
+1 NEW DIR
+2 ; Do you really want to ... these messages?
DO BLD^DIALOG(XMCONFRM,"","","DIR(""A"")")
+3 ; No
SET DIR("B")=$$EZBLD^DIALOG(39053)
+4 SET DIR(0)="Y"
+5 DO ^DIR
IF $DATA(DIRUT)!'Y
SET XMABORT=1
+6 QUIT
POSTPRIV() ;
+1 IF $$POSTPRIV^XMXSEC
QUIT 1
+2 DO SHOW^XMJERR
+3 QUIT 0
SELMSG(XMDUZ,XMK,XMRTN,XMSUM,XMMSG) ;
+1 NEW XMCNT,XMKZ,XMZ,XMKALL
+2 SET (XMCNT,XMKZ)=0
+3 FOR
SET XMKZ=$ORDER(^TMP("XM",$JOB,".",XMKZ))
IF 'XMKZ
QUIT
Begin DoDot:1
+4 SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
IF 'XMZ
QUIT
+5 DO @XMRTN
End DoDot:1
+6 SET XMMSG=$$EZBLD^DIALOG($SELECT(XMCNT=1:XMSUM+.1,1:XMSUM),XMCNT)
+7 DO INCRDECR^XMXMSGS(XMDUZ,.XMCNT)
+8 QUIT
