Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: INHUTC21

INHUTC21.m

Go to the documentation of this file. 
  1. INHUTC21 ;bar,DS; 28 Aug 97 16:14; Interface Criteria date functions
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;;COPYRIGHT 1997 SAIC
  1.  Q
  1.  ;
  1. RELDT(INSTR,INFMT,INPMT) ; convert a relative date text string to a FM
  1.  ; date/time format
  1.  ;
  1.  ; input:   INSTR = string consisting of a relative date/time designation
  1.  ;                 and optionally add/subtract modifiers or @time.
  1.  ;          INFMT = formating options similar to %DT options.
  1.  ;                = "A" Ask for input
  1.  ;                = "E", Echo the answer
  1.  ;                = "F", future dates are assumed
  1.  ;                = "L", for space bar return lookup
  1.  ;                = "N" Pure numeric input is not allowed
  1.  ;                = "P", past dates are assumed
  1.  ;                = "S", allow seconds in input and output
  1.  ;                = "T", allow time in input and output
  1.  ;                = "U", for readable date/time format
  1.  ;          
  1.  ;          INPMT = Prompt to display (Default is 'Date: ')
  1.  ;
  1.  ; returns: date/time in FM format
  1.  ;
  1.  N INA,INB,INCY,IND,INDT,INOUT,INUM,INI,INNOW,INTIME,INX,INY,X
  1.  S INSTR=$$UPCASE^%ZTF($G(INSTR)),INFMT=$$UPCASE^%ZTF($G(INFMT))
  1.  S INPMT=$G(INPMT,"Date: "),INNOW=$$NOW^%ZTFDT
  1.  ;
  1.  ; if asked to prompt for input, get input and call back recursively
  1.  I INFMT["A" D  Q:X="^" "User aborted or timed out"  Q $$RELDT(X,INFMT,INPMT)
  1.  . S INFMT=$TR(INFMT,"A","L")
  1.  . D ^UTSRD(INPMT_";;;;"_INSTR,"^D HELP^INHUTC22")
  1.  . I $D(DTOUT)!$D(DUOUT) S X="^" Q
  1.  . ; if help is requested, display help and quit
  1.  . S:$L(INSTR)&'$L(X) X=INSTR
  1.  . I X=" ",$L($G(^DIJUSV(+$G(DUZ),"RELDT^INHUTC21"))) S X=^("RELDT^INHUTC21")
  1.  ;
  1.  ; check for pure numeric input if not allowed
  1.  I INFMT["N",INSTR?.N,+INSTR=INSTR D  Q INOUT
  1.  . S INOUT="Pure numeric input is not allowed."
  1.  . W:INFMT["E" $C(7)_" "_INOUT
  1.  ;
  1.  ; assume past dates - assume nothing we just want to eval the date
  1.  ; I INFMT'["F",INFMT'["P" S INFMT=INFMT_"P"
  1.  ; create logical pieces of input string into INY
  1.  S INY=$TR(INSTR,"+-@","^^^"),INA=1,INB=0,INDT=""
  1.  ; set INB to each piece and evaluate
  1.  F INI=1:1 S INB=$F(INY,"^",INB) D  Q:'INB!('INDT)
  1.  . S INX=$E(INSTR,INA,$S(INB:INB-2,1:$L(INSTR))),INA=INA+$L(INX) Q:'$L(INX)
  1.  . ; ------------------ process base date ------------------------
  1.  . I INI=1 D  Q
  1.  .. ; set default for base to NOW
  1.  .. S:'$L(INX) INX="NOW"
  1.  .. I INX=$E("TODAY",1,$L(INX)) S INDT=$$CDATH2F^%ZTFDT(+$H) Q
  1.  .. I INX="NOW"!(INX="N") S INDT=INNOW Q
  1.  .. ; process begin/end entries
  1.  .. I "BE"[$E(INX) D  Q
  1.  ... ; set flag IND, true if BEGIN, false if END
  1.  ... N IND,INT S IND=($E(INX)="B")
  1.  ... ; get date type
  1.  ... F I=2:1 I "YMD"[$E(INX,I) S INT=$E(INX,I) Q
  1.  ... Q:'$L(INT)
  1.  ... ; process current year
  1.  ... I $E(INT)="Y" S INDT=$$CDATA2F^%ZTFDT($S(IND:"JAN 01",1:"DEC 31")) Q
  1.  ... ; process current month
  1.  ... I $E(INT)="M" D  Q
  1.  .... N INE
  1.  .... S INDT=$$CDATH2F^%ZTFDT(+$H)
  1.  .... ; set day of the month based on begin or end
  1.  .... S INE=$S(IND:"01",1:$P("31 28 31 30 31 30 31 31 30 31 30 31"," ",$E(INDT,4,5)))
  1.  .... ; leap year is every 4, except on a century
  1.  .... ; every 400 years the century keeps the leap year
  1.  .... I INE=28,'(I#4),'('$E(I,3,4)&(I#400)) S INE=29
  1.  .... S $E(INDT,6,7)=INE
  1.  ... ; process current day
  1.  ... I $E(INT)="D" S INDT=$$DT^%ZTFDT_$S(IND:"",1:".24") Q
  1.  .. ; process days of the week with last and next
  1.  .. I "NL"[$E(INX),$E(INX,2)'="O" D  Q
  1.  ... N IND,INH
  1.  ... S INH=$H,IND=$F("TH,FR,SA,SU,MO,TU,WE",$E(INX,2,3)) Q:'IND
  1.  ... S IND=IND/3+6-(INH#7)#7 S:$E(INX)="L" IND=IND-7 S:'IND IND=7
  1.  ... S INDT=$$ADDT^%ZTFDT(INNOW,IND)
  1.  .. ; check for specific date
  1.  .. S INDT=$$CDATA2F^%ZTFDT(INX)
  1.  . ; --------------- process modifiers -------------------------------
  1.  . ; process @time input
  1.  . I $E(INX)="@" D  Q
  1.  .. S IND=$$CDATA2F^%ZTFDT(INX,"T") I 'IND S INDT="" Q
  1.  .. S INDT=$P(INDT,".",1)_"."_$P(IND,".",2)
  1.  . ; parse number and modifier, no-op if no value, default is DAYS
  1.  . S INUM=+INX,IND=$P(INX,INUM,2) Q:'INUM  S:'$L(IND) IND="D"
  1.  . ; check for Day, Hour, Minites, Seconds
  1.  . I $F(",WEEKS,DAYS,HOURS,MINUTES,SECONDS",","_IND) D  Q
  1.  .. N D,H,M,S
  1.  .. ;calculate weeks into days
  1.  .. S IND=$E(IND) S:IND="W" IND="D",INUM=INUM*7
  1.  .. S @IND=INUM,INDT=$$ADDT^%ZTFDT(INDT,$G(D),$G(H),$G(M),$G(S))
  1.  . ; check for Year, Month
  1.  . I $F(",MONTHS,YEARS",","_IND) D  Q
  1.  .. ; if years, calc number of months. Add months to current date
  1.  .. S:$E(IND)="Y" INUM=INUM*12 S INDT=$$ADDM^%ZTFDT(INDT,INUM)
  1.  . ; if it doesn't pass any formats, it must be bad
  1.  . S INDT=""
  1.  ;
  1.  ; loop back if asked to prompt and user input is invalid
  1.  I 'INDT D  Q INOUT
  1.  . S INOUT="value "_INSTR_" is invalid"
  1.  . W:INFMT["E" $C(7)_" ("_INOUT_")"
  1.  ;
  1.  ; check if time input is required
  1.  I INFMT["R",'$F(INDT,".") D  Q INOUT
  1.  . S INOUT="Time input is required."
  1.  . W:INFMT["E" $C(7)_" "_INOUT
  1.  ;
  1.  ; if INFMT does not contain 'T' to remove the time portion
  1.  S:INFMT'["T" INDT=$P(INDT,".")
  1.  ;
  1.  ; if INFMT does not contain 'S' to remove the seconds portion,
  1.  ; remove the seconds
  1.  S:INFMT'["S" INDT=$P(INDT,".")_"."_$E($P(INDT,".",2),1,4)
  1.  ;
  1.  ; check for past or future date assumptions and increment
  1.  ; or decrement CYY.
  1.  I INFMT["F"!(INFMT["P")&($$CHKDT($P(INSTR,"@"))) D
  1.  . S INDAT=$$PASFUT^INHUTC21($P(INDT,"."),INFMT)
  1.  . S:$L($P(INDT,".",2)) INDAT=INDAT_"."_$P(INDT,".",2)
  1.  . S INDT=INDAT
  1.  ;
  1.  ; check if past date was assumed and entered a date in the future
  1.  I INFMT["P",INDT>INNOW D  Q INOUT
  1.  . S INOUT="Enter a date no later than today"
  1.  . W:INFMT["E" $C(7)_" "_INOUT
  1.  ;
  1.  ; check if future date was assumed and entered a date in the past
  1.  I INFMT["F",INDT<INNOW D  Q INOUT
  1.  . S INOUT="Enter a date greater than today"
  1.  . W:INFMT["E" $C(7)_" "_INOUT
  1.  ;
  1.  ; save input string for space bar return lookup
  1.  S:INFMT["L" ^DIJUSV(+$G(DUZ),"RELDT^INHUTC21")=INSTR
  1.  ;
  1.  ; if requested for readable date/time format
  1.  I INFMT["U" D  Q INOUT
  1.  . S INOUT=$$CDATASC^%ZTFDT(INDT,1,$S(INDT[".":1,1:""))
  1.  . W:INFMT["E" " ("_INOUT_")"
  1.  W:INFMT["E" " ("_+INDT_")"
  1.  Q +INDT
  1.  ;
  1. PASFUT(CYYMMDD,INFMT) ; check for Past or Future date assumptions and
  1.  ; increment or decrement CYY appropriately.
  1.  ;
  1.  ; Input: CYYMMDD (req) = FileMan date format
  1.  ;        INFMT   (req) = like %DT string, holds F or P
  1.  ;
  1.  ; Output: CYY+1_MMDD if future dates are assumed and MMDD is > today
  1.  ;         CYY-1_MMDD if past dates are assumed and MMDD is > today
  1.  ;
  1.  N CYY,DD,INDELTA,INHDT,INHMMDD,MM
  1.  S INFMT=$G(INFMT)
  1.  ; assume past dates
  1.  I INFMT'["F",INFMT'["P" S INFMT=INFMT_"P"
  1.  S INHDT=$$DT^%ZTFDT,INHMMDD=$E(INHDT,4,7),INDELTA=-1,INOPER=">"
  1.  S:INFMT["F" INDELTA=1,INOPER="<"
  1.  S CYY=$E(CYYMMDD,1,3),MM=$E(CYYMMDD,4,5),DD=$E(CYYMMDD,6,7),MD=MM*100+DD
  1.  I @(MD_INOPER_INHMMDD) S CYY=CYY+INDELTA
  1.  Q CYY_MM_DD
  1.  ;
  1. CHKDT(INSTR) ; check the format of the input date string
  1.  ;
  1.  ; Output: 1, if the input date string is in MM/DD or MM-DD format and
  1.  ;            year has not been supplied.
  1.  ;         null, otherwise.
  1.  ;
  1.  S INSTR=$G(INSTR)
  1.  ; check for MM/DD/YYYY, MM-DD-YYYY, MM.DD.YYYY formats
  1.  Q:INSTR?1.2N1"/"1.2N1"/"1.4N ""
  1.  Q:INSTR?1.2N1"-"1.2N1"-"1.4N ""
  1.  Q:INSTR?1.2N1"."1.2N1"."1.4N ""
  1.  Q:INSTR?1.2N1" "1.2N1" "1.4N ""
  1.  ; MMM DD YYYY or DD MMM YYYY formats
  1.  Q:INSTR?3U1" "1.2N1" "1.4N ""
  1.  Q:INSTR?1.2N1" "3U1" "1.4N ""
  1.  ; MMDDYY or MMDDYYYY
  1.  Q:INSTR?6.8N ""
  1.  Q:INSTR["TODAY"!(INSTR["T")!(INSTR["NOW") ""
  1.  ; chech for MM/DD or MM-DD formats, year is not supplied
  1.  Q:INSTR?1.2N1"/"1.2N 1
  1.  Q:INSTR?1.2N1"-"1.2N 1
  1.  Q:INSTR?1.2N1"."1.2N 1
  1.  Q:INSTR?1.2N1" "1.2N 1
  1.  Q ""