- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCEVENP 4311 printed Jan 18, 2025@03:18:53 Page 2
- FSCEVENP ;SLC/STAFF-NOIS Events Processing ;1/13/98 11:27
- +1 ;;1.1;NOIS;;Sep 06, 1998
- EVENT(MODE,D0,FROM,TO) ; from FSCEVENT
- +1 NEW CNT,DATE,DESC,DOW,NEWDATE,NEXTDATE,NEXTDAY,NUM,OCC,OK,START,TYPE,ZERO
- KILL DESC
- +2 SET ZERO=^FSC("REVENT",D0,0)
- +3 MERGE DESC=^FSC("REVENT",D0,1)
- +4 SET NUM=0
- FOR
- SET NUM=$ORDER(^FSC("REVENT",D0,.5,NUM))
- if NUM<1
- QUIT
- SET TYPE=+$GET(^(NUM,0))
- IF TYPE
- Begin DoDot: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
- +2 IF TYPE=1
- DO DAILY
- QUIT
- +3 IF TYPE<20
- DO DOW
- QUIT
- +4 IF TYPE<70
- DO NUMDOW
- QUIT
- +5 IF TYPE<80
- DO ODD
- QUIT
- +6 IF TYPE<90
- DO EVEN
- QUIT
- +7 IF TYPE<100
- DO LAST
- QUIT
- End DoDot:1
- +8 QUIT
- +9 ;
- DAILY ;
- +1 SET DATE=FROM
- FOR
- Begin DoDot:1
- +2 SET DOW=$$DOW^XLFDT(DATE,1)
- +3 IF '(DOW=0!(DOW=6))
- DO TRANSFER(DATE,ZERO,.DESC)
- +4 SET DATE=$$FMADD^XLFDT(DATE,1)
- End DoDot:1
- if DATE>TO
- QUIT
- +5 QUIT
- +6 ;
- DOW ;
- +1 SET DOW=TYPE#10
- SET START=0
- SET DATE=FROM
- FOR
- Begin DoDot:1
- +2 IF $$DOW^XLFDT(DATE,1)=DOW
- SET START=DATE
- QUIT
- +3 SET DATE=$$FMADD^XLFDT(DATE,1)
- End DoDot:1
- if START
- QUIT
- if DATE>TO
- QUIT
- +4 IF 'START
- QUIT
- +5 IF DATE>TO
- QUIT
- +6 SET DATE=START
- FOR
- Begin DoDot:1
- +7 DO TRANSFER(DATE,ZERO,.DESC)
- +8 SET DATE=$$FMADD^XLFDT(DATE,7)
- End DoDot:1
- if DATE>TO
- QUIT
- +9 QUIT
- +10 ;
- NUMDOW ;
- +1 SET DOW=TYPE#10
- SET OCC=$EXTRACT(TYPE)-1
- SET DATE=$EXTRACT(FROM,1,5)_$SELECT(OCC=1:"01",OCC=2:"08",1:(OCC-1)*7+1)
- +2 DO LEAPCHK(.DATE)
- +3 IF DATE>TO
- QUIT
- +4 SET CNT=0
- FOR
- Begin DoDot:1
- +5 IF OCC=5
- IF $EXTRACT(DATE,6,7)'>28
- SET CNT=0
- SET DATE=$EXTRACT(DATE,1,5)_"29"
- DO LEAPCHK(.DATE)
- QUIT
- +6 SET CNT=CNT+1
- IF CNT>7
- SET CNT=0
- DO NEWDATE(.DATE)
- QUIT
- +7 IF DOW=$$DOW^XLFDT(DATE,1)
- IF DATE'<FROM
- SET CNT=0
- DO TRANSFER(DATE,ZERO,.DESC)
- DO NEWDATE(.DATE)
- QUIT
- +8 SET DATE=$$FMADD^XLFDT(DATE,1)
- End DoDot:1
- if DATE>TO
- QUIT
- +9 QUIT
- +10 ;
- NEWDATE(DATE) ;
- +1 SET NEWDATE=$EXTRACT(DATE,1,5)
- +2 IF $EXTRACT(NEWDATE,4,5)="12"
- SET NEWDATE=$EXTRACT(NEWDATE,1,3)+1_"01"
- +3 IF '$TEST
- SET NEWDATE=NEWDATE+1
- +4 SET DATE=NEWDATE_$SELECT(OCC=1:"01",OCC=2:"08",1:(OCC-1)*7+1)
- +5 DO LEAPCHK(.DATE)
- +6 QUIT
- +7 ;
- LEAPCHK(DATE) ;
- +1 IF $EXTRACT(DATE,4,7)="0229"
- SET DATE=$EXTRACT(DATE,1,3)_"0228"
- SET DATE=$$FMADD^XLFDT(DATE,1)
- IF $EXTRACT(DATE,4,5)="03"
- SET DATE=$EXTRACT(DATE,1,5)_$SELECT(OCC=1:"01",OCC=2:"08",1:(OCC-1)*7+1)
- +2 QUIT
- +3 ;
- EVEN ;
- +1 SET DOW=TYPE#10
- SET START=0
- SET DATE=FROM
- FOR
- Begin DoDot:1
- +2 IF $$DOW^XLFDT(DATE,1)=DOW
- SET OK=1
- Begin DoDot:2
- +3 IF '($$DOW^XLFDT(DATE,1)#2)
- IF $$FMDIFF^XLFDT(DATE,2950101)+1#2
- SET START=DATE
- SET OK=0
- QUIT
- +4 IF $$DOW^XLFDT(DATE,1)#2
- IF '($$FMDIFF^XLFDT(DATE,2950101)+1#2)
- SET START=DATE
- SET OK=0
- QUIT
- End DoDot:2
- IF 'OK
- QUIT
- +5 SET DATE=$$FMADD^XLFDT(DATE,1)
- End DoDot:1
- if START
- QUIT
- if DATE>TO
- QUIT
- +6 IF 'START
- QUIT
- +7 IF DATE>TO
- QUIT
- +8 SET DATE=START
- FOR
- Begin DoDot:1
- +9 DO TRANSFER(DATE,ZERO,.DESC)
- +10 SET DATE=$$FMADD^XLFDT(DATE,14)
- End DoDot:1
- if DATE>TO
- QUIT
- +11 QUIT
- +12 ;
- ODD ;
- +1 SET DOW=TYPE#10
- SET START=0
- SET DATE=FROM
- FOR
- Begin DoDot:1
- +2 IF $$DOW^XLFDT(DATE,1)=DOW
- SET OK=1
- Begin DoDot:2
- +3 IF '($$DOW^XLFDT(DATE,1)#2)
- IF '($$FMDIFF^XLFDT(DATE,2950101)+1#2)
- SET START=DATE
- SET OK=0
- QUIT
- +4 IF $$DOW^XLFDT(DATE,1)#2
- IF $$FMDIFF^XLFDT(DATE,2950101)+1#2
- SET START=DATE
- SET OK=0
- QUIT
- End DoDot:2
- IF 'OK
- QUIT
- +5 SET DATE=$$FMADD^XLFDT(DATE,1)
- End DoDot:1
- if START
- QUIT
- if DATE>TO
- QUIT
- +6 IF 'START
- QUIT
- +7 IF DATE>TO
- QUIT
- +8 SET DATE=START
- FOR
- Begin DoDot:1
- +9 DO TRANSFER(DATE,ZERO,.DESC)
- +10 SET DATE=$$FMADD^XLFDT(DATE,14)
- End DoDot:1
- if DATE>TO
- QUIT
- +11 QUIT
- +12 ;
- LAST ;
- +1 SET DOW=TYPE#10
- SET DATE=$$GETSTART(FROM)
- +2 IF DATE>TO
- QUIT
- +3 FOR
- Begin DoDot:1
- +4 IF DOW=$$DOW^XLFDT(DATE,1)
- IF DATE'<FROM
- DO GETLAST(.DATE,.NEXTDATE)
- DO TRANSFER(DATE,ZERO,.DESC)
- SET DATE=NEXTDATE
- QUIT
- +5 IF DATE>TO
- QUIT
- +6 SET DATE=$$FMADD^XLFDT(DATE,1)
- End DoDot:1
- if DATE>TO
- QUIT
- +7 QUIT
- +8 ;
- GETLAST(DATE,NEXTDAY) ;
- +1 NEW NEWDATE
- +2 SET NEWDATE=$$FMADD^XLFDT(DATE,7)
- +3 IF $EXTRACT(NEWDATE,4,5)=$EXTRACT(DATE,4,5)
- SET DATE=NEWDATE
- +4 IF $EXTRACT(DATE,4,5)="12"
- SET NEXTDAY=$EXTRACT(DATE,1,3)+1_"0122"
- +5 IF '$TEST
- SET NEXTDAY=$EXTRACT(DATE,1,3)_$EXTRACT(DATE,4,5)+1_"22"
- +6 QUIT
- +7 ;
- GETSTART(DATE) ; $$(date) -> next start date
- +1 IF $EXTRACT(DATE,6,7)<23
- QUIT $EXTRACT(DATE,1,5)_"22"
- +2 IF $EXTRACT(DATE,4,5)="01"
- QUIT $EXTRACT(DATE,1,3)-1_"1222"
- +3 QUIT $EXTRACT(DATE,1,3)_$EXTRACT(DATE,4,5)-1_"22"
- +4 ;
- TRANSFER(DATE,ZERO,DESC) ;
- +1 IF MODE="DELETE"
- Begin DoDot:1
- +2 NEW DA,DIK
- +3 SET DA=$$DUP(DATE,ZERO)
- SET DIK="^FSCD(""EVENTS"","
- +4 IF 'DA
- QUIT
- +5 DO ^DIK
- +6 DO DISPLAY
- End DoDot:1
- QUIT
- +7 IF $DATA(^FSCD("EVENTS","B",DATE))
- IF $DATA(^FSCD("EVENTS","C",$PIECE(ZERO,U)))
- IF $$DUP(DATE,ZERO)
- QUIT
- +8 NEW DA,DIK,NUM
- +9 SET NUM=1+$PIECE(^FSCD("EVENTS",0),U,3)
- +10 ; *** needs ok
- LOCK +^FSCD("EVENTS",0):30
- IF '$TEST
- QUIT
- +11 FOR
- if '$DATA(^FSCD("EVENTS",NUM,0))
- QUIT
- SET NUM=NUM+1
- +12 SET ^FSCD("EVENTS",NUM,0)=DATE_U_ZERO
- +13 SET $PIECE(^FSCD("EVENTS",0),U,3)=NUM
- SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
- +14 LOCK -^FSCD("EVENTS",0)
- +15 MERGE ^FSCD("EVENTS",NUM,1)=DESC
- +16 SET DIK="^FSCD(""EVENTS"","
- SET DA=NUM
- DO IX1^DIK
- +17 DO DISPLAY
- +18 QUIT
- +19 ;
- DISPLAY WRITE !,+$EXTRACT(DATE,4,5),"/",+$EXTRACT(DATE,6,7),"/",$EXTRACT(DATE,2,3),?17,$PIECE(ZERO,U)
- +1 QUIT
- +2 ;
- DUP(DATE,ZERO) ; $$(date,zero node) -> # if duplicate, else ""
- +1 NEW NODE,NUM,OK
- +2 SET OK=0
- SET NODE=DATE_U_ZERO
- +3 SET NUM=0
- FOR
- SET NUM=$ORDER(^FSCD("EVENTS","B",DATE,NUM))
- if NUM<1
- QUIT
- Begin DoDot:1
- +4 IF $GET(^FSCD("EVENTS",NUM,0))=NODE
- SET OK=1
- QUIT
- End DoDot:1
- if OK
- QUIT
- +5 QUIT NUM