XMJMORX ;ISC-SF/GMB-Range actions for ^TMP message lists ;12/04/2002 10:13
;;8.0;MailMan;**9**;Jun 28, 2002
; Similar to ^XMJMOR
DELETE(XMDUZ,XMKALL,XMK) ; Delete
N XMMSG,XMABORT
S XMABORT=0
I $D(^TMP("XM",$J,".")) D
. D SELMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XDEL",34302,34303,.XMMSG,.XMABORT)
. ;K:'XMKALL ^TMP("XM",$J,".")
E D
. D ACTWHICH^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XDEL",34301,34302,34303.1,.XMMSG,.XMABORT)
Q:XMABORT
W:$D(XMMSG) !,XMMSG
Q
FILTER(XMDUZ,XMKALL,XMK) ; Filter
N XMMSG,XMABORT
S XMABORT=0
I $D(^TMP("XM",$J,".")) D
. D SELMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XFLTR",34306,0,.XMMSG)
E D
. D ACTWHICH^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XFLTR",34305,34306,0,.XMMSG,.XMABORT)
Q:XMABORT
W:$D(XMMSG) !,XMMSG
Q
FORWARD(XMDUZ,XMKALL,XMK) ; Forward
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^XMJMOR(XMDUZ,$P(^TMP("XM",$J,"MSG",XMKZ),U,3),.XMINSTR,.XMABORT)
. D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,"",.XMABORT) Q:XMABORT ; Forward
. D SELMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XFWD^XMXMSGS1",34309,0,.XMMSG)
. D CLEANUP^XMXADDR
. I $D(XMERR) D ZSHOW^XMJERR
. W:$D(XMMSG) !,XMMSG
D WHICH^XMJMORX1(34308,0,.XMWHICH,.XMABORT) Q:XMABORT
D INIT^XMXADDR
I $P(XMWHICH,",",2,99)="",$P(XMWHICH,",",1)=+XMWHICH D Q
. N XMZ
. S XMZ=$P($G(^TMP("XM",$J,"MSG",+XMWHICH)),U,3)
. I 'XMZ W !,$$EZBLD^DIALOG(34309.3) Q ; No messages forwarded.
. D FWDONE^XMJMOR(XMDUZ,XMZ,.XMINSTR,.XMABORT)
D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,"",.XMABORT) Q:XMABORT ; Forward
D ACTMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,XMWHICH,"XFWD^XMXMSGS1",34309,.XMMSG)
D CLEANUP^XMXADDR
I $D(XMERR) D ZSHOW^XMJERR
W:$D(XMMSG) !,XMMSG
Q
LATER(XMDUZ,XMKALL,XMK) ; Later
N XMWHICH,XMMSG,XMABORT,XMWHEN
S XMABORT=0
I $D(^TMP("XM",$J,".")) D
. D LTRDATE^XMJMD(.XMWHEN,.XMABORT) Q:XMABORT
. D SELMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XLATER^XMXMSGS2",34312,0,.XMMSG)
E D
. D WHICH^XMJMORX1(34311,0,.XMWHICH,.XMABORT) Q:XMABORT
. D LTRDATE^XMJMD(.XMWHEN,.XMABORT) Q:XMABORT
. D ACTMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,XMWHICH,"XLATER^XMXMSGS2",34312,.XMMSG)
Q:XMABORT
W:$D(XMMSG) !,XMMSG
Q
NEWTOGL(XMDUZ,XMKALL,XMK) ; New Toggle
N XMMSG,XMABORT
S XMABORT=0
I $D(^TMP("XM",$J,".")) D
. D SELMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XNTOGL",34315,0,.XMMSG)
E D
. D ACTWHICH^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XNTOGL",34314,34315,0,.XMMSG,.XMABORT)
Q:XMABORT
W:$D(XMMSG) !,XMMSG
Q
PRINT(XMDUZ,XMPRTHDR) ; Print (Needs XMTYPE)
N XMRECIPS,XMABORT,XMSAVE,XMMSG,XMWHICH,XMZLIST,I
; XMPRTHDR 1=Print header
; 0=don't (headerless print)
; XMRECIPS 0=Don't print recipients
; 1=Print summary recipients
; 2=Print detail recipients
S XMABORT=0
S:$G(XMPRTHDR)="" XMPRTHDR=1 ; default is to print with headers
I $D(^TMP("XM",$J,".")) D
. D LISTSEL(.XMZLIST)
E D Q:XMABORT
. D WHICH^XMJMORX1($S(XMPRTHDR:34317,1:34317.1),0,.XMWHICH,.XMABORT) Q:XMABORT
. D LIST(.XMWHICH,.XMZLIST)
I '$D(XMZLIST) W !!,$$EZBLD^DIALOG(34319) Q ; No valid messages selected.
I +XMZLIST(1)=XMZLIST(1) D
. D PRTONE^XMJMOR(XMDUZ,$$BSKT^XMXUTIL2(XMDUZ,XMZLIST(1)),XMZLIST(1),XMPRTHDR,.XMABORT)
E D
. 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
. I $G(POP) S XMABORT=1 Q
. W:$D(XMMSG) !!,XMMSG
Q:$G(XMTYPE)'["N"!XMABORT
N XMKZ,XMZ,XMRANGE
I $D(^TMP("XM",$J,".")) D Q
. S XMKZ=""
. F S XMKZ=$O(^TMP("XM",$J,".",XMKZ)) Q:'XMKZ D
. . S XMZ=$P(^TMP("XM",$J,"MSG",XMKZ),U,3)
. . Q:$D(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ))
. . K ^TMP("XM",$J,"MSG",XMKZ)
. . K ^TMP("XM",$J,".",XMKZ)
F I=1:1:$L(XMWHICH,",") D
. S XMRANGE=$P(XMWHICH,",",I)
. Q:'XMRANGE
. F XMKZ=$P(XMRANGE,"-",1):1:$S(XMRANGE["-":$P(XMRANGE,"-",2),1:XMRANGE) D
. . Q:'$D(^TMP("XM",$J,"MSG",XMKZ))
. . S XMZ=$P(^TMP("XM",$J,"MSG",XMKZ),U,3)
. . K:'$D(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ)) ^TMP("XM",$J,"MSG",XMKZ)
Q
LISTSEL(XMZLIST) ;
N XMKZ,J,XMZ
S (XMKZ,J)=0
F S XMKZ=$O(^TMP("XM",$J,".",XMKZ)) Q:'XMKZ D
. S XMZ=$P(^TMP("XM",$J,"MSG",XMKZ),U,3)
. 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(XMWHICH,XMZLIST) ;
N I,J,XMRANGE,XMKZ,XMZ
S J=0
F I=1:1:$L(XMWHICH,",") D
. S XMRANGE=$P(XMWHICH,",",I)
. Q:'XMRANGE
. F XMKZ=$P(XMRANGE,"-",1):1:$S(XMRANGE["-":$P(XMRANGE,"-",2),1:XMRANGE) D
. . S XMZ=$P($G(^TMP("XM",$J,"MSG",XMKZ)),U,3) 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
SAVE(XMDUZ,XMKALL,XMK) ; Save a range of messages to another basket
N XMWHICH,XMMSG,XMABORT,XMKTO,XMDIC,XMKNTO
S XMABORT=0
S XMDIC("B")="@" ; no default bskt
I $D(^TMP("XM",$J,".")) D
. D SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(34325),"L",.XMDIC,.XMKTO,.XMKNTO) I XMKTO=U S XMABORT=1 Q ; Save messages to which basket?
. I 'XMKALL,XMKTO=XMK S XMMSG=$$EZBLD^DIALOG(34326) Q ; Same basket. No messages saved.
. D SELMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XSAVE",34324,0,.XMMSG)
. K:'XMKALL ^TMP("XM",$J,".")
E D
. D WHICH^XMJMORX1(34323,0,.XMWHICH,.XMABORT) Q:XMABORT
. D SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(34325),"L",.XMDIC,.XMKTO,.XMKNTO) ; Save messages to which basket?
. I XMKTO=U S XMABORT=1 Q
. I 'XMKALL,XMKTO=XMK S XMMSG=$$EZBLD^DIALOG(34326) Q ; Same basket. No messages saved.
. D ACTMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,XMWHICH,"XSAVE",34324,.XMMSG)
Q:XMABORT
W:$D(XMMSG) !,XMMSG
Q
TERM(XMDUZ,XMKALL,XMK) ; Terminate a range of messages
N XMMSG,XMABORT
S XMABORT=0
I $D(^TMP("XM",$J,".")) D
. D SELMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XTERM",34329,34330,.XMMSG,.XMABORT)
. ;K:'XMKALL ^TMP("XM",$J,".")
E D
. D ACTWHICH^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XTERM",34328,34329,34330.1,.XMMSG,.XMABORT)
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,XMKALL,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^XMJMOR(.XMWHEN,.XMABORT) Q:XMABORT
. D SELMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XVAPOR^XMXMSGS2",$S(XMWHEN="@":34337.2,1:34337),$S(XMWHEN="@":34338.2,1:34338),.XMMSG)
E D
. D VAPRDATE^XMJMOR(.XMWHEN,.XMABORT) Q:XMABORT
. D WHICH^XMJMORX1($S(XMWHEN="@":34336.1,1:34336),$S(XMWHEN="@":34338.3,1:34338.1),.XMWHICH,.XMABORT) Q:XMABORT
. D ACTMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,XMWHICH,"XVAPOR^XMXMSGS2",34337,.XMMSG)
Q:XMABORT
W:$D(XMMSG) !,XMMSG
Q
XMTPRI(XMDUZ,XMKALL,XMK) ; Toggle transmit priority
; XMDUZ better be .5 and XMK better be > 1000!
N XMTPRI,XMWHICH,XMMSG,XMABORT
S XMABORT=0
I $D(^TMP("XM",$J,".")) D
. D ASKPRI(.XMTPRI,.XMABORT) Q:XMABORT
. D SELMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XXP^XMXMSGS1",34334,34335,.XMMSG,.XMABORT)
E D
. D WHICH^XMJMORX1(34333,34335.1,.XMWHICH,.XMABORT) Q:XMABORT
. D ASKPRI(.XMTPRI,.XMABORT) Q:XMABORT
. D ACTMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,XMWHICH,"XXP^XMXMSGS1",34334,.XMMSGT)
Q:XMABORT
W:$D(XMMSG) !,XMMSG
Q
ASKPRI(XMTPRI,XMABORT) ;
N XMTXT,XMOPT,XMOX,XMDIR
D SET^XMXSEC1("H",34332.3,.XMOPT,.XMOX) ; H:High
D SET^XMXSEC1("L",34332.1,.XMOPT,.XMOX) ; L:Low
D SET^XMXSEC1("N",34332.2,.XMOPT,.XMOX) ; N:Normal
S XMDIR("A")=$$EZBLD^DIALOG(34332) ; Select transmit priority:
I $G(XMTPRI)'="" D
. S XMTXT=XMOPT(XMTPRI)
. S XMDIR("B")=XMOX("O",XMTPRI)_":"_XMTXT
S XMDIR("??")="XM-U-B-XMIT PRIORITY TOGGLE"
D XMDIR^XMJDIR(.XMDIR,.XMOPT,.XMOX,.XMTPRI,.XMABORT) Q:XMABORT
S XMTPRI=$S(XMTPRI="N":0,XMTPRI="H":1,1:2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJMORX 7957 printed Apr 09, 2024@21:13:20 Page 2
XMJMORX ;ISC-SF/GMB-Range actions for ^TMP message lists ;12/04/2002 10:13
+1 ;;8.0;MailMan;**9**;Jun 28, 2002
+2 ; Similar to ^XMJMOR
DELETE(XMDUZ,XMKALL,XMK) ; Delete
+1 NEW XMMSG,XMABORT
+2 SET XMABORT=0
+3 IF $DATA(^TMP("XM",$JOB,"."))
Begin DoDot:1
+4 DO SELMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XDEL",34302,34303,.XMMSG,.XMABORT)
+5 ;K:'XMKALL ^TMP("XM",$J,".")
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 DO ACTWHICH^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XDEL",34301,34302,34303.1,.XMMSG,.XMABORT)
End DoDot:1
+8 if XMABORT
QUIT
+9 if $DATA(XMMSG)
WRITE !,XMMSG
+10 QUIT
FILTER(XMDUZ,XMKALL,XMK) ; Filter
+1 NEW XMMSG,XMABORT
+2 SET XMABORT=0
+3 IF $DATA(^TMP("XM",$JOB,"."))
Begin DoDot:1
+4 DO SELMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XFLTR",34306,0,.XMMSG)
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 DO ACTWHICH^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XFLTR",34305,34306,0,.XMMSG,.XMABORT)
End DoDot:1
+7 if XMABORT
QUIT
+8 if $DATA(XMMSG)
WRITE !,XMMSG
+9 QUIT
FORWARD(XMDUZ,XMKALL,XMK) ; Forward
+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^XMJMOR(XMDUZ,$PIECE(^TMP("XM",$JOB,"MSG",XMKZ),U,3),.XMINSTR,.XMABORT)
End DoDot:2
QUIT
+9 ; Forward
DO TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,"",.XMABORT)
if XMABORT
QUIT
+10 DO SELMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XFWD^XMXMSGS1",34309,0,.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^XMJMORX1(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=$PIECE($GET(^TMP("XM",$JOB,"MSG",+XMWHICH)),U,3)
+19 ; No messages forwarded.
IF 'XMZ
WRITE !,$$EZBLD^DIALOG(34309.3)
QUIT
+20 DO FWDONE^XMJMOR(XMDUZ,XMZ,.XMINSTR,.XMABORT)
End DoDot:1
QUIT
+21 ; Forward
DO TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,"",.XMABORT)
if XMABORT
QUIT
+22 DO ACTMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,XMWHICH,"XFWD^XMXMSGS1",34309,.XMMSG)
+23 DO CLEANUP^XMXADDR
+24 IF $DATA(XMERR)
DO ZSHOW^XMJERR
+25 if $DATA(XMMSG)
WRITE !,XMMSG
+26 QUIT
LATER(XMDUZ,XMKALL,XMK) ; Later
+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^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XLATER^XMXMSGS2",34312,0,.XMMSG)
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 DO WHICH^XMJMORX1(34311,0,.XMWHICH,.XMABORT)
if XMABORT
QUIT
+8 DO LTRDATE^XMJMD(.XMWHEN,.XMABORT)
if XMABORT
QUIT
+9 DO ACTMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,XMWHICH,"XLATER^XMXMSGS2",34312,.XMMSG)
End DoDot:1
+10 if XMABORT
QUIT
+11 if $DATA(XMMSG)
WRITE !,XMMSG
+12 QUIT
NEWTOGL(XMDUZ,XMKALL,XMK) ; New Toggle
+1 NEW XMMSG,XMABORT
+2 SET XMABORT=0
+3 IF $DATA(^TMP("XM",$JOB,"."))
Begin DoDot:1
+4 DO SELMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XNTOGL",34315,0,.XMMSG)
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 DO ACTWHICH^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XNTOGL",34314,34315,0,.XMMSG,.XMABORT)
End DoDot:1
+7 if XMABORT
QUIT
+8 if $DATA(XMMSG)
WRITE !,XMMSG
+9 QUIT
PRINT(XMDUZ,XMPRTHDR) ; Print (Needs XMTYPE)
+1 NEW XMRECIPS,XMABORT,XMSAVE,XMMSG,XMWHICH,XMZLIST,I
+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 SET XMABORT=0
+8 ; default is to print with headers
if $GET(XMPRTHDR)=""
SET XMPRTHDR=1
+9 IF $DATA(^TMP("XM",$JOB,"."))
Begin DoDot:1
+10 DO LISTSEL(.XMZLIST)
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 DO WHICH^XMJMORX1($SELECT(XMPRTHDR:34317,1:34317.1),0,.XMWHICH,.XMABORT)
if XMABORT
QUIT
+13 DO LIST(.XMWHICH,.XMZLIST)
End DoDot:1
if XMABORT
QUIT
+14 ; No valid messages selected.
IF '$DATA(XMZLIST)
WRITE !!,$$EZBLD^DIALOG(34319)
QUIT
+15 IF +XMZLIST(1)=XMZLIST(1)
Begin DoDot:1
+16 DO PRTONE^XMJMOR(XMDUZ,$$BSKT^XMXUTIL2(XMDUZ,XMZLIST(1)),XMZLIST(1),XMPRTHDR,.XMABORT)
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+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 $GET(POP)
SET XMABORT=1
QUIT
+22 if $DATA(XMMSG)
WRITE !!,XMMSG
End DoDot:1
+23 if $GET(XMTYPE)'["N"!XMABORT
QUIT
+24 NEW XMKZ,XMZ,XMRANGE
+25 IF $DATA(^TMP("XM",$JOB,"."))
Begin DoDot:1
+26 SET XMKZ=""
+27 FOR
SET XMKZ=$ORDER(^TMP("XM",$JOB,".",XMKZ))
if 'XMKZ
QUIT
Begin DoDot:2
+28 SET XMZ=$PIECE(^TMP("XM",$JOB,"MSG",XMKZ),U,3)
+29 if $DATA(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ))
QUIT
+30 KILL ^TMP("XM",$JOB,"MSG",XMKZ)
+31 KILL ^TMP("XM",$JOB,".",XMKZ)
End DoDot:2
End DoDot:1
QUIT
+32 FOR I=1:1:$LENGTH(XMWHICH,",")
Begin DoDot:1
+33 SET XMRANGE=$PIECE(XMWHICH,",",I)
+34 if 'XMRANGE
QUIT
+35 FOR XMKZ=$PIECE(XMRANGE,"-",1):1:$SELECT(XMRANGE["-":$PIECE(XMRANGE,"-",2),1:XMRANGE)
Begin DoDot:2
+36 if '$DATA(^TMP("XM",$JOB,"MSG",XMKZ))
QUIT
+37 SET XMZ=$PIECE(^TMP("XM",$JOB,"MSG",XMKZ),U,3)
+38 if '$DATA(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ))
KILL ^TMP("XM",$JOB,"MSG",XMKZ)
End DoDot:2
End DoDot:1
+39 QUIT
LISTSEL(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=$PIECE(^TMP("XM",$JOB,"MSG",XMKZ),U,3)
+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(XMWHICH,XMZLIST) ;
+1 NEW I,J,XMRANGE,XMKZ,XMZ
+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 FOR XMKZ=$PIECE(XMRANGE,"-",1):1:$SELECT(XMRANGE["-":$PIECE(XMRANGE,"-",2),1:XMRANGE)
Begin DoDot:2
+7 SET XMZ=$PIECE($GET(^TMP("XM",$JOB,"MSG",XMKZ)),U,3)
if 'XMZ
QUIT
+8 IF J=0
SET J=1
SET XMZLIST(1)=XMZ
QUIT
+9 IF $LENGTH(XMZLIST(J))+$LENGTH(XMZ)>240
SET J=J+1
SET XMZLIST(J)=XMZ
QUIT
+10 SET XMZLIST(J)=XMZLIST(J)_","_XMZ
End DoDot:2
End DoDot:1
+11 QUIT
SAVE(XMDUZ,XMKALL,XMK) ; Save a range of messages to another basket
+1 NEW XMWHICH,XMMSG,XMABORT,XMKTO,XMDIC,XMKNTO
+2 SET XMABORT=0
+3 ; no default bskt
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,.XMKNTO)
IF XMKTO=U
SET XMABORT=1
QUIT
+6 ; Same basket. No messages saved.
IF 'XMKALL
IF XMKTO=XMK
SET XMMSG=$$EZBLD^DIALOG(34326)
QUIT
+7 DO SELMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XSAVE",34324,0,.XMMSG)
+8 if 'XMKALL
KILL ^TMP("XM",$JOB,".")
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 DO WHICH^XMJMORX1(34323,0,.XMWHICH,.XMABORT)
if XMABORT
QUIT
+11 ; Save messages to which basket?
DO SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(34325),"L",.XMDIC,.XMKTO,.XMKNTO)
+12 IF XMKTO=U
SET XMABORT=1
QUIT
+13 ; Same basket. No messages saved.
IF 'XMKALL
IF XMKTO=XMK
SET XMMSG=$$EZBLD^DIALOG(34326)
QUIT
+14 DO ACTMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,XMWHICH,"XSAVE",34324,.XMMSG)
End DoDot:1
+15 if XMABORT
QUIT
+16 if $DATA(XMMSG)
WRITE !,XMMSG
+17 QUIT
TERM(XMDUZ,XMKALL,XMK) ; Terminate a range of messages
+1 NEW XMMSG,XMABORT
+2 SET XMABORT=0
+3 IF $DATA(^TMP("XM",$JOB,"."))
Begin DoDot:1
+4 DO SELMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XTERM",34329,34330,.XMMSG,.XMABORT)
+5 ;K:'XMKALL ^TMP("XM",$J,".")
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 DO ACTWHICH^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XTERM",34328,34329,34330.1,.XMMSG,.XMABORT)
End DoDot:1
+8 if XMABORT
QUIT
+9 if '$DATA(XMMSG)
QUIT
+10 WRITE !,XMMSG
+11 ; You won't see future responses. (In WASTE basket)
IF XMMSG
WRITE !,$$EZBLD^DIALOG($SELECT(XMK<1:34331.1,1:34331))
+12 QUIT
VAPOR(XMDUZ,XMKALL,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^XMJMOR(.XMWHEN,.XMABORT)
if XMABORT
QUIT
+5 DO SELMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XVAPOR^XMXMSGS2",$SELECT(XMWHEN="@":34337.2,1:34337),$SELECT(XMWHEN="@":34338.2,1:34338),.XMMSG)
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 DO VAPRDATE^XMJMOR(.XMWHEN,.XMABORT)
if XMABORT
QUIT
+8 DO WHICH^XMJMORX1($SELECT(XMWHEN="@":34336.1,1:34336),$SELECT(XMWHEN="@":34338.3,1:34338.1),.XMWHICH,.XMABORT)
if XMABORT
QUIT
+9 DO ACTMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,XMWHICH,"XVAPOR^XMXMSGS2",34337,.XMMSG)
End DoDot:1
+10 if XMABORT
QUIT
+11 if $DATA(XMMSG)
WRITE !,XMMSG
+12 QUIT
XMTPRI(XMDUZ,XMKALL,XMK) ; Toggle transmit priority
+1 ; XMDUZ better be .5 and XMK better be > 1000!
+2 NEW XMTPRI,XMWHICH,XMMSG,XMABORT
+3 SET XMABORT=0
+4 IF $DATA(^TMP("XM",$JOB,"."))
Begin DoDot:1
+5 DO ASKPRI(.XMTPRI,.XMABORT)
if XMABORT
QUIT
+6 DO SELMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,"XXP^XMXMSGS1",34334,34335,.XMMSG,.XMABORT)
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 DO WHICH^XMJMORX1(34333,34335.1,.XMWHICH,.XMABORT)
if XMABORT
QUIT
+9 DO ASKPRI(.XMTPRI,.XMABORT)
if XMABORT
QUIT
+10 DO ACTMSG^XMJMORX1(XMDUZ,1,XMKALL,XMK,XMWHICH,"XXP^XMXMSGS1",34334,.XMMSGT)
End DoDot:1
+11 if XMABORT
QUIT
+12 if $DATA(XMMSG)
WRITE !,XMMSG
+13 QUIT
ASKPRI(XMTPRI,XMABORT) ;
+1 NEW XMTXT,XMOPT,XMOX,XMDIR
+2 ; H:High
DO SET^XMXSEC1("H",34332.3,.XMOPT,.XMOX)
+3 ; L:Low
DO SET^XMXSEC1("L",34332.1,.XMOPT,.XMOX)
+4 ; N:Normal
DO SET^XMXSEC1("N",34332.2,.XMOPT,.XMOX)
+5 ; Select transmit priority:
SET XMDIR("A")=$$EZBLD^DIALOG(34332)
+6 IF $GET(XMTPRI)'=""
Begin DoDot:1
+7 SET XMTXT=XMOPT(XMTPRI)
+8 SET XMDIR("B")=XMOX("O",XMTPRI)_":"_XMTXT
End DoDot:1
+9 SET XMDIR("??")="XM-U-B-XMIT PRIORITY TOGGLE"
+10 DO XMDIR^XMJDIR(.XMDIR,.XMOPT,.XMOX,.XMTPRI,.XMABORT)
if XMABORT
QUIT
+11 SET XMTPRI=$SELECT(XMTPRI="N":0,XMTPRI="H":1,1:2)
+12 QUIT
