source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XLFDT3.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1XLFDT3 ;SEA/RDS - Library Function Schedule ;02/09/2000 09:21
2 ;;8.0;KERNEL;**71,120,141**;Jul 10, 1995
3 ;
4MONTH2 ;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 ;
21BUILD ;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 ;
33TIME(%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 ;
39LEAP(%) ;Check if a Leap year
40 S:%<1700 %=%+1700
41 Q (%#4=0)&'(%#100=0)!(%#400=0)
42 ;
43FLD() ;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
Note: See TracBrowser for help on using the repository browser.