source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMJMLN.m@ 1604

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