| [1147] | 1 | BMXUTL5 ; IHS/OIT/HMW - DATE FORMAT ;
|
|---|
| 2 | ;;4.1000;BMX;;Apr 17, 2011
|
|---|
| 3 | ;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
|---|
| 4 | ;; UTILITY: SETVARS, CENTERT, COPYLET,
|
|---|
| 5 | ;; UPPERCASE XREFS, DATE FORMATS, PADS/SPACES.
|
|---|
| 6 | ;
|
|---|
| 7 | ;
|
|---|
| 8 | ;----------
|
|---|
| 9 | SETVARS ;EP
|
|---|
| 10 | ;---> Set standard variables.
|
|---|
| 11 | D ^XBKVAR
|
|---|
| 12 | S:'$D(IOF) IOF="#"
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | ;
|
|---|
| 16 | ;----------
|
|---|
| 17 | PHONFIX(X) ;EP
|
|---|
| 18 | ;---> Remove parentheses from Phone#.
|
|---|
| 19 | ;---> Parameters:
|
|---|
| 20 | ; 1 - X (req) Input Phone Number; returned without parentheses.
|
|---|
| 21 | ;
|
|---|
| 22 | Q:$G(X)=""
|
|---|
| 23 | S X=$TR(X,"(","")
|
|---|
| 24 | S X=$TR(X,")","-")
|
|---|
| 25 | S X=$TR(X,"/","-")
|
|---|
| 26 | S:X["- " X=$P(X,"- ")_"-"_$P(X,"- ",2)
|
|---|
| 27 | S:$E(X,4)=" " $E(X,4)="-"
|
|---|
| 28 | S:X["--" X=$P(X,"--")_"-"_$P(X,"--",2)
|
|---|
| 29 | S:X?7N X=$E(X,1,3)_"-"_$E(X,4,7)
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | ;
|
|---|
| 33 | ;----------
|
|---|
| 34 | CENTERT(TEXT,X) ;EP
|
|---|
| 35 | ;---> Pad TEXT with leading spaces to center in 80 columns.
|
|---|
| 36 | ;---> Parameters:
|
|---|
| 37 | ; 1 - TEXT (req) Text to be centered.
|
|---|
| 38 | ; 2 - X (opt) Columns to adjust to the right.
|
|---|
| 39 | ;
|
|---|
| 40 | S:$G(TEXT)="" TEXT="* NO TEXT SUPPLIED *"
|
|---|
| 41 | S:'$G(X) X=39
|
|---|
| 42 | N I
|
|---|
| 43 | F I=1:1:(X-($L(TEXT)/2)) S TEXT=" "_TEXT
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | ;
|
|---|
| 47 | ;----------
|
|---|
| 48 | UPPER(X) ;EP
|
|---|
| 49 | ;---> Translate X to all uppercase.
|
|---|
| 50 | ;---> Parameters:
|
|---|
| 51 | ; 1 - X (req) Value to be translated into all uppercase.
|
|---|
| 52 | ;
|
|---|
| 53 | S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
| 54 | Q X
|
|---|
| 55 | ;
|
|---|
| 56 | ;
|
|---|
| 57 | ;----------
|
|---|
| 58 | UPXREF(X,AGGBL) ;EP
|
|---|
| 59 | ;---> Set uppercase xref for X. Called from M xrefs on mixed case
|
|---|
| 60 | ;---> fields where an all uppercase lookup is needed.
|
|---|
| 61 | ;---> Parameters:
|
|---|
| 62 | ; 1 - X (req) The value that should be xrefed in uppercase.
|
|---|
| 63 | ; 2 - AGGBL (req) The global root of the file.
|
|---|
| 64 | ;
|
|---|
| 65 | ;---> Variables:
|
|---|
| 66 | ; 1 - DA (req) IEN of the entry being xrefed.
|
|---|
| 67 | ;
|
|---|
| 68 | Q:'$D(AGGBL) Q:$G(X)="" Q:'$G(DA)
|
|---|
| 69 | S @(AGGBL_"""U"",$E($$UPPER(X),1,30),DA)")=""
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | ;
|
|---|
| 73 | ;----------
|
|---|
| 74 | KUPXREF(X,AGGBL) ;EP
|
|---|
| 75 | ;---> Kill uppercase xref for X. Called from M xrefs on mixed case
|
|---|
| 76 | ;---> fields where an all uppercase lookup is needed.
|
|---|
| 77 | ;---> Parameters:
|
|---|
| 78 | ; 1 - X (req) The value that should be xrefed in uppercase.
|
|---|
| 79 | ; 2 - AGGBL (req) The global root of the file.
|
|---|
| 80 | ;
|
|---|
| 81 | ;---> Variables:
|
|---|
| 82 | ; 1 - DA (req) IEN of the entry being xrefed.
|
|---|
| 83 | ;
|
|---|
| 84 | Q:'$D(AGGBL) Q:$G(X)="" Q:'$G(DA)
|
|---|
| 85 | K @(AGGBL_"""U"",$E($$UPPER(X),1,30),DA)")
|
|---|
| 86 | Q
|
|---|
| 87 | ;
|
|---|
| 88 | ;
|
|---|
| 89 | ;----------
|
|---|
| 90 | SLDT2(DATE) ;EP
|
|---|
| 91 | ;---> CONVERT FILEMAN INTERNAL DATE TO "SLASH" FORMAT: MM/DD/YYYY.
|
|---|
| 92 | ;---> DATE=DATE IN FILEMAN FORMAT.
|
|---|
| 93 | Q:'$G(DATE) "NO DATE"
|
|---|
| 94 | S DATE=$P(DATE,".")
|
|---|
| 95 | Q:$L(DATE)'=7 DATE
|
|---|
| 96 | Q:'$E(DATE,4,5) $E(DATE,1,3)+1700
|
|---|
| 97 | Q:'$E(DATE,6,7) $E(DATE,4,5)_"/"_$E(DATE,2,3)
|
|---|
| 98 | Q $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_($E(DATE,1,3)+1700)
|
|---|
| 99 | ;
|
|---|
| 100 | ;
|
|---|
| 101 | ;----------
|
|---|
| 102 | SLDT1(DATE) ;EP
|
|---|
| 103 | ;---> CONVERT FILEMAN INTERNAL DATE TO "SLASH" FORMAT:
|
|---|
| 104 | ;---> MM/DD/YYYY @TIME
|
|---|
| 105 | N Y
|
|---|
| 106 | Q:'$D(DATE) "NO DATE"
|
|---|
| 107 | S Y=DATE,DATE=$P(DATE,".")
|
|---|
| 108 | Q:'DATE "NO DATE"
|
|---|
| 109 | Q:$L(DATE)'=7 DATE
|
|---|
| 110 | Q:'$E(DATE,4,5) $E(DATE,1,3)+1700
|
|---|
| 111 | Q:'$E(DATE,6,7) $E(DATE,4,5)_"/"_$E(DATE,2,3)
|
|---|
| 112 | D DD^%DT S:Y["@" Y=" @ "_$P($P(Y,"@",2),":",1,2)
|
|---|
| 113 | Q $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_($E(DATE,1,3)+1700)_Y
|
|---|
| 114 | ;
|
|---|
| 115 | ;
|
|---|
| 116 | ;----------
|
|---|
| 117 | NOSLDT(DATE) ;EP
|
|---|
| 118 | ;---> CONVERT FILEMAN INTERNAL DATE TO "NO SLASH" FORMAT: MMDDYYYY.
|
|---|
| 119 | ;---> DATE=DATE IN FILEMAN FORMAT.
|
|---|
| 120 | Q:'$G(DATE) "NO DATE"
|
|---|
| 121 | S DATE=$P(DATE,".")
|
|---|
| 122 | Q:$L(DATE)'=7 DATE
|
|---|
| 123 | Q $E(DATE,4,5)_$E(DATE,6,7)_($E(DATE,1,3)+1700)
|
|---|
| 124 | ;
|
|---|
| 125 | ;
|
|---|
| 126 | ;----------
|
|---|
| 127 | IMMSDT(DATE) ;EP
|
|---|
| 128 | ;---> Convert Immserve Date (format MMDDYYYY) TO FILEMAN
|
|---|
| 129 | ;---> Internal format.
|
|---|
| 130 | ;---> NOTE: This code is copied into routine ^AGPATUP1 for speed.
|
|---|
| 131 | ;---> Any changes here should also be made to the call in ^AGPATUP1.
|
|---|
| 132 | Q:'$G(DATE) "NO DATE"
|
|---|
| 133 | Q ($E(DATE,5,9)-1700)_$E(DATE,1,2)_$E(DATE,3,4)
|
|---|
| 134 | ;
|
|---|
| 135 | ;
|
|---|
| 136 | ;----------
|
|---|
| 137 | TXDT1(DATE,TIME) ;EP
|
|---|
| 138 | ;---> Return external date in format: DD-Mmm-YYYY@HH:MM, from Fileman
|
|---|
| 139 | ;---> internal YYYMMDD.HHMM
|
|---|
| 140 | ;---> Parameters:
|
|---|
| 141 | ; 1 - DATE (req) Internal Fileman date.
|
|---|
| 142 | ; 2 - TIME (opt)
|
|---|
| 143 | ;
|
|---|
| 144 | Q:'$G(DATE) "NO DATE"
|
|---|
| 145 | N X,Y,Z
|
|---|
| 146 | S X="Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec"
|
|---|
| 147 | S Y=$E(DATE,6,7)_"-"_$P(X,U,$E(DATE,4,5))_"-"_($E(DATE,1,3)+1700)
|
|---|
| 148 | S:'$E(DATE,6,7) Y=$E(Y,4,99)
|
|---|
| 149 | S:'$E(DATE,4,5) Y=$E(DATE,1,3)+1700
|
|---|
| 150 | Q:'$G(TIME) Y
|
|---|
| 151 | S Z=$P(DATE,".",2)
|
|---|
| 152 | Q:'Z Y
|
|---|
| 153 | Q Y_" @"_$E(Z,1,2)_":"_$$PAD($E(Z,3,4),2,"0")
|
|---|
| 154 | ;
|
|---|
| 155 | ;
|
|---|
| 156 | ;----------
|
|---|
| 157 | TXDT(DATE) ;EP
|
|---|
| 158 | ;---> CONVERT FILEMAN INTERNAL DATE TO "TEXT" FORMAT: MMM DD,YYYY.
|
|---|
| 159 | N Y
|
|---|
| 160 | Q:'$D(DATE) "NO DATE"
|
|---|
| 161 | S Y=DATE D DD^%DT
|
|---|
| 162 | I Y[", " S Y=$P(Y,", ")_","_$P(Y,", ",2)
|
|---|
| 163 | I Y["@" S Y=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2)
|
|---|
| 164 | Q Y
|
|---|
| 165 | ;
|
|---|
| 166 | ;
|
|---|
| 167 | ;----------
|
|---|
| 168 | NOW() ;EP
|
|---|
| 169 | ;---> Return Current Date and Time in external format.
|
|---|
| 170 | N %H,X,Y,Z
|
|---|
| 171 | S %H=$H
|
|---|
| 172 | D YX^%DTC
|
|---|
| 173 | I Y["@" S Y=$P($P(Y,"@",2),":",1,2)
|
|---|
| 174 | S Z=$$TXDT1(X)
|
|---|
| 175 | S:Y]"" Z=Z_" @"_Y
|
|---|
| 176 | Q Z
|
|---|
| 177 | ;
|
|---|
| 178 | ;
|
|---|
| 179 | ;----------
|
|---|
| 180 | PAD(D,L,C) ;EP
|
|---|
| 181 | ;---> Pad the length of data to a total of L characters
|
|---|
| 182 | ;---> by adding spaces to the end of the data.
|
|---|
| 183 | ; Example: S X=$$PAD("MIKE",7) X="MIKE " (Added 3 spaces.)
|
|---|
| 184 | ;---> Parameters:
|
|---|
| 185 | ; 1 - D (req) Data to be padded.
|
|---|
| 186 | ; 2 - L (req) Total length of resulting data.
|
|---|
| 187 | ; 3 - C (opt) Character to pad with (default=space).
|
|---|
| 188 | ;
|
|---|
| 189 | Q:'$D(D) ""
|
|---|
| 190 | S:'$G(L) L=$L(D)
|
|---|
| 191 | S:$G(C)="" C=" "
|
|---|
| 192 | Q $E(D_$$REPEAT^XLFSTR(C,L),1,L)
|
|---|
| 193 | ;
|
|---|
| 194 | ;
|
|---|
| 195 | ;----------
|
|---|
| 196 | SP(N,C) ;EP
|
|---|
| 197 | ;---> Return N spaces or other character.
|
|---|
| 198 | ; Example: S X=$$SP(5)_X Pads the front of X with 5 spaces.
|
|---|
| 199 | ;---> Parameters:
|
|---|
| 200 | ; 1 - N (req) Number of spaces to be returned as extrinsic var.
|
|---|
| 201 | ; 2 - C (opt) Character to pad with (default=space).
|
|---|
| 202 | ;
|
|---|
| 203 | Q:$G(N)<1 ""
|
|---|
| 204 | S:$G(C)="" C=" "
|
|---|
| 205 | Q $$PAD(C,N,C)
|
|---|
| 206 | ;
|
|---|
| 207 | ;
|
|---|
| 208 | ;----------
|
|---|
| 209 | STRIP(X) ;EP
|
|---|
| 210 | ;---> Strip any punctuation characters from the beginning of X,
|
|---|
| 211 | ;---> including spaces.
|
|---|
| 212 | ;---> Parameters:
|
|---|
| 213 | ; 1 - X (req) String of characters.
|
|---|
| 214 | ;
|
|---|
| 215 | Q:$G(X)="" ""
|
|---|
| 216 | F Q:$E(X)'?1P S X=$E(X,2,99)
|
|---|
| 217 | Q X
|
|---|
