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