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

XM.m

Go to the documentation of this file.
  1. XM ;ISC-SF/GMB-MailMan Main Driver ;04/22/2002 14:31
  1. ;;8.0;MailMan;;Jun 28, 2002
  1. ; Replaces ^XM,EN^XMA01,INTRO^XMA6,REC^XMA22,MULTI^XM0,^XMAK (ISC-WASH/CAP/THM)
  1. ;
  1. ; Entry points (DBIA 10064):
  1. ; ^XM Programmer entry into MailMan
  1. ; CHECKIN Meant to be included in option ENTRY ACTION
  1. ; CHECKOUT Meant to be included in option EXIT ACTION
  1. ; EN Option entry point into MailMan
  1. ; HEADER Displays user intro when entering MailMan
  1. ; KILL Kill MailMan variables
  1. ; N1 Create a mailbox
  1. ; NEW Create a mailbox
  1. ; $$NU Tell user how many new messages he has
  1. ;
  1. ; Entry points used by MailMan options (not covered by DBIA):
  1. ; NEWMBOX XMMGR-NEW-MAIL-BOX - Create a mailbox
  1. D KILL^XUSCLEAN
  1. N XMXUSEC,XMABORT,XMMENU
  1. S XMMENU(0)="^XM"
  1. I '$D(IOF) D HOME^%ZIS
  1. D EN
  1. I $D(XQUIT)!'$D(XMDUZ) K XQUIT D CLEANUP Q
  1. D:'$D(^DOPT("XM")) OPTIONS
  1. S XMABORT=0
  1. F D Q:XMABORT ; Programmer option choices
  1. . N DIC,X,Y
  1. . S XMXUSEC=$S($G(DUZ(0))="@":1,$D(^XUSEC("XUPROG",XMDUZ)):1,$D(^XUSEC("XUPROGMODE",XMDUZ)):1,1:0)
  1. . S DIC="^DOPT(""XM"","
  1. . S DIC(0)="AEQMZ"
  1. . S DIC("S")="Q:XMXUSEC I ^(0)'[""LOAD"""
  1. . W !!
  1. . D ^DIC I Y<0 S XMABORT=1 Q
  1. . K DIC,X
  1. . X $P(Y(0),U,2,999)
  1. D CLEANUP
  1. Q
  1. EN ;Initialize
  1. ;N XMDUZ,XMDISPI,XMDUN,XMNOSEND,XMV
  1. Q:$D(DUZ("SAV")) ; Set by option XUTESTUSER
  1. D SETUP
  1. D HEADER
  1. Q
  1. SETUP ;
  1. I $G(IO)'=$G(IO(0))!'$D(IO(0)) D HOME^%ZIS U IO
  1. D CHECK^XMKPL ; Make sure background filers are running.
  1. I '$D(IOF)!'$D(IOM)!'$D(IOSL) S IOP="" D ^%ZIS K IOP
  1. S XMDUZ=DUZ
  1. D INIT^XMVVITAE
  1. K XMERR,^TMP("XMERR",$J)
  1. Q
  1. N XMPERSON,XMPARM,XMTEXT
  1. I $D(XMV("SYSERR")) D ERROR(.XMV,"SYSERR") S:$D(XMMENU) XQUIT="" Q ; Fatal Errors
  1. I $D(XMV("ERROR")) D ERROR(.XMV,"ERROR") S:$D(XMMENU) XQUIT="" Q ; Fatal Errors
  1. I $D(XMV("WARNING")) D WARNING(XMDUZ,.XMV)
  1. S XMPARM(1)=XMV("VERSION"),XMPARM(2)=XMV("NETNAME")
  1. W !!,$$EZBLD^DIALOG(38150,.XMPARM) ; |1| service for |2|
  1. I XMDUZ'=DUZ W !,$$EZBLD^DIALOG(38008,XMV("DUZ NAME")) ; (Surrogate: |1|)
  1. I XMDUZ'=.6 D
  1. . S XMPARM(1)=XMV("LAST USE"),XMPARM(2)=XMV("NAME")
  1. . W !,$$EZBLD^DIALOG($S(XMDUZ=DUZ:38151,1:38152),.XMPARM) ; You/|2| last used MailMan: |1|
  1. . Q:'$D(XMV("BANNER"))
  1. . S XMPARM(1)=XMV("BANNER"),XMPARM(2)=XMV("NAME")
  1. . D BLD^DIALOG($S(XMDUZ=DUZ:38153,1:38154),.XMPARM,"","XMTEXT","F")
  1. . D MSG^DIALOG("WM","","","","XMTEXT")
  1. . ; Your/|2|'s current banner: |1|
  1. . ;E W !,$S(XMDUZ=DUZ:"You have",1:XMV("NAME")_" has")," no banner."
  1. S XMPARM(1)=XMV("NEW MSGS"),XMPARM(2)=XMV("NAME")
  1. W !,$$EZBLD^DIALOG($S(XMDUZ=DUZ:38155,1:38156)+$S(XMV("NEW MSGS")>1:0,'XMV("NEW MSGS"):.2,1:.1),.XMPARM) ; You have/|2| has |1|/no new message(s).
  1. I XMV("NEW MSGS")<0!(XMV("NEW MSGS")&'$D(^XMB(3.7,XMDUZ,"N0")))!('XMV("NEW MSGS")&$D(^XMB(3.7,XMDUZ,"N0"))) D
  1. . D MSG(38160)
  1. . ; There's a discrepancy in the 'new message' count. Checking the mailbox...
  1. . D USER^XMUT4(XMDUZ)
  1. Q
  1. ERROR(XMV,XMTYPE) ;
  1. N I
  1. S I=0
  1. F S I=$O(XMV(XMTYPE,I)) Q:I="" W !,$C(7),XMV(XMTYPE,I)
  1. K XMDUZ
  1. Q
  1. WARNING(XMDUZ,XMV) ;
  1. D:$D(XMV("WARNING",5)) POST(XMV("WARNING",5))
  1. D:$D(XMV("WARNING",4)) MULTI
  1. D:$D(XMV("WARNING",3)) INTRO(XMDUZ)
  1. D:$D(XMV("WARNING",2)) UNSENT(XMDUZ)
  1. D:$D(XMV("WARNING",1)) LISTPRI^XMJML(XMDUZ)
  1. ;D:$D(XMV("WARNING",1)) PRIO^XMJML(XMDUZ)
  1. K XMV("WARNING")
  1. Q
  1. MSG(XMDIALOG) ;
  1. N XMTEXT
  1. W !
  1. D BLD^DIALOG(XMDIALOG,"","","XMTEXT","F")
  1. D MSG^DIALOG("WM","","","","XMTEXT")
  1. Q
  1. POST(XMMSG) ;
  1. W !!,$C(7),XMMSG ; "POSTMASTER has X baskets."
  1. D MSG(38113.1)
  1. ;POSTMASTER may not have more than 999 baskets.
  1. ;Baskets numbered above 999 are reserved for network transmission
  1. ;queues and for server queues.
  1. Q
  1. MULTI ;
  1. ;It appears someone is signed on as you/|1| already.
  1. ;You may not send mail or respond to mail in this session.
  1. ;(Only the 1st of multiple MailMan sessions may send or respond to mail.)
  1. N XMTEXT
  1. W !
  1. D BLD^DIALOG($S(XMDUZ=DUZ:38110.1,1:38110.2),XMV("NAME"),"","XMTEXT","F")
  1. D BLD^DIALOG(38110.3,"","","XMTEXT","F")
  1. D MSG^DIALOG("WM","","","","XMTEXT")
  1. Q
  1. INTRO(XMDUZ) ;
  1. D MSG(38114.1)
  1. ;You have not yet introduced yourself to the group.
  1. ;Please enter a short introduction, so that others may use
  1. ;the HELP option to find out more about you.
  1. ;You may change your INTRODUCTION later
  1. ;under 'Personal Preferences|User Options Edit.
  1. W !!
  1. N DIR S DIR(0)="E" D ^DIR Q:$D(DIRUT)
  1. N DWPK,DIC
  1. S DWPK=1,DIC="^XMB(3.7,XMDUZ,1,"
  1. D EN^DIWE
  1. Q
  1. UNSENT(XMDUZ) ;
  1. N XMREC,XMZ
  1. L +^XMB(3.7,"AD",XMDUZ):0 E D Q
  1. . S XMV("NOSEND")=1
  1. . D MULTI
  1. S XMREC=^XMB(3.7,XMDUZ,"T")
  1. S XMZ=$P(XMREC,U) Q:'XMZ
  1. I $P(XMREC,U,3) D RECOVER^XMJMR(XMDUZ,XMZ,$P(XMREC,U,3)) Q ; Reply
  1. D RECOVER^XMJMS(XMDUZ,XMZ,$P(XMREC,U,4)) ; Original Message (w/BLOB)
  1. Q
  1. CHECKIN ;
  1. Q:$D(XMMENU(0)) ; Set by option XMUSER or other options using MailMan
  1. Q:$D(DUZ("SAV")) ; Set by option XUTESTUSER
  1. D SETUP
  1. I $D(XMV("WARNING")) D WARNING(XMDUZ,.XMV)
  1. Q
  1. CHECKOUT ;
  1. K XMERR,^TMP("XMERR",$J)
  1. Q:$D(XMMENU(0))
  1. K XMDISPI,XMDUN,XMDUZ,XMNOSEND,XMPRIV,XMV
  1. L -^XMB(3.7,"AD",DUZ)
  1. Q
  1. LOCK ;
  1. S Y=1
  1. Q:'$D(XMMENU(0))
  1. L +^XMB(3.7,"AD",DUZ):0 E D MULTI S Y=-1
  1. Q
  1. UNLOCK ;
  1. Q:'$D(XMMENU(0))
  1. L -^XMB(3.7,"AD",DUZ)
  1. Q
  1. CHK ; Entry used by Kernel
  1. K ^TMP("XMY",$J),^TMP("XMY0",$J)
  1. S XMDUZ=$G(XMDUZ,DUZ)
  1. Q:XMDUZ=.6
  1. D NUS(0)
  1. Q
  1. NU(XMFORCE) ;API for new message display
  1. ; XMFORCE (in) 1=force new display; 0=display only if recent receipt
  1. N XMNEW
  1. D NUS(XMFORCE,.XMNEW)
  1. Q XMNEW
  1. NUS(XMFORCE,XMNEW) ; new message display
  1. ; XMFORCE (in) 1=force new display; 0=display only if recent receipt
  1. ; XMNEW (out) number of new messages
  1. ; XMLAST last message arrival date (FM format)
  1. N XMREC,XMNEW2U,XMLAST
  1. S XMDUZ=$G(XMDUZ,DUZ)
  1. S XMREC=$$NEWS^XMXUTIL(XMDUZ,$D(DUZ("SAV")))
  1. Q:XMREC=-1
  1. S XMNEW=$P(XMREC,U,1)
  1. I 'XMFORCE,'XMNEW Q
  1. S XMLAST=$P(XMREC,U,4)
  1. S XMNEW2U=$P(XMREC,U,5)
  1. I XMNEW2U!XMFORCE D
  1. . N XMPARM,XMDIALOG
  1. . S XMPARM(1)=XMNEW
  1. . I XMDUZ=DUZ S XMDIALOG=38155
  1. . E S XMDIALOG=38156,XMPARM(2)=$$NAME^XMXUTIL(XMDUZ)
  1. . W !,$$EZBLD^DIALOG(XMDIALOG+$S(XMNEW>1:0,'XMNEW:.2,1:.1),.XMPARM) ; You have/|2| has |1|/no new message(s).
  1. . Q:'XMNEW
  1. . W " ",$$EZBLD^DIALOG(38158,$$MMDT^XMXUTIL1(XMLAST)) ; (Last arrival: |1|)
  1. D:$P(XMREC,U,2) NOTEPRIO
  1. Q
  1. NOTEPRIO ;
  1. N XMDIALOG,XMPARM
  1. I XMDUZ=DUZ S XMDIALOG=38159 ;You've got PRIORITY Mail!
  1. E S XMDIALOG=38159.1,XMPARM(1)=$$NAME^XMXUTIL(XMDUZ) ;|1| has PRIORITY Mail!
  1. D ZIS
  1. W $C(7),!!,$G(IORVON),$$EZBLD^DIALOG(XMDIALOG,.XMPARM),!!,$G(IORVOFF)
  1. Q
  1. ZIS ;
  1. Q:$D(IORVON)
  1. N X
  1. S X="IORVON;IORVOFF;IOBON;IOBOFF"
  1. D ENDR^%ZISS
  1. Q
  1. NEWMBOX ; Create a mailbox for a user
  1. N DIC,XMZ
  1. D MSG(38165)
  1. ;Ready to create a mailbox for a user.
  1. ;You will only be able to select a user who does not already have a mailbox.
  1. S DIC="^VA(200,"
  1. S DIC(0)="AEQM"
  1. S DIC("S")="I '$D(^XMB(3.7,Y,0))"
  1. D ^DIC Q:Y=-1
  1. S Y=+Y
  1. D NEW
  1. W !,$$EZBLD^DIALOG(38165.1) ; Mailbox created.
  1. Q
  1. N1 S Y=XMDUZ
  1. NEW ; CREATE MAILBOX 4 NEW USER
  1. N L +^XMB(3.7,0):0 E H 1 G N
  1. D CRE8MBOX^XMXMBOX(Y,$S($D(XMZ):DT,1:""))
  1. L -^XMB(3.7,0)
  1. D:$D(XMERR) SHOW^XMJERR
  1. Q
  1. KILL ;
  1. CLEANUP ;
  1. K XMV,XMDISPI,XMDUN,XMDUZ,XMPRIV,XMNOSEND,XMERR
  1. K:$D(^TMP("XMERR",$J)) ^TMP("XMERR",$J)
  1. D KILLALL
  1. D UNLOCK
  1. Q
  1. KILLALL ;All variables except XMDISPI,XMDUZ,XMDUN and XMPRIV are killed here on
  1. ;exit from the MailMan package or by calls to this code.
  1. K A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Z,%,%0,%1,%2,%3,%4
  1. K XM,XMA,XMA0,XMAPBLOB,XMB,XMB0
  1. K XMC,XMC0,XMCH,XMCI,XMCL,XMCNT,XMCT
  1. K XMD,XMD0,XMDATE,XMDI,XMDT,XME,XME0,XMF,XMF0,XMG,XMG0
  1. K XMK,XMKM,XMKN,XMI,XMJ
  1. K XML,XMLOAD,XMLOC,XMLOCK,XMM,XMMG,XMN,XMOUT,XMP
  1. K XMR,XMRES,XMS,XMSEN,XMSUB
  1. K XMT,XMTYPE,XMU,XMY,XMZ,XMZ1,XMZ2
  1. Q
  1. DSP ;
  1. D INIT^XMVVITAE
  1. Q
  1. OPTIONS ; Set up options
  1. N DIK,I,X
  1. K ^DOPT("XM")
  1. S DIK="^DOPT(""XM"","
  1. S ^DOPT("XM",0)="MailMan Option^1N^"
  1. F I=1:1 S X=$P($T(T+I)," ",1,3) Q:X=" ;;" S X=$E(X,4,255),^DOPT("XM",I,0)=$$UP^XLFSTR($$EZBLD^DIALOG(+X))_U_$P(X,U,2,3)
  1. D IXALL^DIK
  1. Q
  1. T ;;TABLE
  1. ;;38170^D SEND^XMJMS ; SEND A MESSAGE
  1. ;;38171^D MANAGE^XMJBM ; READ/MANAGE MESSAGES
  1. ;;38172^D NEW^XMJBN ; NEW MESSAGES AND RESPONSES
  1. ;;38173^D PAKMAN^XMJMS ; LOAD PACKMAN MESSAGE
  1. ;;38174^D EDIT^XMVVITA ; EDIT USER OPTIONS
  1. ;;38175^D PERSONAL^XMVGROUP ; PERSONAL MAIL GROUP EDIT
  1. ;;38176^D ENROLL^XMVGROUP ; JOIN MAIL GROUP
  1. ;;38177^D LISTMBOX^XMJBL ; MAILBOX CONTENTS LIST
  1. ;;38178^D TALK^XMC ; LOG-IN TO ANOTHER SYSTEM (TalkMan)
  1. ;;38179^D FIND^XMJMF ; QUERY/SEARCH FOR MESSAGES
  1. ;;
  1. ;;**OBSOLETE**
  1. ;;BLOB SEND^D BLOB^XMA2B
  1. ;;