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)
Jump to: navigation, search
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