- 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 Jan 18, 2025@03:11:39 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 ;;