DTFormat -- an extension to $$FMTE^XLFDT
From VistApedia
Revision as of 20:04, 19 May 2005 by 152.131.9.69 (talk) (Enhanced Kevin's code for single quotes. DJW)
DTFormat(FMDate,format) ;"SCOPE: PUBLIC ;"Purpose: to allow custom formating of fileman dates in to text equivalents ;"Input: FMDate -- this is the date to work on, in Fileman Format ;" format -- a formating string with codes as follows. ;" yy -- 2 digit year ;" yyyy -- 4 digit year ;" m - month number without a leading 0. ;" mm -- 2 digit month number (01-12) ;" mmm - abreviated months (Jan,Feb,Mar etc.) ;" mmmm -- full names of months (January,February,March etc) ;" d -- the number of the day of the month (1-31) without a leading 0 ;" dd -- 2 digit number of the day of the month ;" w -- the numeric day of the week (1-7) ;" ww -- abreviated day of week (Mon,Tue,Wed) ;" www -- day of week (Monday,Tuesday,Wednesday) ;" h -- the number of the hour without a leading 0 (1-23) 24-hr clock mode ;" hh -- 2 digit number of the hour. 24-hr clock mode ;" H -- the number of the hour without a leading 0 (1-12) 12-hr clock mode ;" HH -- 2 digit number of the hour. 12-hr clock mode ;" # -- will display 'am' for hours 1-12 and 'pm' for hours 13-24 ;" M - the number of minutes with out a leading 0 ;" MM -- a 2 digit display of minutes ;" s - the number of seconds without a leading 0 ;" ss -- a 2 digit display of number of seconds. ;" allowed punctuation symbols-- ' ' : , / @ .; (space, colon, comma, forward slash, at symbol,semicolon,period) ;" 'text' is included as is, even if it is same as a formatting code ;" Other unexpected text will be ignored ;" ;" If a date value of 0 is found for a code, that code is ignored (except for min/sec) ;" ;" Examples: with FMDate=3050215.183000 (i.e. Feb 5, 2005 @ 18:30 0 sec) ;" "mmmm d,yyyy" --> "February 5,2005" ;" "mm d,yyyy" --> "Feb 5,2005" ;" "'Exactly' H:MM # 'on' mm/dd/yy" --> "Exactly 6:30 pm on 02/05/05" ;" "mm/dd/yyy" --> "02/05/2005" ;" ;"Output: Text of date, as specified by above new result set result="" new Token set Token="" new LastToken set LastToken="" new ch set ch="" new LastCh set LastCh="" new InStr set InStr=0 new done set done=0 new i if $get(format)="" goto FDTDone if +$get(FMDate)=0 goto FDTDone ; ;process the string in lvar format ;when a token is found, it is sent to subr. ProcessToken ; a token is any single character, but multiple contiguous copies ; of the character comprise a single token rather than multiple tokens. ; for example "a" "aa" "aaa" are all separate tokens. ; finally, a string within single quotes 'foo' is a separate token. ; to include a single quote in the token, double the single quote. ; for i=1:1:$length(format) do quit:done . set LastCh=ch . set ch=$extract(format,i) ;"get next char of format string. . if (ch'=LastCh)&(LastCh'="")&(InStr=0) do ProcessToken(FMDate,.Token,.result) . set Token=Token_ch . if ch="'" do quit . . if InStr,$extract(format,i+1)="'" s Token=Token_ch,i=i+2 quit ;allow for doubling single quotes . . if InStr do ProcessToken(FMDate,.Token,.result) . . set InStr='InStr ;"toggle In-String mode . if (i=$length(format)) do ProcessToken(FMDate,.Token,.result) FDTDone quit result ProcessToken(FMDate,Token,Output) ;"SCOPE: PRIVATE ;"Purpose: To take tokens and build output following rules specified by DTFormat) ;"Input: FMDate -- the date to work with ;" Token -- SHOULD BE PASSED BY REFERENCE. The code as oulined in DTFormat ;" Output -- SHOULD BE PASSED BY REFERENCE. The cumulative output if $extract(Token,1)="'" do goto PTDone . new Str set Str(1)=$extract(Token,2,$length(Token)-1) . for Str(0)=1:1:$length(Str,"") S $P(Str,"'",Str(0))=$P(Str(1),"",Str(0)) . set Output=Output_Str if Token=" " set Output=Output_Token goto PTDone if Token="." set Output=Output_Token goto PTDone if Token=":" set Output=Output_Token goto PTDone if Token="/" set Output=Output_Token goto PTDone if Token=";" set Output=Output_Token goto PTDone if Token="," set Output=Output_Token goto PTDone if Token="@" set Output=Output_Token goto PTDone if Token="yy" do goto PTDone . new Year set Year=+$extract(FMDate,1,3) . if Year=0 quit . set Year=+$extract(FMDate,2,3) . if Year<10 set Year="0"_Year . set Output=Output_Year if Token="yyyy" do goto PTDone . new Year set Year=+$extract(FMDate,1,3) . if Year>0 set Output=Output_(Year+1700) if Token="m" do goto PTDone . new Month set Month=+$extract(FMDate,4,5) . if Month>0 set Output=Output_Month if Token="mm" do goto PTDone . new Month set Month=+$extract(FMDate,4,5) . if Month=0 quit . if Month<10 set Month="0"_Month . set Output=Output_Month if Token="mmm" do goto PTDone . new Month set Month=+$extract(FMDate,4,5) . if Month=0 quit . if Month=1 set Output=Output_"Jan" quit . if Month=2 set Output=Output_"Feb" quit . if Month=3 set Output=Output_"Mar" quit . if Month=4 set Output=Output_"Apr" quit . if Month=5 set Output=Output_"May" quit . if Month=6 set Output=Output_"Jun" quit . if Month=7 set Output=Output_"Jul" quit . if Month=8 set Output=Output_"Aug" quit . if Month=9 set Output=Output_"Sept" quit . if Month=10 set Output=Output_"Oct" quit . if Month=11 set Output=Output_"Nov" quit . if Month=12 set Output=Output_"Dec" quit if Token="mmmm" do goto PTDone . new Month set Month=+$extract(FMDate,4,5) . if Month=0 quit . if Month=1 set Output=Output_"January" quit . if Month=2 set Output=Output_"February" quit . if Month=3 set Output=Output_"March" quit . if Month=4 set Output=Output_"April" quit . if Month=5 set Output=Output_"May" quit . if Month=6 set Output=Output_"June" quit . if Month=7 set Output=Output_"July" quit . if Month=8 set Output=Output_"August" quit . if Month=9 set Output=Output_"September" quit . if Month=10 set Output=Output_"October" quit . if Month=11 set Output=Output_"November" quit . if Month=12 set Output=Output_"December" quit if Token="d" do goto PTDone . new Day set Day=+$extract(FMDate,6,7) . if Day>0 set Output=Output_Day if Token="dd" do goto PTDone . new Day set Day=+$extract(FMDate,6,7) . if Day=0 quit . if Day<10 set Day="0"_Day . set Output=Output_Day if Token="w" do goto PTDone . new DOW set DOW=$$DOW^XLFDT(FMDate,1) . if DOW>0 set Output=Output_DOW if Token="ww" do goto PTDone . new DOW set DOW=$$DOW^XLFDT(FMDate,1) . if (DOW<1)!(DOW>7) quit . if DOW=1 set DOW="Sun" . if DOW=2 set DOW="Mon" . if DOW=3 set DOW="Tue" . if DOW=4 set DOW="Wed" . if DOW=5 set DOW="Thur" . if DOW=6 set DOW="Fri" . if DOW=7 set DOW="Sat" . set Output=Output_DOW if Token="www" do goto PTDone . new DOW set DOW=$$DOW^XLFDT(FMDate) . if DOW'="day" set Output=Output_DOW if Token="h" do goto PTDone . new Hour set Hour=+$extract(FMDate,9,10) . if Hour>0 set Output=Output_Hour if Token="hh" do goto PTDone . new Hour set Hour=+$extract(FMDate,9,10) . if Hour=0 quit . if Hour<10 set Hour="0"_Hour . set Output=Output_Hour if Token="H" do goto PTDone . new Hour set Hour=+$extract(FMDate,9,10) . if Hour>12 set Hour=Hour-12 . if Hour>0 set Output=Output_Hour if Token="HH" do goto PTDone . new Hour set Hour=+$extract(FMDate,9,10) . if Hour=0 quit . if Hour>12 set Hour=Hour-12 . if Hour<10 set Hour="0"_Hour . set Output=Output_Hour if Token="#" do goto PTDone . new Hour set Hour=+$extract(FMDate,9,10) . if Hour=0 quit . if Hour>12 set Output=Output_"pm" . else set Output=Output_"am" new Min set Min=+$extract(FMDate,11,12) if Token="M" do goto PTDone . new Min set Min=+$extract(FMDate,11,12) . set Output=Output_Min if Token="MM" do goto PTDone . new Min set Min=+$extract(FMDate,11,12) . if Min<10 set Min="0"_Min . set Output=Output_Min if Token="s" do goto PTDone . new Sec set Sec=+$extract(FMDate,13,14) . set Output=Output_Sec if Token="ss" do goto PTDone . new Sec set Sec=+$extract(FMDate,13,14) . if Sec<10 set Sec="0"_Sec . set Output=Output_Sec PTDone set Token="" quit