Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMJBM

XMJBM.m

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