| [613] | 1 | XUINTSK1 ;ISCSF/RWF - TASKMAN POST INIT ;01/03/95 09:29
|
|---|
| 2 | ;;8.0;KERNEL;;Jul 10, 1995
|
|---|
| 3 | SCH ;Move and build new schedule
|
|---|
| 4 | N DIFROM
|
|---|
| 5 | F X19=0:0 S X19=$O(^DIC(19,X19)) Q:X19'>0 D
|
|---|
| 6 | . S XUTASK=0,XUNEW=0
|
|---|
| 7 | . I $G(^DIC(19,X19,200)) D SCH1
|
|---|
| 8 | . I $G(^DIC(19,X19,1916))["S" D SCH2
|
|---|
| 9 | . Q
|
|---|
| 10 | Q
|
|---|
| 11 | SCH1 ;Move regular options
|
|---|
| 12 | N DUZ S DUZ=0,DUZ(0)="@"
|
|---|
| 13 | S DA=X19,XV19=^DIC(19,DA,200),X=+XV19 D K200 ;KILL OLD
|
|---|
| 14 | S:'$D(^DIC(19,X19,200.9))&($P(XV19,U,3)]"") ^DIC(19,X19,200.9)="y"
|
|---|
| 15 | K DD,DO
|
|---|
| 16 | S X=X19,DIC="^DIC(19.2,",DIC(0)="L",DLAYGO=19.2 D FILE^DICN
|
|---|
| 17 | S (DA,XUNEW)=+Y,X=X19_U_$P(XV19,U,1,2)_U_U_$P(XV19,U,4)_U_$P(XV19,U,3)
|
|---|
| 18 | S ^DIC(19.2,DA,0)=X,DIK=DIC,DIK(1)=2 I (+XV19)'<DT D EN1^DIK
|
|---|
| 19 | D MES^XPDUTL("Option: "_$P(^DIC(19,X19,0),U)_" move to new file.")
|
|---|
| 20 | SCH1X K ^DIC(19,X19,200)
|
|---|
| 21 | Q
|
|---|
| 22 | SCH2 ;Move Special queueing
|
|---|
| 23 | S DA=X19,XV19=$G(^DIC(19,DA,200)),XV1916=^DIC(19,DA,1916)
|
|---|
| 24 | S:'$D(^DIC(19,X19,200.9)) ^DIC(19,X19,200.9)="s"
|
|---|
| 25 | D K1916 K DD,DO,Y S Y=XUNEW
|
|---|
| 26 | I 'Y S X=X19,DIC="^DIC(19.2,",DIC(0)="L",DLAYGO=19.2 D FILE^DICN
|
|---|
| 27 | S DA=+Y,X=^DIC(19.2,DA,0),$P(X,U,5)=$P(XV19,U,4),$P(X,U,9)=$P(XV1916,U)
|
|---|
| 28 | S ^DIC(19.2,DA,0)=X,DIK=DIC,DIK(1)=9 D EN1^DIK
|
|---|
| 29 | D MES^XPDUTL("Option: "_$P(^DIC(19,X19,0),U)_" startup moved.")
|
|---|
| 30 | K ^DIC(19,X19,200),^DIC(19,X19,1916)
|
|---|
| 31 | Q
|
|---|
| 32 | FIND ;subroutine--find scheduled task that will run this option
|
|---|
| 33 | N DV,X,X1,Y X ^%ZOSF("UCI") S %=0,XUTASK=0,Y=$P(Y,","),OPNM=$$GET(19,DA,.01)
|
|---|
| 34 | S X=+$S($D(ZTMQDT):ZTMQDT,$D(^DIC(19,DA,200)):$$GET(19,DA,200),1:0) I 'X Q
|
|---|
| 35 | D H^%DTC S X=%H_","_%T,%=0
|
|---|
| 36 | F S %=$O(^%ZTSCH(X,%)) Q:%'>0 S X1=$G(^%ZTSK(%,0)) I $P(X1,"^",1,2)="ZTSK^XQ1" D Q:XUTASK
|
|---|
| 37 | . Q:$P(X1,"^",11)'=Y Q:$P(X1,"^",13)'[OPNM
|
|---|
| 38 | . S:$G(^%ZTSK(%,.3,"XQY"))=DA XUTASK=% Q
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | GET(FN,IEN,FE) ;
|
|---|
| 42 | N A,B,C S A=$G(^DD(19,FE,0)),A=$P(A,"^",4)
|
|---|
| 43 | S B=$P(A,";"),C=$P(A,";",2)
|
|---|
| 44 | Q $P($G(^DIC(19,IEN,B)),"^",C)
|
|---|
| 45 | ;--------------------------------------------------------------------
|
|---|
| 46 | ;
|
|---|
| 47 | K200 ;kill logic for AZTM cross-reference on field 200
|
|---|
| 48 | S ZTMQDT=X D FIND K ZTMQDT I XUTASK'>0 Q
|
|---|
| 49 | S DUZ=+$P($G(^%ZTSK(XUTASK,0)),"^",3) ;Set DUZ to the old owner
|
|---|
| 50 | K ^%ZTSK(XUTASK),^%ZTSCH(X,XUTASK)
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | K1916 ;kill logic for ASTARTUP cross-reference of field 1916
|
|---|
| 54 | S ZTVOL=$$GET(19,DA,203)
|
|---|
| 55 | X ^%ZOSF("UCI") I ZTVOL]"" S $P(Y,",",2)=ZTVOL
|
|---|
| 56 | K ^%ZTSCH("STARTUP",Y,DA),ZTVOL
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
