XMJBM ;ISC-SF/GMB-Manage Mail in Mailbox ;05/23/2002 11:35
;;8.0;MailMan;;Jun 28, 2002
; Replaces ^XMA0,^XMA01 (ISC-WASH/CAP/THM)
; Entry points used by MailMan options (not covered by DBIA):
; MANAGE XMREAD
MANAGE ; Manage existing mail in your Mailbox
N XMABORT,XMK,XMKN,XMRDR
S XMABORT=0
D INIT^XMJBM1(.XMDUZ,.XMRDR,.XMABORT) Q:XMABORT
F D ASKBSKT^XMJBM1(XMDUZ,XMRDR,.XMK,.XMKN,.XMABORT) Q:XMABORT D Q:XMABORT
. D:XMRDR="C" CLASSIC(XMDUZ,XMK,XMKN,.XMABORT) ; Classic Reader
. D:XMRDR="D" LIST^XMJMLR(XMDUZ,XMK,.XMKN,1,.XMABORT) ; Full Screen Detail
. D:XMRDR="S" LIST^XMJMLR(XMDUZ,XMK,.XMKN,0,.XMABORT) ; Full Screen Summary
. I XMABORT,XMDUZ=.6 S XMABORT=0
. I '$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",0)) D NOMSGS^XMJBM1(XMDUZ,XMK,XMKN)
Q
CLASSIC(XMDUZ,XMK,XMKN,XMABORT) ; Read Message
N XMFIRST,XMLAST,XMZ,XMNEXT,XMKZ,XMORDER,XMPARM
I XMDUZ=.5,XMK>999 S XMORDER=XMV("ORDER"),XMV("ORDER")=1
S XMKZ=""
F D Q:XMABORT
. F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMV("ORDER")) Q:'XMKZ Q:XMDUZ=DUZ Q:'$$SURRCONF^XMXSEC(XMDUZ,$O(^(XMKZ,"")))
. I XMKZ="" D Q:XMABORT
. . F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMV("ORDER")) Q:'XMKZ Q:XMDUZ=DUZ Q:'$$SURRCONF^XMXSEC(XMDUZ,$O(^(XMKZ,"")))
. . I XMKZ D AGAIN^XMJMLR(.XMABORT) Q
. . S XMABORT=1
. . Q:'$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",0))
. . N XMTEXT
. . W !
. . D BLD^DIALOG(34030.9,"","","XMTEXT","F")
. . ;All of the messages in this basket are confidential.
. . ;Surrogates may not read confidential messages.
. . ;Use one of the full screen readers to see a list of the messages.
. . D MSG^DIALOG("WM","","","","XMTEXT")
. S XMFIRST=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""))
. S XMLAST=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1)
. ; have the user pick from first to last, or any xmz
. N XMY,XMOPT,XMOX,XMPREVU
. D SETCMD(XMDUZ,XMK,.XMOPT,.XMOX)
. S:XMV("PREVU") XMPREVU=$$PREVU(XMDUZ,XMK,XMKN,XMKZ)
. S XMNEXT=0
. F D Q:XMNEXT!XMABORT
. . W ! W:XMV("PREVU") !,XMPREVU
. . S XMPARM(1)=XMKN,XMPARM(2)=XMKZ
. . W !,$$EZBLD^DIALOG(34030,.XMPARM) ; XMKN," Basket Message: ",XMKZ,"// "
. . R XMY:DTIME I '$T S XMABORT=1 Q
. . I XMY[U S XMABORT=1 Q
. . I XMY="" S XMY=XMKZ D NUMBER Q
. . I XMY?.N D NUMBER Q
. . I $E(XMY)="?" D QUESTION Q
. . S XMY=$$COMMAND^XMJDIR(.XMOPT,.XMOX,XMY)
. . I XMY=-1 D HELPSCR Q
. . I $D(XMOPT(XMY,"?")) D SHOWERR^XMJDIR(.XMOPT,.XMY) Q
. . D @XMY
. . S:'$D(^XMB(3.7,XMDUZ,2,XMK,1,"C",+XMKZ)) XMNEXT=1
I $D(XMORDER) S XMV("ORDER")=XMORDER
Q
PREVU(XMDUZ,XMK,XMKN,XMKZ) ;
Q:XMKZ="" ""
N XMZ,XMZREC,XMSUBJ,XMFROM,XMLEN,XMSL,XMFL,XMPARM
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)
S XMZREC=$G(^XMB(3.9,XMZ,0))
S XMSUBJ=$$SUBJ^XMXUTIL2(XMZREC)
S XMFROM=$$NAME^XMXUTIL($P(XMZREC,U,2))
S XMSL=$L(XMSUBJ)
S XMFL=$L(XMFROM)
S XMLEN=64
I XMSL+XMFL>XMLEN D
. I XMSL<36 S XMFROM=$E(XMFROM,1,XMLEN-XMSL) Q
. I XMFL<26 S XMSUBJ=$E(XMSUBJ,1,XMLEN-XMFL) Q
. S XMSL=XMSL-(XMSL+XMFL-XMLEN\2)
. S XMSUBJ=$E(XMSUBJ,1,XMSL)
. S XMFROM=$E(XMFROM,1,XMLEN-XMSL)
S XMPARM(1)=XMSUBJ,XMPARM(2)=XMFROM
Q $$EZBLD^DIALOG(34031,.XMPARM) ; "Subj: "_XMSUBJ_" From: "_XMFROM
SETCMD(XMDUZ,XMK,XMOPT,XMOX) ;
D OPTGRP^XMXSEC1(XMDUZ,XMK,.XMOPT,.XMOX,1)
I XMDUZ=.5,XMK>999 Q
D SET^XMXSEC1("I",37241,.XMOPT,.XMOX) ; Ignore this message
Q
NUMBER ;
I $L(XMY)>25 W $C(7),"?" Q
I XMY<XMFIRST D Q
. S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""))
. S:XMV("PREVU") XMPREVU=$$PREVU(XMDUZ,XMK,XMKN,XMKZ)
. W $C(7),"?"
I $D(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMY)) D Q
. S XMKZ=XMY
. 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)
. D READMSG(XMDUZ,XMK,XMKN,XMZ)
. S XMNEXT=1
I XMFIRST'>XMY,XMY'>XMLAST D Q
. S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMY),XMV("ORDER"))
. S:XMV("PREVU") XMPREVU=$$PREVU(XMDUZ,XMK,XMKN,XMKZ)
. W $C(7),"?"
I $D(^XMB(3.9,XMY,0)) D NUMBERZ Q
I XMY>XMLAST D Q
. S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1)
. S:XMV("PREVU") XMPREVU=$$PREVU(XMDUZ,XMK,XMKN,XMKZ)
. W $C(7),"?"
W $C(7),"?"
Q
NUMBERZ ;
I $D(^XMB(3.7,"M",XMY,XMDUZ)) D Q
. S XMZ=XMY
. I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ)) D
. . ; It's in another basket
. . S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
. . S XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
. S XMKZ=$P($G(^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,XMZ)
. S XMNEXT=1
I $D(^XMB(3.9,XMY,0)) D Q
. N XMOK,XMZREC
. S XMZ=XMY,XMZREC=^XMB(3.9,XMZ,0)
. I $D(XMERR) K XMERR,^TMP("XMERR",$J)
. I '$$ACCESS^XMXSEC(XMDUZ,XMZ,XMZREC) D Q:'XMOK
. . W "?"
. . D FWD^XMJMLR1(XMDUZ,XMZ,XMZREC,0,.XMOK)
. D PUTMSG^XMXMSGS2(XMDUZ,XMK,XMKN,XMZ) ; User is a recipient, so save to user's basket
. D READMSG(XMDUZ,XMK,XMKN,XMZ)
. S XMNEXT=1
Q
QUESTION ;
I XMY="?" D LIST^XMJML(XMDUZ,XMK,XMKN,XMKZ,0) Q
I XMY="??" D LIST^XMJML(XMDUZ,XMK,XMKN,XMKZ,1) Q
I XMY="???" D HELPSCR Q
I XMY?4."?"!("?HELP"[$$UP^XLFSTR(XMY)) D Q
. N XQH
. S XQH="XM-U-BO-CLASSIC"
. D EN^XQH
I XMY?1"??".E D Q
. ; Search for messages whose subject starts with string
. I $E(XMY,3,99)?.N,$D(^XMB(3.9,$E(XMY,3,999),0)) D Q
. . S XMY=$E(XMY,3,99)
. . D NUMBERZ
. D FIND^XMJMFA(XMDUZ,$E(XMY,3,99))
I XMY?1"?".E D Q
. ; Search for messages whose subject contains string
. N XMF
. S XMF("BSKT")=XMK
. S XMF("SUBJ")=$E(XMY,2,99)
. D FIND1^XMJMFB(XMDUZ,.XMF)
Q
HELPSCR ;
N XMTEXT,XMLINES,XMPARM
W !
S XMPARM(1)=XMKZ,XMPARM(2)=XMFIRST,XMPARM(3)=XMLAST
D BLD^DIALOG(34032,.XMPARM,"","XMTEXT","F")
; Press ENTER to read message _XMKZ_. Enter message number (_XMFIRST_-_XMLAST_) to read
; a message in this basket. Enter internal message number to read any
; message still on the system, which you ever sent or received. Enter:
; ? or ?? Display a summary or detailed list of messages in this basket
; ???? or ?HELP Display detailed help
; ?string Search for messages in this basket whose subject
; contains the specified string
; ??string Search for messages you once sent or received
; whose subject begins with the specified string
S XMLINES=IOSL-DIHELP-3
D MSG^DIALOG("WH","",$G(IOM),"","XMTEXT")
D HELPCMD^XMJDIR(.XMOPT,.XMOX,XMLINES)
Q
READMSG(XMDUZ,XMK,XMKN,XMZ) ;
I '$D(^XMB(3.9,XMZ,0)) D ZAPIT(XMDUZ,XMK,XMZ) Q
I XMDUZ'=DUZ,'$$SURRACC^XMXSEC(XMDUZ,"",XMZ,$G(^XMB(3.9,XMZ,0))) D Q ; "read"
. D SHOW^XMJERR
. I $G(XMRDR)'="C" D WAIT^XMXUTIL
N XMSECURE,XMPAKMAN,XMSECBAD ; Important 'new' - part of scramble and packman handling
D DISPMSG^XMJMP(XMDUZ,XMK,XMKN,XMZ,.XMSECBAD) Q:$G(XMSECBAD)
D READMSG^XMJMOI(0,XMDUZ,XMK,XMKN,XMZ)
Q
ZAPIT(XMDUZ,XMK,XMZ) ;
W !,$C(7),$$EZBLD^DIALOG(34034) ; This references a message which doesn't exist - deleting it.
D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
Q
C ; Change the name of the basket
D NAMEBSKT^XMJBU(XMDUZ,XMK,.XMKN)
Q
D ; Delete
D DELETE^XMJMOR(XMDUZ,XMK)
Q
F ; Forward
D FORWARD^XMJMOR(XMDUZ,XMK)
Q
FI ; Filter
D FILTER^XMJMOR(XMDUZ,XMK)
Q
H ; Headerless Print
D PRINT^XMJMOR(XMDUZ,XMK,0)
Q
I ; Ignore this message
S XMNEXT=1
Q
L ; Later
LA ; Later
D LATER^XMJMOR(XMDUZ,XMK)
Q
LM ; List Messages (can't read)
D LIST^XMJML(XMDUZ,XMK,XMKN,"",1)
Q
LN ; List New Messages
D LISTONE^XMJMLN(XMDUZ,XMK,XMKN,"N0")
Q
LP ; List Priority Messages
D LISTONE^XMJMLN(XMDUZ,XMK,XMKN,"N")
Q
N ; List New Messages (can't read)
D LISTNEW^XMJML(XMDUZ,XMK,XMKN)
Q
NT ; New Toggle messages
D NEWTOGL^XMJMOR(XMDUZ,XMK)
Q
P ; Print
D PRINT^XMJMOR(XMDUZ,XMK)
Q
Q ; Query by subject, sender, and/or date
D FINDBSKT^XMJMF(XMDUZ,XMK,XMKN)
Q
R ; Resequence
N XMMSG
W !,$$EZBLD^DIALOG(34035) ; Resequencing ...
D RSEQBSKT^XMXBSKT(XMDUZ,XMK,.XMMSG)
W !,XMMSG
S XMKZ=""
Q
S ; Save
D SAVE^XMJMOR(XMDUZ,XMK)
Q
T ; Terminate
D TERM^XMJMOR(XMDUZ,XMK)
Q
V ; Vaporize
D VAPOR^XMJMOR(XMDUZ,XMK)
Q
X ; Xmit Priority toggle (for Postmaster only)
D XMTPRI^XMJMOR(XMDUZ,XMK)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJBM 8188 printed Apr 09, 2024@21:15:43 Page 2
XMJBM ;ISC-SF/GMB-Manage Mail in Mailbox ;05/23/2002 11:35
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Replaces ^XMA0,^XMA01 (ISC-WASH/CAP/THM)
+3 ; Entry points used by MailMan options (not covered by DBIA):
+4 ; MANAGE XMREAD
MANAGE ; Manage existing mail in your Mailbox
+1 NEW XMABORT,XMK,XMKN,XMRDR
+2 SET XMABORT=0
+3 DO INIT^XMJBM1(.XMDUZ,.XMRDR,.XMABORT)
if XMABORT
QUIT
+4 FOR
DO ASKBSKT^XMJBM1(XMDUZ,XMRDR,.XMK,.XMKN,.XMABORT)
if XMABORT
QUIT
Begin DoDot:1
+5 ; Classic Reader
if XMRDR="C"
DO CLASSIC(XMDUZ,XMK,XMKN,.XMABORT)
+6 ; Full Screen Detail
if XMRDR="D"
DO LIST^XMJMLR(XMDUZ,XMK,.XMKN,1,.XMABORT)
+7 ; Full Screen Summary
if XMRDR="S"
DO LIST^XMJMLR(XMDUZ,XMK,.XMKN,0,.XMABORT)
+8 IF XMABORT
IF XMDUZ=.6
SET XMABORT=0
+9 IF '$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",0))
DO NOMSGS^XMJBM1(XMDUZ,XMK,XMKN)
End DoDot:1
if XMABORT
QUIT
+10 QUIT
CLASSIC(XMDUZ,XMK,XMKN,XMABORT) ; Read Message
+1 NEW XMFIRST,XMLAST,XMZ,XMNEXT,XMKZ,XMORDER,XMPARM
+2 IF XMDUZ=.5
IF XMK>999
SET XMORDER=XMV("ORDER")
SET XMV("ORDER")=1
+3 SET XMKZ=""
+4 FOR
Begin DoDot:1
+5 FOR
SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMV("ORDER"))
if 'XMKZ
QUIT
if XMDUZ=DUZ
QUIT
if '$$SURRCONF^XMXSEC(XMDUZ,$ORDER(^(XMKZ,"")))
QUIT
+6 IF XMKZ=""
Begin DoDot:2
+7 FOR
SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMV("ORDER"))
if 'XMKZ
QUIT
if XMDUZ=DUZ
QUIT
if '$$SURRCONF^XMXSEC(XMDUZ,$ORDER(^(XMKZ,"")))
QUIT
+8 IF XMKZ
DO AGAIN^XMJMLR(.XMABORT)
QUIT
+9 SET XMABORT=1
+10 if '$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",0))
QUIT
+11 NEW XMTEXT
+12 WRITE !
+13 DO BLD^DIALOG(34030.9,"","","XMTEXT","F")
+14 ;All of the messages in this basket are confidential.
+15 ;Surrogates may not read confidential messages.
+16 ;Use one of the full screen readers to see a list of the messages.
+17 DO MSG^DIALOG("WM","","","","XMTEXT")
End DoDot:2
if XMABORT
QUIT
+18 SET XMFIRST=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",""))
+19 SET XMLAST=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1)
+20 ; have the user pick from first to last, or any xmz
+21 NEW XMY,XMOPT,XMOX,XMPREVU
+22 DO SETCMD(XMDUZ,XMK,.XMOPT,.XMOX)
+23 if XMV("PREVU")
SET XMPREVU=$$PREVU(XMDUZ,XMK,XMKN,XMKZ)
+24 SET XMNEXT=0
+25 FOR
Begin DoDot:2
+26 WRITE !
if XMV("PREVU")
WRITE !,XMPREVU
+27 SET XMPARM(1)=XMKN
SET XMPARM(2)=XMKZ
+28 ; XMKN," Basket Message: ",XMKZ,"// "
WRITE !,$$EZBLD^DIALOG(34030,.XMPARM)
+29 READ XMY:DTIME
IF '$TEST
SET XMABORT=1
QUIT
+30 IF XMY[U
SET XMABORT=1
QUIT
+31 IF XMY=""
SET XMY=XMKZ
DO NUMBER
QUIT
+32 IF XMY?.N
DO NUMBER
QUIT
+33 IF $EXTRACT(XMY)="?"
DO QUESTION
QUIT
+34 SET XMY=$$COMMAND^XMJDIR(.XMOPT,.XMOX,XMY)
+35 IF XMY=-1
DO HELPSCR
QUIT
+36 IF $DATA(XMOPT(XMY,"?"))
DO SHOWERR^XMJDIR(.XMOPT,.XMY)
QUIT
+37 DO @XMY
+38 if '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,"C",+XMKZ))
SET XMNEXT=1
End DoDot:2
if XMNEXT!XMABORT
QUIT
End DoDot:1
if XMABORT
QUIT
+39 IF $DATA(XMORDER)
SET XMV("ORDER")=XMORDER
+40 QUIT
PREVU(XMDUZ,XMK,XMKN,XMKZ) ;
+1 if XMKZ=""
QUIT ""
+2 NEW XMZ,XMZREC,XMSUBJ,XMFROM,XMLEN,XMSL,XMFL,XMPARM
+3 SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
+4 IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
DO ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZ)
+5 SET XMZREC=$GET(^XMB(3.9,XMZ,0))
+6 SET XMSUBJ=$$SUBJ^XMXUTIL2(XMZREC)
+7 SET XMFROM=$$NAME^XMXUTIL($PIECE(XMZREC,U,2))
+8 SET XMSL=$LENGTH(XMSUBJ)
+9 SET XMFL=$LENGTH(XMFROM)
+10 SET XMLEN=64
+11 IF XMSL+XMFL>XMLEN
Begin DoDot:1
+12 IF XMSL<36
SET XMFROM=$EXTRACT(XMFROM,1,XMLEN-XMSL)
QUIT
+13 IF XMFL<26
SET XMSUBJ=$EXTRACT(XMSUBJ,1,XMLEN-XMFL)
QUIT
+14 SET XMSL=XMSL-(XMSL+XMFL-XMLEN\2)
+15 SET XMSUBJ=$EXTRACT(XMSUBJ,1,XMSL)
+16 SET XMFROM=$EXTRACT(XMFROM,1,XMLEN-XMSL)
End DoDot:1
+17 SET XMPARM(1)=XMSUBJ
SET XMPARM(2)=XMFROM
+18 ; "Subj: "_XMSUBJ_" From: "_XMFROM
QUIT $$EZBLD^DIALOG(34031,.XMPARM)
SETCMD(XMDUZ,XMK,XMOPT,XMOX) ;
+1 DO OPTGRP^XMXSEC1(XMDUZ,XMK,.XMOPT,.XMOX,1)
+2 IF XMDUZ=.5
IF XMK>999
QUIT
+3 ; Ignore this message
DO SET^XMXSEC1("I",37241,.XMOPT,.XMOX)
+4 QUIT
NUMBER ;
+1 IF $LENGTH(XMY)>25
WRITE $CHAR(7),"?"
QUIT
+2 IF XMY<XMFIRST
Begin DoDot:1
+3 SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",""))
+4 if XMV("PREVU")
SET XMPREVU=$$PREVU(XMDUZ,XMK,XMKN,XMKZ)
+5 WRITE $CHAR(7),"?"
End DoDot:1
QUIT
+6 IF $DATA(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMY))
Begin DoDot:1
+7 SET XMKZ=XMY
+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 DO READMSG(XMDUZ,XMK,XMKN,XMZ)
+11 SET XMNEXT=1
End DoDot:1
QUIT
+12 IF XMFIRST'>XMY
IF XMY'>XMLAST
Begin DoDot:1
+13 SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMY),XMV("ORDER"))
+14 if XMV("PREVU")
SET XMPREVU=$$PREVU(XMDUZ,XMK,XMKN,XMKZ)
+15 WRITE $CHAR(7),"?"
End DoDot:1
QUIT
+16 IF $DATA(^XMB(3.9,XMY,0))
DO NUMBERZ
QUIT
+17 IF XMY>XMLAST
Begin DoDot:1
+18 SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1)
+19 if XMV("PREVU")
SET XMPREVU=$$PREVU(XMDUZ,XMK,XMKN,XMKZ)
+20 WRITE $CHAR(7),"?"
End DoDot:1
QUIT
+21 WRITE $CHAR(7),"?"
+22 QUIT
NUMBERZ ;
+1 IF $DATA(^XMB(3.7,"M",XMY,XMDUZ))
Begin DoDot:1
+2 SET XMZ=XMY
+3 IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ))
Begin DoDot:2
+4 ; It's in another basket
+5 SET XMK=$ORDER(^XMB(3.7,"M",XMZ,XMDUZ,""))
+6 SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
End DoDot:2
+7 SET XMKZ=$PIECE($GET(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,2)
+8 IF 'XMKZ
DO ADDITM^XMUT4A(XMDUZ,XMK,XMZ,.XMKZ)
+9 DO READMSG(XMDUZ,XMK,XMKN,XMZ)
+10 SET XMNEXT=1
End DoDot:1
QUIT
+11 IF $DATA(^XMB(3.9,XMY,0))
Begin DoDot:1
+12 NEW XMOK,XMZREC
+13 SET XMZ=XMY
SET XMZREC=^XMB(3.9,XMZ,0)
+14 IF $DATA(XMERR)
KILL XMERR,^TMP("XMERR",$JOB)
+15 IF '$$ACCESS^XMXSEC(XMDUZ,XMZ,XMZREC)
Begin DoDot:2
+16 WRITE "?"
+17 DO FWD^XMJMLR1(XMDUZ,XMZ,XMZREC,0,.XMOK)
End DoDot:2
if 'XMOK
QUIT
+18 ; User is a recipient, so save to user's basket
DO PUTMSG^XMXMSGS2(XMDUZ,XMK,XMKN,XMZ)
+19 DO READMSG(XMDUZ,XMK,XMKN,XMZ)
+20 SET XMNEXT=1
End DoDot:1
QUIT
+21 QUIT
QUESTION ;
+1 IF XMY="?"
DO LIST^XMJML(XMDUZ,XMK,XMKN,XMKZ,0)
QUIT
+2 IF XMY="??"
DO LIST^XMJML(XMDUZ,XMK,XMKN,XMKZ,1)
QUIT
+3 IF XMY="???"
DO HELPSCR
QUIT
+4 IF XMY?4."?"!("?HELP"[$$UP^XLFSTR(XMY))
Begin DoDot:1
+5 NEW XQH
+6 SET XQH="XM-U-BO-CLASSIC"
+7 DO EN^XQH
End DoDot:1
QUIT
+8 IF XMY?1"??".E
Begin DoDot:1
+9 ; Search for messages whose subject starts with string
+10 IF $EXTRACT(XMY,3,99)?.N
IF $DATA(^XMB(3.9,$EXTRACT(XMY,3,999),0))
Begin DoDot:2
+11 SET XMY=$EXTRACT(XMY,3,99)
+12 DO NUMBERZ
End DoDot:2
QUIT
+13 DO FIND^XMJMFA(XMDUZ,$EXTRACT(XMY,3,99))
End DoDot:1
QUIT
+14 IF XMY?1"?".E
Begin DoDot:1
+15 ; Search for messages whose subject contains string
+16 NEW XMF
+17 SET XMF("BSKT")=XMK
+18 SET XMF("SUBJ")=$EXTRACT(XMY,2,99)
+19 DO FIND1^XMJMFB(XMDUZ,.XMF)
End DoDot:1
QUIT
+20 QUIT
HELPSCR ;
+1 NEW XMTEXT,XMLINES,XMPARM
+2 WRITE !
+3 SET XMPARM(1)=XMKZ
SET XMPARM(2)=XMFIRST
SET XMPARM(3)=XMLAST
+4 DO BLD^DIALOG(34032,.XMPARM,"","XMTEXT","F")
+5 ; Press ENTER to read message _XMKZ_. Enter message number (_XMFIRST_-_XMLAST_) to read
+6 ; a message in this basket. Enter internal message number to read any
+7 ; message still on the system, which you ever sent or received. Enter:
+8 ; ? or ?? Display a summary or detailed list of messages in this basket
+9 ; ???? or ?HELP Display detailed help
+10 ; ?string Search for messages in this basket whose subject
+11 ; contains the specified string
+12 ; ??string Search for messages you once sent or received
+13 ; whose subject begins with the specified string
+14 SET XMLINES=IOSL-DIHELP-3
+15 DO MSG^DIALOG("WH","",$GET(IOM),"","XMTEXT")
+16 DO HELPCMD^XMJDIR(.XMOPT,.XMOX,XMLINES)
+17 QUIT
READMSG(XMDUZ,XMK,XMKN,XMZ) ;
+1 IF '$DATA(^XMB(3.9,XMZ,0))
DO ZAPIT(XMDUZ,XMK,XMZ)
QUIT
+2 ; "read"
IF XMDUZ'=DUZ
IF '$$SURRACC^XMXSEC(XMDUZ,"",XMZ,$GET(^XMB(3.9,XMZ,0)))
Begin DoDot:1
+3 DO SHOW^XMJERR
+4 IF $GET(XMRDR)'="C"
DO WAIT^XMXUTIL
End DoDot:1
QUIT
+5 ; Important 'new' - part of scramble and packman handling
NEW XMSECURE,XMPAKMAN,XMSECBAD
+6 DO DISPMSG^XMJMP(XMDUZ,XMK,XMKN,XMZ,.XMSECBAD)
if $GET(XMSECBAD)
QUIT
+7 DO READMSG^XMJMOI(0,XMDUZ,XMK,XMKN,XMZ)
+8 QUIT
ZAPIT(XMDUZ,XMK,XMZ) ;
+1 ; This references a message which doesn't exist - deleting it.
WRITE !,$CHAR(7),$$EZBLD^DIALOG(34034)
+2 DO ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
+3 QUIT
C ; Change the name of the basket
+1 DO NAMEBSKT^XMJBU(XMDUZ,XMK,.XMKN)
+2 QUIT
D ; Delete
+1 DO DELETE^XMJMOR(XMDUZ,XMK)
+2 QUIT
F ; Forward
+1 DO FORWARD^XMJMOR(XMDUZ,XMK)
+2 QUIT
FI ; Filter
+1 DO FILTER^XMJMOR(XMDUZ,XMK)
+2 QUIT
H ; Headerless Print
+1 DO PRINT^XMJMOR(XMDUZ,XMK,0)
+2 QUIT
I ; Ignore this message
+1 SET XMNEXT=1
+2 QUIT
L ; Later
LA ; Later
+1 DO LATER^XMJMOR(XMDUZ,XMK)
+2 QUIT
LM ; List Messages (can't read)
+1 DO LIST^XMJML(XMDUZ,XMK,XMKN,"",1)
+2 QUIT
LN ; List New Messages
+1 DO LISTONE^XMJMLN(XMDUZ,XMK,XMKN,"N0")
+2 QUIT
LP ; List Priority Messages
+1 DO LISTONE^XMJMLN(XMDUZ,XMK,XMKN,"N")
+2 QUIT
N ; List New Messages (can't read)
+1 DO LISTNEW^XMJML(XMDUZ,XMK,XMKN)
+2 QUIT
NT ; New Toggle messages
+1 DO NEWTOGL^XMJMOR(XMDUZ,XMK)
+2 QUIT
P ; Print
+1 DO PRINT^XMJMOR(XMDUZ,XMK)
+2 QUIT
Q ; Query by subject, sender, and/or date
+1 DO FINDBSKT^XMJMF(XMDUZ,XMK,XMKN)
+2 QUIT
R ; Resequence
+1 NEW XMMSG
+2 ; Resequencing ...
WRITE !,$$EZBLD^DIALOG(34035)
+3 DO RSEQBSKT^XMXBSKT(XMDUZ,XMK,.XMMSG)
+4 WRITE !,XMMSG
+5 SET XMKZ=""
+6 QUIT
S ; Save
+1 DO SAVE^XMJMOR(XMDUZ,XMK)
+2 QUIT
T ; Terminate
+1 DO TERM^XMJMOR(XMDUZ,XMK)
+2 QUIT
V ; Vaporize
+1 DO VAPOR^XMJMOR(XMDUZ,XMK)
+2 QUIT
X ; Xmit Priority toggle (for Postmaster only)
+1 DO XMTPRI^XMJMOR(XMDUZ,XMK)
+2 QUIT
