Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMJMS

XMJMS.m

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