source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMGAPI2.m@ 1166

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

initial load of WorldVistAEHR
File size: 3.9 KB
Line 
1XMGAPI2 ;(WASH ISC)/JKL-Get Msg Header Info API ;04/17/2002 08:57
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Entry points (DBIA 1144):
4 ; $$HDR Get message header information
5 ;
6 ;USAGE: S X=$$HDR^XMGAPI2(A,.B,C)
7 ;WHERE: A=message or response #
8 ; .B=array into which data is placed
9 ; C=flag that determines what data is returned as follows:
10 ;Not defined or 0 = returns a function value of 0 if successful, an
11 ; error message if unsuccessful, and a value array:
12 ; L("BROADCAST")= 1 if the message was broadcast; 0 otherwise
13 ; L("BSKT") = basket (of local user)
14 ; L("BSKT IEN") = basket IEN (of local user)
15 ; L("DATE") = origination date
16 ; L("DATE FM") = origination date in FileMan format
17 ; L("LINES") = number of lines in the original message
18 ; L("NEW") = 1 if the message is new; 0 otherwise
19 ; L("PXMZ") = pointer to the original message
20 ; L("SENDER") = sender name
21 ; L("SENDER DUZ") = sender DUZ
22 ; L("SUBJ") = subject
23 ; L("SURROG") = surrogate (DUZ if local user or string if not)
24 ; L("TYPE") = message type(s)
25 ; L("XMZ") = message or response number
26 ;1 = returns function value and value array above, also
27 ; additional value array as follows:
28 ; L("RRED") = responses read
29 ; L("RRCV") = responses received
30 ; L("BLOBCNT") = number of non-textual body parts attached
31 ;91= returns function value, value array as with flag 1,
32 ; and an array of response nodes and values as follows:
33 ; L("RSP",counter)= (pointer to 3.9 file) / array of responses
34 ;92= returns function value, value array as with flag 1,
35 ; and an array of non-textual body parts as follows:
36 ; L("BLOB",counter) = (pointer to 2005 file) array of BLOBS
37 ;93= returns function value, value array as with flag 1,
38 ; response node array, and an array of non-textual body parts.
39HDR(XMZ,L,F) ;Entry for non-MailMan (documented)
40GO N %,%0,D,XMBCAST
41 S %=$G(XMZ) I +%'=%!(%<1) S %="1-Undefined message number" G ERR
42 I XMZ="" S %="1-No message number" G ERR
43 S %0=$G(^XMB(3.9,XMZ,0)) I %0="" S %="1-No such message" G ERR
44 S D=$S($G(XMDUZ):XMDUZ,1:DUZ)
45 I $S(+D'=D:1,D'>0:1,'$D(^XMB(3.7,D,0)):1,1:0) S %="4-Invalid user" G ERR
46 S %=$P(%0,U,8),%=$S(%:%,1:XMZ)
47 S XMBCAST=$S($D(^XMB(3.9,%,1,"C","* (Broadcast to all local users)")):1,$D(^XMB(3.9,%,1,"C","* (Broadcast to all local user")):1,1:0)
48 I $S($P(%0,U,2)=D:0,$D(^XMB(3.9,%,1,"C",D)):0,XMBCAST:0,1:1) S %="2-User is not a sender or recipient." G ERR
49 I $G(F)=""!'$G(F) S F=0 ;Default FLAG
50 N %1,%2,XMK
51 S %1=$$NET^XMRENT(XMZ) ;get message information
52 I %1="" S %="4-Message not defined" G ERR
53 S L("BROADCAST")=XMBCAST
54 S L("XMZ")=XMZ ;set message number into array
55 S L("DATE")=$P(%1,U) ;get origination date
56 S %2=$P(%0,U,3)
57 S L("DATE FM")=$S(%2?7N1".".N:%2,%2?7N:%2,1:$$CONVERT^XMXUTIL1(%2))
58 S:L("DATE FM")<2000000 L("DATE FM")=""
59 S L("SENDER")=$P(%1,U,3) ;get sender
60 S L("SENDER DUZ")=$S($P(%0,U,2):$P(%0,U,2),1:"")
61 S L("PXMZ")=$P(%1,U,7) ;get pointer to original message
62 S L("TYPE")=$P(%1,U,8) ;Message Type(s)
63 ;get number of message lines
64 S L("LINES")=$S($D(^XMB(3.9,XMZ,2,0)):$P(^(0),U,4),1:"")
65 S L("SUBJ")=$P(%1,U,6) ;get subject
66 S L("SURROG")=$P(%1,U,5) ;get surrogate
67 S XMK=$O(^XMB(3.7,"M",XMZ,D,0)) ;get basket
68 I XMK,$D(^XMB(3.7,D,2,XMK,0)) D
69 . S L("BSKT")=$P(^(0),U)
70 . S L("BSKT IEN")=XMK
71 E D
72 . S L("BSKT")=""
73 . S L("BSKT IEN")=""
74 I $G(XMK) S L("NEW")=$S($D(^XMB(3.7,D,"N0",XMK,XMZ)):1,1:0)
75 G Q:F=0
76 ;get responses read/received
77 S L("RRED")="",L("RRCV")="",%1=$O(^XMB(3.9,XMZ,1,"C",D,0))
78 I %1 S L("RRED")=$P(^XMB(3.9,XMZ,1,%1,0),U,2)
79 I $D(^XMB(3.9,XMZ,3,0)) S L("RRCV")=$P(^(0),U,4)
80 S L("BLOBCNT")=0 ;get blob count
81 I $D(^XMB(3.9,XMZ,2005,0)) S L("BLOBCNT")=$P(^(0),U,3)
82 G Q:F=1,BLOB:F=92
83 ;flag=91 - get response numbers and values
84 S %1=0 F S %1=$O(^XMB(3.9,XMZ,3,%1)) Q:'%1 S L("RSP",%1)=^(%1,0)
85 I F=91 G Q
86 ;flag=92 - get nodes and values of non-textual body parts
87BLOB S %1=0 F S %1=$O(^XMB(3.9,XMZ,2005,%1)) Q:'%1 S L("BLOB",%1)=^(%1,0)
88Q Q 0
89ERR Q %
Note: See TracBrowser for help on using the repository browser.