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