XMGAPI2.m

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 %

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 %