XUTMPCH.m

XUTMPCH ;ISF/RWF - Patch rouitne for Pre/post init ;09/27/2000  09:12

 ;;8.0;KERNEL;**1007,1016**;APR 1, 2003;Build 5

 ;;8.0;KERNEL;**170**;Jul 10, 1995

 ;THIS ROUTINE CONTAINS AN IHS MODIFICATION BY IHS/OIRM/DSD/AEF 10/30/02

 ;;

 W !,"NO entry from the top."

 Q

 ;

POST170 ;Post Init work for patch XU*8*170

 D OPTSCH

 ;----- BEGIN IHS MODIFICATION - XU*8.0*1007

 ;IHS/OIRM/DSD/AEF 10/30/02

 ;THIS LINE IS COMMENTED OUT TO PREVENT IT FROM RUNNING DURING POST INIT

 ;TO AVOID AS MUCH USER INTERACTION AS POSSIBLE DURING THE INSTALLATION

 ;OF XU*8.0*1007. INSTRUCTIONS WILL BE GIVEN TO RUN IT MANUALLY

 ;D ^ZUSET

 ;----- END IHS MODIFICATION

 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

XUTMPCH   ;ISF/RWF - Patch rouitne for Pre/post init ;09/27/2000  09:12

 +1       ;;8.0;KERNEL;**1007,1016**;APR 1, 2003;Build 5

 +2       ;;8.0;KERNEL;**170**;Jul 10, 1995

 +3       ;THIS ROUTINE CONTAINS AN IHS MODIFICATION BY IHS/OIRM/DSD/AEF 10/30/02

 +4       ;;

 +5        WRITE !,"NO entry from the top."

 +6        QUIT 

 +7       ;

POST170   ;Post Init work for patch XU*8*170

 +1        DO OPTSCH

 +2       ;----- BEGIN IHS MODIFICATION - XU*8.0*1007

 +3       ;IHS/OIRM/DSD/AEF 10/30/02

 +4       ;THIS LINE IS COMMENTED OUT TO PREVENT IT FROM RUNNING DURING POST INIT

 +5       ;TO AVOID AS MUCH USER INTERACTION AS POSSIBLE DURING THE INSTALLATION

 +6       ;OF XU*8.0*1007. INSTRUCTIONS WILL BE GIVEN TO RUN IT MANUALLY

 +7       ;D ^ZUSET

 +8       ;----- END IHS MODIFICATION

 +9        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).