- 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 Feb 18, 2025@23:38: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