- 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 Feb 18, 2025@23:39:07 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