INHUTC21 ;bar,DS; 28 Aug 97 16:14; Interface Criteria date functions
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;;COPYRIGHT 1997 SAIC
Q
;
RELDT(INSTR,INFMT,INPMT) ; convert a relative date text string to a FM
; date/time format
;
; input: INSTR = string consisting of a relative date/time designation
; and optionally add/subtract modifiers or @time.
; INFMT = formating options similar to %DT options.
; = "A" Ask for input
; = "E", Echo the answer
; = "F", future dates are assumed
; = "L", for space bar return lookup
; = "N" Pure numeric input is not allowed
; = "P", past dates are assumed
; = "S", allow seconds in input and output
; = "T", allow time in input and output
; = "U", for readable date/time format
;
; INPMT = Prompt to display (Default is 'Date: ')
;
; returns: date/time in FM format
;
N INA,INB,INCY,IND,INDT,INOUT,INUM,INI,INNOW,INTIME,INX,INY,X
S INSTR=$$UPCASE^%ZTF($G(INSTR)),INFMT=$$UPCASE^%ZTF($G(INFMT))
S INPMT=$G(INPMT,"Date: "),INNOW=$$NOW^%ZTFDT
;
; if asked to prompt for input, get input and call back recursively
I INFMT["A" D Q:X="^" "User aborted or timed out" Q $$RELDT(X,INFMT,INPMT)
. S INFMT=$TR(INFMT,"A","L")
. D ^UTSRD(INPMT_";;;;"_INSTR,"^D HELP^INHUTC22")
. I $D(DTOUT)!$D(DUOUT) S X="^" Q
. ; if help is requested, display help and quit
. S:$L(INSTR)&'$L(X) X=INSTR
. I X=" ",$L($G(^DIJUSV(+$G(DUZ),"RELDT^INHUTC21"))) S X=^("RELDT^INHUTC21")
;
; check for pure numeric input if not allowed
I INFMT["N",INSTR?.N,+INSTR=INSTR D Q INOUT
. S INOUT="Pure numeric input is not allowed."
. W:INFMT["E" $C(7)_" "_INOUT
;
; assume past dates - assume nothing we just want to eval the date
; I INFMT'["F",INFMT'["P" S INFMT=INFMT_"P"
; create logical pieces of input string into INY
S INY=$TR(INSTR,"+-@","^^^"),INA=1,INB=0,INDT=""
; set INB to each piece and evaluate
F INI=1:1 S INB=$F(INY,"^",INB) D Q:'INB!('INDT)
. S INX=$E(INSTR,INA,$S(INB:INB-2,1:$L(INSTR))),INA=INA+$L(INX) Q:'$L(INX)
. ; ------------------ process base date ------------------------
. I INI=1 D Q
.. ; set default for base to NOW
.. S:'$L(INX) INX="NOW"
.. I INX=$E("TODAY",1,$L(INX)) S INDT=$$CDATH2F^%ZTFDT(+$H) Q
.. I INX="NOW"!(INX="N") S INDT=INNOW Q
.. ; process begin/end entries
.. I "BE"[$E(INX) D Q
... ; set flag IND, true if BEGIN, false if END
... N IND,INT S IND=($E(INX)="B")
... ; get date type
... F I=2:1 I "YMD"[$E(INX,I) S INT=$E(INX,I) Q
... Q:'$L(INT)
... ; process current year
... I $E(INT)="Y" S INDT=$$CDATA2F^%ZTFDT($S(IND:"JAN 01",1:"DEC 31")) Q
... ; process current month
... I $E(INT)="M" D Q
.... N INE
.... S INDT=$$CDATH2F^%ZTFDT(+$H)
.... ; set day of the month based on begin or end
.... S INE=$S(IND:"01",1:$P("31 28 31 30 31 30 31 31 30 31 30 31"," ",$E(INDT,4,5)))
.... ; leap year is every 4, except on a century
.... ; every 400 years the century keeps the leap year
.... I INE=28,'(I#4),'('$E(I,3,4)&(I#400)) S INE=29
.... S $E(INDT,6,7)=INE
... ; process current day
... I $E(INT)="D" S INDT=$$DT^%ZTFDT_$S(IND:"",1:".24") Q
.. ; process days of the week with last and next
.. I "NL"[$E(INX),$E(INX,2)'="O" D Q
... N IND,INH
... S INH=$H,IND=$F("TH,FR,SA,SU,MO,TU,WE",$E(INX,2,3)) Q:'IND
... S IND=IND/3+6-(INH#7)#7 S:$E(INX)="L" IND=IND-7 S:'IND IND=7
... S INDT=$$ADDT^%ZTFDT(INNOW,IND)
.. ; check for specific date
.. S INDT=$$CDATA2F^%ZTFDT(INX)
. ; --------------- process modifiers -------------------------------
. ; process @time input
. I $E(INX)="@" D Q
.. S IND=$$CDATA2F^%ZTFDT(INX,"T") I 'IND S INDT="" Q
.. S INDT=$P(INDT,".",1)_"."_$P(IND,".",2)
. ; parse number and modifier, no-op if no value, default is DAYS
. S INUM=+INX,IND=$P(INX,INUM,2) Q:'INUM S:'$L(IND) IND="D"
. ; check for Day, Hour, Minites, Seconds
. I $F(",WEEKS,DAYS,HOURS,MINUTES,SECONDS",","_IND) D Q
.. N D,H,M,S
.. ;calculate weeks into days
.. S IND=$E(IND) S:IND="W" IND="D",INUM=INUM*7
.. S @IND=INUM,INDT=$$ADDT^%ZTFDT(INDT,$G(D),$G(H),$G(M),$G(S))
. ; check for Year, Month
. I $F(",MONTHS,YEARS",","_IND) D Q
.. ; if years, calc number of months. Add months to current date
.. S:$E(IND)="Y" INUM=INUM*12 S INDT=$$ADDM^%ZTFDT(INDT,INUM)
. ; if it doesn't pass any formats, it must be bad
. S INDT=""
;
; loop back if asked to prompt and user input is invalid
I 'INDT D Q INOUT
. S INOUT="value "_INSTR_" is invalid"
. W:INFMT["E" $C(7)_" ("_INOUT_")"
;
; check if time input is required
I INFMT["R",'$F(INDT,".") D Q INOUT
. S INOUT="Time input is required."
. W:INFMT["E" $C(7)_" "_INOUT
;
; if INFMT does not contain 'T' to remove the time portion
S:INFMT'["T" INDT=$P(INDT,".")
;
; if INFMT does not contain 'S' to remove the seconds portion,
; remove the seconds
S:INFMT'["S" INDT=$P(INDT,".")_"."_$E($P(INDT,".",2),1,4)
;
; check for past or future date assumptions and increment
; or decrement CYY.
I INFMT["F"!(INFMT["P")&($$CHKDT($P(INSTR,"@"))) D
. S INDAT=$$PASFUT^INHUTC21($P(INDT,"."),INFMT)
. S:$L($P(INDT,".",2)) INDAT=INDAT_"."_$P(INDT,".",2)
. S INDT=INDAT
;
; check if past date was assumed and entered a date in the future
I INFMT["P",INDT>INNOW D Q INOUT
. S INOUT="Enter a date no later than today"
. W:INFMT["E" $C(7)_" "_INOUT
;
; check if future date was assumed and entered a date in the past
I INFMT["F",INDT<INNOW D Q INOUT
. S INOUT="Enter a date greater than today"
. W:INFMT["E" $C(7)_" "_INOUT
;
; save input string for space bar return lookup
S:INFMT["L" ^DIJUSV(+$G(DUZ),"RELDT^INHUTC21")=INSTR
;
; if requested for readable date/time format
I INFMT["U" D Q INOUT
. S INOUT=$$CDATASC^%ZTFDT(INDT,1,$S(INDT[".":1,1:""))
. W:INFMT["E" " ("_INOUT_")"
W:INFMT["E" " ("_+INDT_")"
Q +INDT
;
PASFUT(CYYMMDD,INFMT) ; check for Past or Future date assumptions and
; increment or decrement CYY appropriately.
;
; Input: CYYMMDD (req) = FileMan date format
; INFMT (req) = like %DT string, holds F or P
;
; Output: CYY+1_MMDD if future dates are assumed and MMDD is > today
; CYY-1_MMDD if past dates are assumed and MMDD is > today
;
N CYY,DD,INDELTA,INHDT,INHMMDD,MM
S INFMT=$G(INFMT)
; assume past dates
I INFMT'["F",INFMT'["P" S INFMT=INFMT_"P"
S INHDT=$$DT^%ZTFDT,INHMMDD=$E(INHDT,4,7),INDELTA=-1,INOPER=">"
S:INFMT["F" INDELTA=1,INOPER="<"
S CYY=$E(CYYMMDD,1,3),MM=$E(CYYMMDD,4,5),DD=$E(CYYMMDD,6,7),MD=MM*100+DD
I @(MD_INOPER_INHMMDD) S CYY=CYY+INDELTA
Q CYY_MM_DD
;
CHKDT(INSTR) ; check the format of the input date string
;
; Output: 1, if the input date string is in MM/DD or MM-DD format and
; year has not been supplied.
; null, otherwise.
;
S INSTR=$G(INSTR)
; check for MM/DD/YYYY, MM-DD-YYYY, MM.DD.YYYY formats
Q:INSTR?1.2N1"/"1.2N1"/"1.4N ""
Q:INSTR?1.2N1"-"1.2N1"-"1.4N ""
Q:INSTR?1.2N1"."1.2N1"."1.4N ""
Q:INSTR?1.2N1" "1.2N1" "1.4N ""
; MMM DD YYYY or DD MMM YYYY formats
Q:INSTR?3U1" "1.2N1" "1.4N ""
Q:INSTR?1.2N1" "3U1" "1.4N ""
; MMDDYY or MMDDYYYY
Q:INSTR?6.8N ""
Q:INSTR["TODAY"!(INSTR["T")!(INSTR["NOW") ""
; chech for MM/DD or MM-DD formats, year is not supplied
Q:INSTR?1.2N1"/"1.2N 1
Q:INSTR?1.2N1"-"1.2N 1
Q:INSTR?1.2N1"."1.2N 1
Q:INSTR?1.2N1" "1.2N 1
Q ""
INHUTC21 ;bar,DS; 28 Aug 97 16:14; Interface Criteria date functions
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;;COPYRIGHT 1997 SAIC
+4 QUIT
+5 ;
RELDT(INSTR,INFMT,INPMT) ; convert a relative date text string to a FM
+1 ; date/time format
+2 ;
+3 ; input: INSTR = string consisting of a relative date/time designation
+4 ; and optionally add/subtract modifiers or @time.
+5 ; INFMT = formating options similar to %DT options.
+6 ; = "A" Ask for input
+7 ; = "E", Echo the answer
+8 ; = "F", future dates are assumed
+9 ; = "L", for space bar return lookup
+10 ; = "N" Pure numeric input is not allowed
+11 ; = "P", past dates are assumed
+12 ; = "S", allow seconds in input and output
+13 ; = "T", allow time in input and output
+14 ; = "U", for readable date/time format
+15 ;
+16 ; INPMT = Prompt to display (Default is 'Date: ')
+17 ;
+18 ; returns: date/time in FM format
+19 ;
+20 NEW INA,INB,INCY,IND,INDT,INOUT,INUM,INI,INNOW,INTIME,INX,INY,X
+21 SET INSTR=$$UPCASE^%ZTF($GET(INSTR))
SET INFMT=$$UPCASE^%ZTF($GET(INFMT))
+22 SET INPMT=$GET(INPMT,"Date: ")
SET INNOW=$$NOW^%ZTFDT
+23 ;
+24 ; if asked to prompt for input, get input and call back recursively
+25 IF INFMT["A"
Begin DoDot:1
+26 SET INFMT=$TRANSLATE(INFMT,"A","L")
+27 DO ^UTSRD(INPMT_";;;;"_INSTR,"^D HELP^INHUTC22")
+28 IF $DATA(DTOUT)!$DATA(DUOUT)
SET X="^"
QUIT
+29 ; if help is requested, display help and quit
+30 IF $LENGTH(INSTR)&'$LENGTH(X)
SET X=INSTR
+31 IF X=" "
IF $LENGTH($GET(^DIJUSV(+$GET(DUZ),"RELDT^INHUTC21")))
SET X=^("RELDT^INHUTC21")
End DoDot:1
IF X="^"
QUIT "User aborted or timed out"
QUIT $$RELDT(X,INFMT,INPMT)
+32 ;
+33 ; check for pure numeric input if not allowed
+34 IF INFMT["N"
IF INSTR?.N
IF +INSTR=INSTR
Begin DoDot:1
+35 SET INOUT="Pure numeric input is not allowed."
+36 IF INFMT["E"
WRITE $CHAR(7)_" "_INOUT
End DoDot:1
QUIT INOUT
+37 ;
+38 ; assume past dates - assume nothing we just want to eval the date
+39 ; I INFMT'["F",INFMT'["P" S INFMT=INFMT_"P"
+40 ; create logical pieces of input string into INY
+41 SET INY=$TRANSLATE(INSTR,"+-@","^^^")
SET INA=1
SET INB=0
SET INDT=""
+42 ; set INB to each piece and evaluate
+43 FOR INI=1:1
SET INB=$FIND(INY,"^",INB)
Begin DoDot:1
+44 SET INX=$EXTRACT(INSTR,INA,$SELECT(INB:INB-2,1:$LENGTH(INSTR)))
SET INA=INA+$LENGTH(INX)
IF '$LENGTH(INX)
QUIT
+45 ; ------------------ process base date ------------------------
+46 IF INI=1
Begin DoDot:2
+47 ; set default for base to NOW
+48 IF '$LENGTH(INX)
SET INX="NOW"
+49 IF INX=$EXTRACT("TODAY",1,$LENGTH(INX))
SET INDT=$$CDATH2F^%ZTFDT(+$HOROLOG)
QUIT
+50 IF INX="NOW"!(INX="N")
SET INDT=INNOW
QUIT
+51 ; process begin/end entries
+52 IF "BE"[$EXTRACT(INX)
Begin DoDot:3
+53 ; set flag IND, true if BEGIN, false if END
+54 NEW IND,INT
SET IND=($EXTRACT(INX)="B")
+55 ; get date type
+56 FOR I=2:1
IF "YMD"[$EXTRACT(INX,I)
SET INT=$EXTRACT(INX,I)
QUIT
+57 IF '$LENGTH(INT)
QUIT
+58 ; process current year
+59 IF $EXTRACT(INT)="Y"
SET INDT=$$CDATA2F^%ZTFDT($SELECT(IND:"JAN 01",1:"DEC 31"))
QUIT
+60 ; process current month
+61 IF $EXTRACT(INT)="M"
Begin DoDot:4
+62 NEW INE
+63 SET INDT=$$CDATH2F^%ZTFDT(+$HOROLOG)
+64 ; set day of the month based on begin or end
+65 SET INE=$SELECT(IND:"01",1:$PIECE("31 28 31 30 31 30 31 31 30 31 30 31"," ",$EXTRACT(INDT,4,5)))
+66 ; leap year is every 4, except on a century
+67 ; every 400 years the century keeps the leap year
+68 IF INE=28
IF '(I#4)
IF '('$EXTRACT(I,3,4)&(I#400))
SET INE=29
+69 SET $EXTRACT(INDT,6,7)=INE
End DoDot:4
QUIT
+70 ; process current day
+71 IF $EXTRACT(INT)="D"
SET INDT=$$DT^%ZTFDT_$S(IND:"",1:".24")
QUIT
End DoDot:3
QUIT
+72 ; process days of the week with last and next
+73 IF "NL"[$EXTRACT(INX)
IF $EXTRACT(INX,2)'="O"
Begin DoDot:3
+74 NEW IND,INH
+75 SET INH=$HOROLOG
SET IND=$FIND("TH,FR,SA,SU,MO,TU,WE",$EXTRACT(INX,2,3))
IF 'IND
QUIT
+76 SET IND=IND/3+6-(INH#7)#7
IF $EXTRACT(INX)="L"
SET IND=IND-7
IF 'IND
SET IND=7
+77 SET INDT=$$ADDT^%ZTFDT(INNOW,IND)
End DoDot:3
QUIT
+78 ; check for specific date
+79 SET INDT=$$CDATA2F^%ZTFDT(INX)
End DoDot:2
QUIT
+80 ; --------------- process modifiers -------------------------------
+81 ; process @time input
+82 IF $EXTRACT(INX)="@"
Begin DoDot:2
+83 SET IND=$$CDATA2F^%ZTFDT(INX,"T")
IF 'IND
SET INDT=""
QUIT
+84 SET INDT=$PIECE(INDT,".",1)_"."_$PIECE(IND,".",2)
End DoDot:2
QUIT
+85 ; parse number and modifier, no-op if no value, default is DAYS
+86 SET INUM=+INX
SET IND=$PIECE(INX,INUM,2)
IF 'INUM
QUIT
IF '$LENGTH(IND)
SET IND="D"
+87 ; check for Day, Hour, Minites, Seconds
+88 IF $FIND(",WEEKS,DAYS,HOURS,MINUTES,SECONDS",","_IND)
Begin DoDot:2
+89 NEW D,H,M,S
+90 ;calculate weeks into days
+91 SET IND=$EXTRACT(IND)
IF IND="W"
SET IND="D"
SET INUM=INUM*7
+92 SET @IND=INUM
SET INDT=$$ADDT^%ZTFDT(INDT,$GET(D),$GET(H),$GET(M),$GET(S))
End DoDot:2
QUIT
+93 ; check for Year, Month
+94 IF $FIND(",MONTHS,YEARS",","_IND)
Begin DoDot:2
+95 ; if years, calc number of months. Add months to current date
+96 IF $EXTRACT(IND)="Y"
SET INUM=INUM*12
SET INDT=$$ADDM^%ZTFDT(INDT,INUM)
End DoDot:2
QUIT
+97 ; if it doesn't pass any formats, it must be bad
+98 SET INDT=""
End DoDot:1
IF 'INB!('INDT)
QUIT
+99 ;
+100 ; loop back if asked to prompt and user input is invalid
+101 IF 'INDT
Begin DoDot:1
+102 SET INOUT="value "_INSTR_" is invalid"
+103 IF INFMT["E"
WRITE $CHAR(7)_" ("_INOUT_")"
End DoDot:1
QUIT INOUT
+104 ;
+105 ; check if time input is required
+106 IF INFMT["R"
IF '$FIND(INDT,".")
Begin DoDot:1
+107 SET INOUT="Time input is required."
+108 IF INFMT["E"
WRITE $CHAR(7)_" "_INOUT
End DoDot:1
QUIT INOUT
+109 ;
+110 ; if INFMT does not contain 'T' to remove the time portion
+111 IF INFMT'["T"
SET INDT=$PIECE(INDT,".")
+112 ;
+113 ; if INFMT does not contain 'S' to remove the seconds portion,
+114 ; remove the seconds
+115 IF INFMT'["S"
SET INDT=$PIECE(INDT,".")_"."_$EXTRACT($PIECE(INDT,".",2),1,4)
+116 ;
+117 ; check for past or future date assumptions and increment
+118 ; or decrement CYY.
+119 IF INFMT["F"!(INFMT["P")&($$CHKDT($PIECE(INSTR,"@")))
Begin DoDot:1
+120 SET INDAT=$$PASFUT^INHUTC21($PIECE(INDT,"."),INFMT)
+121 IF $LENGTH($PIECE(INDT,".",2))
SET INDAT=INDAT_"."_$PIECE(INDT,".",2)
+122 SET INDT=INDAT
End DoDot:1
+123 ;
+124 ; check if past date was assumed and entered a date in the future
+125 IF INFMT["P"
IF INDT>INNOW
Begin DoDot:1
+126 SET INOUT="Enter a date no later than today"
+127 IF INFMT["E"
WRITE $CHAR(7)_" "_INOUT
End DoDot:1
QUIT INOUT
+128 ;
+129 ; check if future date was assumed and entered a date in the past
+130 IF INFMT["F"
IF INDT<INNOW
Begin DoDot:1
+131 SET INOUT="Enter a date greater than today"
+132 IF INFMT["E"
WRITE $CHAR(7)_" "_INOUT
End DoDot:1
QUIT INOUT
+133 ;
+134 ; save input string for space bar return lookup
+135 IF INFMT["L"
SET ^DIJUSV(+$GET(DUZ),"RELDT^INHUTC21")=INSTR
+136 ;
+137 ; if requested for readable date/time format
+138 IF INFMT["U"
Begin DoDot:1
+139 SET INOUT=$$CDATASC^%ZTFDT(INDT,1,$SELECT(INDT[".":1,1:""))
+140 IF INFMT["E"
WRITE " ("_INOUT_")"
End DoDot:1
QUIT INOUT
+141 IF INFMT["E"
WRITE " ("_+INDT_")"
+142 QUIT +INDT
+143 ;
PASFUT(CYYMMDD,INFMT) ; check for Past or Future date assumptions and
+1 ; increment or decrement CYY appropriately.
+2 ;
+3 ; Input: CYYMMDD (req) = FileMan date format
+4 ; INFMT (req) = like %DT string, holds F or P
+5 ;
+6 ; Output: CYY+1_MMDD if future dates are assumed and MMDD is > today
+7 ; CYY-1_MMDD if past dates are assumed and MMDD is > today
+8 ;
+9 NEW CYY,DD,INDELTA,INHDT,INHMMDD,MM
+10 SET INFMT=$GET(INFMT)
+11 ; assume past dates
+12 IF INFMT'["F"
IF INFMT'["P"
SET INFMT=INFMT_"P"
+13 SET INHDT=$$DT^%ZTFDT
SET INHMMDD=$EXTRACT(INHDT,4,7)
SET INDELTA=-1
SET INOPER=">"
+14 IF INFMT["F"
SET INDELTA=1
SET INOPER="<"
+15 SET CYY=$EXTRACT(CYYMMDD,1,3)
SET MM=$EXTRACT(CYYMMDD,4,5)
SET DD=$EXTRACT(CYYMMDD,6,7)
SET MD=MM*100+DD
+16 IF @(MD_INOPER_INHMMDD)
SET CYY=CYY+INDELTA
+17 QUIT CYY_MM_DD
+18 ;
CHKDT(INSTR) ; check the format of the input date string
+1 ;
+2 ; Output: 1, if the input date string is in MM/DD or MM-DD format and
+3 ; year has not been supplied.
+4 ; null, otherwise.
+5 ;
+6 SET INSTR=$GET(INSTR)
+7 ; check for MM/DD/YYYY, MM-DD-YYYY, MM.DD.YYYY formats
+8 IF INSTR?1.2N1"/"1.2N1"/"1.4N
QUIT ""
+9 IF INSTR?1.2N1"-"1.2N1"-"1.4N
QUIT ""
+10 IF INSTR?1.2N1"."1.2N1"."1.4N
QUIT ""
+11 IF INSTR?1.2N1" "1.2N1" "1.4N
QUIT ""
+12 ; MMM DD YYYY or DD MMM YYYY formats
+13 IF INSTR?3U1" "1.2N1" "1.4N
QUIT ""
+14 IF INSTR?1.2N1" "3U1" "1.4N
QUIT ""
+15 ; MMDDYY or MMDDYYYY
+16 IF INSTR?6.8N
QUIT ""
+17 IF INSTR["TODAY"!(INSTR["T")!(INSTR["NOW")
QUIT ""
+18 ; chech for MM/DD or MM-DD formats, year is not supplied
+19 IF INSTR?1.2N1"/"1.2N
QUIT 1
+20 IF INSTR?1.2N1"-"1.2N
QUIT 1
+21 IF INSTR?1.2N1"."1.2N
QUIT 1
+22 IF INSTR?1.2N1" "1.2N
QUIT 1
+23 QUIT ""
