XMJMLR ;ISC-SF/GMB-List/Read messages in basket ;05/21/2002 06:46
;;8.0;MailMan;;Jun 28, 2002
; Replaces 1^XMAL0 (ISC-WASH/THM/CAP)
LIST(XMDUZ,XMK,XMKN,XMDETAIL,XMABORT) ; List messages in basket
; XMDETAIL 0=Summary; 1=Detailed
N XMKZ,XMLEN,XMFIRST,XMPAGE,XMPMAX,XMZOOM,XMINSTR,XMOPT,XMOX,XMORDER
I XMDUZ=.5,XMK>999 S XMORDER=XMV("ORDER"),XMV("ORDER")=1
S XMINSTR("GOTO")=1 ; may go to another page
D SETOPT^XMJMLR1(XMDUZ,XMK,.XMOPT,.XMOX)
K ^TMP("XM",$J,".")
S XMKZ="",(XMPAGE,XMZOOM)=0,XMPMAX=IOSL-3
D INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
F D Q:XMABORT!'$D(^XMB(3.7,XMDUZ,2,XMK,1,"C"))
. D DISPLAY(XMDUZ,XMDETAIL,XMK,XMKN,.XMKZ,.XMFIRST,.XMPAGE,.XMLEN,XMZOOM,XMPMAX)
. D CHOOSE(XMDUZ,.XMK,.XMKZ,.XMFIRST,.XMPAGE,.XMLEN,.XMZOOM,.XMINSTR,.XMOPT,.XMOX,.XMABORT)
K ^TMP("XM",$J,".")
I $D(XMORDER) S XMV("ORDER")=XMORDER
Q
DISPLAY(XMDUZ,XMDETAIL,XMK,XMKN,XMKZ,XMFIRST,XMPAGE,XMLEN,XMZOOM,XMPMAX) ;
N XMZ
S XMFIRST(XMPAGE)=XMKZ
D HEADER^XMJML(XMDETAIL,.XMLEN,$$HEADLINE^XMJML(XMDUZ,XMK,XMKN))
I XMZOOM D Q
. F S XMKZ=$O(^TMP("XM",$J,".",XMKZ),XMV("ORDER")) Q:XMKZ="" D Q:$Y>XMPMAX
. . D LISTMSG^XMJML(XMK,XMKN,XMKZ,$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,"")),XMDETAIL,.XMLEN)
F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMV("ORDER")) Q:XMKZ="" D Q:$Y>XMPMAX
. S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
. I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZ)
. I '$D(^XMB(3.9,XMZ,0)) D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
. D LISTMSG^XMJML(XMK,XMKN,XMKZ,XMZ,XMDETAIL,.XMLEN)
Q
CHOOSE(XMDUZ,XMK,XMKZ,XMFIRST,XMPAGE,XMLEN,XMZOOM,XMINSTR,XMOPT,XMOX,XMABORT) ;
N XMY,XMZ,XMMORE,XMHI,XMLO
S XMMORE=$S(XMKZ="":0,'$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMV("ORDER")):0,1:1)
S XMLO=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""))
S XMHI=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1)
D XMDIR^XMJMLR1(XMDUZ,XMLO,XMHI,XMPAGE,XMMORE,"XM-U-BO-FULL SCREEN",.XMINSTR,.XMOPT,.XMOX,.XMY,.XMABORT) Q:XMABORT
I '$D(XMY) S XMKZ=XMFIRST(XMPAGE) Q
I XMY=""!($E(XMY)="+") D Q ; Page forward
. I XMMORE D PFWD Q
. I XMPAGE=0 S XMABORT=1 Q
. D AGAIN(.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 XMKZLAST
. S XMKZLAST=XMKZ
. S XMKZ=XMY
. S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
. I XMZ D
. . I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZ)
. . D READMSG(XMDUZ,XMK,XMKN,XMKZ,XMZ,XMZOOM)
. . D FINDXMKZ(XMDUZ,XMK,.XMFIRST,.XMPAGE,XMKZLAST,XMKZ)
. E D
. . S XMZ=XMY
. . I $D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D Q
. . . S XMKZ=$P(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0),U,2)
. . . I 'XMKZ D ADDITM^XMUT4A(XMDUZ,XMK,XMZ,.XMKZ)
. . . D READMSG(XMDUZ,XMK,XMKN,XMKZ,XMZ,XMZOOM)
. . . D FINDXMKZ(XMDUZ,XMK,.XMFIRST,.XMPAGE,XMKZLAST,XMKZ)
. . I '$D(^XMB(3.9,XMZ,0)) D Q
. . . W $C(7)
. . . Q:XMZ>$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1)
. . . S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMZ),XMV("ORDER"))
. . . I 'XMKZ S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMZ),-XMV("ORDER"))
. . . D FINDXMKZ(XMDUZ,XMK,.XMFIRST,.XMPAGE,XMKZLAST,XMKZ)
. . N XMK,XMKN,XMOK
. . S XMK=+$O(^XMB(3.7,"M",XMZ,XMDUZ,0))
. . I 'XMK D Q:'XMOK
. . . N XMZREC
. . . S XMZREC=^XMB(3.9,XMZ,0)
. . . I $D(XMERR) K XMERR,^TMP("XMERR",$J)
. . . S XMOK=$$ACCESS^XMXSEC(XMDUZ,XMZ,XMZREC) Q:XMOK
. . . D FWD^XMJMLR1(XMDUZ,XMZ,XMZREC,1,.XMOK)
. . S XMKN=$S(XMK:$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1),1:$$EZBLD^DIALOG(34014)) ; * N/A *
. . I XMK,'$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITM^XMUT4A(XMDUZ,XMK,XMZ)
. . D READMSG^XMJBM(XMDUZ,XMK,XMKN,XMZ)
. S XMKZ=XMFIRST(XMPAGE)
I XMY=0 D Q ; First page
. S XMPAGE=0
. S XMKZ=XMFIRST(XMPAGE)
I $E(XMY)="-" D Q ; Page back
. N XMCNT
. S XMCNT=$E(XMY,2,99)
. S:XMCNT="" XMCNT=1
. S XMPAGE=XMPAGE-XMCNT
. S:XMPAGE<0 XMPAGE=0
. S XMKZ=XMFIRST(XMPAGE)
D @XMY
S XMKZ=XMFIRST(XMPAGE)
Q
PFWD ;
N XMCNT,XMPDEST
S XMCNT=$E(XMY,2,99)
S:XMCNT="" XMCNT=1
I XMCNT=1 S XMPAGE=XMPAGE+1 Q
S XMPDEST=XMPAGE+XMCNT
D FINDPAGE(.XMFIRST,.XMPAGE,XMKZ,XMPDEST)
S XMKZ=XMFIRST(XMPAGE)
Q
FINDPAGE(XMFIRST,XMPAGE,XMKZ,XMPDEST) ;
N XMO,I
S XMO=$S(XMPDEST>XMPAGE:1,1:-1)
F XMPAGE=XMPAGE+XMO:XMO S XMFIRST(XMPAGE)=XMKZ Q:XMPAGE=XMPDEST D Q:XMKZ=""
. F I=1:1:XMPMAX S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMO*XMV("ORDER")) Q:XMKZ=""
I '$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMFIRST(XMPAGE)),XMO*XMV("ORDER")) S XMPAGE=XMPAGE-XMO Q
Q
FINDXMKZ(XMDUZ,XMK,XMFIRST,XMPAGE,XMKZLAST,XMKZF) ; Find the page with XMKZF on it
Q:'$D(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZF))
I XMV("ORDER")=-1 D Q
. I $S(XMFIRST(XMPAGE):XMFIRST(XMPAGE)>XMKZF,1:1),XMKZF'<XMKZLAST Q
. N XMKZ,I
. I XMKZF<XMKZLAST D Q ; Go forward
. . S XMKZ=XMKZLAST
. . F XMPAGE=XMPAGE+1:1 D Q:XMKZ=XMKZF
. . . S XMFIRST(XMPAGE)=XMKZ
. . . F I=1:1:XMPMAX S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),-1) Q:XMKZ=XMKZF
. E D ; Go back
. . F XMPAGE=XMPAGE-1:-1 Q:XMFIRST(XMPAGE)>XMKZF!'XMPAGE
. . ;S XMKZ=XMFIRST(XMPAGE)-1
. . ;F XMPAGE=XMPAGE-1:-1 D Q:XMFIRST(XMPAGE)>XMKZF
. . ;. F I=1:1:XMPMAX S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:XMKZ=""
. . ;. S XMFIRST(XMPAGE)=$S(XMKZ:XMKZ+1,1:XMKZ)
I XMFIRST(XMPAGE)<XMKZF,$S(XMKZLAST:XMKZF'>XMKZLAST,1:1) Q
N XMKZ,I
I XMKZF>XMKZLAST D Q ; Go forward
. S XMKZ=XMKZLAST
. F XMPAGE=XMPAGE+1:1 D Q:XMKZ=XMKZF
. . S XMFIRST(XMPAGE)=XMKZ
. . F I=1:1:XMPMAX S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:XMKZ=XMKZF
E D ; Go back
. F XMPAGE=XMPAGE-1:-1 Q:XMFIRST(XMPAGE)<XMKZF!'XMPAGE
. ;S XMKZ=XMFIRST(XMPAGE)-1
. ;F XMPAGE=XMPAGE-1:-1 D Q:XMFIRST(XMPAGE)<XMKZF
. ;. F I=1:1:XMPMAX S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),-1) Q:XMKZ=""
. ;. S XMFIRST(XMPAGE)=$S(XMKZ:XMKZ+1,1:XMKZ)
Q
READMSG(XMDUZ,XMK,XMKN,XMKZ,XMZ,XMZOOM) ;
D READMSG^XMJBM(XMDUZ,XMK,XMKN,XMZ)
I $D(^TMP("XM",$J,".",XMKZ)),'$D(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,XMZ)) K ^TMP("XM",$J,".",XMKZ)
I XMZOOM,'$D(^TMP("XM",$J,".")) D Z
Q
AGAIN(XMABORT) ;
N DIR,Y
W !
S DIR("A")=$$EZBLD^DIALOG(34020) ; End reached. Begin again
S DIR(0)="Y",DIR("B")=$$EZBLD^DIALOG(39053) ; No
D BLD^DIALOG(34021,"","","DIR(""?"")") ; Enter 'Yes' if you wish to continue reading messages; 'No' if you don't.
D ^DIR
Q:Y=1 ; Yes, begin again
S XMABORT=1 ; No, exit.
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(^XMB(3.7,XMDUZ,2,XMK,1,"C",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(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:XMKZ>XMN!'XMKZ S:'$D(^TMP("XM",$J,".",XMKZ)) ^(XMKZ)=""
. . F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:XMKZ>XMN!'XMKZ K:$D(^TMP("XM",$J,".",XMKZ)) ^(XMKZ)
. I 'XMSTRIKE D Q
. . I $D(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)),'$D(^TMP("XM",$J,".",XMKZ)) S ^(XMKZ)=""
. K:$D(^TMP("XM",$J,".",XMKZ)) ^(XMKZ)
Q
C ; Change the name of this basket
D NAMEBSKT^XMJBU(XMDUZ,XMK,.XMKN)
K XMLEN
D INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
Q
CD ; Change Detail
S XMDETAIL='XMDETAIL
D INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
Q
D ; Delete messages
D DELETE^XMJMOR(XMDUZ,XMK)
D WAIT^XMXUTIL
I XMZOOM,'$D(^TMP("XM",$J,".")) D Z
Q
F ; Forward messages
D FORWARD^XMJMOR(XMDUZ,XMK)
D WAIT^XMXUTIL
Q
FI ; Filter messages
D FILTER^XMJMOR(XMDUZ,XMK)
D WAIT^XMXUTIL
Q
H ; Headerless Print messages
D PRINT^XMJMOR(XMDUZ,XMK,0)
D WAIT^XMXUTIL
Q
L ; Later messages
D LATER^XMJMOR(XMDUZ,XMK)
D WAIT^XMXUTIL
I XMZOOM,'$D(^TMP("XM",$J,".")) D Z
Q
N ; New message list
D LISTONE^XMJMLN(XMDUZ,XMK,XMKN,"N0")
D WAIT^XMXUTIL
Q
NT ; New Toggle messages
D NEWTOGL^XMJMOR(XMDUZ,XMK)
D WAIT^XMXUTIL
Q
O ; Opposite toggle
N XMKZ
S XMKZ=0
F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",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^XMJMOR(XMDUZ,XMK)
D WAIT^XMXUTIL
Q
Q ; Query messages
D FINDBSKT^XMJMF(XMDUZ,XMK,XMKN)
Q
Q1 ; ?string - search for messages in this basket whose subject contains string.
N XMF
S XMF("BSKT")=XMK
S XMF("SUBJ")=XMY(0)
D FIND1^XMJMFB(XMDUZ,.XMF,1)
Q
Q2 ; ??string - search for messages whose subject starts with string.
D FIND^XMJMFA(XMDUZ,XMY(0),1)
Q
R ; Resequence messages
D R^XMJBM
S XMPAGE=0
K XMLEN,XMFIRST
S XMFIRST(0)=""
D INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
D WAIT^XMXUTIL
Q
S ; Save messages
D SAVE^XMJMOR(XMDUZ,XMK)
D WAIT^XMXUTIL
Q
T ; Terminate messages
D TERM^XMJMOR(XMDUZ,XMK)
D WAIT^XMXUTIL
I XMZOOM,'$D(^TMP("XM",$J,".")) D Z
Q
V ; Vaporize messages
D VAPOR^XMJMOR(XMDUZ,XMK)
D WAIT^XMXUTIL
Q
X ; Xmit priority toggle messages
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[HXMJMLR 9483 printed Dec 13, 2024@02:12:04 Page 2
XMJMLR ;ISC-SF/GMB-List/Read messages in basket ;05/21/2002 06:46
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Replaces 1^XMAL0 (ISC-WASH/THM/CAP)
LIST(XMDUZ,XMK,XMKN,XMDETAIL,XMABORT) ; List messages in basket
+1 ; XMDETAIL 0=Summary; 1=Detailed
+2 NEW XMKZ,XMLEN,XMFIRST,XMPAGE,XMPMAX,XMZOOM,XMINSTR,XMOPT,XMOX,XMORDER
+3 IF XMDUZ=.5
IF XMK>999
SET XMORDER=XMV("ORDER")
SET XMV("ORDER")=1
+4 ; may go to another page
SET XMINSTR("GOTO")=1
+5 DO SETOPT^XMJMLR1(XMDUZ,XMK,.XMOPT,.XMOX)
+6 KILL ^TMP("XM",$JOB,".")
+7 SET XMKZ=""
SET (XMPAGE,XMZOOM)=0
SET XMPMAX=IOSL-3
+8 DO INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
+9 FOR
Begin DoDot:1
+10 DO DISPLAY(XMDUZ,XMDETAIL,XMK,XMKN,.XMKZ,.XMFIRST,.XMPAGE,.XMLEN,XMZOOM,XMPMAX)
+11 DO CHOOSE(XMDUZ,.XMK,.XMKZ,.XMFIRST,.XMPAGE,.XMLEN,.XMZOOM,.XMINSTR,.XMOPT,.XMOX,.XMABORT)
End DoDot:1
if XMABORT!'$DATA(^XMB(3.7,XMDUZ,2,XMK,1,"C"))
QUIT
+12 KILL ^TMP("XM",$JOB,".")
+13 IF $DATA(XMORDER)
SET XMV("ORDER")=XMORDER
+14 QUIT
DISPLAY(XMDUZ,XMDETAIL,XMK,XMKN,XMKZ,XMFIRST,XMPAGE,XMLEN,XMZOOM,XMPMAX) ;
+1 NEW XMZ
+2 SET XMFIRST(XMPAGE)=XMKZ
+3 DO HEADER^XMJML(XMDETAIL,.XMLEN,$$HEADLINE^XMJML(XMDUZ,XMK,XMKN))
+4 IF XMZOOM
Begin DoDot:1
+5 FOR
SET XMKZ=$ORDER(^TMP("XM",$JOB,".",XMKZ),XMV("ORDER"))
if XMKZ=""
QUIT
Begin DoDot:2
+6 DO LISTMSG^XMJML(XMK,XMKN,XMKZ,$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,"")),XMDETAIL,.XMLEN)
End DoDot:2
if $Y>XMPMAX
QUIT
End DoDot:1
QUIT
+7 FOR
SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMV("ORDER"))
if XMKZ=""
QUIT
Begin DoDot:1
+8 SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
+9 IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
DO ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZ)
+10 IF '$DATA(^XMB(3.9,XMZ,0))
DO ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
QUIT
+11 DO LISTMSG^XMJML(XMK,XMKN,XMKZ,XMZ,XMDETAIL,.XMLEN)
End DoDot:1
if $Y>XMPMAX
QUIT
+12 QUIT
CHOOSE(XMDUZ,XMK,XMKZ,XMFIRST,XMPAGE,XMLEN,XMZOOM,XMINSTR,XMOPT,XMOX,XMABORT) ;
+1 NEW XMY,XMZ,XMMORE,XMHI,XMLO
+2 SET XMMORE=$SELECT(XMKZ="":0,'$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMV("ORDER")):0,1:1)
+3 SET XMLO=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",""))
+4 SET XMHI=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1)
+5 DO XMDIR^XMJMLR1(XMDUZ,XMLO,XMHI,XMPAGE,XMMORE,"XM-U-BO-FULL SCREEN",.XMINSTR,.XMOPT,.XMOX,.XMY,.XMABORT)
if XMABORT
QUIT
+6 IF '$DATA(XMY)
SET XMKZ=XMFIRST(XMPAGE)
QUIT
+7 ; Page forward
IF XMY=""!($EXTRACT(XMY)="+")
Begin DoDot:1
+8 IF XMMORE
DO PFWD
QUIT
+9 IF XMPAGE=0
SET XMABORT=1
QUIT
+10 DO AGAIN(.XMABORT)
if XMABORT
QUIT
+11 SET XMPAGE=0
+12 SET XMKZ=XMFIRST(XMPAGE)
End DoDot:1
QUIT
+13 ; (De)Select messages
IF $EXTRACT(XMY)="."
Begin DoDot:1
+14 DO DODOT
+15 IF XMZOOM
IF '$DATA(^TMP("XM",$JOB,"."))
DO Z
+16 SET XMKZ=XMFIRST(XMPAGE)
End DoDot:1
QUIT
+17 ;
IF XMY>0
Begin DoDot:1
+18 NEW XMKZLAST
+19 SET XMKZLAST=XMKZ
+20 SET XMKZ=XMY
+21 SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
+22 IF XMZ
Begin DoDot:2
+23 IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
DO ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZ)
+24 DO READMSG(XMDUZ,XMK,XMKN,XMKZ,XMZ,XMZOOM)
+25 DO FINDXMKZ(XMDUZ,XMK,.XMFIRST,.XMPAGE,XMKZLAST,XMKZ)
End DoDot:2
+26 IF '$TEST
Begin DoDot:2
+27 SET XMZ=XMY
+28 IF $DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
Begin DoDot:3
+29 SET XMKZ=$PIECE(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0),U,2)
+30 IF 'XMKZ
DO ADDITM^XMUT4A(XMDUZ,XMK,XMZ,.XMKZ)
+31 DO READMSG(XMDUZ,XMK,XMKN,XMKZ,XMZ,XMZOOM)
+32 DO FINDXMKZ(XMDUZ,XMK,.XMFIRST,.XMPAGE,XMKZLAST,XMKZ)
End DoDot:3
QUIT
+33 IF '$DATA(^XMB(3.9,XMZ,0))
Begin DoDot:3
+34 WRITE $CHAR(7)
+35 if XMZ>$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1)
QUIT
+36 SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMZ),XMV("ORDER"))
+37 IF 'XMKZ
SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMZ),-XMV("ORDER"))
+38 DO FINDXMKZ(XMDUZ,XMK,.XMFIRST,.XMPAGE,XMKZLAST,XMKZ)
End DoDot:3
QUIT
+39 NEW XMK,XMKN,XMOK
+40 SET XMK=+$ORDER(^XMB(3.7,"M",XMZ,XMDUZ,0))
+41 IF 'XMK
Begin DoDot:3
+42 NEW XMZREC
+43 SET XMZREC=^XMB(3.9,XMZ,0)
+44 IF $DATA(XMERR)
KILL XMERR,^TMP("XMERR",$JOB)
+45 SET XMOK=$$ACCESS^XMXSEC(XMDUZ,XMZ,XMZREC)
if XMOK
QUIT
+46 DO FWD^XMJMLR1(XMDUZ,XMZ,XMZREC,1,.XMOK)
End DoDot:3
if 'XMOK
QUIT
+47 ; * N/A *
SET XMKN=$SELECT(XMK:$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,1),1:$$EZBLD^DIALOG(34014))
+48 IF XMK
IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
DO ADDITM^XMUT4A(XMDUZ,XMK,XMZ)
+49 DO READMSG^XMJBM(XMDUZ,XMK,XMKN,XMZ)
End DoDot:2
+50 SET XMKZ=XMFIRST(XMPAGE)
End DoDot:1
QUIT
+51 ; First page
IF XMY=0
Begin DoDot:1
+52 SET XMPAGE=0
+53 SET XMKZ=XMFIRST(XMPAGE)
End DoDot:1
QUIT
+54 ; Page back
IF $EXTRACT(XMY)="-"
Begin DoDot:1
+55 NEW XMCNT
+56 SET XMCNT=$EXTRACT(XMY,2,99)
+57 if XMCNT=""
SET XMCNT=1
+58 SET XMPAGE=XMPAGE-XMCNT
+59 if XMPAGE<0
SET XMPAGE=0
+60 SET XMKZ=XMFIRST(XMPAGE)
End DoDot:1
QUIT
+61 DO @XMY
+62 SET XMKZ=XMFIRST(XMPAGE)
+63 QUIT
PFWD ;
+1 NEW XMCNT,XMPDEST
+2 SET XMCNT=$EXTRACT(XMY,2,99)
+3 if XMCNT=""
SET XMCNT=1
+4 IF XMCNT=1
SET XMPAGE=XMPAGE+1
QUIT
+5 SET XMPDEST=XMPAGE+XMCNT
+6 DO FINDPAGE(.XMFIRST,.XMPAGE,XMKZ,XMPDEST)
+7 SET XMKZ=XMFIRST(XMPAGE)
+8 QUIT
FINDPAGE(XMFIRST,XMPAGE,XMKZ,XMPDEST) ;
+1 NEW XMO,I
+2 SET XMO=$SELECT(XMPDEST>XMPAGE:1,1:-1)
+3 FOR XMPAGE=XMPAGE+XMO:XMO
SET XMFIRST(XMPAGE)=XMKZ
if XMPAGE=XMPDEST
QUIT
Begin DoDot:1
+4 FOR I=1:1:XMPMAX
SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMO*XMV("ORDER"))
if XMKZ=""
QUIT
End DoDot:1
if XMKZ=""
QUIT
+5 IF '$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMFIRST(XMPAGE)),XMO*XMV("ORDER"))
SET XMPAGE=XMPAGE-XMO
QUIT
+6 QUIT
FINDXMKZ(XMDUZ,XMK,XMFIRST,XMPAGE,XMKZLAST,XMKZF) ; Find the page with XMKZF on it
+1 if '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZF))
QUIT
+2 IF XMV("ORDER")=-1
Begin DoDot:1
+3 IF $SELECT(XMFIRST(XMPAGE):XMFIRST(XMPAGE)>XMKZF,1:1)
IF XMKZF'<XMKZLAST
QUIT
+4 NEW XMKZ,I
+5 ; Go forward
IF XMKZF<XMKZLAST
Begin DoDot:2
+6 SET XMKZ=XMKZLAST
+7 FOR XMPAGE=XMPAGE+1:1
Begin DoDot:3
+8 SET XMFIRST(XMPAGE)=XMKZ
+9 FOR I=1:1:XMPMAX
SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),-1)
if XMKZ=XMKZF
QUIT
End DoDot:3
if XMKZ=XMKZF
QUIT
End DoDot:2
QUIT
+10 ; Go back
IF '$TEST
Begin DoDot:2
+11 FOR XMPAGE=XMPAGE-1:-1
if XMFIRST(XMPAGE)>XMKZF!'XMPAGE
QUIT
+12 ;S XMKZ=XMFIRST(XMPAGE)-1
+13 ;F XMPAGE=XMPAGE-1:-1 D Q:XMFIRST(XMPAGE)>XMKZF
+14 ;. F I=1:1:XMPMAX S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:XMKZ=""
+15 ;. S XMFIRST(XMPAGE)=$S(XMKZ:XMKZ+1,1:XMKZ)
End DoDot:2
End DoDot:1
QUIT
+16 IF XMFIRST(XMPAGE)<XMKZF
IF $SELECT(XMKZLAST:XMKZF'>XMKZLAST,1:1)
QUIT
+17 NEW XMKZ,I
+18 ; Go forward
IF XMKZF>XMKZLAST
Begin DoDot:1
+19 SET XMKZ=XMKZLAST
+20 FOR XMPAGE=XMPAGE+1:1
Begin DoDot:2
+21 SET XMFIRST(XMPAGE)=XMKZ
+22 FOR I=1:1:XMPMAX
SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ))
if XMKZ=XMKZF
QUIT
End DoDot:2
if XMKZ=XMKZF
QUIT
End DoDot:1
QUIT
+23 ; Go back
IF '$TEST
Begin DoDot:1
+24 FOR XMPAGE=XMPAGE-1:-1
if XMFIRST(XMPAGE)<XMKZF!'XMPAGE
QUIT
+25 ;S XMKZ=XMFIRST(XMPAGE)-1
+26 ;F XMPAGE=XMPAGE-1:-1 D Q:XMFIRST(XMPAGE)<XMKZF
+27 ;. F I=1:1:XMPMAX S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),-1) Q:XMKZ=""
+28 ;. S XMFIRST(XMPAGE)=$S(XMKZ:XMKZ+1,1:XMKZ)
End DoDot:1
+29 QUIT
READMSG(XMDUZ,XMK,XMKN,XMKZ,XMZ,XMZOOM) ;
+1 DO READMSG^XMJBM(XMDUZ,XMK,XMKN,XMZ)
+2 IF $DATA(^TMP("XM",$JOB,".",XMKZ))
IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,XMZ))
KILL ^TMP("XM",$JOB,".",XMKZ)
+3 IF XMZOOM
IF '$DATA(^TMP("XM",$JOB,"."))
DO Z
+4 QUIT
AGAIN(XMABORT) ;
+1 NEW DIR,Y
+2 WRITE !
+3 ; End reached. Begin again
SET DIR("A")=$$EZBLD^DIALOG(34020)
+4 ; No
SET DIR(0)="Y"
SET DIR("B")=$$EZBLD^DIALOG(39053)
+5 ; Enter 'Yes' if you wish to continue reading messages; 'No' if you don't.
DO BLD^DIALOG(34021,"","","DIR(""?"")")
+6 DO ^DIR
+7 ; Yes, begin again
if Y=1
QUIT
+8 ; No, exit.
SET XMABORT=1
+9 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(^XMB(3.7,XMDUZ,2,XMK,1,"C",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(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ))
if XMKZ>XMN!'XMKZ
QUIT
if '$DATA(^TMP("XM",$JOB,".",XMKZ))
SET ^(XMKZ)=""
End DoDot:3
QUIT
+16 FOR
SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ))
if XMKZ>XMN!'XMKZ
QUIT
if $DATA(^TMP("XM",$JOB,".",XMKZ))
KILL ^(XMKZ)
End DoDot:2
QUIT
+17 IF 'XMSTRIKE
Begin DoDot:2
+18 IF $DATA(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ))
IF '$DATA(^TMP("XM",$JOB,".",XMKZ))
SET ^(XMKZ)=""
End DoDot:2
QUIT
+19 if $DATA(^TMP("XM",$JOB,".",XMKZ))
KILL ^(XMKZ)
End DoDot:1
+20 QUIT
C ; Change the name of this basket
+1 DO NAMEBSKT^XMJBU(XMDUZ,XMK,.XMKN)
+2 KILL XMLEN
+3 DO INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
+4 QUIT
CD ; Change Detail
+1 SET XMDETAIL='XMDETAIL
+2 DO INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
+3 QUIT
D ; Delete messages
+1 DO DELETE^XMJMOR(XMDUZ,XMK)
+2 DO WAIT^XMXUTIL
+3 IF XMZOOM
IF '$DATA(^TMP("XM",$JOB,"."))
DO Z
+4 QUIT
F ; Forward messages
+1 DO FORWARD^XMJMOR(XMDUZ,XMK)
+2 DO WAIT^XMXUTIL
+3 QUIT
FI ; Filter messages
+1 DO FILTER^XMJMOR(XMDUZ,XMK)
+2 DO WAIT^XMXUTIL
+3 QUIT
H ; Headerless Print messages
+1 DO PRINT^XMJMOR(XMDUZ,XMK,0)
+2 DO WAIT^XMXUTIL
+3 QUIT
L ; Later messages
+1 DO LATER^XMJMOR(XMDUZ,XMK)
+2 DO WAIT^XMXUTIL
+3 IF XMZOOM
IF '$DATA(^TMP("XM",$JOB,"."))
DO Z
+4 QUIT
N ; New message list
+1 DO LISTONE^XMJMLN(XMDUZ,XMK,XMKN,"N0")
+2 DO WAIT^XMXUTIL
+3 QUIT
NT ; New Toggle messages
+1 DO NEWTOGL^XMJMOR(XMDUZ,XMK)
+2 DO WAIT^XMXUTIL
+3 QUIT
O ; Opposite toggle
+1 NEW XMKZ
+2 SET XMKZ=0
+3 FOR
SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",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^XMJMOR(XMDUZ,XMK)
+2 DO WAIT^XMXUTIL
+3 QUIT
Q ; Query messages
+1 DO FINDBSKT^XMJMF(XMDUZ,XMK,XMKN)
+2 QUIT
Q1 ; ?string - search for messages in this basket whose subject contains string.
+1 NEW XMF
+2 SET XMF("BSKT")=XMK
+3 SET XMF("SUBJ")=XMY(0)
+4 DO FIND1^XMJMFB(XMDUZ,.XMF,1)
+5 QUIT
Q2 ; ??string - search for messages whose subject starts with string.
+1 DO FIND^XMJMFA(XMDUZ,XMY(0),1)
+2 QUIT
R ; Resequence messages
+1 DO R^XMJBM
+2 SET XMPAGE=0
+3 KILL XMLEN,XMFIRST
+4 SET XMFIRST(0)=""
+5 DO INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
+6 DO WAIT^XMXUTIL
+7 QUIT
S ; Save messages
+1 DO SAVE^XMJMOR(XMDUZ,XMK)
+2 DO WAIT^XMXUTIL
+3 QUIT
T ; Terminate messages
+1 DO TERM^XMJMOR(XMDUZ,XMK)
+2 DO WAIT^XMXUTIL
+3 IF XMZOOM
IF '$DATA(^TMP("XM",$JOB,"."))
DO Z
+4 QUIT
V ; Vaporize messages
+1 DO VAPOR^XMJMOR(XMDUZ,XMK)
+2 DO WAIT^XMXUTIL
+3 QUIT
X ; Xmit priority toggle messages
+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
