| 1 | XUTMPCH ;ISF/RWF - Patch rouitne for Pre/post init ;09/27/2000 09:12
|
|---|
| 2 | ;;8.0;KERNEL;**170**;Jul 10, 1995
|
|---|
| 3 | ;;
|
|---|
| 4 | W !,"NO entry from the top."
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | POST170 ;Post Init work for patch XU*8*170
|
|---|
| 8 | D OPTSCH
|
|---|
| 9 | D ^ZUSET
|
|---|
| 10 | Q
|
|---|
| 11 | OPTSCH ;To reschedule any entry in OPTION SCHEDULE that is not current.
|
|---|
| 12 | N TSK,XQ1,XQ2,XQSH,NOW
|
|---|
| 13 | S XQ1=0,NOW=$$NOW^XLFDT()
|
|---|
| 14 | F S XQ1=$O(^DIC(19.2,XQ1)) Q:XQ1'>0 D RESCH(XQ1)
|
|---|
| 15 | ;Clean up any strange schedule entries.
|
|---|
| 16 | S XQ1=9999999999
|
|---|
| 17 | F S XQ1=$O(^%ZTSCH(XQ1)),TSK=0 Q:XQ1'?1N.NP D
|
|---|
| 18 | . F S TSK=$O(^%ZTSCH(XQ1,TSK)) Q:TSK'>0 I $G(^%ZTSK(TSK,0))="" K ^%ZTSCH(XQ1,TSK)
|
|---|
| 19 | . Q
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | RESCH(DA) ;See if need to re-schedule
|
|---|
| 23 | N X,X0,Y,T,DR,DIE
|
|---|
| 24 | S X0=$G(^DIC(19.2,DA,0)) Q:X0="" S X=$P(X0,"^",2),Y=$P(X0,"^",6)
|
|---|
| 25 | Q:(X'>0)!(Y="")
|
|---|
| 26 | ;Patch XU*8*162 was released on 08/19/00 so only reschedule from then on
|
|---|
| 27 | I (X<3000819)!(X>NOW) Q
|
|---|
| 28 | ;Schedule, last time
|
|---|
| 29 | S MS="Option '"_$P($G(^DIC(19,+X0,0)),U)_"' has been Re-Scheduled for "
|
|---|
| 30 | S T=$$SCH^XLFDT(Y,X,1),DIE="^DIC(19.2,",DR="2////"_T
|
|---|
| 31 | D BMES^XPDUTL(MS_T)
|
|---|
| 32 | D ^DIE
|
|---|
| 33 | Q
|
|---|
| 34 |
|
|---|
