BMXUTL5 ; IHS/OIT/HMW - DATE FORMAT ;
;;4.0;BMX;;JUN 28, 2010
;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; UTILITY: SETVARS, CENTERT, COPYLET,
;; UPPERCASE XREFS, DATE FORMATS, PADS/SPACES.
;
;
;----------
SETVARS ;EP
;---> Set standard variables.
D ^XBKVAR
S:'$D(IOF) IOF="#"
Q
;
;
;----------
PHONFIX(X) ;EP
;---> Remove parentheses from Phone#.
;---> Parameters:
; 1 - X (req) Input Phone Number; returned without parentheses.
;
Q:$G(X)=""
S X=$TR(X,"(","")
S X=$TR(X,")","-")
S X=$TR(X,"/","-")
S:X["- " X=$P(X,"- ")_"-"_$P(X,"- ",2)
S:$E(X,4)=" " $E(X,4)="-"
S:X["--" X=$P(X,"--")_"-"_$P(X,"--",2)
S:X?7N X=$E(X,1,3)_"-"_$E(X,4,7)
Q
;
;
;----------
CENTERT(TEXT,X) ;EP
;---> Pad TEXT with leading spaces to center in 80 columns.
;---> Parameters:
; 1 - TEXT (req) Text to be centered.
; 2 - X (opt) Columns to adjust to the right.
;
S:$G(TEXT)="" TEXT="* NO TEXT SUPPLIED *"
S:'$G(X) X=39
N I
F I=1:1:(X-($L(TEXT)/2)) S TEXT=" "_TEXT
Q
;
;
;----------
UPPER(X) ;EP
;---> Translate X to all uppercase.
;---> Parameters:
; 1 - X (req) Value to be translated into all uppercase.
;
S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Q X
;
;
;----------
UPXREF(X,AGGBL) ;EP
;---> Set uppercase xref for X. Called from M xrefs on mixed case
;---> fields where an all uppercase lookup is needed.
;---> Parameters:
; 1 - X (req) The value that should be xrefed in uppercase.
; 2 - AGGBL (req) The global root of the file.
;
;---> Variables:
; 1 - DA (req) IEN of the entry being xrefed.
;
Q:'$D(AGGBL) Q:$G(X)="" Q:'$G(DA)
S @(AGGBL_"""U"",$E($$UPPER(X),1,30),DA)")=""
Q
;
;
;----------
KUPXREF(X,AGGBL) ;EP
;---> Kill uppercase xref for X. Called from M xrefs on mixed case
;---> fields where an all uppercase lookup is needed.
;---> Parameters:
; 1 - X (req) The value that should be xrefed in uppercase.
; 2 - AGGBL (req) The global root of the file.
;
;---> Variables:
; 1 - DA (req) IEN of the entry being xrefed.
;
Q:'$D(AGGBL) Q:$G(X)="" Q:'$G(DA)
K @(AGGBL_"""U"",$E($$UPPER(X),1,30),DA)")
Q
;
;
;----------
SLDT2(DATE) ;EP
;---> CONVERT FILEMAN INTERNAL DATE TO "SLASH" FORMAT: MM/DD/YYYY.
;---> DATE=DATE IN FILEMAN FORMAT.
Q:'$G(DATE) "NO DATE"
S DATE=$P(DATE,".")
Q:$L(DATE)'=7 DATE
Q:'$E(DATE,4,5) $E(DATE,1,3)+1700
Q:'$E(DATE,6,7) $E(DATE,4,5)_"/"_$E(DATE,2,3)
Q $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_($E(DATE,1,3)+1700)
;
;
;----------
SLDT1(DATE) ;EP
;---> CONVERT FILEMAN INTERNAL DATE TO "SLASH" FORMAT:
;---> MM/DD/YYYY @TIME
N Y
Q:'$D(DATE) "NO DATE"
S Y=DATE,DATE=$P(DATE,".")
Q:'DATE "NO DATE"
Q:$L(DATE)'=7 DATE
Q:'$E(DATE,4,5) $E(DATE,1,3)+1700
Q:'$E(DATE,6,7) $E(DATE,4,5)_"/"_$E(DATE,2,3)
D DD^%DT S:Y["@" Y=" @ "_$P($P(Y,"@",2),":",1,2)
Q $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_($E(DATE,1,3)+1700)_Y
;
;
;----------
NOSLDT(DATE) ;EP
;---> CONVERT FILEMAN INTERNAL DATE TO "NO SLASH" FORMAT: MMDDYYYY.
;---> DATE=DATE IN FILEMAN FORMAT.
Q:'$G(DATE) "NO DATE"
S DATE=$P(DATE,".")
Q:$L(DATE)'=7 DATE
Q $E(DATE,4,5)_$E(DATE,6,7)_($E(DATE,1,3)+1700)
;
;
;----------
IMMSDT(DATE) ;EP
;---> Convert Immserve Date (format MMDDYYYY) TO FILEMAN
;---> Internal format.
;---> NOTE: This code is copied into routine ^AGPATUP1 for speed.
;---> Any changes here should also be made to the call in ^AGPATUP1.
Q:'$G(DATE) "NO DATE"
Q ($E(DATE,5,9)-1700)_$E(DATE,1,2)_$E(DATE,3,4)
;
;
;----------
TXDT1(DATE,TIME) ;EP
;---> Return external date in format: DD-Mmm-YYYY@HH:MM, from Fileman
;---> internal YYYMMDD.HHMM
;---> Parameters:
; 1 - DATE (req) Internal Fileman date.
; 2 - TIME (opt)
;
Q:'$G(DATE) "NO DATE"
N X,Y,Z
S X="Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec"
S Y=$E(DATE,6,7)_"-"_$P(X,U,$E(DATE,4,5))_"-"_($E(DATE,1,3)+1700)
S:'$E(DATE,6,7) Y=$E(Y,4,99)
S:'$E(DATE,4,5) Y=$E(DATE,1,3)+1700
Q:'$G(TIME) Y
S Z=$P(DATE,".",2)
Q:'Z Y
Q Y_" @"_$E(Z,1,2)_":"_$$PAD($E(Z,3,4),2,"0")
;
;
;----------
TXDT(DATE) ;EP
;---> CONVERT FILEMAN INTERNAL DATE TO "TEXT" FORMAT: MMM DD,YYYY.
N Y
Q:'$D(DATE) "NO DATE"
S Y=DATE D DD^%DT
I Y[", " S Y=$P(Y,", ")_","_$P(Y,", ",2)
I Y["@" S Y=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2)
Q Y
;
;
;----------
NOW() ;EP
;---> Return Current Date and Time in external format.
N %H,X,Y,Z
S %H=$H
D YX^%DTC
I Y["@" S Y=$P($P(Y,"@",2),":",1,2)
S Z=$$TXDT1(X)
S:Y]"" Z=Z_" @"_Y
Q Z
;
;
;----------
PAD(D,L,C) ;EP
;---> Pad the length of data to a total of L characters
;---> by adding spaces to the end of the data.
; Example: S X=$$PAD("MIKE",7) X="MIKE " (Added 3 spaces.)
;---> Parameters:
; 1 - D (req) Data to be padded.
; 2 - L (req) Total length of resulting data.
; 3 - C (opt) Character to pad with (default=space).
;
Q:'$D(D) ""
S:'$G(L) L=$L(D)
S:$G(C)="" C=" "
Q $E(D_$$REPEAT^XLFSTR(C,L),1,L)
;
;
;----------
SP(N,C) ;EP
;---> Return N spaces or other character.
; Example: S X=$$SP(5)_X Pads the front of X with 5 spaces.
;---> Parameters:
; 1 - N (req) Number of spaces to be returned as extrinsic var.
; 2 - C (opt) Character to pad with (default=space).
;
Q:$G(N)<1 ""
S:$G(C)="" C=" "
Q $$PAD(C,N,C)
;
;
;----------
STRIP(X) ;EP
;---> Strip any punctuation characters from the beginning of X,
;---> including spaces.
;---> Parameters:
; 1 - X (req) String of characters.
;
Q:$G(X)="" ""
F Q:$E(X)'?1P S X=$E(X,2,99)
Q X
BMXUTL5 ; IHS/OIT/HMW - DATE FORMAT ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; UTILITY: SETVARS, CENTERT, COPYLET,
+4 ;; UPPERCASE XREFS, DATE FORMATS, PADS/SPACES.
+5 ;
+6 ;
+7 ;----------
SETVARS ;EP
+1 ;---> Set standard variables.
+2 DO ^XBKVAR
+3 IF '$DATA(IOF)
SET IOF="#"
+4 QUIT
+5 ;
+6 ;
+7 ;----------
PHONFIX(X) ;EP
+1 ;---> Remove parentheses from Phone#.
+2 ;---> Parameters:
+3 ; 1 - X (req) Input Phone Number; returned without parentheses.
+4 ;
+5 IF $GET(X)=""
QUIT
+6 SET X=$TRANSLATE(X,"(","")
+7 SET X=$TRANSLATE(X,")","-")
+8 SET X=$TRANSLATE(X,"/","-")
+9 IF X["- "
SET X=$PIECE(X,"- ")_"-"_$PIECE(X,"- ",2)
+10 IF $EXTRACT(X,4)=" "
SET $EXTRACT(X,4)="-"
+11 IF X["--"
SET X=$PIECE(X,"--")_"-"_$PIECE(X,"--",2)
+12 IF X?7N
SET X=$EXTRACT(X,1,3)_"-"_$EXTRACT(X,4,7)
+13 QUIT
+14 ;
+15 ;
+16 ;----------
CENTERT(TEXT,X) ;EP
+1 ;---> Pad TEXT with leading spaces to center in 80 columns.
+2 ;---> Parameters:
+3 ; 1 - TEXT (req) Text to be centered.
+4 ; 2 - X (opt) Columns to adjust to the right.
+5 ;
+6 IF $GET(TEXT)=""
SET TEXT="* NO TEXT SUPPLIED *"
+7 IF '$GET(X)
SET X=39
+8 NEW I
+9 FOR I=1:1:(X-($LENGTH(TEXT)/2))
SET TEXT=" "_TEXT
+10 QUIT
+11 ;
+12 ;
+13 ;----------
UPPER(X) ;EP
+1 ;---> Translate X to all uppercase.
+2 ;---> Parameters:
+3 ; 1 - X (req) Value to be translated into all uppercase.
+4 ;
+5 SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+6 QUIT X
+7 ;
+8 ;
+9 ;----------
UPXREF(X,AGGBL) ;EP
+1 ;---> Set uppercase xref for X. Called from M xrefs on mixed case
+2 ;---> fields where an all uppercase lookup is needed.
+3 ;---> Parameters:
+4 ; 1 - X (req) The value that should be xrefed in uppercase.
+5 ; 2 - AGGBL (req) The global root of the file.
+6 ;
+7 ;---> Variables:
+8 ; 1 - DA (req) IEN of the entry being xrefed.
+9 ;
+10 IF '$DATA(AGGBL)
QUIT
IF $GET(X)=""
QUIT
IF '$GET(DA)
QUIT
+11 SET @(AGGBL_"""U"",$E($$UPPER(X),1,30),DA)")=""
+12 QUIT
+13 ;
+14 ;
+15 ;----------
KUPXREF(X,AGGBL) ;EP
+1 ;---> Kill uppercase xref for X. Called from M xrefs on mixed case
+2 ;---> fields where an all uppercase lookup is needed.
+3 ;---> Parameters:
+4 ; 1 - X (req) The value that should be xrefed in uppercase.
+5 ; 2 - AGGBL (req) The global root of the file.
+6 ;
+7 ;---> Variables:
+8 ; 1 - DA (req) IEN of the entry being xrefed.
+9 ;
+10 IF '$DATA(AGGBL)
QUIT
IF $GET(X)=""
QUIT
IF '$GET(DA)
QUIT
+11 KILL @(AGGBL_"""U"",$E($$UPPER(X),1,30),DA)")
+12 QUIT
+13 ;
+14 ;
+15 ;----------
SLDT2(DATE) ;EP
+1 ;---> CONVERT FILEMAN INTERNAL DATE TO "SLASH" FORMAT: MM/DD/YYYY.
+2 ;---> DATE=DATE IN FILEMAN FORMAT.
+3 IF '$GET(DATE)
QUIT "NO DATE"
+4 SET DATE=$PIECE(DATE,".")
+5 IF $LENGTH(DATE)'=7
QUIT DATE
+6 IF '$EXTRACT(DATE,4,5)
QUIT $EXTRACT(DATE,1,3)+1700
+7 IF '$EXTRACT(DATE,6,7)
QUIT $EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,2,3)
+8 QUIT $EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_($EXTRACT(DATE,1,3)+1700)
+9 ;
+10 ;
+11 ;----------
SLDT1(DATE) ;EP
+1 ;---> CONVERT FILEMAN INTERNAL DATE TO "SLASH" FORMAT:
+2 ;---> MM/DD/YYYY @TIME
+3 NEW Y
+4 IF '$DATA(DATE)
QUIT "NO DATE"
+5 SET Y=DATE
SET DATE=$PIECE(DATE,".")
+6 IF 'DATE
QUIT "NO DATE"
+7 IF $LENGTH(DATE)'=7
QUIT DATE
+8 IF '$EXTRACT(DATE,4,5)
QUIT $EXTRACT(DATE,1,3)+1700
+9 IF '$EXTRACT(DATE,6,7)
QUIT $EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,2,3)
+10 DO DD^%DT
IF Y["@"
SET Y=" @ "_$PIECE($PIECE(Y,"@",2),":",1,2)
+11 QUIT $EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_($EXTRACT(DATE,1,3)+1700)_Y
+12 ;
+13 ;
+14 ;----------
NOSLDT(DATE) ;EP
+1 ;---> CONVERT FILEMAN INTERNAL DATE TO "NO SLASH" FORMAT: MMDDYYYY.
+2 ;---> DATE=DATE IN FILEMAN FORMAT.
+3 IF '$GET(DATE)
QUIT "NO DATE"
+4 SET DATE=$PIECE(DATE,".")
+5 IF $LENGTH(DATE)'=7
QUIT DATE
+6 QUIT $EXTRACT(DATE,4,5)_$EXTRACT(DATE,6,7)_($EXTRACT(DATE,1,3)+1700)
+7 ;
+8 ;
+9 ;----------
IMMSDT(DATE) ;EP
+1 ;---> Convert Immserve Date (format MMDDYYYY) TO FILEMAN
+2 ;---> Internal format.
+3 ;---> NOTE: This code is copied into routine ^AGPATUP1 for speed.
+4 ;---> Any changes here should also be made to the call in ^AGPATUP1.
+5 IF '$GET(DATE)
QUIT "NO DATE"
+6 QUIT ($EXTRACT(DATE,5,9)-1700)_$EXTRACT(DATE,1,2)_$EXTRACT(DATE,3,4)
+7 ;
+8 ;
+9 ;----------
TXDT1(DATE,TIME) ;EP
+1 ;---> Return external date in format: DD-Mmm-YYYY@HH:MM, from Fileman
+2 ;---> internal YYYMMDD.HHMM
+3 ;---> Parameters:
+4 ; 1 - DATE (req) Internal Fileman date.
+5 ; 2 - TIME (opt)
+6 ;
+7 IF '$GET(DATE)
QUIT "NO DATE"
+8 NEW X,Y,Z
+9 SET X="Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec"
+10 SET Y=$EXTRACT(DATE,6,7)_"-"_$PIECE(X,U,$EXTRACT(DATE,4,5))_"-"_($EXTRACT(DATE,1,3)+1700)
+11 IF '$EXTRACT(DATE,6,7)
SET Y=$EXTRACT(Y,4,99)
+12 IF '$EXTRACT(DATE,4,5)
SET Y=$EXTRACT(DATE,1,3)+1700
+13 IF '$GET(TIME)
QUIT Y
+14 SET Z=$PIECE(DATE,".",2)
+15 IF 'Z
QUIT Y
+16 QUIT Y_" @"_$EXTRACT(Z,1,2)_":"_$$PAD($EXTRACT(Z,3,4),2,"0")
+17 ;
+18 ;
+19 ;----------
TXDT(DATE) ;EP
+1 ;---> CONVERT FILEMAN INTERNAL DATE TO "TEXT" FORMAT: MMM DD,YYYY.
+2 NEW Y
+3 IF '$DATA(DATE)
QUIT "NO DATE"
+4 SET Y=DATE
DO DD^%DT
+5 IF Y[", "
SET Y=$PIECE(Y,", ")_","_$PIECE(Y,", ",2)
+6 IF Y["@"
SET Y=$PIECE(Y,"@")_" "_$PIECE($PIECE(Y,"@",2),":",1,2)
+7 QUIT Y
+8 ;
+9 ;
+10 ;----------
NOW() ;EP
+1 ;---> Return Current Date and Time in external format.
+2 NEW %H,X,Y,Z
+3 SET %H=$HOROLOG
+4 DO YX^%DTC
+5 IF Y["@"
SET Y=$PIECE($PIECE(Y,"@",2),":",1,2)
+6 SET Z=$$TXDT1(X)
+7 IF Y]""
SET Z=Z_" @"_Y
+8 QUIT Z
+9 ;
+10 ;
+11 ;----------
PAD(D,L,C) ;EP
+1 ;---> Pad the length of data to a total of L characters
+2 ;---> by adding spaces to the end of the data.
+3 ; Example: S X=$$PAD("MIKE",7) X="MIKE " (Added 3 spaces.)
+4 ;---> Parameters:
+5 ; 1 - D (req) Data to be padded.
+6 ; 2 - L (req) Total length of resulting data.
+7 ; 3 - C (opt) Character to pad with (default=space).
+8 ;
+9 IF '$DATA(D)
QUIT ""
+10 IF '$GET(L)
SET L=$LENGTH(D)
+11 IF $GET(C)=""
SET C=" "
+12 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(C,L),1,L)
+13 ;
+14 ;
+15 ;----------
SP(N,C) ;EP
+1 ;---> Return N spaces or other character.
+2 ; Example: S X=$$SP(5)_X Pads the front of X with 5 spaces.
+3 ;---> Parameters:
+4 ; 1 - N (req) Number of spaces to be returned as extrinsic var.
+5 ; 2 - C (opt) Character to pad with (default=space).
+6 ;
+7 IF $GET(N)<1
QUIT ""
+8 IF $GET(C)=""
SET C=" "
+9 QUIT $$PAD(C,N,C)
+10 ;
+11 ;
+12 ;----------
STRIP(X) ;EP
+1 ;---> Strip any punctuation characters from the beginning of X,
+2 ;---> including spaces.
+3 ;---> Parameters:
+4 ; 1 - X (req) String of characters.
+5 ;
+6 IF $GET(X)=""
QUIT ""
+7 FOR
IF $EXTRACT(X)'?1P
QUIT
SET X=$EXTRACT(X,2,99)
+8 QUIT X
