- 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 Jan 18, 2025@03:12:47 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