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 09, 2024@21:11:29 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).
