XMGAPI2 ;(WASH ISC)/JKL-Get Msg Header Info API ;04/17/2002 08:57
;;8.0;MailMan;;Jun 28, 2002
; Entry points (DBIA 1144):
; $$HDR Get message header information
;
;USAGE: S X=$$HDR^XMGAPI2(A,.B,C)
;WHERE: A=message or response #
; .B=array into which data is placed
; C=flag that determines what data is returned as follows:
;Not defined or 0 = returns a function value of 0 if successful, an
; error message if unsuccessful, and a value array:
; L("BROADCAST")= 1 if the message was broadcast; 0 otherwise
; L("BSKT") = basket (of local user)
; L("BSKT IEN") = basket IEN (of local user)
; L("DATE") = origination date
; L("DATE FM") = origination date in FileMan format
; L("LINES") = number of lines in the original message
; L("NEW") = 1 if the message is new; 0 otherwise
; L("PXMZ") = pointer to the original message
; L("SENDER") = sender name
; L("SENDER DUZ") = sender DUZ
; L("SUBJ") = subject
; L("SURROG") = surrogate (DUZ if local user or string if not)
; L("TYPE") = message type(s)
; L("XMZ") = message or response number
;1 = returns function value and value array above, also
; additional value array as follows:
; L("RRED") = responses read
; L("RRCV") = responses received
; L("BLOBCNT") = number of non-textual body parts attached
;91= returns function value, value array as with flag 1,
; and an array of response nodes and values as follows:
; L("RSP",counter)= (pointer to 3.9 file) / array of responses
;92= returns function value, value array as with flag 1,
; and an array of non-textual body parts as follows:
; L("BLOB",counter) = (pointer to 2005 file) array of BLOBS
;93= returns function value, value array as with flag 1,
; response node array, and an array of non-textual body parts.
HDR(XMZ,L,F) ;Entry for non-MailMan (documented)
GO N %,%0,D,XMBCAST
S %=$G(XMZ) I +%'=%!(%<1) S %="1-Undefined message number" G ERR
I XMZ="" S %="1-No message number" G ERR
S %0=$G(^XMB(3.9,XMZ,0)) I %0="" S %="1-No such message" G ERR
S D=$S($G(XMDUZ):XMDUZ,1:DUZ)
I $S(+D'=D:1,D'>0:1,'$D(^XMB(3.7,D,0)):1,1:0) S %="4-Invalid user" G ERR
S %=$P(%0,U,8),%=$S(%:%,1:XMZ)
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)
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
I $G(F)=""!'$G(F) S F=0 ;Default FLAG
N %1,%2,XMK
S %1=$$NET^XMRENT(XMZ) ;get message information
I %1="" S %="4-Message not defined" G ERR
S L("BROADCAST")=XMBCAST
S L("XMZ")=XMZ ;set message number into array
S L("DATE")=$P(%1,U) ;get origination date
S %2=$P(%0,U,3)
S L("DATE FM")=$S(%2?7N1".".N:%2,%2?7N:%2,1:$$CONVERT^XMXUTIL1(%2))
S:L("DATE FM")<2000000 L("DATE FM")=""
S L("SENDER")=$P(%1,U,3) ;get sender
S L("SENDER DUZ")=$S($P(%0,U,2):$P(%0,U,2),1:"")
S L("PXMZ")=$P(%1,U,7) ;get pointer to original message
S L("TYPE")=$P(%1,U,8) ;Message Type(s)
;get number of message lines
S L("LINES")=$S($D(^XMB(3.9,XMZ,2,0)):$P(^(0),U,4),1:"")
S L("SUBJ")=$P(%1,U,6) ;get subject
S L("SURROG")=$P(%1,U,5) ;get surrogate
S XMK=$O(^XMB(3.7,"M",XMZ,D,0)) ;get basket
I XMK,$D(^XMB(3.7,D,2,XMK,0)) D
. S L("BSKT")=$P(^(0),U)
. S L("BSKT IEN")=XMK
E D
. S L("BSKT")=""
. S L("BSKT IEN")=""
I $G(XMK) S L("NEW")=$S($D(^XMB(3.7,D,"N0",XMK,XMZ)):1,1:0)
G Q:F=0
;get responses read/received
S L("RRED")="",L("RRCV")="",%1=$O(^XMB(3.9,XMZ,1,"C",D,0))
I %1 S L("RRED")=$P(^XMB(3.9,XMZ,1,%1,0),U,2)
I $D(^XMB(3.9,XMZ,3,0)) S L("RRCV")=$P(^(0),U,4)
S L("BLOBCNT")=0 ;get blob count
I $D(^XMB(3.9,XMZ,2005,0)) S L("BLOBCNT")=$P(^(0),U,3)
G Q:F=1,BLOB:F=92
;flag=91 - get response numbers and values
S %1=0 F S %1=$O(^XMB(3.9,XMZ,3,%1)) Q:'%1 S L("RSP",%1)=^(%1,0)
I F=91 G Q
;flag=92 - get nodes and values of non-textual body parts
BLOB S %1=0 F S %1=$O(^XMB(3.9,XMZ,2005,%1)) Q:'%1 S L("BLOB",%1)=^(%1,0)
Q Q 0
ERR Q %
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMGAPI2 4126 printed Dec 13, 2024@02:11:39 Page 2
XMGAPI2 ;(WASH ISC)/JKL-Get Msg Header Info API ;04/17/2002 08:57
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Entry points (DBIA 1144):
+3 ; $$HDR Get message header information
+4 ;
+5 ;USAGE: S X=$$HDR^XMGAPI2(A,.B,C)
+6 ;WHERE: A=message or response #
+7 ; .B=array into which data is placed
+8 ; C=flag that determines what data is returned as follows:
+9 ;Not defined or 0 = returns a function value of 0 if successful, an
+10 ; error message if unsuccessful, and a value array:
+11 ; L("BROADCAST")= 1 if the message was broadcast; 0 otherwise
+12 ; L("BSKT") = basket (of local user)
+13 ; L("BSKT IEN") = basket IEN (of local user)
+14 ; L("DATE") = origination date
+15 ; L("DATE FM") = origination date in FileMan format
+16 ; L("LINES") = number of lines in the original message
+17 ; L("NEW") = 1 if the message is new; 0 otherwise
+18 ; L("PXMZ") = pointer to the original message
+19 ; L("SENDER") = sender name
+20 ; L("SENDER DUZ") = sender DUZ
+21 ; L("SUBJ") = subject
+22 ; L("SURROG") = surrogate (DUZ if local user or string if not)
+23 ; L("TYPE") = message type(s)
+24 ; L("XMZ") = message or response number
+25 ;1 = returns function value and value array above, also
+26 ; additional value array as follows:
+27 ; L("RRED") = responses read
+28 ; L("RRCV") = responses received
+29 ; L("BLOBCNT") = number of non-textual body parts attached
+30 ;91= returns function value, value array as with flag 1,
+31 ; and an array of response nodes and values as follows:
+32 ; L("RSP",counter)= (pointer to 3.9 file) / array of responses
+33 ;92= returns function value, value array as with flag 1,
+34 ; and an array of non-textual body parts as follows:
+35 ; L("BLOB",counter) = (pointer to 2005 file) array of BLOBS
+36 ;93= returns function value, value array as with flag 1,
+37 ; response node array, and an array of non-textual body parts.
HDR(XMZ,L,F) ;Entry for non-MailMan (documented)
GO NEW %,%0,D,XMBCAST
+1 SET %=$GET(XMZ)
IF +%'=%!(%<1)
SET %="1-Undefined message number"
GOTO ERR
+2 IF XMZ=""
SET %="1-No message number"
GOTO ERR
+3 SET %0=$GET(^XMB(3.9,XMZ,0))
IF %0=""
SET %="1-No such message"
GOTO ERR
+4 SET D=$SELECT($GET(XMDUZ):XMDUZ,1:DUZ)
+5 IF $SELECT(+D'=D:1,D'>0:1,'$DATA(^XMB(3.7,D,0)):1,1:0)
SET %="4-Invalid user"
GOTO ERR
+6 SET %=$PIECE(%0,U,8)
SET %=$SELECT(%:%,1:XMZ)
+7 SET XMBCAST=$SELECT($DATA(^XMB(3.9,%,1,"C","* (Broadcast to all local users)")):1,$DATA(^XMB(3.9,%,1,"C","* (Broadcast to all local user")):1,1:0)
+8 IF $SELECT($PIECE(%0,U,2)=D:0,$DATA(^XMB(3.9,%,1,"C",D)):0,XMBCAST:0,1:1)
SET %="2-User is not a sender or recipient."
GOTO ERR
+9 ;Default FLAG
IF $GET(F)=""!'$GET(F)
SET F=0
+10 NEW %1,%2,XMK
+11 ;get message information
SET %1=$$NET^XMRENT(XMZ)
+12 IF %1=""
SET %="4-Message not defined"
GOTO ERR
+13 SET L("BROADCAST")=XMBCAST
+14 ;set message number into array
SET L("XMZ")=XMZ
+15 ;get origination date
SET L("DATE")=$PIECE(%1,U)
+16 SET %2=$PIECE(%0,U,3)
+17 SET L("DATE FM")=$SELECT(%2?7N1".".N:%2,%2?7N:%2,1:$$CONVERT^XMXUTIL1(%2))
+18 if L("DATE FM")<2000000
SET L("DATE FM")=""
+19 ;get sender
SET L("SENDER")=$PIECE(%1,U,3)
+20 SET L("SENDER DUZ")=$SELECT($PIECE(%0,U,2):$PIECE(%0,U,2),1:"")
+21 ;get pointer to original message
SET L("PXMZ")=$PIECE(%1,U,7)
+22 ;Message Type(s)
SET L("TYPE")=$PIECE(%1,U,8)
+23 ;get number of message lines
+24 SET L("LINES")=$SELECT($DATA(^XMB(3.9,XMZ,2,0)):$PIECE(^(0),U,4),1:"")
+25 ;get subject
SET L("SUBJ")=$PIECE(%1,U,6)
+26 ;get surrogate
SET L("SURROG")=$PIECE(%1,U,5)
+27 ;get basket
SET XMK=$ORDER(^XMB(3.7,"M",XMZ,D,0))
+28 IF XMK
IF $DATA(^XMB(3.7,D,2,XMK,0))
Begin DoDot:1
+29 SET L("BSKT")=$PIECE(^(0),U)
+30 SET L("BSKT IEN")=XMK
End DoDot:1
+31 IF '$TEST
Begin DoDot:1
+32 SET L("BSKT")=""
+33 SET L("BSKT IEN")=""
End DoDot:1
+34 IF $GET(XMK)
SET L("NEW")=$SELECT($DATA(^XMB(3.7,D,"N0",XMK,XMZ)):1,1:0)
+35 if F=0
GOTO Q
+36 ;get responses read/received
+37 SET L("RRED")=""
SET L("RRCV")=""
SET %1=$ORDER(^XMB(3.9,XMZ,1,"C",D,0))
+38 IF %1
SET L("RRED")=$PIECE(^XMB(3.9,XMZ,1,%1,0),U,2)
+39 IF $DATA(^XMB(3.9,XMZ,3,0))
SET L("RRCV")=$PIECE(^(0),U,4)
+40 ;get blob count
SET L("BLOBCNT")=0
+41 IF $DATA(^XMB(3.9,XMZ,2005,0))
SET L("BLOBCNT")=$PIECE(^(0),U,3)
+42 if F=1
GOTO Q
if F=92
GOTO BLOB
+43 ;flag=91 - get response numbers and values
+44 SET %1=0
FOR
SET %1=$ORDER(^XMB(3.9,XMZ,3,%1))
if '%1
QUIT
SET L("RSP",%1)=^(%1,0)
+45 IF F=91
GOTO Q
+46 ;flag=92 - get nodes and values of non-textual body parts
BLOB SET %1=0
FOR
SET %1=$ORDER(^XMB(3.9,XMZ,2005,%1))
if '%1
QUIT
SET L("BLOB",%1)=^(%1,0)
Q QUIT 0
ERR QUIT %
