XMJBN ;ISC-SF/GMB-Access new mail in mailbox ;05/18/2004 08:37
;;8.0;MailMan;**25**;Jun 28, 2002
; Replaces ^XMA (ISC-WASH/THM/CAP)
; Entry points used by MailMan options (not covered by DBIA):
; NEW XMNEW - Read new messages
NEW ;
; XMNEW Number of new messages
; XMKMULT 1=New msgs in multiple baskets; 0=new msgs in one basket
N XMABORT,XMK,XMKN,XMNEW,XMKMULT,XMNEWS
S XMABORT=0
D INIT^XMJBN1(XMDUZ,.XMK,.XMKN,.XMNEW,.XMKMULT,.XMABORT) Q:XMABORT
S XMNEWS=1 ; Makes 'new'd msgs drop off list 'til next time
I XMNEW=1 D Q
. N XMZ
. S XMZ=$O(^XMB(3.7,XMDUZ,"N0",XMK,""))
. I XMDUZ'=DUZ,'$$SURRACC^XMXSEC(XMDUZ,"",XMZ,$G(XMB(3.9,XMZ,0))) D Q
. . D ZSHOW^XMJERR
. . D WAIT^XMXUTIL
. I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITN^XMUT4A(XMDUZ,"N0",XMK,XMZ)
. D READNEW(XMDUZ,XMK,XMKN,XMZ)
. D:$D(^XTMP("XM","MAKENEW",XMDUZ)) NEWAGAIN^XMJBN1(XMDUZ)
F D Q:'$D(^XMB(3.7,XMDUZ,"N0"))!XMABORT
. N XMDIR,XMOPT,XMOX,XMY
. S XMDIR("A")=$$EZBLD^DIALOG(34085) ; Select New mail option
. D SET^XMXSEC1("R",34086,.XMOPT,.XMOX) ; Read new mail by basket
. D SET^XMXSEC1("LB",34087,.XMOPT,.XMOX) ; List Baskets with new mail
. D SET^XMXSEC1("LN",34088,.XMOPT,.XMOX) ; List all new messages
. D SET^XMXSEC1("LP",34089,.XMOPT,.XMOX) ; List all priority messages
. I '$D(^XMB(3.7,XMDUZ,"N")) S XMOPT("LP","?")=$$EZBLD^DIALOG(34018) ; You have no new priority messages.
. D SET^XMXSEC1("P",34090,.XMOPT,.XMOX) ; Print all new messages
. D SET^XMXSEC1("S",34091,.XMOPT,.XMOX) ; Scan all new messages
. D SET^XMXSEC1("Q",34092,.XMOPT,.XMOX) ; Quit
. S XMDIR("B")=XMOX("O",XMV("NEW OPT"))_":"_XMOPT(XMV("NEW OPT"))
. S XMDIR("??")="XM-U-R-READ NEW"
. D XMDIR^XMJDIR(.XMDIR,.XMOPT,.XMOX,.XMY,.XMABORT) Q:XMABORT
. K XMOPT,XMOX,XMDIR
. D @XMY
D:$D(^XTMP("XM","MAKENEW",XMDUZ)) NEWAGAIN^XMJBN1(XMDUZ)
Q
LB ; List Baskets with new mail (Replaces NEW^XMA0A)
N DIC,D,DZ
S DIC="^XMB(3.7,"_XMDUZ_",2,"
S DIC(0)="AEQ",D="B",DZ="??"
S DIC("S")="I $P(^(0),U,2)"
S DIC("W")="W ?31,$$EZBLD^DIALOG($S($P(^(0),U,2)'=1:34027.2,1:34027.4),$P(^(0),U,2))" ; (|1| New)
D DQ^DICQ
Q
LN ; List all new messages (Replaces LIST^XMA0A)
D LISTALL^XMJMLN(XMDUZ,"N0")
Q
LP ; List all priority messages (Replaces PRIO^XMA0A)
D LISTALL^XMJMLN(XMDUZ,"N")
Q
P ; Print all new messages
; Replaces PRINT^XMA0A
N XMSAVE,I
F I="XMV(","DUZ","XMDUZ","XMKMULT" S XMSAVE(I)=""
D EN^XUTMDEVQ("PRTNEW^XMJBN",$$EZBLD^DIALOG(34501),.XMSAVE) ; MailMan: Print
Q
PRTNEW ; Print all new messages
N XMSCAN,XMNEWPRT,XMFIRST
S (XMSCAN,XMNEWPRT,XMFIRST)=1
D R
I $D(ZTQUEUED),$D(^XTMP("XM","MAKENEW",XMDUZ)) D NEWAGAIN^XMJBN1(XMDUZ)
Q
Q ; Quit
S XMABORT=1
Q
S ; Scan all new messages
N XMSCAN
S XMSCAN=1
D R
Q
R ; Read new mail by basket, priority first.
N XMTYPE,XMK,XMKN,XMZ,XMIA,XMKPRI
S XMABORT=0 ; (required when printing new messages)
S XMIA='$D(ZTQUEUED)
S XMKPRI=0,(XMKN,XMKPRI("XMKN"))="" K ^TMP("XM",$J,"APX")
F D Q:'$D(^XMB(3.7,XMDUZ,"N0"))!XMABORT
. S XMTYPE=$S($D(^XMB(3.7,XMDUZ,"N")):"N",$D(^XMB(3.7,XMDUZ,"N0")):"N0",1:"")
. I XMTYPE="" S XMABORT=1 W:'$D(ZTQUEUED) !,$$EZBLD^DIALOG(34017) Q ; You have no new messages.
. I 'XMKMULT D
. . S XMK=$O(^XMB(3.7,XMDUZ,XMTYPE,0))
. . S XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U)
. E D Q:XMABORT
. . D NXTBSKT^XMJBN1(XMDUZ,XMTYPE,.XMKN,.XMK,.XMKPRI) I 'XMK S XMABORT=1 Q
. . Q:$G(XMSCAN)
. . D ASKBSKT(XMDUZ,1,.XMK,.XMKN,.XMABORT) Q:XMABORT
. . I XMTYPE="N",'$D(^XMB(3.7,XMDUZ,XMTYPE,XMK)) S XMTYPE="N0"
. S XMZ=""
. F S XMZ=$O(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMV("NEW ORDER")) Q:XMZ="" D Q:XMABORT
. . I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITN^XMUT4A(XMDUZ,XMTYPE,XMK,XMZ)
. . I $G(XMNEWPRT) D Q
. . . D PRTMULT^XMJMP(XMDUZ,XMK,XMKN,XMZ,0,1,.XMFIRST,"",.XMABORT)
. . . I XMDUZ'=DUZ,$$SURRCONF^XMXSEC(XMDUZ,XMZ) D Q
. . . . D NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
. . . . S ^XTMP("XM","MAKENEW",XMDUZ,XMZ)=""
. . I XMDUZ'=DUZ,'$$SURRACC^XMXSEC(XMDUZ,"",XMZ,$G(XMB(3.9,XMZ,0))) D Q
. . . D ZSHOW^XMJERR
. . . D WAIT^XMXUTIL
. . . D NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
. . . S ^XTMP("XM","MAKENEW",XMDUZ,XMZ)=""
. . D READNEW(XMDUZ,XMK,XMKN,XMZ,.XMABORT)
. Q:XMABORT
. S:$D(^XMB(3.7,XMDUZ,"N0")) XMKMULT=1
. Q:$G(XMSCAN)!'XMKMULT
. W !!,$$EZBLD^DIALOG($S(XMTYPE="N0":34098,1:34099),XMKN) ; Done with new/priority mail in your '|1|' Basket.
. W:$D(^XMB(3.7,XMDUZ,"N0")) !!
K ^TMP("XM",$J,"APX")
Q
READNEW(XMDUZ,XMK,XMKN,XMZ,XMABORT) ;
N XMSECURE,XMPAKMAN,XMSECBAD ; Important 'new' - part of scramble and packman handling
I '$D(^XMB(3.9,XMZ,0)) D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
D DISPMSG^XMJMP(XMDUZ,XMK,XMKN,XMZ,.XMSECBAD) Q:$G(XMSECBAD)
D READMSG^XMJMOI($G(XMNEWS),XMDUZ,XMK,XMKN,XMZ,.XMABORT)
Q
ASKBSKT(XMDUZ,XMNEWMSG,XMK,XMKN,XMABORT) ;
; XMNEWMSG 1=Read new mail; 0=Read any mail
N XMDIC,XMPROMPT
S XMDIC("W")="N XMPARM S XMPARM(2)=$P(^(0),U,2),XMPARM(1)=+$P($G(^(1,0)),U,4) W ?31,$$EZBLD^DIALOG($S(XMPARM(1)'=1:$S('XMPARM(2):34026,XMPARM(2)>1:34027,1:34027.3),XMPARM(2):34027.1,1:34026.1),.XMPARM)" ; (|1| messages, |2| new)
I XMNEWMSG D
. S XMPROMPT=34029 ; Read NEW mail in MAIL BASKET:
. S XMDIC("S")="I $P(^(0),U,2)"
. S XMDIC("B")=$P(^XMB(3.7,XMDUZ,2,XMK,0),U)
E S XMPROMPT=34028 ; Read mail in MAIL BASKET:
D SELBSKT^XMJBU(XMDUZ,XMPROMPT,"",.XMDIC,.XMK,.XMKN)
I XMK=U S XMABORT=1
Q
NPBSKT(XMDUZ) ; Return the first priority read basket that has new messages.
; If none has new messages, return the first priority basket.
N XMDEFALT
S XMDEFALT=$$BNMSGCT^XMXUTIL(XMDUZ,1)_U_1_U_$$EZBLD^DIALOG(37005) ; IN
I '$D(^XMB(3.7,XMDUZ,2,"AP")) Q XMDEFALT
N XMK,XMKN
S XMKN=""
D NXTBSKT^XMJBN1(XMDUZ,"N0",.XMKN,.XMK)
I $D(^TMP("XM",$J,"APX")) K ^TMP("XM",$J,"APX") Q $$BNMSGCT^XMXUTIL(XMDUZ,XMK)_U_XMK_U_XMKN
N XMI
S (XMI,XMK)=0
S XMI=+$O(^XMB(3.7,XMDUZ,2,"AP",XMI))
I 'XMI Q XMDEFALT
F S XMK=$O(^XMB(3.7,XMDUZ,2,"AP",XMI,XMK)) Q:'XMK D
. S XMK($$BSKTNAME^XMXUTIL(XMDUZ,XMK))=XMK
S XMKN=$O(XMK(""))
I XMKN="" Q XMDEFALT
S XMK=XMK(XMKN)
Q "0^"_XMK_U_XMKN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJBN 6124 printed Apr 09, 2024@21:16:08 Page 2
XMJBN ;ISC-SF/GMB-Access new mail in mailbox ;05/18/2004 08:37
+1 ;;8.0;MailMan;**25**;Jun 28, 2002
+2 ; Replaces ^XMA (ISC-WASH/THM/CAP)
+3 ; Entry points used by MailMan options (not covered by DBIA):
+4 ; NEW XMNEW - Read new messages
NEW ;
+1 ; XMNEW Number of new messages
+2 ; XMKMULT 1=New msgs in multiple baskets; 0=new msgs in one basket
+3 NEW XMABORT,XMK,XMKN,XMNEW,XMKMULT,XMNEWS
+4 SET XMABORT=0
+5 DO INIT^XMJBN1(XMDUZ,.XMK,.XMKN,.XMNEW,.XMKMULT,.XMABORT)
if XMABORT
QUIT
+6 ; Makes 'new'd msgs drop off list 'til next time
SET XMNEWS=1
+7 IF XMNEW=1
Begin DoDot:1
+8 NEW XMZ
+9 SET XMZ=$ORDER(^XMB(3.7,XMDUZ,"N0",XMK,""))
+10 IF XMDUZ'=DUZ
IF '$$SURRACC^XMXSEC(XMDUZ,"",XMZ,$GET(XMB(3.9,XMZ,0)))
Begin DoDot:2
+11 DO ZSHOW^XMJERR
+12 DO WAIT^XMXUTIL
End DoDot:2
QUIT
+13 IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
DO ADDITN^XMUT4A(XMDUZ,"N0",XMK,XMZ)
+14 DO READNEW(XMDUZ,XMK,XMKN,XMZ)
+15 if $DATA(^XTMP("XM","MAKENEW",XMDUZ))
DO NEWAGAIN^XMJBN1(XMDUZ)
End DoDot:1
QUIT
+16 FOR
Begin DoDot:1
+17 NEW XMDIR,XMOPT,XMOX,XMY
+18 ; Select New mail option
SET XMDIR("A")=$$EZBLD^DIALOG(34085)
+19 ; Read new mail by basket
DO SET^XMXSEC1("R",34086,.XMOPT,.XMOX)
+20 ; List Baskets with new mail
DO SET^XMXSEC1("LB",34087,.XMOPT,.XMOX)
+21 ; List all new messages
DO SET^XMXSEC1("LN",34088,.XMOPT,.XMOX)
+22 ; List all priority messages
DO SET^XMXSEC1("LP",34089,.XMOPT,.XMOX)
+23 ; You have no new priority messages.
IF '$DATA(^XMB(3.7,XMDUZ,"N"))
SET XMOPT("LP","?")=$$EZBLD^DIALOG(34018)
+24 ; Print all new messages
DO SET^XMXSEC1("P",34090,.XMOPT,.XMOX)
+25 ; Scan all new messages
DO SET^XMXSEC1("S",34091,.XMOPT,.XMOX)
+26 ; Quit
DO SET^XMXSEC1("Q",34092,.XMOPT,.XMOX)
+27 SET XMDIR("B")=XMOX("O",XMV("NEW OPT"))_":"_XMOPT(XMV("NEW OPT"))
+28 SET XMDIR("??")="XM-U-R-READ NEW"
+29 DO XMDIR^XMJDIR(.XMDIR,.XMOPT,.XMOX,.XMY,.XMABORT)
if XMABORT
QUIT
+30 KILL XMOPT,XMOX,XMDIR
+31 DO @XMY
End DoDot:1
if '$DATA(^XMB(3.7,XMDUZ,"N0"))!XMABORT
QUIT
+32 if $DATA(^XTMP("XM","MAKENEW",XMDUZ))
DO NEWAGAIN^XMJBN1(XMDUZ)
+33 QUIT
LB ; List Baskets with new mail (Replaces NEW^XMA0A)
+1 NEW DIC,D,DZ
+2 SET DIC="^XMB(3.7,"_XMDUZ_",2,"
+3 SET DIC(0)="AEQ"
SET D="B"
SET DZ="??"
+4 SET DIC("S")="I $P(^(0),U,2)"
+5 ; (|1| New)
SET DIC("W")="W ?31,$$EZBLD^DIALOG($S($P(^(0),U,2)'=1:34027.2,1:34027.4),$P(^(0),U,2))"
+6 DO DQ^DICQ
+7 QUIT
LN ; List all new messages (Replaces LIST^XMA0A)
+1 DO LISTALL^XMJMLN(XMDUZ,"N0")
+2 QUIT
LP ; List all priority messages (Replaces PRIO^XMA0A)
+1 DO LISTALL^XMJMLN(XMDUZ,"N")
+2 QUIT
P ; Print all new messages
+1 ; Replaces PRINT^XMA0A
+2 NEW XMSAVE,I
+3 FOR I="XMV(","DUZ","XMDUZ","XMKMULT"
SET XMSAVE(I)=""
+4 ; MailMan: Print
DO EN^XUTMDEVQ("PRTNEW^XMJBN",$$EZBLD^DIALOG(34501),.XMSAVE)
+5 QUIT
PRTNEW ; Print all new messages
+1 NEW XMSCAN,XMNEWPRT,XMFIRST
+2 SET (XMSCAN,XMNEWPRT,XMFIRST)=1
+3 DO R
+4 IF $DATA(ZTQUEUED)
IF $DATA(^XTMP("XM","MAKENEW",XMDUZ))
DO NEWAGAIN^XMJBN1(XMDUZ)
+5 QUIT
Q ; Quit
+1 SET XMABORT=1
+2 QUIT
S ; Scan all new messages
+1 NEW XMSCAN
+2 SET XMSCAN=1
+3 DO R
+4 QUIT
R ; Read new mail by basket, priority first.
+1 NEW XMTYPE,XMK,XMKN,XMZ,XMIA,XMKPRI
+2 ; (required when printing new messages)
SET XMABORT=0
+3 SET XMIA='$DATA(ZTQUEUED)
+4 SET XMKPRI=0
SET (XMKN,XMKPRI("XMKN"))=""
KILL ^TMP("XM",$JOB,"APX")
+5 FOR
Begin DoDot:1
+6 SET XMTYPE=$SELECT($DATA(^XMB(3.7,XMDUZ,"N")):"N",$DATA(^XMB(3.7,XMDUZ,"N0")):"N0",1:"")
+7 ; You have no new messages.
IF XMTYPE=""
SET XMABORT=1
if '$DATA(ZTQUEUED)
WRITE !,$$EZBLD^DIALOG(34017)
QUIT
+8 IF 'XMKMULT
Begin DoDot:2
+9 SET XMK=$ORDER(^XMB(3.7,XMDUZ,XMTYPE,0))
+10 SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U)
End DoDot:2
+11 IF '$TEST
Begin DoDot:2
+12 DO NXTBSKT^XMJBN1(XMDUZ,XMTYPE,.XMKN,.XMK,.XMKPRI)
IF 'XMK
SET XMABORT=1
QUIT
+13 if $GET(XMSCAN)
QUIT
+14 DO ASKBSKT(XMDUZ,1,.XMK,.XMKN,.XMABORT)
if XMABORT
QUIT
+15 IF XMTYPE="N"
IF '$DATA(^XMB(3.7,XMDUZ,XMTYPE,XMK))
SET XMTYPE="N0"
End DoDot:2
if XMABORT
QUIT
+16 SET XMZ=""
+17 FOR
SET XMZ=$ORDER(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMV("NEW ORDER"))
if XMZ=""
QUIT
Begin DoDot:2
+18 IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
DO ADDITN^XMUT4A(XMDUZ,XMTYPE,XMK,XMZ)
+19 IF $GET(XMNEWPRT)
Begin DoDot:3
+20 DO PRTMULT^XMJMP(XMDUZ,XMK,XMKN,XMZ,0,1,.XMFIRST,"",.XMABORT)
+21 IF XMDUZ'=DUZ
IF $$SURRCONF^XMXSEC(XMDUZ,XMZ)
Begin DoDot:4
+22 DO NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
+23 SET ^XTMP("XM","MAKENEW",XMDUZ,XMZ)=""
End DoDot:4
QUIT
End DoDot:3
QUIT
+24 IF XMDUZ'=DUZ
IF '$$SURRACC^XMXSEC(XMDUZ,"",XMZ,$GET(XMB(3.9,XMZ,0)))
Begin DoDot:3
+25 DO ZSHOW^XMJERR
+26 DO WAIT^XMXUTIL
+27 DO NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
+28 SET ^XTMP("XM","MAKENEW",XMDUZ,XMZ)=""
End DoDot:3
QUIT
+29 DO READNEW(XMDUZ,XMK,XMKN,XMZ,.XMABORT)
End DoDot:2
if XMABORT
QUIT
+30 if XMABORT
QUIT
+31 if $DATA(^XMB(3.7,XMDUZ,"N0"))
SET XMKMULT=1
+32 if $GET(XMSCAN)!'XMKMULT
QUIT
+33 ; Done with new/priority mail in your '|1|' Basket.
WRITE !!,$$EZBLD^DIALOG($SELECT(XMTYPE="N0":34098,1:34099),XMKN)
+34 if $DATA(^XMB(3.7,XMDUZ,"N0"))
WRITE !!
End DoDot:1
if '$DATA(^XMB(3.7,XMDUZ,"N0"))!XMABORT
QUIT
+35 KILL ^TMP("XM",$JOB,"APX")
+36 QUIT
READNEW(XMDUZ,XMK,XMKN,XMZ,XMABORT) ;
+1 ; Important 'new' - part of scramble and packman handling
NEW XMSECURE,XMPAKMAN,XMSECBAD
+2 IF '$DATA(^XMB(3.9,XMZ,0))
DO ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
QUIT
+3 DO DISPMSG^XMJMP(XMDUZ,XMK,XMKN,XMZ,.XMSECBAD)
if $GET(XMSECBAD)
QUIT
+4 DO READMSG^XMJMOI($GET(XMNEWS),XMDUZ,XMK,XMKN,XMZ,.XMABORT)
+5 QUIT
ASKBSKT(XMDUZ,XMNEWMSG,XMK,XMKN,XMABORT) ;
+1 ; XMNEWMSG 1=Read new mail; 0=Read any mail
+2 NEW XMDIC,XMPROMPT
+3 ; (|1| messages, |2| new)
SET XMDIC("W")="N XMPARM S XMPARM(2)=$P(^(0),U,2),XMPARM(1)=+$P($G(^(1,0)),U,4) W ?31,$$EZBLD^DIALOG($S(XMPARM(1)'=1:$S('XMPARM(2):34026,XMPARM(2)>1:34027,1:34027.3),XMPARM(2):34027.1,1:34026.1),.XMPARM)"
+4 IF XMNEWMSG
Begin DoDot:1
+5 ; Read NEW mail in MAIL BASKET:
SET XMPROMPT=34029
+6 SET XMDIC("S")="I $P(^(0),U,2)"
+7 SET XMDIC("B")=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U)
End DoDot:1
+8 ; Read mail in MAIL BASKET:
IF '$TEST
SET XMPROMPT=34028
+9 DO SELBSKT^XMJBU(XMDUZ,XMPROMPT,"",.XMDIC,.XMK,.XMKN)
+10 IF XMK=U
SET XMABORT=1
+11 QUIT
NPBSKT(XMDUZ) ; Return the first priority read basket that has new messages.
+1 ; If none has new messages, return the first priority basket.
+2 NEW XMDEFALT
+3 ; IN
SET XMDEFALT=$$BNMSGCT^XMXUTIL(XMDUZ,1)_U_1_U_$$EZBLD^DIALOG(37005)
+4 IF '$DATA(^XMB(3.7,XMDUZ,2,"AP"))
QUIT XMDEFALT
+5 NEW XMK,XMKN
+6 SET XMKN=""
+7 DO NXTBSKT^XMJBN1(XMDUZ,"N0",.XMKN,.XMK)
+8 IF $DATA(^TMP("XM",$JOB,"APX"))
KILL ^TMP("XM",$JOB,"APX")
QUIT $$BNMSGCT^XMXUTIL(XMDUZ,XMK)_U_XMK_U_XMKN
+9 NEW XMI
+10 SET (XMI,XMK)=0
+11 SET XMI=+$ORDER(^XMB(3.7,XMDUZ,2,"AP",XMI))
+12 IF 'XMI
QUIT XMDEFALT
+13 FOR
SET XMK=$ORDER(^XMB(3.7,XMDUZ,2,"AP",XMI,XMK))
if 'XMK
QUIT
Begin DoDot:1
+14 SET XMK($$BSKTNAME^XMXUTIL(XMDUZ,XMK))=XMK
End DoDot:1
+15 SET XMKN=$ORDER(XMK(""))
+16 IF XMKN=""
QUIT XMDEFALT
+17 SET XMK=XMK(XMKN)
+18 QUIT "0^"_XMK_U_XMKN
