| 1 | XLFDT3 ;SEA/RDS - Library Function Schedule ;02/09/2000 09:21
|
|---|
| 2 | ;;8.0;KERNEL;**71,120,141**;Jul 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | MONTH2 ;DECODE--Complex Month Increment Specification
|
|---|
| 5 | N %,%A,%B,%C,%D,%H,%L,%M,%O,%T,%Y,XL,XLCT,XLW,XLX,XLF,XLFS,XLL,XLLW,XLO,XLT
|
|---|
| 6 | S %H=LTM D YMD^XLFDT S %L=%Y+1700,%L=$$LEAP(%L)
|
|---|
| 7 | S LTMA="31^"_(%L+28)_"^31^30^31^30^31^31^30^31^30^31",%=$P(LTM,",",2),XLCT=%#60/100+(%#3600\60)/100+(%\3600)/100
|
|---|
| 8 | ;Check if a date in current month
|
|---|
| 9 | S XLF=LTM-%D+5#7+1,XLFS=2-XLF,XLL=$P(LTMA,"^",%M),XLLW=XLF-29+XLL S:XLLW=0 XLLW=7 S:XLLW>7 XLLW=XLLW#8+1
|
|---|
| 10 | K %A F XLX=1:1:$L(SCHL,",") D BUILD
|
|---|
| 11 | I $O(%A(%D+XLCT))]"" S XLO=$O(%A(%D+XLCT)),%1=XLO\1-%D,XLT=XLO#1,XLT=$E(XLT_0,2,3)*60+$E(XLT_"000",4,5)*60+$E(XLT_"00000",6,7),Y=LTM+%1_","_XLT Q
|
|---|
| 12 | ;Check the next months
|
|---|
| 13 | S %C=XLL-%D,XL=$P(SCH,"M")-1,%M=%M+1 S:%M=13 %Y=%Y+1,%M=1,$P(LTMA,"^",2)=28+$$LEAP(%Y)
|
|---|
| 14 | F Q:'XL S %C=%C+$P(LTMA,"^",%M),%M=%M+1,XL=XL-1 I %M=13 S %Y=%Y+1,%M=1,$P(LTMA,"^",2)=28+$$LEAP(%Y)
|
|---|
| 15 | S LTM=LTM+%C_","_$P(LTM,",",2),XLF=LTM+5#7+1,XLFS=2-XLF,XLL=$P(LTMA,"^",%M),XLLW=XLF-29+XLL S:XLLW=0 XLLW=7 S:XLLW>7 XLLW=XLLW#8+1
|
|---|
| 16 | K %A F XLX=1:1:$L(SCHL,",") D BUILD
|
|---|
| 17 | S %O=$O(%A("")) I %O="" S %O=$$FLD() ;Q ;Bad input, force last day
|
|---|
| 18 | S %=%O#1,%=$E(%_0,2,3)*60+$E(%_"000",4,5)*60+$E(%_"00000",6,7),Y=%O\1+LTM_","_%
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | BUILD ;MONTH2--Building Array Of Run Incidents For Month
|
|---|
| 22 | S %B=$P(SCHL,",",XLX),XLT=""
|
|---|
| 23 | ;Build for a day in month (15)
|
|---|
| 24 | I $P(%B,"@")?1.2N S %A=%B\1 Q:%A>XLL!'%A S XLT=$$TIME($P(%B,"@",2)) S %A(%A+XLT)="" Q
|
|---|
| 25 | ;Build for 1st.. DOW in month ("2W")
|
|---|
| 26 | I $P(%B,"@")?1N1U,"UMTWRFS"[$E(%B,2) S %A=XLFS+$F("UMTWRFS",$E(%B,2))-2,%A=%B-(%A>0)*7+%A\1 Q:%A>XLL!'%A S XLT=$$TIME($P(%B,"@",2)) S %A(%A+XLT)="" Q
|
|---|
| 27 | ;Build for Last day of month ("L")
|
|---|
| 28 | I $P(%B,"@")="L" S %A=XLL,XLT=$$TIME($P(%B,"@",2)) S %A(%A+XLT)="" Q
|
|---|
| 29 | ;Build for last DOW in month ("LF") last friday
|
|---|
| 30 | I $P(%B,"@")?1"L"1U,"UMTWRFS"[$E(%B,2) S XLW=$F("UMTWRFS",$E(%B,2))-1,%A=XLL-$S(XLLW-XLW<0:XLLW+7-XLW,1:XLLW-XLW),XLT=$$TIME($P(%B,"@",2)) S %A(%A+XLT)="" Q
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | TIME(%X) ;BUILD--Build Time Node For Incidents That Include Times
|
|---|
| 34 | N %Y,%M,%D,%T,%DT,X,Y
|
|---|
| 35 | I %X="" Q XLCT ;use current time
|
|---|
| 36 | S %DT="RS",X="T@"_%X D ^%DT
|
|---|
| 37 | Q $S(Y=-1:XLCT,1:Y#1)
|
|---|
| 38 | ;
|
|---|
| 39 | LEAP(%) ;Check if a Leap year
|
|---|
| 40 | S:%<1700 %=%+1700
|
|---|
| 41 | Q (%#4=0)&'(%#100=0)!(%#400=0)
|
|---|
| 42 | ;
|
|---|
| 43 | FLD() ;Force to last day of month.
|
|---|
| 44 | S XLT=""
|
|---|
| 45 | F XLX=1:1:$L(SCHL,",") S %B=$P(SCHL,",",XLX) I +%B>XLL S XLT=$$TIME($P(%B,"@",2))
|
|---|
| 46 | Q XLL+XLT
|
|---|
