%ZTM2 ;SEA/RDS-TaskMan: Manager, Part 4 (Link Handling 1) ;22 May 2003 10:17 am
;;8.0;KERNEL;**23,118,275**;JUL 10, 1995
;
XLINK ;SEND^%ZTM--determine routing of XCPU task
S ZTJOBIT=0
S ZTI=$O(^%ZIS(14.5,"B",ZTDVOL,""))
S ZTS=^%ZIS(14.5,ZTI,0)
I $P(ZTS,U,4)="Y" G DOWN
S ZTM=$P(ZTS,U,6)
S ZTN=$P(ZTS,U,7) I ZTN S ZTN=$P(^%ZIS(14.5,ZTN,0),U)
I ZTN="" S ZTN=ZTDVOL
I ZTN=%ZTVOL S ZTJOBIT=1 Q
I $D(^%ZTSCH("LINK",ZTDVOL)) G DOWN
I ZTYPE="C" S ZTJOBIT=1 Q
;
OCPU ;XLINK--send task to manager on another volume set
;First check how many jumps to other volume sets we have done.
I $P(^%ZTSK(ZTSK,.02),"^",3)>2 D REJCT^%ZTM1("Too many hops") Q
S $P(^%ZTSK(ZTSK,.02),"^",3)=$P($G(^%ZTSK(ZTSK,.02)),"^",3)+1
S X="EROCPU^%ZTM2",@^%ZOSF("TRAP")
I '$D(^[ZTM,ZTN]%ZTSCH("RUN")) S ZTT=$H G O1
S ZTT=^[ZTM,ZTN]%ZTSCH("RUN")
;
O1 L +^[ZTM,ZTN]%ZTSK(-1):5
S ZTS=^[ZTM,ZTN]%ZTSK(-1)+1
F ZT=0:0 Q:'$D(^[ZTM,ZTN]%ZTSK(ZTS)) S ZTS=ZTS+1
S ^[ZTM,ZTN]%ZTSK(-1)=ZTS
;
L -^[ZTM,ZTN]%ZTSK(-1),+^[ZTM,ZTN]%ZTSK(ZTS)
D TSKSTAT^%ZTM1(1,"Ready to Move") ;S $P(^%ZTSK(ZTSK,.1),U,1,3)=1_U_ZTT_U
S %X="^%ZTSK(ZTSK,",%Y="^[ZTM,ZTN]%ZTSK(ZTS," D %XY^%RCR
;Now schedule task.
S $P(^[ZTM,ZTN]%ZTSK(ZTS,0),U,6)=ZTT,^[ZTM,ZTN]%ZTSCH($$H3^%ZTM(ZTT),ZTS)=""
L -^[ZTM,ZTN]%ZTSK(ZTS)
;
S X="",@^%ZOSF("TRAP")
K ^%ZTSK(ZTSK,.3)
D TSKSTAT^%ZTM1(6,"^Moved to "_ZTM_","_ZTN_" as task number "_ZTS)
K ZT,ZT1,ZTD,ZTI,ZTM,ZTN,ZTR,ZTS,ZTT,ZTREP Q
;
EROCPU ;OCPU--trap dropped link and reroute task
S X="",@^%ZOSF("TRAP")
I $D(^%ZTSCH("LINK"))[0 S ^("LINK")=$H
S ^%ZTSCH("LINK",ZTDVOL)=1
;
DOWN ;XLINK/EROCPU--reroute XCPU task whose link is down
D REQRD I $D(ZTREQUIR) G ORIGNL
I ZTIO]"",$D(IOCPU)#2,IOCPU]"" G LIST
S ZTREP(ZTDVOL)=""
S ZTREP=$P(^%ZIS(14.5,ZTI,0),U,8)
I ZTREP S ZTREP=$P(^%ZIS(14.5,ZTREP,0),U)
I ZTREP="" G ORIGNL
I $D(ZTREP(ZTREP))#2 G ORIGNL
D1 ;
I $D(^%ZTSK(ZTSK,.01))[0 S ^%ZTSK(ZTSK,.01)=ZTUCI_U_ZTDVOL
S Y=$O(^%ZIS(14.6,"AT",ZTUCI,ZTDVOL,ZTREP,""))
I Y="" S Y=ZTUCI
S ZTUCI=Y,ZTDVOL=ZTREP
I ZTDVOL=%ZTVOL S X=ZTUCI_","_ZTDVOL X ^%ZOSF("UCICHECK") S:0'[Y ZTUCI=Y I 0[Y S %ZTREJCT=1
S $P(^%ZTSK(ZTSK,.02),U)=ZTUCI
I ZTDVOL'=%ZTVOL S $P(^%ZTSK(ZTSK,.02),U,2)=ZTDVOL
E S $P(^%ZTSK(ZTSK,.02),U,2)=""
I %ZTREJCT D TSKSTAT^%ZTM1("B","BAD DESTINATION UCI") Q
I ZTDVOL=%ZTVOL G SEND^%ZTM
G XLINK
;
REQRD ;DOWN--is dropped link required?
S ZTI=$O(^%ZIS(14.5,"B",ZTDVOL,""))
I ZTI="" Q
I $D(^%ZIS(14.5,ZTI,0))#2 S ZTS=^(0)
E Q
I $P(ZTS,U,5)="Y" S ZTREQUIR=ZTDVOL
Q
;
ORIGNL ;DOWN--give up trying to reroute; make it wait for original destination
I $D(^%ZTSK(ZTSK,.01))[0 G LIST
S ZTORIGNL=^%ZTSK(ZTSK,.01)
S ZTUCI=$P(ZTORIGNL,U)
S ZTDVOL=$P(ZTORIGNL,U,2)
S $P(^%ZTSK(ZTSK,.02),U)=ZTUCI
I ZTDVOL'=%ZTVOL S $P(^%ZTSK(ZTSK,.02),U,2)=ZTDVOL
E S $P(^%ZTSK(ZTSK,.02),U,2)=""
;
LIST ;DOWN/ORIGNL--place task on waiting list for down volume
I $D(^%ZTSCH("LINK"))[0 S ^("LINK")=$H
I ZTYPE'="C" S ^%ZTSCH("LINK",ZTDVOL,ZTDTH,ZTSK)=""
E D
.S ^%ZTSCH("LINK",ZTDVOL)=1
.L +^%ZTSCH("C",ZTDVOL):5
.S ^%ZTSCH("C",ZTDVOL,ZTDTH,ZTSK)=""
.L -^%ZTSCH("C",ZTDVOL)
.Q
D TSKSTAT^%ZTM1("G","Link Wait")
L K ZT,ZT1,ZTD,ZTI,ZTM,ZTN,ZTORIGNL,ZTR,ZTS,ZTT,ZTREP Q
;
ERCL ;I2^%ZTM - error in C list
Q:$$OOS^%ZTM(ZTVOL) N %
S %=$O(^%ZIS(14.7,"B",ZTVOL,0))
I %>0 S $P(^%ZIS(14.7,%,0),U,11)=1
Q
LKUP(VS) ;Lookup a VS and place in ZTVS
N %,%1
S %=$O(^%ZIS(14.5,"B",VS,0)),%1=$G(^%ZIS(14.5,+%,0))
S %ZTVS(VS)=%1,%ZTVS(VS,"IFN")=% Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZTM2 3561 printed Apr 09, 2024@21:14 Page 2
%ZTM2 ;SEA/RDS-TaskMan: Manager, Part 4 (Link Handling 1) ;22 May 2003 10:17 am
+1 ;;8.0;KERNEL;**23,118,275**;JUL 10, 1995
+2 ;
XLINK ;SEND^%ZTM--determine routing of XCPU task
+1 SET ZTJOBIT=0
+2 SET ZTI=$ORDER(^%ZIS(14.5,"B",ZTDVOL,""))
+3 SET ZTS=^%ZIS(14.5,ZTI,0)
+4 IF $PIECE(ZTS,U,4)="Y"
GOTO DOWN
+5 SET ZTM=$PIECE(ZTS,U,6)
+6 SET ZTN=$PIECE(ZTS,U,7)
IF ZTN
SET ZTN=$PIECE(^%ZIS(14.5,ZTN,0),U)
+7 IF ZTN=""
SET ZTN=ZTDVOL
+8 IF ZTN=%ZTVOL
SET ZTJOBIT=1
QUIT
+9 IF $DATA(^%ZTSCH("LINK",ZTDVOL))
GOTO DOWN
+10 IF ZTYPE="C"
SET ZTJOBIT=1
QUIT
+11 ;
OCPU ;XLINK--send task to manager on another volume set
+1 ;First check how many jumps to other volume sets we have done.
+2 IF $PIECE(^%ZTSK(ZTSK,.02),"^",3)>2
DO REJCT^%ZTM1("Too many hops")
QUIT
+3 SET $PIECE(^%ZTSK(ZTSK,.02),"^",3)=$PIECE($GET(^%ZTSK(ZTSK,.02)),"^",3)+1
+4 SET X="EROCPU^%ZTM2"
SET @^%ZOSF("TRAP")
+5 IF '$DATA(^[ZTM,ZTN]%ZTSCH("RUN"))
SET ZTT=$HOROLOG
GOTO O1
+6 SET ZTT=^[ZTM
SET ZTN]%ZTSCH("RUN")
+7 ;
O1 LOCK +^[ZTM,ZTN]%ZTSK(-1):5
+1 SET ZTS=^[ZTM
SET ZTN]%ZTSK(-1)+1
+2 FOR ZT=0:0
if '$DATA(^[ZTM,ZTN]%ZTSK(ZTS))
QUIT
SET ZTS=ZTS+1
+3 SET ^[ZTM
SET ZTN]%ZTSK(-1)=ZTS
+4 ;
+5 LOCK -^[ZTM,ZTN]%ZTSK(-1),+^[ZTM,ZTN]%ZTSK(ZTS)
+6 ;S $P(^%ZTSK(ZTSK,.1),U,1,3)=1_U_ZTT_U
DO TSKSTAT^%ZTM1(1,"Ready to Move")
+7 SET %X="^%ZTSK(ZTSK,"
SET %Y="^[ZTM,ZTN]%ZTSK(ZTS,"
DO %XY^%RCR
+8 ;Now schedule task.
+9 SET $PIECE(^[ZTM,ZTN]%ZTSK(ZTS,0),U,6)=ZTT
SET ^[ZTM
SET ZTN]%ZTSCH($$H3^%ZTM(ZTT),ZTS)=""
+10 LOCK -^[ZTM,ZTN]%ZTSK(ZTS)
+11 ;
+12 SET X=""
SET @^%ZOSF("TRAP")
+13 KILL ^%ZTSK(ZTSK,.3)
+14 DO TSKSTAT^%ZTM1(6,"^Moved to "_ZTM_","_ZTN_" as task number "_ZTS)
+15 KILL ZT,ZT1,ZTD,ZTI,ZTM,ZTN,ZTR,ZTS,ZTT,ZTREP
QUIT
+16 ;
EROCPU ;OCPU--trap dropped link and reroute task
+1 SET X=""
SET @^%ZOSF("TRAP")
+2 IF $DATA(^%ZTSCH("LINK"))[0
SET ^("LINK")=$HOROLOG
+3 SET ^%ZTSCH("LINK",ZTDVOL)=1
+4 ;
DOWN ;XLINK/EROCPU--reroute XCPU task whose link is down
+1 DO REQRD
IF $DATA(ZTREQUIR)
GOTO ORIGNL
+2 IF ZTIO]""
IF $DATA(IOCPU)#2
IF IOCPU]""
GOTO LIST
+3 SET ZTREP(ZTDVOL)=""
+4 SET ZTREP=$PIECE(^%ZIS(14.5,ZTI,0),U,8)
+5 IF ZTREP
SET ZTREP=$PIECE(^%ZIS(14.5,ZTREP,0),U)
+6 IF ZTREP=""
GOTO ORIGNL
+7 IF $DATA(ZTREP(ZTREP))#2
GOTO ORIGNL
D1 ;
+1 IF $DATA(^%ZTSK(ZTSK,.01))[0
SET ^%ZTSK(ZTSK,.01)=ZTUCI_U_ZTDVOL
+2 SET Y=$ORDER(^%ZIS(14.6,"AT",ZTUCI,ZTDVOL,ZTREP,""))
+3 IF Y=""
SET Y=ZTUCI
+4 SET ZTUCI=Y
SET ZTDVOL=ZTREP
+5 IF ZTDVOL=%ZTVOL
SET X=ZTUCI_","_ZTDVOL
XECUTE ^%ZOSF("UCICHECK")
if 0'[Y
SET ZTUCI=Y
IF 0[Y
SET %ZTREJCT=1
+6 SET $PIECE(^%ZTSK(ZTSK,.02),U)=ZTUCI
+7 IF ZTDVOL'=%ZTVOL
SET $PIECE(^%ZTSK(ZTSK,.02),U,2)=ZTDVOL
+8 IF '$TEST
SET $PIECE(^%ZTSK(ZTSK,.02),U,2)=""
+9 IF %ZTREJCT
DO TSKSTAT^%ZTM1("B","BAD DESTINATION UCI")
QUIT
+10 IF ZTDVOL=%ZTVOL
GOTO SEND^%ZTM
+11 GOTO XLINK
+12 ;
REQRD ;DOWN--is dropped link required?
+1 SET ZTI=$ORDER(^%ZIS(14.5,"B",ZTDVOL,""))
+2 IF ZTI=""
QUIT
+3 IF $DATA(^%ZIS(14.5,ZTI,0))#2
SET ZTS=^(0)
+4 IF '$TEST
QUIT
+5 IF $PIECE(ZTS,U,5)="Y"
SET ZTREQUIR=ZTDVOL
+6 QUIT
+7 ;
ORIGNL ;DOWN--give up trying to reroute; make it wait for original destination
+1 IF $DATA(^%ZTSK(ZTSK,.01))[0
GOTO LIST
+2 SET ZTORIGNL=^%ZTSK(ZTSK,.01)
+3 SET ZTUCI=$PIECE(ZTORIGNL,U)
+4 SET ZTDVOL=$PIECE(ZTORIGNL,U,2)
+5 SET $PIECE(^%ZTSK(ZTSK,.02),U)=ZTUCI
+6 IF ZTDVOL'=%ZTVOL
SET $PIECE(^%ZTSK(ZTSK,.02),U,2)=ZTDVOL
+7 IF '$TEST
SET $PIECE(^%ZTSK(ZTSK,.02),U,2)=""
+8 ;
LIST ;DOWN/ORIGNL--place task on waiting list for down volume
+1 IF $DATA(^%ZTSCH("LINK"))[0
SET ^("LINK")=$HOROLOG
+2 IF ZTYPE'="C"
SET ^%ZTSCH("LINK",ZTDVOL,ZTDTH,ZTSK)=""
+3 IF '$TEST
Begin DoDot:1
+4 SET ^%ZTSCH("LINK",ZTDVOL)=1
+5 LOCK +^%ZTSCH("C",ZTDVOL):5
+6 SET ^%ZTSCH("C",ZTDVOL,ZTDTH,ZTSK)=""
+7 LOCK -^%ZTSCH("C",ZTDVOL)
+8 QUIT
End DoDot:1
+9 DO TSKSTAT^%ZTM1("G","Link Wait")
+10 LOCK
KILL ZT,ZT1,ZTD,ZTI,ZTM,ZTN,ZTORIGNL,ZTR,ZTS,ZTT,ZTREP
QUIT
+11 ;
ERCL ;I2^%ZTM - error in C list
+1 if $$OOS^%ZTM(ZTVOL)
QUIT
NEW %
+2 SET %=$ORDER(^%ZIS(14.7,"B",ZTVOL,0))
+3 IF %>0
SET $PIECE(^%ZIS(14.7,%,0),U,11)=1
+4 QUIT
LKUP(VS) ;Lookup a VS and place in ZTVS
+1 NEW %,%1
+2 SET %=$ORDER(^%ZIS(14.5,"B",VS,0))
SET %1=$GET(^%ZIS(14.5,+%,0))
+3 SET %ZTVS(VS)=%1
SET %ZTVS(VS,"IFN")=%
QUIT
