- XLFDT3 ;SEA/RDS - Library Function Schedule ;02/09/2000 09:21
- ;;8.0;KERNEL;**71,120,141**;Jul 10, 1995
- ;
- MONTH2 ;DECODE--Complex Month Increment Specification
- N %,%A,%B,%C,%D,%H,%L,%M,%O,%T,%Y,XL,XLCT,XLW,XLX,XLF,XLFS,XLL,XLLW,XLO,XLT
- S %H=LTM D YMD^XLFDT S %L=%Y+1700,%L=$$LEAP(%L)
- 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
- ;Check if a date in current month
- 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
- K %A F XLX=1:1:$L(SCHL,",") D BUILD
- 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
- ;Check the next months
- 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)
- 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)
- 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
- K %A F XLX=1:1:$L(SCHL,",") D BUILD
- S %O=$O(%A("")) I %O="" S %O=$$FLD() ;Q ;Bad input, force last day
- S %=%O#1,%=$E(%_0,2,3)*60+$E(%_"000",4,5)*60+$E(%_"00000",6,7),Y=%O\1+LTM_","_%
- Q
- ;
- BUILD ;MONTH2--Building Array Of Run Incidents For Month
- S %B=$P(SCHL,",",XLX),XLT=""
- ;Build for a day in month (15)
- I $P(%B,"@")?1.2N S %A=%B\1 Q:%A>XLL!'%A S XLT=$$TIME($P(%B,"@",2)) S %A(%A+XLT)="" Q
- ;Build for 1st.. DOW in month ("2W")
- 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
- ;Build for Last day of month ("L")
- I $P(%B,"@")="L" S %A=XLL,XLT=$$TIME($P(%B,"@",2)) S %A(%A+XLT)="" Q
- ;Build for last DOW in month ("LF") last friday
- 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
- Q
- ;
- TIME(%X) ;BUILD--Build Time Node For Incidents That Include Times
- N %Y,%M,%D,%T,%DT,X,Y
- I %X="" Q XLCT ;use current time
- S %DT="RS",X="T@"_%X D ^%DT
- Q $S(Y=-1:XLCT,1:Y#1)
- ;
- LEAP(%) ;Check if a Leap year
- S:%<1700 %=%+1700
- Q (%#4=0)&'(%#100=0)!(%#400=0)
- ;
- FLD() ;Force to last day of month.
- S XLT=""
- F XLX=1:1:$L(SCHL,",") S %B=$P(SCHL,",",XLX) I +%B>XLL S XLT=$$TIME($P(%B,"@",2))
- Q XLL+XLT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXLFDT3 2430 printed Feb 18, 2025@23:29:05 Page 2
- XLFDT3 ;SEA/RDS - Library Function Schedule ;02/09/2000 09:21
- +1 ;;8.0;KERNEL;**71,120,141**;Jul 10, 1995
- +2 ;
- MONTH2 ;DECODE--Complex Month Increment Specification
- +1 NEW %,%A,%B,%C,%D,%H,%L,%M,%O,%T,%Y,XL,XLCT,XLW,XLX,XLF,XLFS,XLL,XLLW,XLO,XLT
- +2 SET %H=LTM
- DO YMD^XLFDT
- SET %L=%Y+1700
- SET %L=$$LEAP(%L)
- +3 SET LTMA="31^"_(%L+28)_"^31^30^31^30^31^31^30^31^30^31"
- SET %=$PIECE(LTM,",",2)
- SET XLCT=%#60/100+(%#3600\60)/100+(%\3600)/100
- +4 ;Check if a date in current month
- +5 SET XLF=LTM-%D+5#7+1
- SET XLFS=2-XLF
- SET XLL=$PIECE(LTMA,"^",%M)
- SET XLLW=XLF-29+XLL
- if XLLW=0
- SET XLLW=7
- if XLLW>7
- SET XLLW=XLLW#8+1
- +6 KILL %A
- FOR XLX=1:1:$LENGTH(SCHL,",")
- DO BUILD
- +7 IF $ORDER(%A(%D+XLCT))]""
- SET XLO=$ORDER(%A(%D+XLCT))
- SET %1=XLO\1-%D
- SET XLT=XLO#1
- SET XLT=$EXTRACT(XLT_0,2,3)*60+$EXTRACT(XLT_"000",4,5)*60+$EXTRACT(XLT_"00000",6,7)
- SET Y=LTM+%1_","_XLT
- QUIT
- +8 ;Check the next months
- +9 SET %C=XLL-%D
- SET XL=$PIECE(SCH,"M")-1
- SET %M=%M+1
- if %M=13
- SET %Y=%Y+1
- SET %M=1
- SET $PIECE(LTMA,"^",2)=28+$$LEAP(%Y)
- +10 FOR
- if 'XL
- QUIT
- SET %C=%C+$PIECE(LTMA,"^",%M)
- SET %M=%M+1
- SET XL=XL-1
- IF %M=13
- SET %Y=%Y+1
- SET %M=1
- SET $PIECE(LTMA,"^",2)=28+$$LEAP(%Y)
- +11 SET LTM=LTM+%C_","_$PIECE(LTM,",",2)
- SET XLF=LTM+5#7+1
- SET XLFS=2-XLF
- SET XLL=$PIECE(LTMA,"^",%M)
- SET XLLW=XLF-29+XLL
- if XLLW=0
- SET XLLW=7
- if XLLW>7
- SET XLLW=XLLW#8+1
- +12 KILL %A
- FOR XLX=1:1:$LENGTH(SCHL,",")
- DO BUILD
- +13 ;Q ;Bad input, force last day
- SET %O=$ORDER(%A(""))
- IF %O=""
- SET %O=$$FLD()
- +14 SET %=%O#1
- SET %=$EXTRACT(%_0,2,3)*60+$EXTRACT(%_"000",4,5)*60+$EXTRACT(%_"00000",6,7)
- SET Y=%O\1+LTM_","_%
- +15 QUIT
- +16 ;
- BUILD ;MONTH2--Building Array Of Run Incidents For Month
- +1 SET %B=$PIECE(SCHL,",",XLX)
- SET XLT=""
- +2 ;Build for a day in month (15)
- +3 IF $PIECE(%B,"@")?1.2N
- SET %A=%B\1
- if %A>XLL!'%A
- QUIT
- SET XLT=$$TIME($PIECE(%B,"@",2))
- SET %A(%A+XLT)=""
- QUIT
- +4 ;Build for 1st.. DOW in month ("2W")
- +5 IF $PIECE(%B,"@")?1N1U
- IF "UMTWRFS"[$EXTRACT(%B,2)
- SET %A=XLFS+$FIND("UMTWRFS",$EXTRACT(%B,2))-2
- SET %A=%B-(%A>0)*7+%A\1
- if %A>XLL!'%A
- QUIT
- SET XLT=$$TIME($PIECE(%B,"@",2))
- SET %A(%A+XLT)=""
- QUIT
- +6 ;Build for Last day of month ("L")
- +7 IF $PIECE(%B,"@")="L"
- SET %A=XLL
- SET XLT=$$TIME($PIECE(%B,"@",2))
- SET %A(%A+XLT)=""
- QUIT
- +8 ;Build for last DOW in month ("LF") last friday
- +9 IF $PIECE(%B,"@")?1"L"1U
- IF "UMTWRFS"[$EXTRACT(%B,2)
- SET XLW=$FIND("UMTWRFS",$EXTRACT(%B,2))-1
- SET %A=XLL-$SELECT(XLLW-XLW<0:XLLW+7-XLW,1:XLLW-XLW)
- SET XLT=$$TIME($PIECE(%B,"@",2))
- SET %A(%A+XLT)=""
- QUIT
- +10 QUIT
- +11 ;
- TIME(%X) ;BUILD--Build Time Node For Incidents That Include Times
- +1 NEW %Y,%M,%D,%T,%DT,X,Y
- +2 ;use current time
- IF %X=""
- QUIT XLCT
- +3 SET %DT="RS"
- SET X="T@"_%X
- DO ^%DT
- +4 QUIT $SELECT(Y=-1:XLCT,1:Y#1)
- +5 ;
- LEAP(%) ;Check if a Leap year
- +1 if %<1700
- SET %=%+1700
- +2 QUIT (%#4=0)&'(%#100=0)!(%#400=0)
- +3 ;
- FLD() ;Force to last day of month.
- +1 SET XLT=""
- +2 FOR XLX=1:1:$LENGTH(SCHL,",")
- SET %B=$PIECE(SCHL,",",XLX)
- IF +%B>XLL
- SET XLT=$$TIME($PIECE(%B,"@",2))
- +3 QUIT XLL+XLT
