source: FOIAVistA/tag/r/MAILMAN-XM/XMJMORX.m@ 1267

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