| [613] | 1 | XMXUTIL1 ;ISC-SF/GMB-Date & String Utilities ;04/17/2002 14:14
|
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
|---|
| 3 | ; All entry points covered by DBIA 2735.
|
|---|
| 4 | ENCODEUP(XMSUBJ) ; Change ^ to ~U~
|
|---|
| 5 | F Q:XMSUBJ'[U S XMSUBJ=$P(XMSUBJ,U)_"~U~"_$P(XMSUBJ,U,2,999)
|
|---|
| 6 | Q XMSUBJ
|
|---|
| 7 | DECODEUP(XMSUBJ) ; Change ~U~ to ^
|
|---|
| 8 | F Q:XMSUBJ'["~U~" S XMSUBJ=$P(XMSUBJ,"~U~")_U_$P(XMSUBJ,"~U~",2,999)
|
|---|
| 9 | Q XMSUBJ
|
|---|
| 10 | SCRUB(XMSTRING) ; Strip ctrl chars and leading/trailing blanks
|
|---|
| 11 | S:$E(XMSTRING,1)=" "!($E(XMSTRING,$L(XMSTRING))=" ") XMSTRING=$$STRIP(XMSTRING)
|
|---|
| 12 | S:XMSTRING?.E1C.E XMSTRING=$$CTRL(XMSTRING)
|
|---|
| 13 | Q XMSTRING
|
|---|
| 14 | STRIP(XMSTRING) ; Strip leading and trailing blanks from a string
|
|---|
| 15 | N I
|
|---|
| 16 | I $E(XMSTRING,1)=" " D
|
|---|
| 17 | . F I=2:1 Q:$E(XMSTRING,I)'=" "
|
|---|
| 18 | . S XMSTRING=$E(XMSTRING,I,999)
|
|---|
| 19 | I $E(XMSTRING,$L(XMSTRING))=" " D
|
|---|
| 20 | . F I=$L(XMSTRING):-1 Q:$E(XMSTRING,I)'=" "
|
|---|
| 21 | . S XMSTRING=$E(XMSTRING,1,I)
|
|---|
| 22 | Q XMSTRING
|
|---|
| 23 | MAXBLANK(XMSTRING) ; Reduce 3 or more consecutive blanks in a string to 2
|
|---|
| 24 | F Q:XMSTRING'[" " D
|
|---|
| 25 | . S XMSTRING=$P(XMSTRING," ",1)_" "_$P(XMSTRING," ",2,999)
|
|---|
| 26 | Q XMSTRING
|
|---|
| 27 | CTRL(XMSTRING) ; Strip control characters from a string
|
|---|
| 28 | N I
|
|---|
| 29 | S I=1
|
|---|
| 30 | F Q:XMSTRING'?.E1C.E D
|
|---|
| 31 | . F I=I:1 Q:$E(XMSTRING,I)?1C
|
|---|
| 32 | . S XMSTRING=$E(XMSTRING,1,I-1)_$E(XMSTRING,I+1,999)
|
|---|
| 33 | Q XMSTRING
|
|---|
| 34 | MELD(XMSTRING,XMNUMBER,XMLEN) ; Function right-justifies a string and
|
|---|
| 35 | ; left-justifies a number in a combined string of a given length.
|
|---|
| 36 | ; The string will be truncated, if necessary.
|
|---|
| 37 | ; e.g. $$MELD("I just love Lotus, don't you?",123,22) returns:
|
|---|
| 38 | ; "I just love Lotus 123"
|
|---|
| 39 | Q:$G(XMNUMBER)="" $E($$LJ^XLFSTR(XMSTRING,XMLEN),1,XMLEN)
|
|---|
| 40 | S XMLEN=XMLEN-$L(XMNUMBER)-2
|
|---|
| 41 | Q $E($$LJ^XLFSTR(XMSTRING,XMLEN),1,XMLEN)_" "_XMNUMBER
|
|---|
| 42 | TSTAMP() ; Timestamp
|
|---|
| 43 | N X
|
|---|
| 44 | S X=$H
|
|---|
| 45 | Q X*86400+$P(X,",",2)
|
|---|
| 46 | MMDT(XMDT) ; (MailMan Date/Time) Given FM date/time, return external.
|
|---|
| 47 | ; time is optional
|
|---|
| 48 | Q:XMDT'=+XMDT XMDT
|
|---|
| 49 | Q $$FMTE^XLFDT($E(XMDT,1,12),"2Z") ; return mm/dd/yy@hh:mm
|
|---|
| 50 | N MMDT ; return dd mmm yy hh:mm
|
|---|
| 51 | I $E(XMDT,4,5)="00" S $E(XMDT,4,5)="01"
|
|---|
| 52 | I $E(XMDT,6,7)="00" S $E(XMDT,6,7)="01"
|
|---|
| 53 | 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)
|
|---|
| 54 | S XMDT=$P(XMDT,".",2)_"0000"
|
|---|
| 55 | Q:'XMDT MMDT
|
|---|
| 56 | Q MMDT_" "_$E(XMDT,1,2)_":"_$E(XMDT,3,4)
|
|---|
| 57 | INDT(XMDT) ; (InterNet Date/Time) Given FM date/time, return dd mmm yyyy hh:mm:ss +-hhmm (zone)
|
|---|
| 58 | I $E(XMDT,4,5)="00" S $E(XMDT,4,5)="01"
|
|---|
| 59 | I $E(XMDT,6,7)="00" S $E(XMDT,6,7)="01"
|
|---|
| 60 | S XMDT=$$FMTE^XLFDT(XMDT,"1S")
|
|---|
| 61 | ; Convert "Jun 28, 1955@10:10:00" to "28 Jun 1955 10:10:00"
|
|---|
| 62 | S XMDT=+$P(XMDT," ",2)_" "_$P(XMDT," ",1)_" "_+$P(XMDT," ",3)_" "_$S(XMDT["@":$P(XMDT,"@",2),1:"00:00:00")
|
|---|
| 63 | Q XMDT_" "_^XMB("TIMEDIFF")_" ("_^XMB("TIMEZONE")_")"
|
|---|
| 64 | CONVERT(X,XMTIME) ; Function to convert Internet dates to FM (returns -1 if error)
|
|---|
| 65 | ; X Internet date
|
|---|
| 66 | ; XMTIME =1 Convert time, too; =0 convert date only
|
|---|
| 67 | ; Formats: Tuesday, 28 June 1955 17:30:45 PDT
|
|---|
| 68 | ; Tue, 28 Jun 1955 17:30:45 PDT
|
|---|
| 69 | ; Tue 28 Jun 1955 17:30:45 PDT
|
|---|
| 70 | ; 28 Jun 1955 17:30:45 -0900 (PST) <== MailMan standard
|
|---|
| 71 | ; 28 Jun 55 17:30 PST <== Previous MailMan standard
|
|---|
| 72 | ; Tue Jun 28 17:30:45 PDT 1955
|
|---|
| 73 | ; 28-JUN-1955 17:30:45 -0400
|
|---|
| 74 | ; 6/28/55 17:30
|
|---|
| 75 | ; JUN 28 17:30 1955
|
|---|
| 76 | N %DT,Y,XMD,XMT
|
|---|
| 77 | 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
|
|---|
| 78 | I X?.E2" ".E D ; reduce all consecutive blanks to 1 blank
|
|---|
| 79 | . N I S I=1
|
|---|
| 80 | . F S I=$F(X," ",I) Q:I=0 S X=$E(X,1,I-2)_$E(X,I,99),I=I-1
|
|---|
| 81 | I X?3.A.E D
|
|---|
| 82 | . 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
|
|---|
| 83 | I $P(X," ",3)[":" D
|
|---|
| 84 | . S XMD=$P(X," ",1,2)_" "_$P(X," ",$L(X," ")) ; time is before year
|
|---|
| 85 | . S XMT=$P(X," ",3,$L(X," ")-1)
|
|---|
| 86 | E D
|
|---|
| 87 | . S XMD=$P(X," ",1,3) ; year is before time
|
|---|
| 88 | . I XMD[":" D
|
|---|
| 89 | . . S XMD=$P(X," ",1) ; "28-JUN-1955 17:30:45 -0400" or "6/28/55 17:30"
|
|---|
| 90 | . . S XMT=$P(X," ",2,99)
|
|---|
| 91 | . E S XMT=$P(X," ",4,99)
|
|---|
| 92 | I $G(XMTIME) Q $$TIMETOO(XMD,XMT)
|
|---|
| 93 | S X=XMD
|
|---|
| 94 | D ^%DT
|
|---|
| 95 | Q Y
|
|---|
| 96 | TIMETOO(XMD,XMT) ; For internal MailMan use only. Combine date and time, adjusting for difference from GMT.
|
|---|
| 97 | N XMHH,XMMM,X,Y
|
|---|
| 98 | I $L(XMT," ")>1 D Q:XMMM=-1 -1
|
|---|
| 99 | . N XMYT ; 17:30:45 -0800 (PST)
|
|---|
| 100 | . S XMYT=$TR($P(XMT," ",2),"()")
|
|---|
| 101 | . D ZONEDIFF(XMYT,.XMHH,.XMMM)
|
|---|
| 102 | E D
|
|---|
| 103 | . S (XMHH,XMMM)=0 ; 17:30:45
|
|---|
| 104 | S XMT=$P(XMT," ",1)
|
|---|
| 105 | S:$L($P(XMT,":"))=1 XMT="0"_XMT
|
|---|
| 106 | S XMT=$E(XMT,1,5) ; FM will only handle hh:mm, not :ss
|
|---|
| 107 | S:XMT="00:00" XMT="00:01" ; if midnight, add a minute
|
|---|
| 108 | S X=XMD_"@"_XMT
|
|---|
| 109 | S %DT="T" D ^%DT Q:Y=-1 -1
|
|---|
| 110 | I 'XMHH,'XMMM Q Y
|
|---|
| 111 | Q $$FMADD^XLFDT(Y,"",XMHH,XMMM)
|
|---|
| 112 | ZONEDIFF(XMYT,XMHH,XMMM) ; Given a time zone or time difference from GMT,
|
|---|
| 113 | ; calculates the hours and minutes difference between that zone and ours
|
|---|
| 114 | ; XMYT IN: Your Time zone or Time difference from GMT
|
|---|
| 115 | ; XMHH OUT: The time difference between us in hours
|
|---|
| 116 | ; XMMM OUT: The time difference between us in minutes
|
|---|
| 117 | ; XMYTHH Your Time difference from GMT in hours
|
|---|
| 118 | ; XMYTMM Your Time difference from GMT in minutes
|
|---|
| 119 | ; XMMT My Time difference from GMT
|
|---|
| 120 | ; XMMTHH My Time difference from GMT in hours
|
|---|
| 121 | ; XMMTMM My Time difference from GMT in minutes
|
|---|
| 122 | N XMMT,XMYTHH,XMYTMM,XMMTHH,XMMTMM
|
|---|
| 123 | S XMMT=^XMB("TIMEDIFF")
|
|---|
| 124 | I XMYT=^XMB("TIMEZONE")!(XMYT=XMMT) S (XMHH,XMMM)=0 Q
|
|---|
| 125 | I XMYT?3A S XMYT=$$GMTDIFF(XMYT) I XMYT="" S XMMM=-1 Q
|
|---|
| 126 | S XMYTHH=XMYT\100
|
|---|
| 127 | S XMYTMM=XMYT-(XMYTHH*100)
|
|---|
| 128 | S XMMTHH=XMMT\100
|
|---|
| 129 | S XMMTMM=XMMT-(XMMTHH*100)
|
|---|
| 130 | S XMHH=XMMTHH-XMYTHH
|
|---|
| 131 | S XMMM=XMMTMM-XMYTMM
|
|---|
| 132 | Q
|
|---|
| 133 | ; Also, remember, FM will not handle a 1-digit year
|
|---|
| 134 | ; If this becomes a problem:
|
|---|
| 135 | I $L($P(X," ",3))=1 S $P(X," ",3)="0"_$P(X," ",3)
|
|---|
| 136 | ; *****************************************************
|
|---|
| 137 | GMTDIFF(XMZONE) ; Given time zone, returns standard internet time difference from GMT
|
|---|
| 138 | ; XMZONE 3-char time zone name (PST, EDT, etc.)
|
|---|
| 139 | ; returns difference in hours and minutes (+-hhmm) from GMT
|
|---|
| 140 | ; e.g. -0230, +1600
|
|---|
| 141 | ; If time zone can't be found, returns null string
|
|---|
| 142 | N XMIEN
|
|---|
| 143 | S XMIEN=$O(^XMB(4.4,"B",XMZONE,0)) Q:'XMIEN ""
|
|---|
| 144 | S XMDIFF=$P($G(^XMB(4.4,XMIEN,0)),U,3) Q:XMIEN="" ""
|
|---|
| 145 | Q $$TIMEDIFF(XMDIFF)
|
|---|
| 146 | TIMEDIFF(XMDIFF) ; Given time difference, returns standard internet time difference.
|
|---|
| 147 | ; XMDIFF Difference (in hours) from GMT
|
|---|
| 148 | ; e.g. -2.5 => -0230
|
|---|
| 149 | ; 16 => +1600
|
|---|
| 150 | N XMSIGN
|
|---|
| 151 | I XMDIFF<0 S XMSIGN="-",XMDIFF=-XMDIFF
|
|---|
| 152 | E S XMSIGN="+"
|
|---|
| 153 | S XMDIFF=XMDIFF\1*100+(XMDIFF#1*60\1)
|
|---|
| 154 | Q XMSIGN_$$RJ^XLFSTR(XMDIFF,4,"0")
|
|---|
| 155 | CONFIRM(XMDUZ,XMZ,XMIM) ; For internal MailMan use only. Send confirmation message to sender.
|
|---|
| 156 | N XMPARM,XMTO
|
|---|
| 157 | S XMPARM(1)=XMIM("SUBJ")
|
|---|
| 158 | S XMPARM(2)=XMV("NAME") S:XMDUZ'=DUZ XMPARM(2)=XMPARM(2)_$$EZBLD^DIALOG(38008,XMV("DUZ NAME")) ; (Surrogate: |1|)
|
|---|
| 159 | ;S XMPARM(3)=$S($D(^XMB(3.9,XMZ,5)):$P(^(5),U),1:XMZ)
|
|---|
| 160 | S XMTO=XMIM("FROM")
|
|---|
| 161 | S XMTO=$S(+XMTO=XMTO:XMTO,1:$$RCPTTO(XMZ))
|
|---|
| 162 | D TASKBULL^XMXBULL(XMDUZ,"XMRDACK",.XMPARM,"",XMTO)
|
|---|
| 163 | Q
|
|---|
| 164 | RCPTTO(XMZ) ; For internal MailMan use only. Return-receipt-to a remote address.
|
|---|
| 165 | N XMI,XMREC,XMHDR,XMTO
|
|---|
| 166 | S XMI=0,XMHDR=""
|
|---|
| 167 | F S XMI=$O(^XMB(3.9,XMZ,2,XMI)) Q:XMI'<1!'XMI S XMREC=^(XMI,0) D Q:$D(XMTO)
|
|---|
| 168 | . Q:XMREC=""
|
|---|
| 169 | . S XMHDR=$P(XMREC,":") Q:XMHDR=""
|
|---|
| 170 | . S XMHDR=$$UP^XLFSTR(XMHDR)
|
|---|
| 171 | . I XMHDR="RETURN-RECEIPT-TO" S XMTO=$$SCRUB($P(XMREC,":",2,99)) Q
|
|---|
| 172 | S:'$D(XMTO) XMTO=$P(^XMB(3.9,XMZ,0),U,2)
|
|---|
| 173 | Q $$REMADDR^XMXADDR3(XMTO)
|
|---|
