- XLFDT2 ;SEA/RDS - Library function Schedule ;03/21/2006
- ;;8.0;KERNEL;**71,86,141,414**;Jul 10, 1995;Build 1
- ;
- DECODE() ;SCH^XLFDT--Decode A Cycle Schedule String (Return Next Time)
- N %1,%D,%M,%T,%Y,Y,SCHL,LTMA,LTFM
- I $L(+LTM)>6 S LTFM=LTM,LTM=$$FMTH^XLFDT(LTM)
- A D NEXT Q:Y="" Y
- I $G(FF),Y<$H S LTM=Y G A
- I $G(FF),(+Y=+$H),$P(Y,",",2)'>$P($H,",",2) S LTM=Y G A
- Q $$HTFM^XLFDT(Y)
- ;
- NEXT ;
- I SCH?1.4N1"S" S Y=$P(SCH,"S")+$P(LTM,",",2),Y=(Y\86400+LTM)_","_(Y#86400) Q
- I SCH?1.4N1"H" S Y=$P(SCH,"H")*3600+$P(LTM,",",2),Y=(Y\86400+LTM)_","_(Y#86400) Q
- I SCH?1.3N1"D" S Y=($P(SCH,"D")+LTM)_","_$P(LTM,",",2) Q
- ;I SCH?1.3N1"D@".E S X=$P(SCH,"@",2),%DT="RS" D ^%DT Q:Y=-1 S X=Y D H^%DTC S Y=($P(SCH,"D")+LTM)_","_%T Q
- I SCH?1.2N1"M" D MONTH Q
- I SCH?1.2N1"M(".E1")" S SCHL=$P($P(SCH,")"),"(",2) D MONTH2^XLFDT3 Q
- I SCH?5.7N1P.5N.1";".E D LIST Q
- I "MTWRFSUDE"[$E(SCH),"@,"[$E(SCH,2),SCH]"" D WEEK Q
- S Y="" Q
- ;
- MONTH ;DECODE--Simple Month Increment (Add x Months)
- N X,XL,XLA,%,%H,%Y,%M,%D,%T
- S %H=LTM D YMD^XLFDT ;Break into %Y %M %D
- S XL=$P(SCH,"M") F Q:'XL S %M=%M+1,XL=XL-1 I %M=13 S %Y=%Y+1,%M=1
- S XLA="31^"_($$LEAP(%Y)+28)_"^31^30^31^30^31^31^30^31^30^31"
- I %D>$P(XLA,"^",%M) S %D=$P(XLA,"^",%M)
- S Y=$$FMTH^XLFDT(%Y_"00"+%M_"00"+%D_%T) ;Note %T has a leading '.'
- Q
- ;
- LIST ;DECODE--Find Next Run Time In List
- N %A,XL
- F %1=1:1 S XL=$P(SCH,";",%1) Q:XL="" S:$L(+XL)<7 XL=$$HTFM^XLFDT(XL) S %A(XL)=""
- S Y=$O(%A($$NOW^XLFDT)) S:Y>0 Y=$$FMTH^XLFDT(Y)
- Q
- ;
- WEEK ;DECODE--List Of Day Of Week Specifications
- N %A,%W,%Z,XL,XLT
- S XL=$P(LTM,",",2),%T=XL#60/100+(XL#3600\60)/100+(XL\3600)/100,%W=LTM+4#7+1,%Z="0"_%T,%Y=""
- F %1=1:1 S %Y=$P(SCH,",",%1) Q:%Y="" D ARRAY S:%A]"" %A(%A+XLT)=""
- S %A=$O(%A(%T)),Y="" S:%A]"" XLT=%A#1,XLT=$E(XLT_0,2,3)*60+$E(XLT_"000",4,5)*60+$E(XLT_"00000",6,7),Y=%A\1+LTM_","_XLT Q
- ;
- ARRAY ;WEEK Subroutine--Build Incident Array
- S XL=$E(%Y),XLT="" D TIME:$P(%Y,"@",2)]"" S:XLT="" XLT=%T
- S %A="" S:"UMTWRFS"[XL %A=$F("UMTWRFS",XL)-1,%A=$S(%A'=%W:6-%W+%A#7+1,XLT'>%T:6-%W+%A#7+1,1:0) S:XL="D" %A=$S(%W=1:1,%W=7:2,XLT'>%T:1+(%W=6*2),1:0)
- ;Mid week > Sat, Sat > Sun, Sun > Sat.
- S:XL="E" %A=$S(%W>1&(%W<7):7-%W,XLT'>%T:$S(%W=1:6,1:1),1:0) Q
- ;
- TIME ;ARRAY--Build Time Node For Incidents That Include Times
- N %DT,X S %DT="RS",X="T@"_$P(%Y,"@",2) D ^%DT S XLT=$S(Y=-1:"",1:Y#1) Q
- ;
- LEAP(%) ;Check if a Leap year
- S:%<1700 %=%+1700
- Q (%#4=0)&'(%#100=0)!(%#400=0)
- XLFDT2 ;SEA/RDS - Library function Schedule ;03/21/2006
- +1 ;;8.0;KERNEL;**71,86,141,414**;Jul 10, 1995;Build 1
- +2 ;
- DECODE() ;SCH^XLFDT--Decode A Cycle Schedule String (Return Next Time)
- +1 NEW %1,%D,%M,%T,%Y,Y,SCHL,LTMA,LTFM
- +2 IF $LENGTH(+LTM)>6
- SET LTFM=LTM
- SET LTM=$$FMTH^XLFDT(LTM)
- A DO NEXT
- IF Y=""
- QUIT Y
- +1 IF $GET(FF)
- IF Y<$HOROLOG
- SET LTM=Y
- GOTO A
- +2 IF $GET(FF)
- IF (+Y=+$HOROLOG)
- IF $PIECE(Y,",",2)'>$PIECE($HOROLOG,",",2)
- SET LTM=Y
- GOTO A
- +3 QUIT $$HTFM^XLFDT(Y)
- +4 ;
- NEXT ;
- +1 IF SCH?1.4N1"S"
- SET Y=$PIECE(SCH,"S")+$PIECE(LTM,",",2)
- SET Y=(Y\86400+LTM)_","_(Y#86400)
- QUIT
- +2 IF SCH?1.4N1"H"
- SET Y=$PIECE(SCH,"H")*3600+$PIECE(LTM,",",2)
- SET Y=(Y\86400+LTM)_","_(Y#86400)
- QUIT
- +3 IF SCH?1.3N1"D"
- SET Y=($PIECE(SCH,"D")+LTM)_","_$PIECE(LTM,",",2)
- QUIT
- +4 ;I SCH?1.3N1"D@".E S X=$P(SCH,"@",2),%DT="RS" D ^%DT Q:Y=-1 S X=Y D H^%DTC S Y=($P(SCH,"D")+LTM)_","_%T Q
- +5 IF SCH?1.2N1"M"
- DO MONTH
- QUIT
- +6 IF SCH?1.2N1"M(".E1")"
- SET SCHL=$PIECE($PIECE(SCH,")"),"(",2)
- DO MONTH2^XLFDT3
- QUIT
- +7 IF SCH?5.7N1P.5N.1";".E
- DO LIST
- QUIT
- +8 IF "MTWRFSUDE"[$EXTRACT(SCH)
- IF "@,"[$EXTRACT(SCH,2)
- IF SCH]""
- DO WEEK
- QUIT
- +9 SET Y=""
- QUIT
- +10 ;
- MONTH ;DECODE--Simple Month Increment (Add x Months)
- +1 NEW X,XL,XLA,%,%H,%Y,%M,%D,%T
- +2 ;Break into %Y %M %D
- SET %H=LTM
- DO YMD^XLFDT
- +3 SET XL=$PIECE(SCH,"M")
- FOR
- IF 'XL
- QUIT
- SET %M=%M+1
- SET XL=XL-1
- IF %M=13
- SET %Y=%Y+1
- SET %M=1
- +4 SET XLA="31^"_($$LEAP(%Y)+28)_"^31^30^31^30^31^31^30^31^30^31"
- +5 IF %D>$PIECE(XLA,"^",%M)
- SET %D=$PIECE(XLA,"^",%M)
- +6 ;Note %T has a leading '.'
- SET Y=$$FMTH^XLFDT(%Y_"00"+%M_"00"+%D_%T)
- +7 QUIT
- +8 ;
- LIST ;DECODE--Find Next Run Time In List
- +1 NEW %A,XL
- +2 FOR %1=1:1
- SET XL=$PIECE(SCH,";",%1)
- IF XL=""
- QUIT
- IF $LENGTH(+XL)<7
- SET XL=$$HTFM^XLFDT(XL)
- SET %A(XL)=""
- +3 SET Y=$ORDER(%A($$NOW^XLFDT))
- IF Y>0
- SET Y=$$FMTH^XLFDT(Y)
- +4 QUIT
- +5 ;
- WEEK ;DECODE--List Of Day Of Week Specifications
- +1 NEW %A,%W,%Z,XL,XLT
- +2 SET XL=$PIECE(LTM,",",2)
- SET %T=XL#60/100+(XL#3600\60)/100+(XL\3600)/100
- SET %W=LTM+4#7+1
- SET %Z="0"_%T
- SET %Y=""
- +3 FOR %1=1:1
- SET %Y=$PIECE(SCH,",",%1)
- IF %Y=""
- QUIT
- DO ARRAY
- IF %A]""
- SET %A(%A+XLT)=""
- +4 SET %A=$ORDER(%A(%T))
- SET Y=""
- IF %A]""
- SET XLT=%A#1
- SET XLT=$EXTRACT(XLT_0,2,3)*60+$EXTRACT(XLT_"000",4,5)*60+$EXTRACT(XLT_"00000",6,7)
- SET Y=%A\1+LTM_","_XLT
- QUIT
- +5 ;
- ARRAY ;WEEK Subroutine--Build Incident Array
- +1 SET XL=$EXTRACT(%Y)
- SET XLT=""
- IF $PIECE(%Y,"@",2)]""
- DO TIME
- IF XLT=""
- SET XLT=%T
- +2 SET %A=""
- IF "UMTWRFS"[XL
- SET %A=$FIND("UMTWRFS",XL)-1
- SET %A=$SELECT(%A'=%W:6-%W+%A#7+1,XLT'>%T:6-%W+%A#7+1,1:0)
- IF XL="D"
- SET %A=$SELECT(%W=1:1,%W=7:2,XLT'>%T:1+(%W=6*2),1:0)
- +3 ;Mid week > Sat, Sat > Sun, Sun > Sat.
- +4 IF XL="E"
- SET %A=$SELECT(%W>1&(%W<7):7-%W,XLT'>%T:$SELECT(%W=1:6,1:1),1:0)
- QUIT
- +5 ;
- TIME ;ARRAY--Build Time Node For Incidents That Include Times
- +1 NEW %DT,X
- SET %DT="RS"
- SET X="T@"_$PIECE(%Y,"@",2)
- DO ^%DT
- SET XLT=$SELECT(Y=-1:"",1:Y#1)
- QUIT
- +2 ;
- LEAP(%) ;Check if a Leap year
- +1 IF %<1700
- SET %=%+1700
- +2 QUIT (%#4=0)&'(%#100=0)!(%#400=0)
