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 ---[H[J[2J[HXMRENT 1707 printed Dec 13, 2024@02:12:57 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
