source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCEVENP.m@ 1384

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