- XUINTSK1 ;ISCSF/RWF - TASKMAN POST INIT ;01/03/95 09:29
- ;;8.0;KERNEL;;Jul 10, 1995
- SCH ;Move and build new schedule
- N DIFROM
- F X19=0:0 S X19=$O(^DIC(19,X19)) Q:X19'>0 D
- . S XUTASK=0,XUNEW=0
- . I $G(^DIC(19,X19,200)) D SCH1
- . I $G(^DIC(19,X19,1916))["S" D SCH2
- . Q
- Q
- SCH1 ;Move regular options
- N DUZ S DUZ=0,DUZ(0)="@"
- S DA=X19,XV19=^DIC(19,DA,200),X=+XV19 D K200 ;KILL OLD
- S:'$D(^DIC(19,X19,200.9))&($P(XV19,U,3)]"") ^DIC(19,X19,200.9)="y"
- K DD,DO
- S X=X19,DIC="^DIC(19.2,",DIC(0)="L",DLAYGO=19.2 D FILE^DICN
- S (DA,XUNEW)=+Y,X=X19_U_$P(XV19,U,1,2)_U_U_$P(XV19,U,4)_U_$P(XV19,U,3)
- S ^DIC(19.2,DA,0)=X,DIK=DIC,DIK(1)=2 I (+XV19)'<DT D EN1^DIK
- D MES^XPDUTL("Option: "_$P(^DIC(19,X19,0),U)_" move to new file.")
- SCH1X K ^DIC(19,X19,200)
- Q
- SCH2 ;Move Special queueing
- S DA=X19,XV19=$G(^DIC(19,DA,200)),XV1916=^DIC(19,DA,1916)
- S:'$D(^DIC(19,X19,200.9)) ^DIC(19,X19,200.9)="s"
- D K1916 K DD,DO,Y S Y=XUNEW
- I 'Y S X=X19,DIC="^DIC(19.2,",DIC(0)="L",DLAYGO=19.2 D FILE^DICN
- S DA=+Y,X=^DIC(19.2,DA,0),$P(X,U,5)=$P(XV19,U,4),$P(X,U,9)=$P(XV1916,U)
- S ^DIC(19.2,DA,0)=X,DIK=DIC,DIK(1)=9 D EN1^DIK
- D MES^XPDUTL("Option: "_$P(^DIC(19,X19,0),U)_" startup moved.")
- K ^DIC(19,X19,200),^DIC(19,X19,1916)
- Q
- FIND ;subroutine--find scheduled task that will run this option
- N DV,X,X1,Y X ^%ZOSF("UCI") S %=0,XUTASK=0,Y=$P(Y,","),OPNM=$$GET(19,DA,.01)
- S X=+$S($D(ZTMQDT):ZTMQDT,$D(^DIC(19,DA,200)):$$GET(19,DA,200),1:0) I 'X Q
- D H^%DTC S X=%H_","_%T,%=0
- F S %=$O(^%ZTSCH(X,%)) Q:%'>0 S X1=$G(^%ZTSK(%,0)) I $P(X1,"^",1,2)="ZTSK^XQ1" D Q:XUTASK
- . Q:$P(X1,"^",11)'=Y Q:$P(X1,"^",13)'[OPNM
- . S:$G(^%ZTSK(%,.3,"XQY"))=DA XUTASK=% Q
- Q
- ;
- GET(FN,IEN,FE) ;
- N A,B,C S A=$G(^DD(19,FE,0)),A=$P(A,"^",4)
- S B=$P(A,";"),C=$P(A,";",2)
- Q $P($G(^DIC(19,IEN,B)),"^",C)
- ;--------------------------------------------------------------------
- ;
- K200 ;kill logic for AZTM cross-reference on field 200
- S ZTMQDT=X D FIND K ZTMQDT I XUTASK'>0 Q
- S DUZ=+$P($G(^%ZTSK(XUTASK,0)),"^",3) ;Set DUZ to the old owner
- K ^%ZTSK(XUTASK),^%ZTSCH(X,XUTASK)
- Q
- ;
- K1916 ;kill logic for ASTARTUP cross-reference of field 1916
- S ZTVOL=$$GET(19,DA,203)
- X ^%ZOSF("UCI") I ZTVOL]"" S $P(Y,",",2)=ZTVOL
- K ^%ZTSCH("STARTUP",Y,DA),ZTVOL
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUINTSK1 2276 printed Feb 18, 2025@23:36:19 Page 2
- XUINTSK1 ;ISCSF/RWF - TASKMAN POST INIT ;01/03/95 09:29
- +1 ;;8.0;KERNEL;;Jul 10, 1995
- SCH ;Move and build new schedule
- +1 NEW DIFROM
- +2 FOR X19=0:0
- SET X19=$ORDER(^DIC(19,X19))
- if X19'>0
- QUIT
- Begin DoDot:1
- +3 SET XUTASK=0
- SET XUNEW=0
- +4 IF $GET(^DIC(19,X19,200))
- DO SCH1
- +5 IF $GET(^DIC(19,X19,1916))["S"
- DO SCH2
- +6 QUIT
- End DoDot:1
- +7 QUIT
- SCH1 ;Move regular options
- +1 NEW DUZ
- SET DUZ=0
- SET DUZ(0)="@"
- +2 ;KILL OLD
- SET DA=X19
- SET XV19=^DIC(19,DA,200)
- SET X=+XV19
- DO K200
- +3 if '$DATA(^DIC(19,X19,200.9))&($PIECE(XV19,U,3)]"")
- SET ^DIC(19,X19,200.9)="y"
- +4 KILL DD,DO
- +5 SET X=X19
- SET DIC="^DIC(19.2,"
- SET DIC(0)="L"
- SET DLAYGO=19.2
- DO FILE^DICN
- +6 SET (DA,XUNEW)=+Y
- SET X=X19_U_$PIECE(XV19,U,1,2)_U_U_$PIECE(XV19,U,4)_U_$PIECE(XV19,U,3)
- +7 SET ^DIC(19.2,DA,0)=X
- SET DIK=DIC
- SET DIK(1)=2
- IF (+XV19)'<DT
- DO EN1^DIK
- +8 DO MES^XPDUTL("Option: "_$PIECE(^DIC(19,X19,0),U)_" move to new file.")
- SCH1X KILL ^DIC(19,X19,200)
- +1 QUIT
- SCH2 ;Move Special queueing
- +1 SET DA=X19
- SET XV19=$GET(^DIC(19,DA,200))
- SET XV1916=^DIC(19,DA,1916)
- +2 if '$DATA(^DIC(19,X19,200.9))
- SET ^DIC(19,X19,200.9)="s"
- +3 DO K1916
- KILL DD,DO,Y
- SET Y=XUNEW
- +4 IF 'Y
- SET X=X19
- SET DIC="^DIC(19.2,"
- SET DIC(0)="L"
- SET DLAYGO=19.2
- DO FILE^DICN
- +5 SET DA=+Y
- SET X=^DIC(19.2,DA,0)
- SET $PIECE(X,U,5)=$PIECE(XV19,U,4)
- SET $PIECE(X,U,9)=$PIECE(XV1916,U)
- +6 SET ^DIC(19.2,DA,0)=X
- SET DIK=DIC
- SET DIK(1)=9
- DO EN1^DIK
- +7 DO MES^XPDUTL("Option: "_$PIECE(^DIC(19,X19,0),U)_" startup moved.")
- +8 KILL ^DIC(19,X19,200),^DIC(19,X19,1916)
- +9 QUIT
- FIND ;subroutine--find scheduled task that will run this option
- +1 NEW DV,X,X1,Y
- XECUTE ^%ZOSF("UCI")
- SET %=0
- SET XUTASK=0
- SET Y=$PIECE(Y,",")
- SET OPNM=$$GET(19,DA,.01)
- +2 SET X=+$SELECT($DATA(ZTMQDT):ZTMQDT,$DATA(^DIC(19,DA,200)):$$GET(19,DA,200),1:0)
- IF 'X
- QUIT
- +3 DO H^%DTC
- SET X=%H_","_%T
- SET %=0
- +4 FOR
- SET %=$ORDER(^%ZTSCH(X,%))
- if %'>0
- QUIT
- SET X1=$GET(^%ZTSK(%,0))
- IF $PIECE(X1,"^",1,2)="ZTSK^XQ1"
- Begin DoDot:1
- +5 if $PIECE(X1,"^",11)'=Y
- QUIT
- if $PIECE(X1,"^",13)'[OPNM
- QUIT
- +6 if $GET(^%ZTSK(%,.3,"XQY"))=DA
- SET XUTASK=%
- QUIT
- End DoDot:1
- if XUTASK
- QUIT
- +7 QUIT
- +8 ;
- GET(FN,IEN,FE) ;
- +1 NEW A,B,C
- SET A=$GET(^DD(19,FE,0))
- SET A=$PIECE(A,"^",4)
- +2 SET B=$PIECE(A,";")
- SET C=$PIECE(A,";",2)
- +3 QUIT $PIECE($GET(^DIC(19,IEN,B)),"^",C)
- +4 ;--------------------------------------------------------------------
- +5 ;
- K200 ;kill logic for AZTM cross-reference on field 200
- +1 SET ZTMQDT=X
- DO FIND
- KILL ZTMQDT
- IF XUTASK'>0
- QUIT
- +2 ;Set DUZ to the old owner
- SET DUZ=+$PIECE($GET(^%ZTSK(XUTASK,0)),"^",3)
- +3 KILL ^%ZTSK(XUTASK),^%ZTSCH(X,XUTASK)
- +4 QUIT
- +5 ;
- K1916 ;kill logic for ASTARTUP cross-reference of field 1916
- +1 SET ZTVOL=$$GET(19,DA,203)
- +2 XECUTE ^%ZOSF("UCI")
- IF ZTVOL]""
- SET $PIECE(Y,",",2)=ZTVOL
- +3 KILL ^%ZTSCH("STARTUP",Y,DA),ZTVOL
- +4 QUIT
- +5 ;
