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/XLFDT4.m@ 738

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

initial load of WorldVistAEHR

File size: 1.0 KB
Line 
1XLFDT4 ;ISCSF/RWF - Exclude time ;7/8/94 07:58
2 ;;8.0;KERNEL;**71**;Jul 10, 1995
3 Q
4WI(XLSCH,XLRD) ;Test Entry Point
5WITHIN ;EF. Called from XLFDT, Return 1 XLRD is in XLSCH, else 0.
6 ;XLSCH contact schedule, XLRD Reference date
7 N XL1,XLCT,XLDOW,XLFOK
8 S:'$D(XLRD) XLRD=$$NOW^XLFDT()
9 Q:XLSCH="ANY" 1
10 S XLCT=$E($P(XLRD,".",2)_"0000",1,4),XLDOW=$E("UMTWRFS",$$FMTH^XLFDT(XLRD)+4#7+1)
11 F XL1=1:1:$L(XLSCH,",") S XLFOK=$$CHECK(XLCT,XLDOW,$P(XLSCH,",",XL1)) Q:XLFOK
12 Q XLFOK
13CHECK(XLT,XLD,XLS) ;EF. Check one time.
14 ;XLT is reference time, XLD is reference DOW, XLS is schedule
15 N %,XLT1,XLT2,XLDP,XLTP,XLNEG,XLOK
16 I XLS?1U.E D
17 . I XLS?1U S XLDP=XLS,XLTP=""
18 . E F I=1:1:$L(XLS) I $E(XLS,I)?1N S XLDP=$E(XLS,1,I-1),XLTP=$E(XLS,I,$L(XLS)) Q
19 . Q
20 E S XLDP="",XLTP=XLS
21 S XLT1=$P(XLTP,"-"),XLT2=$P(XLTP,"-",2) S:XLT2="" XLT2=XLT1
22 I XLT1<XLT2 S XLNEG=0
23 E S XLNEG=1,%=XLT1,XLT1=XLT2,XLT2=%
24 S XLOK=(XLDP="")!(XLDP="ANY")!((XLDP="D")&("SU"'[XLD))!((XLDP="E")&("SU"[XLD))!(XLDP[XLD) Q:'XLOK 0
25 S XLOK=(XLTP="")!(((XLT1'>XLT)&(XLT'>XLT2))'=XLNEG) Q:'XLOK 0
26 Q 1
Note: See TracBrowser for help on using the repository browser.