XMRENT.m

XMRENT ;ISC-SF/GMB-Msg Network Header Info API ;04/19/2002  13:17

 ;;8.0;MailMan;;Jun 28, 2002

 ; Was (WASH ISC)/CMW

 ;

 ; Entry points (DBIA 1143):

 ; $$NET  Get message information.

 ;

 ;Extrinsic Function for API call to parse network header

 ;Parameter #1=Message #

 ;

 ;Output=STRING

 ; Message-date ^ Encryption-code ^ Returned addr of sender ^ Message ID

 ; ^ Sender ^ Message subject ^ Message ID of In-reply-to ^ Message Type

 ;

NET(XMZ) ;

 Q:'$D(^XMB(3.9,XMZ,0)) ""

 N XMDATE,XMENCR,XMFROM,XMREMID,XMSEND,XMSUBJ,XMZO,XMFIRST

 S XMFIRST=$O(^XMB(3.9,XMZ,2,0))

 I XMFIRST,XMFIRST<1 D

 . D NETMAIL(XMZ,.XMREMID,.XMSUBJ,.XMFROM,.XMDATE,.XMSEND,.XMENCR,.XMZO)

 E  D

 . D LOCMAIL(XMZ,.XMREMID,.XMSUBJ,.XMFROM,.XMDATE,.XMSEND,.XMENCR,.XMZO)

 Q $G(XMDATE)_U_$G(XMENCR)_U_$G(XMFROM)_U_$G(XMREMID)_U_$G(XMSEND)_U_$G(XMSUBJ)_U_$G(XMZO)_U_$P($G(^XMB(3.9,XMZ,0)),U,7)

LOCMAIL(XMZ,XMREMID,XMSUBJ,XMFROM,XMDATE,XMSEND,XMENCR,XMZO) ; Get data for Locally originated message

 N XMZREC,Y

 S XMZREC=^XMB(3.9,XMZ,0)

 S Y=$P(XMZREC,U,3),%DT="S" D DD^%DT S XMDATE=Y

 S:$P(XMZREC,U,8) XMZO=^XMB("NETNAME")_"@"_$P(XMZREC,U,8)

 S XMSEND=$S($P(XMZREC,U,4)="":"",1:$$NAME^XMXUTIL($P(XMZREC,U,4)))

 S XMENCR=$P(XMZREC,U,10)

 S XMFROM=$$NAME^XMXUTIL($P(XMZREC,U,2))

 S XMSUBJ=$$SUBJ^XMXUTIL2(XMZREC)

 S XMREMID=$$NETID^XMS3(XMZ)

 Q

NETMAIL(XMZ,XMREMID,XMSUBJ,XMFROM,XMDATE,XMSEND,XMENCR,XMZO) ; Get data for Message that originated from another domain

 D PARSE^XMR3(XMZ,.XMREMID,.XMSUBJ,.XMFROM,.XMDATE,.XMSEND,.XMENCR,.XMZO)

 S:$G(XMSUBJ)="" XMSUBJ=" "

 S XMFROM="<"_$$REMADDR^XMXADDR3(XMFROM)_">"

 S:XMREMID[".DOMAIN.EXT" XMFROM=$TR($P(XMFROM,"@"),"._+",", .")_"@"_$P(XMFROM,"@",2)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XMRENT   1707     printed  Apr 09, 2024@21:16:25                                                                                                                                                                                                      Page 2

XMRENT    ;ISC-SF/GMB-Msg Network Header Info API ;04/19/2002  13:17

 +1       ;;8.0;MailMan;;Jun 28, 2002

 +2       ; Was (WASH ISC)/CMW

 +3       ;

 +4       ; Entry points (DBIA 1143):

 +5       ; $$NET  Get message information.

 +6       ;

 +7       ;Extrinsic Function for API call to parse network header

 +8       ;Parameter #1=Message #

 +9       ;

 +10      ;Output=STRING

 +11      ; Message-date ^ Encryption-code ^ Returned addr of sender ^ Message ID

 +12      ; ^ Sender ^ Message subject ^ Message ID of In-reply-to ^ Message Type

 +13      ;

NET(XMZ)  ;

 +1        if '$DATA(^XMB(3.9,XMZ,0))

               QUIT ""

 +2        NEW XMDATE,XMENCR,XMFROM,XMREMID,XMSEND,XMSUBJ,XMZO,XMFIRST

 +3        SET XMFIRST=$ORDER(^XMB(3.9,XMZ,2,0))

 +4        IF XMFIRST

               IF XMFIRST<1

                   Begin DoDot:1

 +5                    DO NETMAIL(XMZ,.XMREMID,.XMSUBJ,.XMFROM,.XMDATE,.XMSEND,.XMENCR,.XMZO)

                   End DoDot:1

 +6       IF '$TEST

               Begin DoDot:1

 +7                DO LOCMAIL(XMZ,.XMREMID,.XMSUBJ,.XMFROM,.XMDATE,.XMSEND,.XMENCR,.XMZO)

               End DoDot:1

 +8        QUIT $GET(XMDATE)_U_$GET(XMENCR)_U_$GET(XMFROM)_U_$GET(XMREMID)_U_$GET(XMSEND)_U_$GET(XMSUBJ)_U_$GET(XMZO)_U_$PIECE($GET(^XMB(3.9,XMZ,0)),U,7)

LOCMAIL(XMZ,XMREMID,XMSUBJ,XMFROM,XMDATE,XMSEND,XMENCR,XMZO) ; Get data for Locally originated message

 +1        NEW XMZREC,Y

 +2        SET XMZREC=^XMB(3.9,XMZ,0)

 +3        SET Y=$PIECE(XMZREC,U,3)

           SET %DT="S"

           DO DD^%DT

           SET XMDATE=Y

 +4        if $PIECE(XMZREC,U,8)

               SET XMZO=^XMB("NETNAME")_"@"_$PIECE(XMZREC,U,8)

 +5        SET XMSEND=$SELECT($PIECE(XMZREC,U,4)="":"",1:$$NAME^XMXUTIL($PIECE(XMZREC,U,4)))

 +6        SET XMENCR=$PIECE(XMZREC,U,10)

 +7        SET XMFROM=$$NAME^XMXUTIL($PIECE(XMZREC,U,2))

 +8        SET XMSUBJ=$$SUBJ^XMXUTIL2(XMZREC)

 +9        SET XMREMID=$$NETID^XMS3(XMZ)

 +10       QUIT 

NETMAIL(XMZ,XMREMID,XMSUBJ,XMFROM,XMDATE,XMSEND,XMENCR,XMZO) ; Get data for Message that originated from another domain

 +1        DO PARSE^XMR3(XMZ,.XMREMID,.XMSUBJ,.XMFROM,.XMDATE,.XMSEND,.XMENCR,.XMZO)

 +2        if $GET(XMSUBJ)=""

               SET XMSUBJ=" "

 +3        SET XMFROM="<"_$$REMADDR^XMXADDR3(XMFROM)_">"

 +4        if XMREMID[".DOMAIN.EXT"

               SET XMFROM=$TRANSLATE($PIECE(XMFROM,"@"),"._+",", .")_"@"_$PIECE(XMFROM,"@",2)

 +5        QUIT