XMJMLN ;ISC-SF/GB-List/Read new messages ;12/12/2001 08:53
;;8.0;MailMan;;Jun 28, 2002
; Replaces LIST,PRIO^XMA0A (ISC-WASH/CAP)
LISTONE(XMDUZ,XMK,XMKN,XMTYPE) ; List new/priority messages in one basket
; XMTYPE N0=New; N=Priority
N XMKZ,XMZ,XMCNT,XMABORT,XMLEN,XMFIRST,XMPAGE,XMDETAIL,XMPMAX,XMKALL,XMIA,XMZOOM,XMMORE,XMCD,XMOPT,XMOX
S XMIA=1 ; Interactive
I '$D(^XMB(3.7,XMDUZ,XMTYPE,XMK)) D Q
. W !!,$$EZBLD^DIALOG($S(XMTYPE="N":34016,1:34015)) ; You have no new (priority) messages in this basket.
K ^TMP("XM",$J,"MSG"),^TMP("XM",$J,".")
S (XMKZ,XMZ)="",(XMPAGE,XMCNT,XMKALL,XMZOOM,XMCD,XMABORT)=0,(XMDETAIL,XMMORE)=1
S XMPMAX=IOSL-3
D SETOPT^XMJMLR1(XMDUZ,0,.XMOPT,.XMOX)
S XMLEN("XMKZ")=$L($P(^XMB(3.7,XMDUZ,2,XMK,0),U,2))
D INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
F D Q:XMABORT
. I XMCD S XMCD=0,XMDETAIL='XMDETAIL D INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
. D DISPLAY(XMDUZ,XMKALL,XMTYPE,XMDETAIL,XMK,XMKN,.XMKZ,.XMZ,.XMCNT,.XMFIRST,.XMPAGE,.XMMORE,.XMLEN,XMZOOM,XMPMAX)
. D CHOOSE(XMDUZ,XMKALL,XMK,.XMKZ,.XMFIRST,.XMPAGE,XMMORE,.XMLEN,.XMZOOM,.XMOPT,.XMOX,"READMSG",.XMABORT)
. S:'$D(^XMB(3.7,XMDUZ,XMTYPE,XMK)) XMABORT=1
K ^TMP("XM",$J,"MSG"),^TMP("XM",$J,".")
Q
LISTALL(XMDUZ,XMTYPE) ; List new/priority messages in all baskets
; XMTYPE N0=New; N=Priority
N XMK,XMKZ,XMZ,XMCNT,XMABORT,XMLEN,XMFIRST,XMPAGE,XMDETAIL,XMPMAX,XMKALL,XMIA,XMZOOM,XMMORE,XMCD,XMOPT,XMOX
S XMIA=1 ; Interactive
I '$D(^XMB(3.7,XMDUZ,XMTYPE)) D Q
. W !!,$$EZBLD^DIALOG($S(XMTYPE="N":34018,1:34017)) ; You have no new (priority) messages.
K ^TMP("XM",$J,"MSG"),^TMP("XM",$J,".")
S (XMKZ,XMZ)="",(XMPAGE,XMCNT,XMZOOM,XMCD,XMABORT)=0,(XMK,XMDETAIL,XMMORE,XMKALL)=1
S XMPMAX=IOSL-3
D SETOPT^XMJMLR1(XMDUZ,0,.XMOPT,.XMOX)
D INIT(XMDUZ,XMTYPE,XMDETAIL,0,.XMLEN)
F D Q:XMABORT
. I XMCD S XMCD=0,XMDETAIL='XMDETAIL D INIT(XMDUZ,XMTYPE,XMDETAIL,0,.XMLEN)
. D DISPLAY(XMDUZ,XMKALL,XMTYPE,XMDETAIL,.XMK,"",.XMKZ,.XMZ,.XMCNT,.XMFIRST,.XMPAGE,.XMMORE,.XMLEN,XMZOOM,XMPMAX)
. D CHOOSE(XMDUZ,XMKALL,0,.XMKZ,.XMFIRST,.XMPAGE,XMMORE,.XMLEN,.XMZOOM,.XMOPT,.XMOX,"READMSG",.XMABORT)
. S:'$D(^XMB(3.7,XMDUZ,XMTYPE)) XMABORT=1
K ^TMP("XM",$J,"MSG"),^TMP("XM",$J,".")
Q
INIT(XMDUZ,XMTYPE,XMDETAIL,XMACTUAL,XMLEN) ;
; XMACTUAL 1/0=do/do not use actual XMKZ
N XMK,XMKN,XMKNMAX,XMKZL
S XMLEN("XMKZ")=$S(XMACTUAL:0,1:$L($P(^XMB(3.7,XMDUZ,0),U,6)))
S XMK=0,XMKNMAX=""
F S XMK=$O(^XMB(3.7,XMDUZ,XMTYPE,XMK)) Q:XMK="" D
. S XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
. S:$L(XMKN)>$L(XMKNMAX) XMKNMAX=XMKN
. Q:'XMACTUAL
. S XMKZL=$L($O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1))
. S:XMKZL>XMLEN("XMKZ") XMLEN("XMKZ")=XMKZL
D INIT^XMJML(XMDUZ,"",XMKNMAX,XMDETAIL,.XMLEN)
Q
DISPLAY(XMDUZ,XMKALL,XMTYPE,XMDETAIL,XMK,XMKN,XMKZ,XMZ,XMCNT,XMFIRST,XMPAGE,XMMORE,XMLEN,XMZOOM,XMPMAX) ;
N XMREC,XMHDLINE
S XMFIRST(XMPAGE)=XMKZ
S XMHDLINE=$$HEADLINE(XMDUZ,XMKALL,XMK,XMKN,XMTYPE)
D HEADER^XMJML(XMDETAIL,.XMLEN,XMHDLINE)
I XMZOOM D Q
. F S XMKZ=$O(^TMP("XM",$J,".",XMKZ)) Q:XMKZ="" D Q:$Y>XMPMAX
. . S XMREC=^TMP("XM",$J,"MSG",XMKZ)
. . D LISTMSG^XMJML($P(XMREC,U,1),$P(XMREC,U,2),XMKZ,$P(XMREC,U,3),XMDETAIL,.XMLEN)
F S XMKZ=$O(^TMP("XM",$J,"MSG",XMKZ)) Q:XMKZ="" D Q:$Y>XMPMAX
. S XMREC=^TMP("XM",$J,"MSG",XMKZ)
. D LISTMSG^XMJML($P(XMREC,U,1),$P(XMREC,U,2),XMKZ,$P(XMREC,U,3),XMDETAIL,.XMLEN)
Q:$Y>XMPMAX!'XMMORE
I XMKALL D
. S XMK=XMK-.01
. F S XMK=$O(^XMB(3.7,XMDUZ,XMTYPE,XMK)) Q:XMK="" D Q:$Y>XMPMAX
. . S XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U)
. . D LISTBSKT(XMDUZ,XMTYPE,XMDETAIL,XMK,XMKN,.XMZ,.XMCNT,.XMLEN,XMPMAX)
. S XMMORE=$S('XMK:0,$O(^XMB(3.7,XMDUZ,XMTYPE,XMK)):1,XMZ="":0,$O(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMV("ORDER")):1,1:0)
E D
. D LISTBSKT(XMDUZ,XMTYPE,XMDETAIL,XMK,XMKN,.XMZ,.XMCNT,.XMLEN,XMPMAX)
. S XMMORE=$S(XMZ="":0,$O(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMV("ORDER")):1,1:0)
S XMKZ=XMCNT
Q
HEADLINE(XMDUZ,XMKALL,XMK,XMKN,XMTYPE) ;
N XMDIALOG,XMPARM
I XMTYPE="N0" D
. I XMKALL S XMDIALOG=34022,XMPARM(1)=$P(^XMB(3.7,XMDUZ,0),U,6) Q
. S XMDIALOG=34024,XMPARM(1)=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,2),XMPARM(3)=XMKN
E D
. I XMKALL S XMDIALOG=34023,XMPARM(2)=$$TPMSGCT^XMXUTIL(XMDUZ) Q
. S XMDIALOG=34024,XMPARM(2)=$$BPMSGCT^XMXUTIL(XMDUZ,XMK),XMPARM(3)=XMKN
Q $$EZBLD^DIALOG(XMDIALOG,.XMPARM)
LISTBSKT(XMDUZ,XMTYPE,XMDETAIL,XMK,XMKN,XMZ,XMCNT,XMLEN,XMPMAX) ;
F S XMZ=$O(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMV("ORDER")) Q:XMZ="" D Q:$Y>XMPMAX
. I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITN^XMUT4A(XMDUZ,XMTYPE,XMK,XMZ)
. I '$D(^XMB(3.9,XMZ,0)) D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
. S XMCNT=XMCNT+1
. S ^TMP("XM",$J,"MSG",XMCNT)=XMK_U_XMKN_U_XMZ
. D LISTMSG^XMJML(XMK,XMKN,XMCNT,XMZ,XMDETAIL,.XMLEN)
Q
CHOOSE(XMDUZ,XMKALL,XMK,XMKZ,XMFIRST,XMPAGE,XMMORE,XMLEN,XMZOOM,XMOPT,XMOX,XMREAD,XMABORT) ;
N XMY,XMHI,XMLO
I XMZOOM D
. S XMMORE=$S(XMKZ="":0,1:1)
E I $O(XMFIRST(XMPAGE)),XMKZ,$O(^TMP("XM",$J,"MSG",XMKZ)) D
. S XMMORE=1
. S XMFIRST(XMPAGE+1)=XMKZ
S XMLO=$O(^TMP("XM",$J,"MSG",""))
S XMHI=$O(^TMP("XM",$J,"MSG",""),-1)
D XMDIR^XMJMLR1(XMDUZ,XMLO,XMHI,XMPAGE,XMMORE,"XM-U-BO-FULL SCREEN LIST","",.XMOPT,.XMOX,.XMY,.XMABORT) Q:XMABORT
I '$D(XMY) S XMKZ=XMFIRST(XMPAGE) Q
I XMY=""!($E(XMY)="+") D Q ; Next page
. I XMMORE S XMPAGE=XMPAGE+1 Q
. I XMPAGE=0 S XMABORT=1 Q
. D AGAIN^XMJMLR(.XMABORT) Q:XMABORT
. S XMPAGE=0
. S XMKZ=XMFIRST(XMPAGE)
I $E(XMY)="." D Q ; (De)Select messages
. D DODOT
. I XMZOOM,'$D(^TMP("XM",$J,".")) D Z
. S XMKZ=XMFIRST(XMPAGE)
I XMY>0 D Q
. N XMREC
. S XMREC=$G(^TMP("XM",$J,"MSG",XMY))
. I XMREC="" D
. . W $C(7)
. E D
. . N XMKZ
. . S XMKZ=XMY
. . D @XMREAD
. . I XMZOOM,'$D(^TMP("XM",$J,".")) D Z
. S XMKZ=XMFIRST(XMPAGE)
I XMY=0 D Q ; First page
. S XMPAGE=0
. S XMKZ=XMFIRST(XMPAGE)
I $E(XMY)="-" D Q ; Previous page
. S:XMPAGE>0 XMPAGE=XMPAGE-1
. S XMKZ=XMFIRST(XMPAGE)
D @XMY
S XMKZ=XMFIRST(XMPAGE)
Q
READMSG ; (XMDUZ,XMKZ,XMREC,XMTYPE) <- needed!
N XMK,XMKN,XMZ
S XMK=$P(XMREC,U,1),XMKN=$P(XMREC,U,2),XMZ=$P(XMREC,U,3)
I XMDUZ'=DUZ,'$$SURRACC^XMXSEC(XMDUZ,"",XMZ,$G(^XMB(3.9,XMZ,0))) D Q ; "read"
. D SHOW^XMJERR
. D WAIT^XMXUTIL
D READNEW^XMJBN(XMDUZ,XMK,XMKN,XMZ)
Q:$D(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ))
K ^TMP("XM",$J,"MSG",XMKZ)
K:$D(^TMP("XM",$J,".",XMKZ)) ^TMP("XM",$J,".",XMKZ)
Q
DODOT ;
N I,XMSTRIKE,XM1,XMN,XMKZ
I $E(XMY,2)="-" S XMSTRIKE=1,XMY=$E(XMY,3,999)
E S XMSTRIKE=0,XMY=$E(XMY,2,999)
I XMY="*" D Q
. I XMSTRIKE K ^TMP("XM",$J,".") Q
. S XMKZ=""
. F S XMKZ=$O(^TMP("XM",$J,"MSG",XMKZ)) Q:'XMKZ S ^TMP("XM",$J,".",XMKZ)=""
F I=1:1:$L(XMY,",") D
. S XMKZ=$P(XMY,",",I)
. I XMKZ["-" D Q
. . S XM1=$P(XMKZ,"-")
. . S XMN=$P(XMKZ,"-",2) S:XMN="" XMN=XMHI
. . S XMKZ=XM1-.1
. . I 'XMSTRIKE D Q
. . . F S XMKZ=$O(^TMP("XM",$J,"MSG",XMKZ)) Q:XMKZ>XMN!'XMKZ D
. . . . S:'$D(^TMP("XM",$J,".",XMKZ)) ^TMP("XM",$J,".",XMKZ)=""
. . F S XMKZ=$O(^TMP("XM",$J,".",XMKZ)) Q:XMKZ>XMN!'XMKZ K ^TMP("XM",$J,".",XMKZ)
. I 'XMSTRIKE D Q
. . I $D(^TMP("XM",$J,"MSG",XMKZ)),'$D(^TMP("XM",$J,".",XMKZ)) S ^TMP("XM",$J,".",XMKZ)=""
. I $D(^TMP("XM",$J,".",XMKZ)) K ^TMP("XM",$J,".",XMKZ)
Q
CD ; Change Detail
S XMCD=1
Q
D ; Delete messages
D DELETE^XMJMORX(XMDUZ,XMKALL,XMK)
D WAIT^XMXUTIL
I XMZOOM,'$D(^TMP("XM",$J,".")) D Z
Q
F ; Forward messages
D FORWARD^XMJMORX(XMDUZ,XMKALL,XMK)
D WAIT^XMXUTIL
Q
FI ; Filter messages
D FILTER^XMJMORX(XMDUZ,XMKALL,XMK)
D WAIT^XMXUTIL
Q
H ; Headerless Print messages
D PRINT^XMJMORX(XMDUZ,0)
D WAIT^XMXUTIL
Q
L ; Later messages
D LATER^XMJMORX(XMDUZ,XMKALL,XMK)
D WAIT^XMXUTIL
Q
NT ; New Toggle messages
D NEWTOGL^XMJMORX(XMDUZ,XMKALL,XMK)
D WAIT^XMXUTIL
Q
O ; Opposite toggle
N XMKZ
S XMKZ=0
F S XMKZ=$O(^TMP("XM",$J,"MSG",XMKZ)) Q:'XMKZ D
. I $D(^TMP("XM",$J,".",XMKZ)) K ^TMP("XM",$J,".",XMKZ) Q
. S ^TMP("XM",$J,".",XMKZ)=""
S XMPAGE=0
Q
P ; Print messages
D PRINT^XMJMORX(XMDUZ,1)
D WAIT^XMXUTIL
Q
S ; Save messages
D SAVE^XMJMORX(XMDUZ,XMKALL,XMK)
D WAIT^XMXUTIL
I XMZOOM,'$D(^TMP("XM",$J,".")) D Z
Q
T ; Terminate messages
D TERM^XMJMORX(XMDUZ,XMKALL,XMK)
D WAIT^XMXUTIL
I XMZOOM,'$D(^TMP("XM",$J,".")) D Z
Q
V ; Vaporize messages
D VAPOR^XMJMORX(XMDUZ,XMKALL,XMK)
D WAIT^XMXUTIL
Q
X ; Xmit Priority Toggle messages (for Postmaster only)
D XMTPRI^XMJMOR(XMDUZ,XMK)
D WAIT^XMXUTIL
Q
Z ; Zoom toggle
N I
I XMZOOM D
. S XMZOOM=0
. S I=""
. F S I=$O(XMFIRST(0,I)) Q:I="" S XMFIRST(I)=XMFIRST(0,I)
. S XMPAGE=XMPAGE(0)
E D
. S XMZOOM=1
. S I=""
. F S I=$O(XMFIRST(I)) Q:I="" S XMFIRST(0,I)=XMFIRST(I)
. S XMPAGE(0)=XMPAGE
. S XMPAGE=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJMLN 8760 printed Apr 09, 2024@21:12:39 Page 2
XMJMLN ;ISC-SF/GB-List/Read new messages ;12/12/2001 08:53
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Replaces LIST,PRIO^XMA0A (ISC-WASH/CAP)
LISTONE(XMDUZ,XMK,XMKN,XMTYPE) ; List new/priority messages in one basket
+1 ; XMTYPE N0=New; N=Priority
+2 NEW XMKZ,XMZ,XMCNT,XMABORT,XMLEN,XMFIRST,XMPAGE,XMDETAIL,XMPMAX,XMKALL,XMIA,XMZOOM,XMMORE,XMCD,XMOPT,XMOX
+3 ; Interactive
SET XMIA=1
+4 IF '$DATA(^XMB(3.7,XMDUZ,XMTYPE,XMK))
Begin DoDot:1
+5 ; You have no new (priority) messages in this basket.
WRITE !!,$$EZBLD^DIALOG($SELECT(XMTYPE="N":34016,1:34015))
End DoDot:1
QUIT
+6 KILL ^TMP("XM",$JOB,"MSG"),^TMP("XM",$JOB,".")
+7 SET (XMKZ,XMZ)=""
SET (XMPAGE,XMCNT,XMKALL,XMZOOM,XMCD,XMABORT)=0
SET (XMDETAIL,XMMORE)=1
+8 SET XMPMAX=IOSL-3
+9 DO SETOPT^XMJMLR1(XMDUZ,0,.XMOPT,.XMOX)
+10 SET XMLEN("XMKZ")=$LENGTH($PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,2))
+11 DO INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
+12 FOR
Begin DoDot:1
+13 IF XMCD
SET XMCD=0
SET XMDETAIL='XMDETAIL
DO INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
+14 DO DISPLAY(XMDUZ,XMKALL,XMTYPE,XMDETAIL,XMK,XMKN,.XMKZ,.XMZ,.XMCNT,.XMFIRST,.XMPAGE,.XMMORE,.XMLEN,XMZOOM,XMPMAX)
+15 DO CHOOSE(XMDUZ,XMKALL,XMK,.XMKZ,.XMFIRST,.XMPAGE,XMMORE,.XMLEN,.XMZOOM,.XMOPT,.XMOX,"READMSG",.XMABORT)
+16 if '$DATA(^XMB(3.7,XMDUZ,XMTYPE,XMK))
SET XMABORT=1
End DoDot:1
if XMABORT
QUIT
+17 KILL ^TMP("XM",$JOB,"MSG"),^TMP("XM",$JOB,".")
+18 QUIT
LISTALL(XMDUZ,XMTYPE) ; List new/priority messages in all baskets
+1 ; XMTYPE N0=New; N=Priority
+2 NEW XMK,XMKZ,XMZ,XMCNT,XMABORT,XMLEN,XMFIRST,XMPAGE,XMDETAIL,XMPMAX,XMKALL,XMIA,XMZOOM,XMMORE,XMCD,XMOPT,XMOX
+3 ; Interactive
SET XMIA=1
+4 IF '$DATA(^XMB(3.7,XMDUZ,XMTYPE))
Begin DoDot:1
+5 ; You have no new (priority) messages.
WRITE !!,$$EZBLD^DIALOG($SELECT(XMTYPE="N":34018,1:34017))
End DoDot:1
QUIT
+6 KILL ^TMP("XM",$JOB,"MSG"),^TMP("XM",$JOB,".")
+7 SET (XMKZ,XMZ)=""
SET (XMPAGE,XMCNT,XMZOOM,XMCD,XMABORT)=0
SET (XMK,XMDETAIL,XMMORE,XMKALL)=1
+8 SET XMPMAX=IOSL-3
+9 DO SETOPT^XMJMLR1(XMDUZ,0,.XMOPT,.XMOX)
+10 DO INIT(XMDUZ,XMTYPE,XMDETAIL,0,.XMLEN)
+11 FOR
Begin DoDot:1
+12 IF XMCD
SET XMCD=0
SET XMDETAIL='XMDETAIL
DO INIT(XMDUZ,XMTYPE,XMDETAIL,0,.XMLEN)
+13 DO DISPLAY(XMDUZ,XMKALL,XMTYPE,XMDETAIL,.XMK,"",.XMKZ,.XMZ,.XMCNT,.XMFIRST,.XMPAGE,.XMMORE,.XMLEN,XMZOOM,XMPMAX)
+14 DO CHOOSE(XMDUZ,XMKALL,0,.XMKZ,.XMFIRST,.XMPAGE,XMMORE,.XMLEN,.XMZOOM,.XMOPT,.XMOX,"READMSG",.XMABORT)
+15 if '$DATA(^XMB(3.7,XMDUZ,XMTYPE))
SET XMABORT=1
End DoDot:1
if XMABORT
QUIT
+16 KILL ^TMP("XM",$JOB,"MSG"),^TMP("XM",$JOB,".")
+17 QUIT
INIT(XMDUZ,XMTYPE,XMDETAIL,XMACTUAL,XMLEN) ;
+1 ; XMACTUAL 1/0=do/do not use actual XMKZ
+2 NEW XMK,XMKN,XMKNMAX,XMKZL
+3 SET XMLEN("XMKZ")=$SELECT(XMACTUAL:0,1:$LENGTH($PIECE(^XMB(3.7,XMDUZ,0),U,6)))
+4 SET XMK=0
SET XMKNMAX=""
+5 FOR
SET XMK=$ORDER(^XMB(3.7,XMDUZ,XMTYPE,XMK))
if XMK=""
QUIT
Begin DoDot:1
+6 SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
+7 if $LENGTH(XMKN)>$LENGTH(XMKNMAX)
SET XMKNMAX=XMKN
+8 if 'XMACTUAL
QUIT
+9 SET XMKZL=$LENGTH($ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1))
+10 if XMKZL>XMLEN("XMKZ")
SET XMLEN("XMKZ")=XMKZL
End DoDot:1
+11 DO INIT^XMJML(XMDUZ,"",XMKNMAX,XMDETAIL,.XMLEN)
+12 QUIT
DISPLAY(XMDUZ,XMKALL,XMTYPE,XMDETAIL,XMK,XMKN,XMKZ,XMZ,XMCNT,XMFIRST,XMPAGE,XMMORE,XMLEN,XMZOOM,XMPMAX) ;
+1 NEW XMREC,XMHDLINE
+2 SET XMFIRST(XMPAGE)=XMKZ
+3 SET XMHDLINE=$$HEADLINE(XMDUZ,XMKALL,XMK,XMKN,XMTYPE)
+4 DO HEADER^XMJML(XMDETAIL,.XMLEN,XMHDLINE)
+5 IF XMZOOM
Begin DoDot:1
+6 FOR
SET XMKZ=$ORDER(^TMP("XM",$JOB,".",XMKZ))
if XMKZ=""
QUIT
Begin DoDot:2
+7 SET XMREC=^TMP("XM",$JOB,"MSG",XMKZ)
+8 DO LISTMSG^XMJML($PIECE(XMREC,U,1),$PIECE(XMREC,U,2),XMKZ,$PIECE(XMREC,U,3),XMDETAIL,.XMLEN)
End DoDot:2
if $Y>XMPMAX
QUIT
End DoDot:1
QUIT
+9 FOR
SET XMKZ=$ORDER(^TMP("XM",$JOB,"MSG",XMKZ))
if XMKZ=""
QUIT
Begin DoDot:1
+10 SET XMREC=^TMP("XM",$JOB,"MSG",XMKZ)
+11 DO LISTMSG^XMJML($PIECE(XMREC,U,1),$PIECE(XMREC,U,2),XMKZ,$PIECE(XMREC,U,3),XMDETAIL,.XMLEN)
End DoDot:1
if $Y>XMPMAX
QUIT
+12 if $Y>XMPMAX!'XMMORE
QUIT
+13 IF XMKALL
Begin DoDot:1
+14 SET XMK=XMK-.01
+15 FOR
SET XMK=$ORDER(^XMB(3.7,XMDUZ,XMTYPE,XMK))
if XMK=""
QUIT
Begin DoDot:2
+16 SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U)
+17 DO LISTBSKT(XMDUZ,XMTYPE,XMDETAIL,XMK,XMKN,.XMZ,.XMCNT,.XMLEN,XMPMAX)
End DoDot:2
if $Y>XMPMAX
QUIT
+18 SET XMMORE=$SELECT('XMK:0,$ORDER(^XMB(3.7,XMDUZ,XMTYPE,XMK)):1,XMZ="":0,$ORDER(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMV("ORDER")):1,1:0)
End DoDot:1
+19 IF '$TEST
Begin DoDot:1
+20 DO LISTBSKT(XMDUZ,XMTYPE,XMDETAIL,XMK,XMKN,.XMZ,.XMCNT,.XMLEN,XMPMAX)
+21 SET XMMORE=$SELECT(XMZ="":0,$ORDER(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMV("ORDER")):1,1:0)
End DoDot:1
+22 SET XMKZ=XMCNT
+23 QUIT
HEADLINE(XMDUZ,XMKALL,XMK,XMKN,XMTYPE) ;
+1 NEW XMDIALOG,XMPARM
+2 IF XMTYPE="N0"
Begin DoDot:1
+3 IF XMKALL
SET XMDIALOG=34022
SET XMPARM(1)=$PIECE(^XMB(3.7,XMDUZ,0),U,6)
QUIT
+4 SET XMDIALOG=34024
SET XMPARM(1)=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,2)
SET XMPARM(3)=XMKN
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 IF XMKALL
SET XMDIALOG=34023
SET XMPARM(2)=$$TPMSGCT^XMXUTIL(XMDUZ)
QUIT
+7 SET XMDIALOG=34024
SET XMPARM(2)=$$BPMSGCT^XMXUTIL(XMDUZ,XMK)
SET XMPARM(3)=XMKN
End DoDot:1
+8 QUIT $$EZBLD^DIALOG(XMDIALOG,.XMPARM)
LISTBSKT(XMDUZ,XMTYPE,XMDETAIL,XMK,XMKN,XMZ,XMCNT,XMLEN,XMPMAX) ;
+1 FOR
SET XMZ=$ORDER(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMV("ORDER"))
if XMZ=""
QUIT
Begin DoDot:1
+2 IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
DO ADDITN^XMUT4A(XMDUZ,XMTYPE,XMK,XMZ)
+3 IF '$DATA(^XMB(3.9,XMZ,0))
DO ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
QUIT
+4 SET XMCNT=XMCNT+1
+5 SET ^TMP("XM",$JOB,"MSG",XMCNT)=XMK_U_XMKN_U_XMZ
+6 DO LISTMSG^XMJML(XMK,XMKN,XMCNT,XMZ,XMDETAIL,.XMLEN)
End DoDot:1
if $Y>XMPMAX
QUIT
+7 QUIT
CHOOSE(XMDUZ,XMKALL,XMK,XMKZ,XMFIRST,XMPAGE,XMMORE,XMLEN,XMZOOM,XMOPT,XMOX,XMREAD,XMABORT) ;
+1 NEW XMY,XMHI,XMLO
+2 IF XMZOOM
Begin DoDot:1
+3 SET XMMORE=$SELECT(XMKZ="":0,1:1)
End DoDot:1
+4 IF '$TEST
IF $ORDER(XMFIRST(XMPAGE))
IF XMKZ
IF $ORDER(^TMP("XM",$JOB,"MSG",XMKZ))
Begin DoDot:1
+5 SET XMMORE=1
+6 SET XMFIRST(XMPAGE+1)=XMKZ
End DoDot:1
+7 SET XMLO=$ORDER(^TMP("XM",$JOB,"MSG",""))
+8 SET XMHI=$ORDER(^TMP("XM",$JOB,"MSG",""),-1)
+9 DO XMDIR^XMJMLR1(XMDUZ,XMLO,XMHI,XMPAGE,XMMORE,"XM-U-BO-FULL SCREEN LIST","",.XMOPT,.XMOX,.XMY,.XMABORT)
if XMABORT
QUIT
+10 IF '$DATA(XMY)
SET XMKZ=XMFIRST(XMPAGE)
QUIT
+11 ; Next page
IF XMY=""!($EXTRACT(XMY)="+")
Begin DoDot:1
+12 IF XMMORE
SET XMPAGE=XMPAGE+1
QUIT
+13 IF XMPAGE=0
SET XMABORT=1
QUIT
+14 DO AGAIN^XMJMLR(.XMABORT)
if XMABORT
QUIT
+15 SET XMPAGE=0
+16 SET XMKZ=XMFIRST(XMPAGE)
End DoDot:1
QUIT
+17 ; (De)Select messages
IF $EXTRACT(XMY)="."
Begin DoDot:1
+18 DO DODOT
+19 IF XMZOOM
IF '$DATA(^TMP("XM",$JOB,"."))
DO Z
+20 SET XMKZ=XMFIRST(XMPAGE)
End DoDot:1
QUIT
+21 IF XMY>0
Begin DoDot:1
+22 NEW XMREC
+23 SET XMREC=$GET(^TMP("XM",$JOB,"MSG",XMY))
+24 IF XMREC=""
Begin DoDot:2
+25 WRITE $CHAR(7)
End DoDot:2
+26 IF '$TEST
Begin DoDot:2
+27 NEW XMKZ
+28 SET XMKZ=XMY
+29 DO @XMREAD
+30 IF XMZOOM
IF '$DATA(^TMP("XM",$JOB,"."))
DO Z
End DoDot:2
+31 SET XMKZ=XMFIRST(XMPAGE)
End DoDot:1
QUIT
+32 ; First page
IF XMY=0
Begin DoDot:1
+33 SET XMPAGE=0
+34 SET XMKZ=XMFIRST(XMPAGE)
End DoDot:1
QUIT
+35 ; Previous page
IF $EXTRACT(XMY)="-"
Begin DoDot:1
+36 if XMPAGE>0
SET XMPAGE=XMPAGE-1
+37 SET XMKZ=XMFIRST(XMPAGE)
End DoDot:1
QUIT
+38 DO @XMY
+39 SET XMKZ=XMFIRST(XMPAGE)
+40 QUIT
READMSG ; (XMDUZ,XMKZ,XMREC,XMTYPE) <- needed!
+1 NEW XMK,XMKN,XMZ
+2 SET XMK=$PIECE(XMREC,U,1)
SET XMKN=$PIECE(XMREC,U,2)
SET XMZ=$PIECE(XMREC,U,3)
+3 ; "read"
IF XMDUZ'=DUZ
IF '$$SURRACC^XMXSEC(XMDUZ,"",XMZ,$GET(^XMB(3.9,XMZ,0)))
Begin DoDot:1
+4 DO SHOW^XMJERR
+5 DO WAIT^XMXUTIL
End DoDot:1
QUIT
+6 DO READNEW^XMJBN(XMDUZ,XMK,XMKN,XMZ)
+7 if $DATA(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ))
QUIT
+8 KILL ^TMP("XM",$JOB,"MSG",XMKZ)
+9 if $DATA(^TMP("XM",$JOB,".",XMKZ))
KILL ^TMP("XM",$JOB,".",XMKZ)
+10 QUIT
DODOT ;
+1 NEW I,XMSTRIKE,XM1,XMN,XMKZ
+2 IF $EXTRACT(XMY,2)="-"
SET XMSTRIKE=1
SET XMY=$EXTRACT(XMY,3,999)
+3 IF '$TEST
SET XMSTRIKE=0
SET XMY=$EXTRACT(XMY,2,999)
+4 IF XMY="*"
Begin DoDot:1
+5 IF XMSTRIKE
KILL ^TMP("XM",$JOB,".")
QUIT
+6 SET XMKZ=""
+7 FOR
SET XMKZ=$ORDER(^TMP("XM",$JOB,"MSG",XMKZ))
if 'XMKZ
QUIT
SET ^TMP("XM",$JOB,".",XMKZ)=""
End DoDot:1
QUIT
+8 FOR I=1:1:$LENGTH(XMY,",")
Begin DoDot:1
+9 SET XMKZ=$PIECE(XMY,",",I)
+10 IF XMKZ["-"
Begin DoDot:2
+11 SET XM1=$PIECE(XMKZ,"-")
+12 SET XMN=$PIECE(XMKZ,"-",2)
if XMN=""
SET XMN=XMHI
+13 SET XMKZ=XM1-.1
+14 IF 'XMSTRIKE
Begin DoDot:3
+15 FOR
SET XMKZ=$ORDER(^TMP("XM",$JOB,"MSG",XMKZ))
if XMKZ>XMN!'XMKZ
QUIT
Begin DoDot:4
+16 if '$DATA(^TMP("XM",$JOB,".",XMKZ))
SET ^TMP("XM",$JOB,".",XMKZ)=""
End DoDot:4
End DoDot:3
QUIT
+17 FOR
SET XMKZ=$ORDER(^TMP("XM",$JOB,".",XMKZ))
if XMKZ>XMN!'XMKZ
QUIT
KILL ^TMP("XM",$JOB,".",XMKZ)
End DoDot:2
QUIT
+18 IF 'XMSTRIKE
Begin DoDot:2
+19 IF $DATA(^TMP("XM",$JOB,"MSG",XMKZ))
IF '$DATA(^TMP("XM",$JOB,".",XMKZ))
SET ^TMP("XM",$JOB,".",XMKZ)=""
End DoDot:2
QUIT
+20 IF $DATA(^TMP("XM",$JOB,".",XMKZ))
KILL ^TMP("XM",$JOB,".",XMKZ)
End DoDot:1
+21 QUIT
CD ; Change Detail
+1 SET XMCD=1
+2 QUIT
D ; Delete messages
+1 DO DELETE^XMJMORX(XMDUZ,XMKALL,XMK)
+2 DO WAIT^XMXUTIL
+3 IF XMZOOM
IF '$DATA(^TMP("XM",$JOB,"."))
DO Z
+4 QUIT
F ; Forward messages
+1 DO FORWARD^XMJMORX(XMDUZ,XMKALL,XMK)
+2 DO WAIT^XMXUTIL
+3 QUIT
FI ; Filter messages
+1 DO FILTER^XMJMORX(XMDUZ,XMKALL,XMK)
+2 DO WAIT^XMXUTIL
+3 QUIT
H ; Headerless Print messages
+1 DO PRINT^XMJMORX(XMDUZ,0)
+2 DO WAIT^XMXUTIL
+3 QUIT
L ; Later messages
+1 DO LATER^XMJMORX(XMDUZ,XMKALL,XMK)
+2 DO WAIT^XMXUTIL
+3 QUIT
NT ; New Toggle messages
+1 DO NEWTOGL^XMJMORX(XMDUZ,XMKALL,XMK)
+2 DO WAIT^XMXUTIL
+3 QUIT
O ; Opposite toggle
+1 NEW XMKZ
+2 SET XMKZ=0
+3 FOR
SET XMKZ=$ORDER(^TMP("XM",$JOB,"MSG",XMKZ))
if 'XMKZ
QUIT
Begin DoDot:1
+4 IF $DATA(^TMP("XM",$JOB,".",XMKZ))
KILL ^TMP("XM",$JOB,".",XMKZ)
QUIT
+5 SET ^TMP("XM",$JOB,".",XMKZ)=""
End DoDot:1
+6 SET XMPAGE=0
+7 QUIT
P ; Print messages
+1 DO PRINT^XMJMORX(XMDUZ,1)
+2 DO WAIT^XMXUTIL
+3 QUIT
S ; Save messages
+1 DO SAVE^XMJMORX(XMDUZ,XMKALL,XMK)
+2 DO WAIT^XMXUTIL
+3 IF XMZOOM
IF '$DATA(^TMP("XM",$JOB,"."))
DO Z
+4 QUIT
T ; Terminate messages
+1 DO TERM^XMJMORX(XMDUZ,XMKALL,XMK)
+2 DO WAIT^XMXUTIL
+3 IF XMZOOM
IF '$DATA(^TMP("XM",$JOB,"."))
DO Z
+4 QUIT
V ; Vaporize messages
+1 DO VAPOR^XMJMORX(XMDUZ,XMKALL,XMK)
+2 DO WAIT^XMXUTIL
+3 QUIT
X ; Xmit Priority Toggle messages (for Postmaster only)
+1 DO XMTPRI^XMJMOR(XMDUZ,XMK)
+2 DO WAIT^XMXUTIL
+3 QUIT
Z ; Zoom toggle
+1 NEW I
+2 IF XMZOOM
Begin DoDot:1
+3 SET XMZOOM=0
+4 SET I=""
+5 FOR
SET I=$ORDER(XMFIRST(0,I))
if I=""
QUIT
SET XMFIRST(I)=XMFIRST(0,I)
+6 SET XMPAGE=XMPAGE(0)
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 SET XMZOOM=1
+9 SET I=""
+10 FOR
SET I=$ORDER(XMFIRST(I))
if I=""
QUIT
SET XMFIRST(0,I)=XMFIRST(I)
+11 SET XMPAGE(0)=XMPAGE
+12 SET XMPAGE=0
End DoDot:1
+13 QUIT
