- XUTMPCH ;ISF/RWF - Patch rouitne for Pre/post init ;09/27/2000 09:12
- ;;8.0;KERNEL;**170**;Jul 10, 1995
- ;;
- W !,"NO entry from the top."
- Q
- ;
- POST170 ;Post Init work for patch XU*8*170
- D OPTSCH
- D ^ZUSET
- Q
- OPTSCH ;To reschedule any entry in OPTION SCHEDULE that is not current.
- N TSK,XQ1,XQ2,XQSH,NOW
- S XQ1=0,NOW=$$NOW^XLFDT()
- F S XQ1=$O(^DIC(19.2,XQ1)) Q:XQ1'>0 D RESCH(XQ1)
- ;Clean up any strange schedule entries.
- S XQ1=9999999999
- F S XQ1=$O(^%ZTSCH(XQ1)),TSK=0 Q:XQ1'?1N.NP D
- . F S TSK=$O(^%ZTSCH(XQ1,TSK)) Q:TSK'>0 I $G(^%ZTSK(TSK,0))="" K ^%ZTSCH(XQ1,TSK)
- . Q
- Q
- ;
- RESCH(DA) ;See if need to re-schedule
- N X,X0,Y,T,DR,DIE
- S X0=$G(^DIC(19.2,DA,0)) Q:X0="" S X=$P(X0,"^",2),Y=$P(X0,"^",6)
- Q:(X'>0)!(Y="")
- ;Patch XU*8*162 was released on 08/19/00 so only reschedule from then on
- I (X<3000819)!(X>NOW) Q
- ;Schedule, last time
- S MS="Option '"_$P($G(^DIC(19,+X0,0)),U)_"' has been Re-Scheduled for "
- S T=$$SCH^XLFDT(Y,X,1),DIE="^DIC(19.2,",DR="2////"_T
- D BMES^XPDUTL(MS_T)
- D ^DIE
- Q
-
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUTMPCH 1047 printed Apr 23, 2025@18:27:59 Page 2
- XUTMPCH ;ISF/RWF - Patch rouitne for Pre/post init ;09/27/2000 09:12
- +1 ;;8.0;KERNEL;**170**;Jul 10, 1995
- +2 ;;
- +3 WRITE !,"NO entry from the top."
- +4 QUIT
- +5 ;
- POST170 ;Post Init work for patch XU*8*170
- +1 DO OPTSCH
- +2 DO ^ZUSET
- +3 QUIT
- OPTSCH ;To reschedule any entry in OPTION SCHEDULE that is not current.
- +1 NEW TSK,XQ1,XQ2,XQSH,NOW
- +2 SET XQ1=0
- SET NOW=$$NOW^XLFDT()
- +3 FOR
- SET XQ1=$ORDER(^DIC(19.2,XQ1))
- if XQ1'>0
- QUIT
- DO RESCH(XQ1)
- +4 ;Clean up any strange schedule entries.
- +5 SET XQ1=9999999999
- +6 FOR
- SET XQ1=$ORDER(^%ZTSCH(XQ1))
- SET TSK=0
- if XQ1'?1N.NP
- QUIT
- Begin DoDot:1
- +7 FOR
- SET TSK=$ORDER(^%ZTSCH(XQ1,TSK))
- if TSK'>0
- QUIT
- IF $GET(^%ZTSK(TSK,0))=""
- KILL ^%ZTSCH(XQ1,TSK)
- +8 QUIT
- End DoDot:1
- +9 QUIT
- +10 ;
- RESCH(DA) ;See if need to re-schedule
- +1 NEW X,X0,Y,T,DR,DIE
- +2 SET X0=$GET(^DIC(19.2,DA,0))
- if X0=""
- QUIT
- SET X=$PIECE(X0,"^",2)
- SET Y=$PIECE(X0,"^",6)
- +3 if (X'>0)!(Y="")
- QUIT
- +4 ;Patch XU*8*162 was released on 08/19/00 so only reschedule from then on
- +5 IF (X<3000819)!(X>NOW)
- QUIT
- +6 ;Schedule, last time
- +7 SET MS="Option '"_$PIECE($GET(^DIC(19,+X0,0)),U)_"' has been Re-Scheduled for "
- +8 SET T=$$SCH^XLFDT(Y,X,1)
- SET DIE="^DIC(19.2,"
- SET DR="2////"_T
- +9 DO BMES^XPDUTL(MS_T)
- +10 DO ^DIE
- +11 QUIT
- +12
- ***** ERRORS & WARNINGS IN XUTMPCH *****
- RESCH+12 W - Null line (no commands or comment).
