- XMXUTIL1 ;ISC-SF/GMB-Date & String Utilities ;04/17/2002 14:14
- ;;8.0;MailMan;;Jun 28, 2002
- ; All entry points covered by DBIA 2735.
- ENCODEUP(XMSUBJ) ; Change ^ to ~U~
- F Q:XMSUBJ'[U S XMSUBJ=$P(XMSUBJ,U)_"~U~"_$P(XMSUBJ,U,2,999)
- Q XMSUBJ
- DECODEUP(XMSUBJ) ; Change ~U~ to ^
- F Q:XMSUBJ'["~U~" S XMSUBJ=$P(XMSUBJ,"~U~")_U_$P(XMSUBJ,"~U~",2,999)
- Q XMSUBJ
- SCRUB(XMSTRING) ; Strip ctrl chars and leading/trailing blanks
- S:$E(XMSTRING,1)=" "!($E(XMSTRING,$L(XMSTRING))=" ") XMSTRING=$$STRIP(XMSTRING)
- S:XMSTRING?.E1C.E XMSTRING=$$CTRL(XMSTRING)
- Q XMSTRING
- STRIP(XMSTRING) ; Strip leading and trailing blanks from a string
- N I
- I $E(XMSTRING,1)=" " D
- . F I=2:1 Q:$E(XMSTRING,I)'=" "
- . S XMSTRING=$E(XMSTRING,I,999)
- I $E(XMSTRING,$L(XMSTRING))=" " D
- . F I=$L(XMSTRING):-1 Q:$E(XMSTRING,I)'=" "
- . S XMSTRING=$E(XMSTRING,1,I)
- Q XMSTRING
- MAXBLANK(XMSTRING) ; Reduce 3 or more consecutive blanks in a string to 2
- F Q:XMSTRING'[" " D
- . S XMSTRING=$P(XMSTRING," ",1)_" "_$P(XMSTRING," ",2,999)
- Q XMSTRING
- CTRL(XMSTRING) ; Strip control characters from a string
- N I
- S I=1
- F Q:XMSTRING'?.E1C.E D
- . F I=I:1 Q:$E(XMSTRING,I)?1C
- . S XMSTRING=$E(XMSTRING,1,I-1)_$E(XMSTRING,I+1,999)
- Q XMSTRING
- MELD(XMSTRING,XMNUMBER,XMLEN) ; Function right-justifies a string and
- ; left-justifies a number in a combined string of a given length.
- ; The string will be truncated, if necessary.
- ; e.g. $$MELD("I just love Lotus, don't you?",123,22) returns:
- ; "I just love Lotus 123"
- Q:$G(XMNUMBER)="" $E($$LJ^XLFSTR(XMSTRING,XMLEN),1,XMLEN)
- S XMLEN=XMLEN-$L(XMNUMBER)-2
- Q $E($$LJ^XLFSTR(XMSTRING,XMLEN),1,XMLEN)_" "_XMNUMBER
- TSTAMP() ; Timestamp
- N X
- S X=$H
- Q X*86400+$P(X,",",2)
- MMDT(XMDT) ; (MailMan Date/Time) Given FM date/time, return external.
- ; time is optional
- Q:XMDT'=+XMDT XMDT
- Q $$FMTE^XLFDT($E(XMDT,1,12),"2Z") ; return mm/dd/yy@hh:mm
- N MMDT ; return dd mmm yy hh:mm
- I $E(XMDT,4,5)="00" S $E(XMDT,4,5)="01"
- I $E(XMDT,6,7)="00" S $E(XMDT,6,7)="01"
- S MMDT=$E(XMDT,6,7)_" "_$P("Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec",U,$E(XMDT,4,5))_" "_$E(XMDT,2,3)
- S XMDT=$P(XMDT,".",2)_"0000"
- Q:'XMDT MMDT
- Q MMDT_" "_$E(XMDT,1,2)_":"_$E(XMDT,3,4)
- INDT(XMDT) ; (InterNet Date/Time) Given FM date/time, return dd mmm yyyy hh:mm:ss +-hhmm (zone)
- I $E(XMDT,4,5)="00" S $E(XMDT,4,5)="01"
- I $E(XMDT,6,7)="00" S $E(XMDT,6,7)="01"
- S XMDT=$$FMTE^XLFDT(XMDT,"1S")
- ; Convert "Jun 28, 1955@10:10:00" to "28 Jun 1955 10:10:00"
- S XMDT=+$P(XMDT," ",2)_" "_$P(XMDT," ",1)_" "_+$P(XMDT," ",3)_" "_$S(XMDT["@":$P(XMDT,"@",2),1:"00:00:00")
- Q XMDT_" "_^XMB("TIMEDIFF")_" ("_^XMB("TIMEZONE")_")"
- CONVERT(X,XMTIME) ; Function to convert Internet dates to FM (returns -1 if error)
- ; X Internet date
- ; XMTIME =1 Convert time, too; =0 convert date only
- ; Formats: Tuesday, 28 June 1955 17:30:45 PDT
- ; Tue, 28 Jun 1955 17:30:45 PDT
- ; Tue 28 Jun 1955 17:30:45 PDT
- ; 28 Jun 1955 17:30:45 -0900 (PST) <== MailMan standard
- ; 28 Jun 55 17:30 PST <== Previous MailMan standard
- ; Tue Jun 28 17:30:45 PDT 1955
- ; 28-JUN-1955 17:30:45 -0400
- ; 6/28/55 17:30
- ; JUN 28 17:30 1955
- N %DT,Y,XMD,XMT
- I $E(X)=" "!($E(X)=$C(9)) F S X=$E(X,2,99) Q:$E(X)'=$C(9)&($E(X)'=" ") ; remove leading blanks or tabs
- I X?.E2" ".E D ; reduce all consecutive blanks to 1 blank
- . N I S I=1
- . F S I=$F(X," ",I) Q:I=0 S X=$E(X,1,I-2)_$E(X,I,99),I=I-1
- I X?3.A.E D
- . I X?3.A1", ".E!(X?3.A1" "3.A.E)!(X?3.A1" "1.2N1" "3.A.E) S X=$P(X," ",2,99) ; remove leading day of week
- I $P(X," ",3)[":" D
- . S XMD=$P(X," ",1,2)_" "_$P(X," ",$L(X," ")) ; time is before year
- . S XMT=$P(X," ",3,$L(X," ")-1)
- E D
- . S XMD=$P(X," ",1,3) ; year is before time
- . I XMD[":" D
- . . S XMD=$P(X," ",1) ; "28-JUN-1955 17:30:45 -0400" or "6/28/55 17:30"
- . . S XMT=$P(X," ",2,99)
- . E S XMT=$P(X," ",4,99)
- I $G(XMTIME) Q $$TIMETOO(XMD,XMT)
- S X=XMD
- D ^%DT
- Q Y
- TIMETOO(XMD,XMT) ; For internal MailMan use only. Combine date and time, adjusting for difference from GMT.
- N XMHH,XMMM,X,Y
- I $L(XMT," ")>1 D Q:XMMM=-1 -1
- . N XMYT ; 17:30:45 -0800 (PST)
- . S XMYT=$TR($P(XMT," ",2),"()")
- . D ZONEDIFF(XMYT,.XMHH,.XMMM)
- E D
- . S (XMHH,XMMM)=0 ; 17:30:45
- S XMT=$P(XMT," ",1)
- S:$L($P(XMT,":"))=1 XMT="0"_XMT
- S XMT=$E(XMT,1,5) ; FM will only handle hh:mm, not :ss
- S:XMT="00:00" XMT="00:01" ; if midnight, add a minute
- S X=XMD_"@"_XMT
- S %DT="T" D ^%DT Q:Y=-1 -1
- I 'XMHH,'XMMM Q Y
- Q $$FMADD^XLFDT(Y,"",XMHH,XMMM)
- ZONEDIFF(XMYT,XMHH,XMMM) ; Given a time zone or time difference from GMT,
- ; calculates the hours and minutes difference between that zone and ours
- ; XMYT IN: Your Time zone or Time difference from GMT
- ; XMHH OUT: The time difference between us in hours
- ; XMMM OUT: The time difference between us in minutes
- ; XMYTHH Your Time difference from GMT in hours
- ; XMYTMM Your Time difference from GMT in minutes
- ; XMMT My Time difference from GMT
- ; XMMTHH My Time difference from GMT in hours
- ; XMMTMM My Time difference from GMT in minutes
- N XMMT,XMYTHH,XMYTMM,XMMTHH,XMMTMM
- S XMMT=^XMB("TIMEDIFF")
- I XMYT=^XMB("TIMEZONE")!(XMYT=XMMT) S (XMHH,XMMM)=0 Q
- I XMYT?3A S XMYT=$$GMTDIFF(XMYT) I XMYT="" S XMMM=-1 Q
- S XMYTHH=XMYT\100
- S XMYTMM=XMYT-(XMYTHH*100)
- S XMMTHH=XMMT\100
- S XMMTMM=XMMT-(XMMTHH*100)
- S XMHH=XMMTHH-XMYTHH
- S XMMM=XMMTMM-XMYTMM
- Q
- ; Also, remember, FM will not handle a 1-digit year
- ; If this becomes a problem:
- I $L($P(X," ",3))=1 S $P(X," ",3)="0"_$P(X," ",3)
- ; *****************************************************
- GMTDIFF(XMZONE) ; Given time zone, returns standard internet time difference from GMT
- ; XMZONE 3-char time zone name (PST, EDT, etc.)
- ; returns difference in hours and minutes (+-hhmm) from GMT
- ; e.g. -0230, +1600
- ; If time zone can't be found, returns null string
- N XMIEN
- S XMIEN=$O(^XMB(4.4,"B",XMZONE,0)) Q:'XMIEN ""
- S XMDIFF=$P($G(^XMB(4.4,XMIEN,0)),U,3) Q:XMIEN="" ""
- Q $$TIMEDIFF(XMDIFF)
- TIMEDIFF(XMDIFF) ; Given time difference, returns standard internet time difference.
- ; XMDIFF Difference (in hours) from GMT
- ; e.g. -2.5 => -0230
- ; 16 => +1600
- N XMSIGN
- I XMDIFF<0 S XMSIGN="-",XMDIFF=-XMDIFF
- E S XMSIGN="+"
- S XMDIFF=XMDIFF\1*100+(XMDIFF#1*60\1)
- Q XMSIGN_$$RJ^XLFSTR(XMDIFF,4,"0")
- CONFIRM(XMDUZ,XMZ,XMIM) ; For internal MailMan use only. Send confirmation message to sender.
- N XMPARM,XMTO
- S XMPARM(1)=XMIM("SUBJ")
- S XMPARM(2)=XMV("NAME") S:XMDUZ'=DUZ XMPARM(2)=XMPARM(2)_$$EZBLD^DIALOG(38008,XMV("DUZ NAME")) ; (Surrogate: |1|)
- ;S XMPARM(3)=$S($D(^XMB(3.9,XMZ,5)):$P(^(5),U),1:XMZ)
- S XMTO=XMIM("FROM")
- S XMTO=$S(+XMTO=XMTO:XMTO,1:$$RCPTTO(XMZ))
- D TASKBULL^XMXBULL(XMDUZ,"XMRDACK",.XMPARM,"",XMTO)
- Q
- RCPTTO(XMZ) ; For internal MailMan use only. Return-receipt-to a remote address.
- N XMI,XMREC,XMHDR,XMTO
- S XMI=0,XMHDR=""
- F S XMI=$O(^XMB(3.9,XMZ,2,XMI)) Q:XMI'<1!'XMI S XMREC=^(XMI,0) D Q:$D(XMTO)
- . Q:XMREC=""
- . S XMHDR=$P(XMREC,":") Q:XMHDR=""
- . S XMHDR=$$UP^XLFSTR(XMHDR)
- . I XMHDR="RETURN-RECEIPT-TO" S XMTO=$$SCRUB($P(XMREC,":",2,99)) Q
- S:'$D(XMTO) XMTO=$P(^XMB(3.9,XMZ,0),U,2)
- Q $$REMADDR^XMXADDR3(XMTO)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXUTIL1 7353 printed Jan 18, 2025@03:15:31 Page 2
- XMXUTIL1 ;ISC-SF/GMB-Date & String Utilities ;04/17/2002 14:14
- +1 ;;8.0;MailMan;;Jun 28, 2002
- +2 ; All entry points covered by DBIA 2735.
- ENCODEUP(XMSUBJ) ; Change ^ to ~U~
- +1 FOR
- if XMSUBJ'[U
- QUIT
- SET XMSUBJ=$PIECE(XMSUBJ,U)_"~U~"_$PIECE(XMSUBJ,U,2,999)
- +2 QUIT XMSUBJ
- DECODEUP(XMSUBJ) ; Change ~U~ to ^
- +1 FOR
- if XMSUBJ'["~U~"
- QUIT
- SET XMSUBJ=$PIECE(XMSUBJ,"~U~")_U_$PIECE(XMSUBJ,"~U~",2,999)
- +2 QUIT XMSUBJ
- SCRUB(XMSTRING) ; Strip ctrl chars and leading/trailing blanks
- +1 if $EXTRACT(XMSTRING,1)=" "!($EXTRACT(XMSTRING,$LENGTH(XMSTRING))=" ")
- SET XMSTRING=$$STRIP(XMSTRING)
- +2 if XMSTRING?.E1C.E
- SET XMSTRING=$$CTRL(XMSTRING)
- +3 QUIT XMSTRING
- STRIP(XMSTRING) ; Strip leading and trailing blanks from a string
- +1 NEW I
- +2 IF $EXTRACT(XMSTRING,1)=" "
- Begin DoDot:1
- +3 FOR I=2:1
- if $EXTRACT(XMSTRING,I)'=" "
- QUIT
- +4 SET XMSTRING=$EXTRACT(XMSTRING,I,999)
- End DoDot:1
- +5 IF $EXTRACT(XMSTRING,$LENGTH(XMSTRING))=" "
- Begin DoDot:1
- +6 FOR I=$LENGTH(XMSTRING):-1
- if $EXTRACT(XMSTRING,I)'=" "
- QUIT
- +7 SET XMSTRING=$EXTRACT(XMSTRING,1,I)
- End DoDot:1
- +8 QUIT XMSTRING
- MAXBLANK(XMSTRING) ; Reduce 3 or more consecutive blanks in a string to 2
- +1 FOR
- if XMSTRING'[" "
- QUIT
- Begin DoDot:1
- +2 SET XMSTRING=$PIECE(XMSTRING," ",1)_" "_$PIECE(XMSTRING," ",2,999)
- End DoDot:1
- +3 QUIT XMSTRING
- CTRL(XMSTRING) ; Strip control characters from a string
- +1 NEW I
- +2 SET I=1
- +3 FOR
- if XMSTRING'?.E1C.E
- QUIT
- Begin DoDot:1
- +4 FOR I=I:1
- if $EXTRACT(XMSTRING,I)?1C
- QUIT
- +5 SET XMSTRING=$EXTRACT(XMSTRING,1,I-1)_$EXTRACT(XMSTRING,I+1,999)
- End DoDot:1
- +6 QUIT XMSTRING
- MELD(XMSTRING,XMNUMBER,XMLEN) ; Function right-justifies a string and
- +1 ; left-justifies a number in a combined string of a given length.
- +2 ; The string will be truncated, if necessary.
- +3 ; e.g. $$MELD("I just love Lotus, don't you?",123,22) returns:
- +4 ; "I just love Lotus 123"
- +5 if $GET(XMNUMBER)=""
- QUIT $EXTRACT($$LJ^XLFSTR(XMSTRING,XMLEN),1,XMLEN)
- +6 SET XMLEN=XMLEN-$LENGTH(XMNUMBER)-2
- +7 QUIT $EXTRACT($$LJ^XLFSTR(XMSTRING,XMLEN),1,XMLEN)_" "_XMNUMBER
- TSTAMP() ; Timestamp
- +1 NEW X
- +2 SET X=$HOROLOG
- +3 QUIT X*86400+$PIECE(X,",",2)
- MMDT(XMDT) ; (MailMan Date/Time) Given FM date/time, return external.
- +1 ; time is optional
- +2 if XMDT'=+XMDT
- QUIT XMDT
- +3 ; return mm/dd/yy@hh:mm
- QUIT $$FMTE^XLFDT($EXTRACT(XMDT,1,12),"2Z")
- +4 ; return dd mmm yy hh:mm
- NEW MMDT
- +5 IF $EXTRACT(XMDT,4,5)="00"
- SET $EXTRACT(XMDT,4,5)="01"
- +6 IF $EXTRACT(XMDT,6,7)="00"
- SET $EXTRACT(XMDT,6,7)="01"
- +7 SET MMDT=$EXTRACT(XMDT,6,7)_" "_$PIECE("Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec",U,$EXTRACT(XMDT,4,5))_" "_$EXTRACT(XMDT,2,3)
- +8 SET XMDT=$PIECE(XMDT,".",2)_"0000"
- +9 if 'XMDT
- QUIT MMDT
- +10 QUIT MMDT_" "_$EXTRACT(XMDT,1,2)_":"_$EXTRACT(XMDT,3,4)
- INDT(XMDT) ; (InterNet Date/Time) Given FM date/time, return dd mmm yyyy hh:mm:ss +-hhmm (zone)
- +1 IF $EXTRACT(XMDT,4,5)="00"
- SET $EXTRACT(XMDT,4,5)="01"
- +2 IF $EXTRACT(XMDT,6,7)="00"
- SET $EXTRACT(XMDT,6,7)="01"
- +3 SET XMDT=$$FMTE^XLFDT(XMDT,"1S")
- +4 ; Convert "Jun 28, 1955@10:10:00" to "28 Jun 1955 10:10:00"
- +5 SET XMDT=+$PIECE(XMDT," ",2)_" "_$PIECE(XMDT," ",1)_" "_+$PIECE(XMDT," ",3)_" "_$SELECT(XMDT["@":$PIECE(XMDT,"@",2),1:"00:00:00")
- +6 QUIT XMDT_" "_^XMB("TIMEDIFF")_" ("_^XMB("TIMEZONE")_")"
- CONVERT(X,XMTIME) ; Function to convert Internet dates to FM (returns -1 if error)
- +1 ; X Internet date
- +2 ; XMTIME =1 Convert time, too; =0 convert date only
- +3 ; Formats: Tuesday, 28 June 1955 17:30:45 PDT
- +4 ; Tue, 28 Jun 1955 17:30:45 PDT
- +5 ; Tue 28 Jun 1955 17:30:45 PDT
- +6 ; 28 Jun 1955 17:30:45 -0900 (PST) <== MailMan standard
- +7 ; 28 Jun 55 17:30 PST <== Previous MailMan standard
- +8 ; Tue Jun 28 17:30:45 PDT 1955
- +9 ; 28-JUN-1955 17:30:45 -0400
- +10 ; 6/28/55 17:30
- +11 ; JUN 28 17:30 1955
- +12 NEW %DT,Y,XMD,XMT
- +13 ; remove leading blanks or tabs
- IF $EXTRACT(X)=" "!($EXTRACT(X)=$CHAR(9))
- FOR
- SET X=$EXTRACT(X,2,99)
- if $EXTRACT(X)'=$CHAR(9)&($EXTRACT(X)'=" ")
- QUIT
- +14 ; reduce all consecutive blanks to 1 blank
- IF X?.E2" ".E
- Begin DoDot:1
- +15 NEW I
- SET I=1
- +16 FOR
- SET I=$FIND(X," ",I)
- if I=0
- QUIT
- SET X=$EXTRACT(X,1,I-2)_$EXTRACT(X,I,99)
- SET I=I-1
- End DoDot:1
- +17 IF X?3.A.E
- Begin DoDot:1
- +18 ; remove leading day of week
- IF X?3.A1", ".E!(X?3.A1" "3.A.E)!(X?3.A1" "1.2N1" "3.A.E)
- SET X=$PIECE(X," ",2,99)
- End DoDot:1
- +19 IF $PIECE(X," ",3)[":"
- Begin DoDot:1
- +20 ; time is before year
- SET XMD=$PIECE(X," ",1,2)_" "_$PIECE(X," ",$LENGTH(X," "))
- +21 SET XMT=$PIECE(X," ",3,$LENGTH(X," ")-1)
- End DoDot:1
- +22 IF '$TEST
- Begin DoDot:1
- +23 ; year is before time
- SET XMD=$PIECE(X," ",1,3)
- +24 IF XMD[":"
- Begin DoDot:2
- +25 ; "28-JUN-1955 17:30:45 -0400" or "6/28/55 17:30"
- SET XMD=$PIECE(X," ",1)
- +26 SET XMT=$PIECE(X," ",2,99)
- End DoDot:2
- +27 IF '$TEST
- SET XMT=$PIECE(X," ",4,99)
- End DoDot:1
- +28 IF $GET(XMTIME)
- QUIT $$TIMETOO(XMD,XMT)
- +29 SET X=XMD
- +30 DO ^%DT
- +31 QUIT Y
- TIMETOO(XMD,XMT) ; For internal MailMan use only. Combine date and time, adjusting for difference from GMT.
- +1 NEW XMHH,XMMM,X,Y
- +2 IF $LENGTH(XMT," ")>1
- Begin DoDot:1
- +3 ; 17:30:45 -0800 (PST)
- NEW XMYT
- +4 SET XMYT=$TRANSLATE($PIECE(XMT," ",2),"()")
- +5 DO ZONEDIFF(XMYT,.XMHH,.XMMM)
- End DoDot:1
- if XMMM=-1
- QUIT -1
- +6 IF '$TEST
- Begin DoDot:1
- +7 ; 17:30:45
- SET (XMHH,XMMM)=0
- End DoDot:1
- +8 SET XMT=$PIECE(XMT," ",1)
- +9 if $LENGTH($PIECE(XMT,"
- SET XMT="0"_XMT
- +10 ; FM will only handle hh:mm, not :ss
- SET XMT=$EXTRACT(XMT,1,5)
- +11 ; if midnight, add a minute
- if XMT="00
- SET XMT="00:01"
- +12 SET X=XMD_"@"_XMT
- +13 SET %DT="T"
- DO ^%DT
- if Y=-1
- QUIT -1
- +14 IF 'XMHH
- IF 'XMMM
- QUIT Y
- +15 QUIT $$FMADD^XLFDT(Y,"",XMHH,XMMM)
- ZONEDIFF(XMYT,XMHH,XMMM) ; Given a time zone or time difference from GMT,
- +1 ; calculates the hours and minutes difference between that zone and ours
- +2 ; XMYT IN: Your Time zone or Time difference from GMT
- +3 ; XMHH OUT: The time difference between us in hours
- +4 ; XMMM OUT: The time difference between us in minutes
- +5 ; XMYTHH Your Time difference from GMT in hours
- +6 ; XMYTMM Your Time difference from GMT in minutes
- +7 ; XMMT My Time difference from GMT
- +8 ; XMMTHH My Time difference from GMT in hours
- +9 ; XMMTMM My Time difference from GMT in minutes
- +10 NEW XMMT,XMYTHH,XMYTMM,XMMTHH,XMMTMM
- +11 SET XMMT=^XMB("TIMEDIFF")
- +12 IF XMYT=^XMB("TIMEZONE")!(XMYT=XMMT)
- SET (XMHH,XMMM)=0
- QUIT
- +13 IF XMYT?3A
- SET XMYT=$$GMTDIFF(XMYT)
- IF XMYT=""
- SET XMMM=-1
- QUIT
- +14 SET XMYTHH=XMYT\100
- +15 SET XMYTMM=XMYT-(XMYTHH*100)
- +16 SET XMMTHH=XMMT\100
- +17 SET XMMTMM=XMMT-(XMMTHH*100)
- +18 SET XMHH=XMMTHH-XMYTHH
- +19 SET XMMM=XMMTMM-XMYTMM
- +20 QUIT
- +21 ; Also, remember, FM will not handle a 1-digit year
- +22 ; If this becomes a problem:
- +23 IF $LENGTH($PIECE(X," ",3))=1
- SET $PIECE(X," ",3)="0"_$PIECE(X," ",3)
- +24 ; *****************************************************
- GMTDIFF(XMZONE) ; Given time zone, returns standard internet time difference from GMT
- +1 ; XMZONE 3-char time zone name (PST, EDT, etc.)
- +2 ; returns difference in hours and minutes (+-hhmm) from GMT
- +3 ; e.g. -0230, +1600
- +4 ; If time zone can't be found, returns null string
- +5 NEW XMIEN
- +6 SET XMIEN=$ORDER(^XMB(4.4,"B",XMZONE,0))
- if 'XMIEN
- QUIT ""
- +7 SET XMDIFF=$PIECE($GET(^XMB(4.4,XMIEN,0)),U,3)
- if XMIEN=""
- QUIT ""
- +8 QUIT $$TIMEDIFF(XMDIFF)
- TIMEDIFF(XMDIFF) ; Given time difference, returns standard internet time difference.
- +1 ; XMDIFF Difference (in hours) from GMT
- +2 ; e.g. -2.5 => -0230
- +3 ; 16 => +1600
- +4 NEW XMSIGN
- +5 IF XMDIFF<0
- SET XMSIGN="-"
- SET XMDIFF=-XMDIFF
- +6 IF '$TEST
- SET XMSIGN="+"
- +7 SET XMDIFF=XMDIFF\1*100+(XMDIFF#1*60\1)
- +8 QUIT XMSIGN_$$RJ^XLFSTR(XMDIFF,4,"0")
- CONFIRM(XMDUZ,XMZ,XMIM) ; For internal MailMan use only. Send confirmation message to sender.
- +1 NEW XMPARM,XMTO
- +2 SET XMPARM(1)=XMIM("SUBJ")
- +3 ; (Surrogate: |1|)
- SET XMPARM(2)=XMV("NAME")
- if XMDUZ'=DUZ
- SET XMPARM(2)=XMPARM(2)_$$EZBLD^DIALOG(38008,XMV("DUZ NAME"))
- +4 ;S XMPARM(3)=$S($D(^XMB(3.9,XMZ,5)):$P(^(5),U),1:XMZ)
- +5 SET XMTO=XMIM("FROM")
- +6 SET XMTO=$SELECT(+XMTO=XMTO:XMTO,1:$$RCPTTO(XMZ))
- +7 DO TASKBULL^XMXBULL(XMDUZ,"XMRDACK",.XMPARM,"",XMTO)
- +8 QUIT
- RCPTTO(XMZ) ; For internal MailMan use only. Return-receipt-to a remote address.
- +1 NEW XMI,XMREC,XMHDR,XMTO
- +2 SET XMI=0
- SET XMHDR=""
- +3 FOR
- SET XMI=$ORDER(^XMB(3.9,XMZ,2,XMI))
- if XMI'<1!'XMI
- QUIT
- SET XMREC=^(XMI,0)
- Begin DoDot:1
- +4 if XMREC=""
- QUIT
- +5 SET XMHDR=$PIECE(XMREC,":")
- if XMHDR=""
- QUIT
- +6 SET XMHDR=$$UP^XLFSTR(XMHDR)
- +7 IF XMHDR="RETURN-RECEIPT-TO"
- SET XMTO=$$SCRUB($PIECE(XMREC,":",2,99))
- QUIT
- End DoDot:1
- if $DATA(XMTO)
- QUIT
- +8 if '$DATA(XMTO)
- SET XMTO=$PIECE(^XMB(3.9,XMZ,0),U,2)
- +9 QUIT $$REMADDR^XMXADDR3(XMTO)