source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMJMSA.m@ 632

Last change on this file since 632 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1XMJMSA ;ISC-SF/GMB-Send Anonymous User Suggestion Message ;04/17/2002 10:12
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Replaces ^XMANON (ISC-WASH/CAP)
4 ; Entry points used by MailMan options (not covered by DBIA):
5 ; SEND XMSUGGESTION
6 ; This routine allows a user to send an anonymous message to the
7 ; SUGGESTION BOX basket of SHARED,MAIL. If this basket doesn't exist,
8 ; it will be created.
9 ;
10 ; MailMan masks (does not record) the actual identity of the sender.
11 ;
12 ; To use it, put the XMSUGGESTION option onto the appropriate menu.
13 ; To stop a particular person from using it, put a 'Reverse/negative
14 ; Lock' onto the XMSUGGESTION option and assign that key to the
15 ; person you do not want to be able to use it.
16SEND ;
17 N XMSUBJ,XMABORT,XMFINISH,XMDIR,XMY,XMOPT,XMOX
18 D SET^XMXSEC2("ES",37305,.XMOPT,.XMOX) ; Edit Subject
19 D SET^XMXSEC2("ET",37306,.XMOPT,.XMOX) ; Edit Text
20 D SET^XMXSEC2("T",37334,.XMOPT,.XMOX) ; Transmit now
21 S XMDIR("A")=$$EZBLD^DIALOG(34067) ; Select Message option:
22 S XMDIR("B")=XMOX("O","T")_":"_XMOPT("T") ; Transmit now
23 S XMDIR("??")="@" ; no help screen
24 S XMABORT=0
25 ;D WARNING(.XMABORT) Q:XMABORT
26 D ES Q:XMABORT ; Edit the subject
27 K ^TMP("XM",$J)
28 D ET Q:XMABORT ; Edit the text
29 S XMFINISH=0
30 F D Q:XMFINISH!XMABORT
31 . D XMDIR^XMJDIR(.XMDIR,.XMOPT,.XMOX,.XMY,.XMABORT) Q:XMABORT
32 . D @XMY
33 K ^TMP("XM",$J)
34 Q
35ES ;
36 D SUBJ^XMJMS(.XMSUBJ,.XMABORT)
37 Q
38ET ; Edit text
39 N DIC
40 S DWPK=1,DWLW=75,DIC="^TMP(""XM"",$J,"
41 S DIWESUB=XMSUBJ
42 D EN^DIWE
43 I '$O(^TMP("XM",$J,0)) S XMABORT=1 Q
44 Q
45T ; Transmit the message
46 N XMDUZ,DUZ,XMINSTR,XMZ
47 S XMFINISH=1,(XMDUZ,DUZ)=.6
48 S XMINSTR("FROM")=$$EZBLD^DIALOG(34665) ; Anonymous
49 S XMINSTR("SHARE DATE")="3991231"
50 S XMINSTR("SHARE BSKT")=$$EZBLD^DIALOG(34666) ; SUGGESTION BOX
51 D CRE8XMZ^XMXSEND(XMSUBJ,.XMZ,1) Q:XMZ<1
52 W $$EZBLD^DIALOG(34217,XMZ) ; Sending [|1|]...
53 D MOVEBODY^XMXSEND(XMZ,"^TMP(""XM"",$J)")
54 D ADDRNSND^XMXSEND(XMDUZ,XMZ,XMDUZ,.XMINSTR)
55 W !,$$EZBLD^DIALOG(34213) ; Sent
56 Q
57WARNING(XMABORT) ;
58 ; * * * * * ATTENTION * * * * *
59 ; Anonymous messages may or may not be totally anonymous.
60 ; Please check with your local IRM
61 ; to find out if your facility has methods in place to identify you.
62 N XMTEXT
63 W @IOF
64 D BLD^DIALOG(34667,"","","XMTEXT","F")
65 D MSG^DIALOG("WM","",79,"","XMTEXT")
66 W !!
67 D PAGE^XMXUTIL(.XMABORT)
68 Q
Note: See TracBrowser for help on using the repository browser.