Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FSCEVENP

FSCEVENP.m

Go to the documentation of this file.
  1. FSCEVENP ;SLC/STAFF-NOIS Events Processing ;1/13/98 11:27
  1. ;;1.1;NOIS;;Sep 06, 1998
  1. EVENT(MODE,D0,FROM,TO) ; from FSCEVENT
  1. N CNT,DATE,DESC,DOW,NEWDATE,NEXTDATE,NEXTDAY,NUM,OCC,OK,START,TYPE,ZERO K DESC
  1. S ZERO=^FSC("REVENT",D0,0)
  1. M DESC=^FSC("REVENT",D0,1)
  1. S NUM=0 F S NUM=$O(^FSC("REVENT",D0,.5,NUM)) Q:NUM<1 S TYPE=+$G(^(NUM,0)) I TYPE D
  1. TEST .;S FROM=2941201,TO=2951201,ZERO=1,DESC(0)=""
  1. .;S TYPE=19 F S TYPE=$O(^FSC("ETYPE",TYPE)) Q:TYPE<1 W !,^(TYPE,0) D
  1. .I TYPE=1 D DAILY Q
  1. .I TYPE<20 D DOW Q
  1. .I TYPE<70 D NUMDOW Q
  1. .I TYPE<80 D ODD Q
  1. .I TYPE<90 D EVEN Q
  1. .I TYPE<100 D LAST Q
  1. Q
  1. ;
  1. DAILY ;
  1. S DATE=FROM F D Q:DATE>TO
  1. .S DOW=$$DOW^XLFDT(DATE,1)
  1. .I '(DOW=0!(DOW=6)) D TRANSFER(DATE,ZERO,.DESC)
  1. .S DATE=$$FMADD^XLFDT(DATE,1)
  1. Q
  1. ;
  1. DOW ;
  1. S DOW=TYPE#10,START=0,DATE=FROM F D Q:START Q:DATE>TO
  1. .I $$DOW^XLFDT(DATE,1)=DOW S START=DATE Q
  1. .S DATE=$$FMADD^XLFDT(DATE,1)
  1. I 'START Q
  1. I DATE>TO Q
  1. S DATE=START F D Q:DATE>TO
  1. .D TRANSFER(DATE,ZERO,.DESC)
  1. .S DATE=$$FMADD^XLFDT(DATE,7)
  1. Q
  1. ;
  1. NUMDOW ;
  1. S DOW=TYPE#10,OCC=$E(TYPE)-1,DATE=$E(FROM,1,5)_$S(OCC=1:"01",OCC=2:"08",1:(OCC-1)*7+1)
  1. D LEAPCHK(.DATE)
  1. I DATE>TO Q
  1. S CNT=0 F D Q:DATE>TO
  1. .I OCC=5,$E(DATE,6,7)'>28 S CNT=0 S DATE=$E(DATE,1,5)_"29" D LEAPCHK(.DATE) Q
  1. .S CNT=CNT+1 I CNT>7 S CNT=0 D NEWDATE(.DATE) Q
  1. .I DOW=$$DOW^XLFDT(DATE,1),DATE'<FROM S CNT=0 D TRANSFER(DATE,ZERO,.DESC),NEWDATE(.DATE) Q
  1. .S DATE=$$FMADD^XLFDT(DATE,1)
  1. Q
  1. ;
  1. NEWDATE(DATE) ;
  1. S NEWDATE=$E(DATE,1,5)
  1. I $E(NEWDATE,4,5)="12" S NEWDATE=$E(NEWDATE,1,3)+1_"01"
  1. E S NEWDATE=NEWDATE+1
  1. S DATE=NEWDATE_$S(OCC=1:"01",OCC=2:"08",1:(OCC-1)*7+1)
  1. D LEAPCHK(.DATE)
  1. Q
  1. ;
  1. LEAPCHK(DATE) ;
  1. I $E(DATE,4,7)="0229" S DATE=$E(DATE,1,3)_"0228" S DATE=$$FMADD^XLFDT(DATE,1) I $E(DATE,4,5)="03" S DATE=$E(DATE,1,5)_$S(OCC=1:"01",OCC=2:"08",1:(OCC-1)*7+1)
  1. Q
  1. ;
  1. EVEN ;
  1. S DOW=TYPE#10,START=0,DATE=FROM F D Q:START Q:DATE>TO
  1. .I $$DOW^XLFDT(DATE,1)=DOW S OK=1 D I 'OK Q
  1. ..I '($$DOW^XLFDT(DATE,1)#2),$$FMDIFF^XLFDT(DATE,2950101)+1#2 S START=DATE,OK=0 Q
  1. ..I $$DOW^XLFDT(DATE,1)#2,'($$FMDIFF^XLFDT(DATE,2950101)+1#2) S START=DATE,OK=0 Q
  1. .S DATE=$$FMADD^XLFDT(DATE,1)
  1. I 'START Q
  1. I DATE>TO Q
  1. S DATE=START F D Q:DATE>TO
  1. .D TRANSFER(DATE,ZERO,.DESC)
  1. .S DATE=$$FMADD^XLFDT(DATE,14)
  1. Q
  1. ;
  1. ODD ;
  1. S DOW=TYPE#10,START=0,DATE=FROM F D Q:START Q:DATE>TO
  1. .I $$DOW^XLFDT(DATE,1)=DOW S OK=1 D I 'OK Q
  1. ..I '($$DOW^XLFDT(DATE,1)#2),'($$FMDIFF^XLFDT(DATE,2950101)+1#2) S START=DATE,OK=0 Q
  1. ..I $$DOW^XLFDT(DATE,1)#2,$$FMDIFF^XLFDT(DATE,2950101)+1#2 S START=DATE,OK=0 Q
  1. .S DATE=$$FMADD^XLFDT(DATE,1)
  1. I 'START Q
  1. I DATE>TO Q
  1. S DATE=START F D Q:DATE>TO
  1. .D TRANSFER(DATE,ZERO,.DESC)
  1. .S DATE=$$FMADD^XLFDT(DATE,14)
  1. Q
  1. ;
  1. LAST ;
  1. S DOW=TYPE#10,DATE=$$GETSTART(FROM)
  1. I DATE>TO Q
  1. F D Q:DATE>TO
  1. .I DOW=$$DOW^XLFDT(DATE,1),DATE'<FROM D GETLAST(.DATE,.NEXTDATE),TRANSFER(DATE,ZERO,.DESC) S DATE=NEXTDATE Q
  1. .I DATE>TO Q
  1. .S DATE=$$FMADD^XLFDT(DATE,1)
  1. Q
  1. ;
  1. GETLAST(DATE,NEXTDAY) ;
  1. N NEWDATE
  1. S NEWDATE=$$FMADD^XLFDT(DATE,7)
  1. I $E(NEWDATE,4,5)=$E(DATE,4,5) S DATE=NEWDATE
  1. I $E(DATE,4,5)="12" S NEXTDAY=$E(DATE,1,3)+1_"0122"
  1. E S NEXTDAY=$E(DATE,1,3)_$E(DATE,4,5)+1_"22"
  1. Q
  1. ;
  1. GETSTART(DATE) ; $$(date) -> next start date
  1. I $E(DATE,6,7)<23 Q $E(DATE,1,5)_"22"
  1. I $E(DATE,4,5)="01" Q $E(DATE,1,3)-1_"1222"
  1. Q $E(DATE,1,3)_$E(DATE,4,5)-1_"22"
  1. ;
  1. TRANSFER(DATE,ZERO,DESC) ;
  1. I MODE="DELETE" D Q
  1. .N DA,DIK
  1. .S DA=$$DUP(DATE,ZERO),DIK="^FSCD(""EVENTS"","
  1. .I 'DA Q
  1. .D ^DIK
  1. .D DISPLAY
  1. I $D(^FSCD("EVENTS","B",DATE)),$D(^FSCD("EVENTS","C",$P(ZERO,U))) I $$DUP(DATE,ZERO) Q
  1. N DA,DIK,NUM
  1. S NUM=1+$P(^FSCD("EVENTS",0),U,3)
  1. L +^FSCD("EVENTS",0):30 I '$T Q ; *** needs ok
  1. F Q:'$D(^FSCD("EVENTS",NUM,0)) S NUM=NUM+1
  1. S ^FSCD("EVENTS",NUM,0)=DATE_U_ZERO
  1. S $P(^FSCD("EVENTS",0),U,3)=NUM,$P(^(0),U,4)=$P(^(0),U,4)+1
  1. L -^FSCD("EVENTS",0)
  1. M ^FSCD("EVENTS",NUM,1)=DESC
  1. S DIK="^FSCD(""EVENTS"",",DA=NUM D IX1^DIK
  1. D DISPLAY
  1. Q
  1. ;
  1. DISPLAY W !,+$E(DATE,4,5),"/",+$E(DATE,6,7),"/",$E(DATE,2,3),?17,$P(ZERO,U)
  1. Q
  1. ;
  1. DUP(DATE,ZERO) ; $$(date,zero node) -> # if duplicate, else ""
  1. N NODE,NUM,OK
  1. S OK=0,NODE=DATE_U_ZERO
  1. S NUM=0 F S NUM=$O(^FSCD("EVENTS","B",DATE,NUM)) Q:NUM<1 D Q:OK
  1. .I $G(^FSCD("EVENTS",NUM,0))=NODE S OK=1 Q
  1. Q NUM