XMJMS ;ISC-SF/GMB-Interactive Send ;08/24/2001 12:02
;;8.0;MailMan;;Jun 28, 2002
; Replaces ^XMA2,^XMA20 (ISC-WASH/CAP/THM)
; Entry points used by MailMan options (not covered by DBIA):
; PAKMAN XMPACK - Load PackMan message
; SEND XMSEND - Send a message
; *** BLOB^XMA2B (Imaging package) calls entry BLOB
SEND ;
N XMSUBJ,XMZ,XMABORT
S XMABORT=0
D INIT(XMDUZ,.XMABORT) Q:XMABORT
D SUBJ(.XMSUBJ,.XMABORT) Q:XMABORT
D CRE8XMZ^XMXSEND(XMSUBJ,.XMZ,1) I XMZ<1 S XMABORT=1 Q
D:'$G(XMPAKMAN) EDITON(XMDUZ,XMZ,"",.XMBLOB)
D PROCESS(XMDUZ,XMZ,XMSUBJ,.XMABORT)
D:XMABORT=DTIME HALT($$EZBLD^DIALOG(34260)) ; sending
D:'$G(XMPAKMAN) EDITOFF(XMDUZ)
D:XMABORT KILLMSG^XMXUTIL(XMZ)
Q
PAKMAN ;
N XMPAKMAN,XMLOAD,X,XMR
S (XMPAKMAN,XMLOAD)=1
D SEND
Q
BLOB ;
N XMBLOB,XMOUT
S XMBLOB=1
D SEND
Q
INIT(XMDUZ,XMABORT) ; Clean up and initialize for Sending a message
D CHECK^XMVVITAE
I XMDUZ'=DUZ,'$$WPRIV^XMXSEC D Q ; Replaces SUR^XMA22
. S XMABORT=1
. D SHOW^XMJERR
D CHKLOCK(XMDUZ,.XMABORT)
Q
CHKLOCK(XMDUZ,XMABORT) ;
; FYI, The menu system releases all locks upon exit from an option.
I $G(XMV("PRIV"),"W")["W" S XMV("NOSEND")=0
I 'XMV("NOSEND") D
. L +^XMB(3.7,"AD",XMDUZ):0 E S XMV("NOSEND")=1
I XMV("NOSEND") D Q ; Replaces TWO^XMA1E
. W !,$$EZBLD^DIALOG(37453) ; This session is concurrent with another. You may not do this.
. S XMABORT=1
Q
PROCESS(XMDUZ,XMZ,XMSUBJ,XMABORT) ;
N XMINSTR,XMRESTR
I '$G(XMPAKMAN) D BODY(XMDUZ,XMZ,XMSUBJ,.XMRESTR,.XMABORT) Q:XMABORT
I $G(XMBLOB) D ADD^XMA2B K XMBLOB I $D(XMOUT) S XMABORT=1 Q
I $G(XMPAKMAN) D PACKIT(XMDUZ,XMZ,XMSUBJ,.XMABORT) Q:XMABORT
D INIT^XMXADDR
D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34110),.XMINSTR,.XMRESTR,.XMABORT) ; Send
I $G(XMPAKMAN),'XMABORT D PSECURE^XMPSEC(XMZ,.XMABORT)
D:'XMABORT SENDMSG^XMJMSO(XMDUZ,XMZ,XMSUBJ,.XMINSTR,.XMRESTR,.XMABORT)
D CLEANUP^XMXADDR
Q
SUBJ(XMSUBJ,XMABORT) ; ask subject
N DIR,X,Y,XMY
S DIR("A")=$$EZBLD^DIALOG(34002) ; Subject:
S DIR(0)="FOU^3:65"
S:$D(XMSUBJ) DIR("B")=XMSUBJ
S DIR("?")=$$EZBLD^DIALOG(39403) ; Subject must be from 3 to 65 characters long.
S DIR("??")="^D QSUBJ^XMJMS"
F D Q:XMY'=""!XMABORT
. W !
. D ^DIR S XMY=Y
. I $D(DTOUT)!$D(DUOUT) S XMABORT=1 Q
. D VSUBJ^XMXPARM(.XMY)
. I $D(XMERR) D SHOW^XMJERR S XMY=""
Q:XMABORT
S XMSUBJ=$S(XMY[U:$$ENCODEUP^XMXUTIL1(XMY),1:XMY)
Q
QSUBJ ;
;This is the subject of the message, shown whenever the message is displayed.
;Leading and trailing blanks are deleted.
;Any sequence of 3 or more blanks is reduced to 2 blanks.
N XMTEXT
D BLD^DIALOG(34261,"","","XMTEXT","F")
D MSG^DIALOG("WH","",79,"","XMTEXT")
Q:$D(XMSUBJ)
W !!,$$EZBLD^DIALOG(34262) ; If you want to send a message with no subject, just press ENTER.
Q
BODY(XMDUZ,XMZ,DIWESUB,XMRESTR,XMABORT) ; Replaces ENT1^XMA2
N DIC
;W !,"You may ",$S($D(^XMB(3.9,XMZ,2,0)):"edit",1:"enter")," the ",$S($G(XMPAKMAN):"description of the PackMan",1:"text of the")," message..."
W !,$$EZBLD^DIALOG($S($D(^XMB(3.9,XMZ,2,0)):34263.1,1:34263)) ; You may edit/enter the text of the message...
S DWPK=1,DWLW=75,DIC="^XMB(3.9,"_XMZ_",2,"
D EN^DIWE
; The following $D check is to recover from situations in which a user
; is in the middle of replying to a message, then opens a 2nd session,
; and somehow the reply message stub gets deleted in the 2nd session,
; and when the user returns to the 1st session and sends the reply, it
; says the reply is from * No Name *. A lock on ^XMB(3.7,"AD",XMDUZ)
; is supposed to prevent the second session from doing this, but for
; some reason, at some sites, the second session does not see the lock.
; So we recreate the message stub here, in the 1st session, if it was
; deleted in the 2nd session.
I '$D(^XMB(3.9,XMZ,0)) D
. N XMSUBJ
. S XMSUBJ=$S($D(XMRESTR("REPLYTO")):"R"_XMRESTR("REPLYTO"),1:DIWESUB)
. S ^XMB(3.9,XMZ,0)=XMSUBJ
. S ^XMB(3.9,"B",$E(XMSUBJ,1,30),XMZ)=""
. I '$D(^XMB(3.9,XMZ,.6)) S ^XMB(3.9,XMZ,.6)=DT,^XMB(3.9,"C",DT,XMZ)=""
I '$O(^XMB(3.9,XMZ,2,0)) S XMABORT=1 Q
D CHKLINES^XMXSEC1(XMDUZ,XMZ,.XMRESTR)
Q
PACKIT(XMDUZ,XMZ,XMSUBJ,XMABORT) ;
N XCF,XCN,XMA,XMB0,XMP2,X,Y
D ^XMP
I X=U,Y=-1 S XMABORT=1
Q
EDITON(XMDUZ,XMZ,XMZR,XMBLOB) ; Note that msg is being edited. Replaces D^XMA0A
N XMFDA,XMIENS
S XMIENS=XMDUZ_","
S XMFDA(3.7,XMIENS,5)=XMZ ; current message/response
S XMFDA(3.7,XMIENS,7)=$G(XMZR) ; original message for response
S XMFDA(3.7,XMIENS,7.5)=$G(XMBLOB) ; 0/1=BLOB yes/no
D FILE^DIE("","XMFDA")
Q
EDITOFF(XMDUZ) ; Note that msg is no longer being edited.
N XMFDA,XMIENS
S XMIENS=XMDUZ_","
S XMFDA(3.7,XMIENS,5)="@"
S XMFDA(3.7,XMIENS,7)="@"
S XMFDA(3.7,XMIENS,7.5)="@"
D FILE^DIE("","XMFDA")
Q
HALT(XMACTION) ;
W $C(7),!
;You have timed out while _XMACTION_ a message.
;You can resume when you log back on and re-enter MailMan.
;Do it today, or your text may be purged this evening.
N XMTEXT
D BLD^DIALOG(34264,XMACTION,"","XMTEXT","F")
D MSG^DIALOG("WM","",79,"","XMTEXT")
G H^XUS
RECOVER(XMDUZ,XMZ,XMBLOB) ;
N XMTEXT,XMSUBJ,XMABORT
S XMABORT=0
W $C(7),!
;You have / |1| has an unsent message in your buffer.
D BLD^DIALOG($S(XMDUZ=DUZ:34265,1:34265.1),XMV("NAME"),"","XMTEXT","F")
I $G(XMV("PRIV"),"W")'["W" D Q
. ;Since you don't have 'send' privilege, you may not complete this
. ;message. If we delete this message, you'll be able to read and
. ;reply to messages in this mailbox. If we leave it alone, you'll
. ;be able to read messages, but you won't be able to reply to them.
. D BLD^DIALOG(34267,"","","XMTEXT","F")
. D MSG^DIALOG("WM","",79,"","XMTEXT")
. W !
. N DIR,X,Y
. S DIR(0)="Y"
. S DIR("A")=$$EZBLD^DIALOG(34267.1) ; Shall we delete the message?
. S DIR("B")=$$EZBLD^DIALOG(39054) ; YES
. D ^DIR
. I $D(DTOUT) D HALT($$EZBLD^DIALOG(34221)) ; recovering
. I Y D Q
. . D EDITOFF(XMDUZ)
. . D KILLMSG^XMXUTIL(XMZ)
. S XMV("NOSEND")=1
. W !
. ;OK, you'll be able to read messages,
. ;but you won't be able to reply to them.
. D BLD^DIALOG(34267.2,"","","XMTEXT","F")
. D MSG^DIALOG("WM","",79,"","XMTEXT")
S XMSUBJ=$P(^XMB(3.9,XMZ,0),U,1)
S:XMSUBJ["~U~" XMSUBJ=$$DECODEUP^XMXUTIL1(XMSUBJ)
;Subj: _XMSUBJ
D BLD^DIALOG(34536,XMSUBJ,"","XMTEXT","FS")
;Some of the text may have been lost.
;You must re-enter recipients and any special handling instructions.
D BLD^DIALOG(34266,"","","XMTEXT","FS")
D MSG^DIALOG("WM","",79,"","XMTEXT")
W !
D INIT(XMDUZ,.XMABORT) Q:XMV("NOSEND")
D WAIT^XMXUTIL
I XMABORT D HALT($$EZBLD^DIALOG(34221)) ; recovering
D PROCESS(XMDUZ,XMZ,XMSUBJ,.XMABORT)
I XMABORT=DTIME D HALT($$EZBLD^DIALOG(34260)) ; sending
D EDITOFF(XMDUZ)
D:XMABORT KILLMSG^XMXUTIL(XMZ)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJMS 6828 printed Dec 13, 2024@02:12:19 Page 2
XMJMS ;ISC-SF/GMB-Interactive Send ;08/24/2001 12:02
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Replaces ^XMA2,^XMA20 (ISC-WASH/CAP/THM)
+3 ; Entry points used by MailMan options (not covered by DBIA):
+4 ; PAKMAN XMPACK - Load PackMan message
+5 ; SEND XMSEND - Send a message
+6 ; *** BLOB^XMA2B (Imaging package) calls entry BLOB
SEND ;
+1 NEW XMSUBJ,XMZ,XMABORT
+2 SET XMABORT=0
+3 DO INIT(XMDUZ,.XMABORT)
if XMABORT
QUIT
+4 DO SUBJ(.XMSUBJ,.XMABORT)
if XMABORT
QUIT
+5 DO CRE8XMZ^XMXSEND(XMSUBJ,.XMZ,1)
IF XMZ<1
SET XMABORT=1
QUIT
+6 if '$GET(XMPAKMAN)
DO EDITON(XMDUZ,XMZ,"",.XMBLOB)
+7 DO PROCESS(XMDUZ,XMZ,XMSUBJ,.XMABORT)
+8 ; sending
if XMABORT=DTIME
DO HALT($$EZBLD^DIALOG(34260))
+9 if '$GET(XMPAKMAN)
DO EDITOFF(XMDUZ)
+10 if XMABORT
DO KILLMSG^XMXUTIL(XMZ)
+11 QUIT
PAKMAN ;
+1 NEW XMPAKMAN,XMLOAD,X,XMR
+2 SET (XMPAKMAN,XMLOAD)=1
+3 DO SEND
+4 QUIT
BLOB ;
+1 NEW XMBLOB,XMOUT
+2 SET XMBLOB=1
+3 DO SEND
+4 QUIT
INIT(XMDUZ,XMABORT) ; Clean up and initialize for Sending a message
+1 DO CHECK^XMVVITAE
+2 ; Replaces SUR^XMA22
IF XMDUZ'=DUZ
IF '$$WPRIV^XMXSEC
Begin DoDot:1
+3 SET XMABORT=1
+4 DO SHOW^XMJERR
End DoDot:1
QUIT
+5 DO CHKLOCK(XMDUZ,.XMABORT)
+6 QUIT
CHKLOCK(XMDUZ,XMABORT) ;
+1 ; FYI, The menu system releases all locks upon exit from an option.
+2 IF $GET(XMV("PRIV"),"W")["W"
SET XMV("NOSEND")=0
+3 IF 'XMV("NOSEND")
Begin DoDot:1
+4 LOCK +^XMB(3.7,"AD",XMDUZ):0
IF '$TEST
SET XMV("NOSEND")=1
End DoDot:1
+5 ; Replaces TWO^XMA1E
IF XMV("NOSEND")
Begin DoDot:1
+6 ; This session is concurrent with another. You may not do this.
WRITE !,$$EZBLD^DIALOG(37453)
+7 SET XMABORT=1
End DoDot:1
QUIT
+8 QUIT
PROCESS(XMDUZ,XMZ,XMSUBJ,XMABORT) ;
+1 NEW XMINSTR,XMRESTR
+2 IF '$GET(XMPAKMAN)
DO BODY(XMDUZ,XMZ,XMSUBJ,.XMRESTR,.XMABORT)
if XMABORT
QUIT
+3 IF $GET(XMBLOB)
DO ADD^XMA2B
KILL XMBLOB
IF $DATA(XMOUT)
SET XMABORT=1
QUIT
+4 IF $GET(XMPAKMAN)
DO PACKIT(XMDUZ,XMZ,XMSUBJ,.XMABORT)
if XMABORT
QUIT
+5 DO INIT^XMXADDR
+6 ; Send
DO TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34110),.XMINSTR,.XMRESTR,.XMABORT)
+7 IF $GET(XMPAKMAN)
IF 'XMABORT
DO PSECURE^XMPSEC(XMZ,.XMABORT)
+8 if 'XMABORT
DO SENDMSG^XMJMSO(XMDUZ,XMZ,XMSUBJ,.XMINSTR,.XMRESTR,.XMABORT)
+9 DO CLEANUP^XMXADDR
+10 QUIT
SUBJ(XMSUBJ,XMABORT) ; ask subject
+1 NEW DIR,X,Y,XMY
+2 ; Subject:
SET DIR("A")=$$EZBLD^DIALOG(34002)
+3 SET DIR(0)="FOU^3:65"
+4 if $DATA(XMSUBJ)
SET DIR("B")=XMSUBJ
+5 ; Subject must be from 3 to 65 characters long.
SET DIR("?")=$$EZBLD^DIALOG(39403)
+6 SET DIR("??")="^D QSUBJ^XMJMS"
+7 FOR
Begin DoDot:1
+8 WRITE !
+9 DO ^DIR
SET XMY=Y
+10 IF $DATA(DTOUT)!$DATA(DUOUT)
SET XMABORT=1
QUIT
+11 DO VSUBJ^XMXPARM(.XMY)
+12 IF $DATA(XMERR)
DO SHOW^XMJERR
SET XMY=""
End DoDot:1
if XMY'=""!XMABORT
QUIT
+13 if XMABORT
QUIT
+14 SET XMSUBJ=$SELECT(XMY[U:$$ENCODEUP^XMXUTIL1(XMY),1:XMY)
+15 QUIT
QSUBJ ;
+1 ;This is the subject of the message, shown whenever the message is displayed.
+2 ;Leading and trailing blanks are deleted.
+3 ;Any sequence of 3 or more blanks is reduced to 2 blanks.
+4 NEW XMTEXT
+5 DO BLD^DIALOG(34261,"","","XMTEXT","F")
+6 DO MSG^DIALOG("WH","",79,"","XMTEXT")
+7 if $DATA(XMSUBJ)
QUIT
+8 ; If you want to send a message with no subject, just press ENTER.
WRITE !!,$$EZBLD^DIALOG(34262)
+9 QUIT
BODY(XMDUZ,XMZ,DIWESUB,XMRESTR,XMABORT) ; Replaces ENT1^XMA2
+1 NEW DIC
+2 ;W !,"You may ",$S($D(^XMB(3.9,XMZ,2,0)):"edit",1:"enter")," the ",$S($G(XMPAKMAN):"description of the PackMan",1:"text of the")," message..."
+3 ; You may edit/enter the text of the message...
WRITE !,$$EZBLD^DIALOG($SELECT($DATA(^XMB(3.9,XMZ,2,0)):34263.1,1:34263))
+4 SET DWPK=1
SET DWLW=75
SET DIC="^XMB(3.9,"_XMZ_",2,"
+5 DO EN^DIWE
+6 ; The following $D check is to recover from situations in which a user
+7 ; is in the middle of replying to a message, then opens a 2nd session,
+8 ; and somehow the reply message stub gets deleted in the 2nd session,
+9 ; and when the user returns to the 1st session and sends the reply, it
+10 ; says the reply is from * No Name *. A lock on ^XMB(3.7,"AD",XMDUZ)
+11 ; is supposed to prevent the second session from doing this, but for
+12 ; some reason, at some sites, the second session does not see the lock.
+13 ; So we recreate the message stub here, in the 1st session, if it was
+14 ; deleted in the 2nd session.
+15 IF '$DATA(^XMB(3.9,XMZ,0))
Begin DoDot:1
+16 NEW XMSUBJ
+17 SET XMSUBJ=$SELECT($DATA(XMRESTR("REPLYTO")):"R"_XMRESTR("REPLYTO"),1:DIWESUB)
+18 SET ^XMB(3.9,XMZ,0)=XMSUBJ
+19 SET ^XMB(3.9,"B",$EXTRACT(XMSUBJ,1,30),XMZ)=""
+20 IF '$DATA(^XMB(3.9,XMZ,.6))
SET ^XMB(3.9,XMZ,.6)=DT
SET ^XMB(3.9,"C",DT,XMZ)=""
End DoDot:1
+21 IF '$ORDER(^XMB(3.9,XMZ,2,0))
SET XMABORT=1
QUIT
+22 DO CHKLINES^XMXSEC1(XMDUZ,XMZ,.XMRESTR)
+23 QUIT
PACKIT(XMDUZ,XMZ,XMSUBJ,XMABORT) ;
+1 NEW XCF,XCN,XMA,XMB0,XMP2,X,Y
+2 DO ^XMP
+3 IF X=U
IF Y=-1
SET XMABORT=1
+4 QUIT
EDITON(XMDUZ,XMZ,XMZR,XMBLOB) ; Note that msg is being edited. Replaces D^XMA0A
+1 NEW XMFDA,XMIENS
+2 SET XMIENS=XMDUZ_","
+3 ; current message/response
SET XMFDA(3.7,XMIENS,5)=XMZ
+4 ; original message for response
SET XMFDA(3.7,XMIENS,7)=$GET(XMZR)
+5 ; 0/1=BLOB yes/no
SET XMFDA(3.7,XMIENS,7.5)=$GET(XMBLOB)
+6 DO FILE^DIE("","XMFDA")
+7 QUIT
EDITOFF(XMDUZ) ; Note that msg is no longer being edited.
+1 NEW XMFDA,XMIENS
+2 SET XMIENS=XMDUZ_","
+3 SET XMFDA(3.7,XMIENS,5)="@"
+4 SET XMFDA(3.7,XMIENS,7)="@"
+5 SET XMFDA(3.7,XMIENS,7.5)="@"
+6 DO FILE^DIE("","XMFDA")
+7 QUIT
HALT(XMACTION) ;
+1 WRITE $CHAR(7),!
+2 ;You have timed out while _XMACTION_ a message.
+3 ;You can resume when you log back on and re-enter MailMan.
+4 ;Do it today, or your text may be purged this evening.
+5 NEW XMTEXT
+6 DO BLD^DIALOG(34264,XMACTION,"","XMTEXT","F")
+7 DO MSG^DIALOG("WM","",79,"","XMTEXT")
+8 GOTO H^XUS
RECOVER(XMDUZ,XMZ,XMBLOB) ;
+1 NEW XMTEXT,XMSUBJ,XMABORT
+2 SET XMABORT=0
+3 WRITE $CHAR(7),!
+4 ;You have / |1| has an unsent message in your buffer.
+5 DO BLD^DIALOG($SELECT(XMDUZ=DUZ:34265,1:34265.1),XMV("NAME"),"","XMTEXT","F")
+6 IF $GET(XMV("PRIV"),"W")'["W"
Begin DoDot:1
+7 ;Since you don't have 'send' privilege, you may not complete this
+8 ;message. If we delete this message, you'll be able to read and
+9 ;reply to messages in this mailbox. If we leave it alone, you'll
+10 ;be able to read messages, but you won't be able to reply to them.
+11 DO BLD^DIALOG(34267,"","","XMTEXT","F")
+12 DO MSG^DIALOG("WM","",79,"","XMTEXT")
+13 WRITE !
+14 NEW DIR,X,Y
+15 SET DIR(0)="Y"
+16 ; Shall we delete the message?
SET DIR("A")=$$EZBLD^DIALOG(34267.1)
+17 ; YES
SET DIR("B")=$$EZBLD^DIALOG(39054)
+18 DO ^DIR
+19 ; recovering
IF $DATA(DTOUT)
DO HALT($$EZBLD^DIALOG(34221))
+20 IF Y
Begin DoDot:2
+21 DO EDITOFF(XMDUZ)
+22 DO KILLMSG^XMXUTIL(XMZ)
End DoDot:2
QUIT
+23 SET XMV("NOSEND")=1
+24 WRITE !
+25 ;OK, you'll be able to read messages,
+26 ;but you won't be able to reply to them.
+27 DO BLD^DIALOG(34267.2,"","","XMTEXT","F")
+28 DO MSG^DIALOG("WM","",79,"","XMTEXT")
End DoDot:1
QUIT
+29 SET XMSUBJ=$PIECE(^XMB(3.9,XMZ,0),U,1)
+30 if XMSUBJ["~U~"
SET XMSUBJ=$$DECODEUP^XMXUTIL1(XMSUBJ)
+31 ;Subj: _XMSUBJ
+32 DO BLD^DIALOG(34536,XMSUBJ,"","XMTEXT","FS")
+33 ;Some of the text may have been lost.
+34 ;You must re-enter recipients and any special handling instructions.
+35 DO BLD^DIALOG(34266,"","","XMTEXT","FS")
+36 DO MSG^DIALOG("WM","",79,"","XMTEXT")
+37 WRITE !
+38 DO INIT(XMDUZ,.XMABORT)
if XMV("NOSEND")
QUIT
+39 DO WAIT^XMXUTIL
+40 ; recovering
IF XMABORT
DO HALT($$EZBLD^DIALOG(34221))
+41 DO PROCESS(XMDUZ,XMZ,XMSUBJ,.XMABORT)
+42 ; sending
IF XMABORT=DTIME
DO HALT($$EZBLD^DIALOG(34260))
+43 DO EDITOFF(XMDUZ)
+44 if XMABORT
DO KILLMSG^XMXUTIL(XMZ)
+45 QUIT
