source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXUTL5.m@ 1168

Last change on this file since 1168 was 1087, checked in by Sam Habiel, 14 years ago

BMX updated to v2.3. No actual routine changes from 2.21
File size: 5.4 KB
RevLine 
[645]1BMXUTL5 ; IHS/OIT/HMW - DATE FORMAT ;
[1087]2 ;;2.3;BMX;;Jan 25, 2011
[645]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 ;----------
9SETVARS ;EP
10 ;---> Set standard variables.
11 D ^XBKVAR
12 S:'$D(IOF) IOF="#"
13 Q
14 ;
15 ;
16 ;----------
17PHONFIX(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 ;----------
34CENTERT(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 ;----------
48UPPER(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 ;----------
58UPXREF(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 ;----------
74KUPXREF(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 ;----------
90SLDT2(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 ;----------
102SLDT1(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 ;----------
117NOSLDT(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 ;----------
127IMMSDT(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 ;----------
137TXDT1(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 ;----------
157TXDT(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 ;----------
168NOW() ;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 ;----------
180PAD(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 ;----------
196SP(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 ;----------
209STRIP(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
Note: See TracBrowser for help on using the repository browser.