VistA-WorldVistAEHR/r/MAILMAN-XM/XMJMLR.m

280 lines
9.0 KiB
Mathematica

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