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