%ZTM3 ;SEA/RDS-TaskMan: Manager, Part 5 (Link Handling 2) ;22 May 2003 10:21 am
;;8.0;KERNEL;**275**;JUL 10, 1995
;
LINK ;CHECK^%ZTM/LOOKUP^%ZTM0--test dropped links for recovery
L ^%ZTSCH("LINK") S ^%ZTSCH("LINK")=""
S ZTDVOL=""
L0 F ZT=0:0 S ZTDVOL=$O(^%ZTSCH("LINK",ZTDVOL)) Q:ZTDVOL="" D TEST
I $D(^%ZTSCH("LINK"))#2,$O(^%ZTSCH("LINK",""))="" K ^%ZTSCH("LINK")
L K %ZTX,ZT,ZTDVOL,ZTD,ZTDTH,ZTH,ZTI,ZTM,ZTN,ZTR,ZTS,ZTSK,ZTT
Q
;
TEST ;LINK--test dropped link and send tasks if restored
S ZTI=$O(^%ZIS(14.5,"B",ZTDVOL,""))
S ZTS=^%ZIS(14.5,ZTI,0)
I $P(ZTS,U,3)="N" D REJECT Q
I $P(ZTS,U,4)="Y" Q
S ZTM=$P(ZTS,U,6)
S ZTN=$P(ZTS,U,7)
I ZTN S ZTNS=^%ZIS(14.5,ZTN,0),ZTN=$P(ZTNS,U)
I ZTN="" S ZTN=ZTDVOL
E S ZTS=ZTNS
T1 ;
S X="ERTEST^%ZTM3",@^%ZOSF("TRAP")
S X=$D(^[ZTM,ZTN]%ZTSK)
S X="",@^%ZOSF("TRAP")
I $P(ZTS,U,10)="C" K ^%ZTSCH("LINK",ZTDVOL) Q
D XCPU I $O(^%ZTSCH("LINK",ZTDVOL,""))="" K ^%ZTSCH("LINK",ZTDVOL)
Q
;
REJECT ;TEST--reject waiting tasks whose volume set's link access is removed
S ZTDTH=""
R3 S ZTDTH=$O(^%ZTSCH("LINK",ZTDVOL,ZTDTH)) I ZTDTH="" K ^%ZTSCH("LINK",ZTDVOL) Q
S ZTSK=""
R4 S ZTSK=$O(^%ZTSCH("LINK",ZTDVOL,ZTDTH,ZTSK)) I ZTSK="" G R3
K ^%ZTSCH("LINK",ZTDVOL,ZTDTH,ZTSK)
I '$D(^%ZTSK(ZTSK)) G R4
D TSKSTAT^%ZTM1("B","NO LINK ACCESS TO VOLUME SET")
G R4
;
ERTEST ;TEST--trap if dropped link is still down
S X="",@^%ZOSF("TRAP")
S ^%ZTSCH("LINK")=$H
Q
;
XCPU ;TEST--send saved tasks across reestablished link
S X="ERXCPU^%ZTM3",@^%ZOSF("TRAP")
I '$D(^[ZTM,ZTN]%ZTSCH("RUN")) S ZTT=$H G X1
S ZTR=^[ZTM,ZTN]%ZTSCH("RUN"),ZTH=$H
S ZTD=$P(ZTDTH,",",2)+(ZTR-ZTH*86400)+$P(ZTR,",",2)-$P(ZTH,",",2)
S ZTT=ZTDTH+ZTR-ZTH+(ZTD\86400)-(ZTD<0)_","_$S(ZTD<0:0,1:ZTD#86400)
;
X1 S ZTDTH=""
X3 S ZTDTH=$O(^%ZTSCH("LINK",ZTDVOL,ZTDTH)) I ZTDTH="" Q
S ZTSK=""
X4 S ZTSK=$O(^%ZTSCH("LINK",ZTDVOL,ZTDTH,"")) I ZTSK="" G X3
K ^%ZTSCH("LINK",ZTDVOL,ZTDTH,ZTSK)
I $D(^%ZTSK(ZTSK,0))[0 G X4
I $L($P($G(^%ZTSK(ZTSK,.1)),U,10)) D TSKSTAT^%ZTM1("D","Stopped while waiting for Link") G X4
;
L ^[ZTM,ZTN]%ZTSK(-1)
S ZTS=^[ZTM,ZTN]%ZTSK(-1)+1
F ZTI=0:0 Q:'$D(^[ZTM,ZTN]%ZTSK(ZTS)) S ZTS=ZTS+1
S ^[ZTM,ZTN]%ZTSK(-1)=ZTS
;
L (^%ZTSK(ZTSK),^[ZTM,ZTN]%ZTSK(ZTS))
D TSKSTAT^%ZTM1(1,"Link")
S %X="^%ZTSK(ZTSK,",%Y="^[ZTM,ZTN]%ZTSK(ZTS," D %XY^%RCR
S $P(^[ZTM,ZTN]%ZTSK(ZTS,0),U,6)=ZTT
S ^[ZTM,ZTN]%ZTSCH(ZTT,ZTS)=""
;
K ^%ZTSK(ZTSK)
L ^%ZTSCH("LINK")
G X4
;
ERXCPU ;XCPU--trap if link drops again while a task is being sent
S X="",@^%ZOSF("TRAP")
I ^%ZTSCH("LINK")="" S ^("LINK")=$H
I ZTSK]"",$D(^%ZTSK(ZTSK,0))#2 D TSKSTAT^%ZTM1("G","Link Error")
L ^%ZTSCH("LINK")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZTM3 2711 printed Oct 16, 2024@18:16:56 Page 2
%ZTM3 ;SEA/RDS-TaskMan: Manager, Part 5 (Link Handling 2) ;22 May 2003 10:21 am
+1 ;;8.0;KERNEL;**275**;JUL 10, 1995
+2 ;
LINK ;CHECK^%ZTM/LOOKUP^%ZTM0--test dropped links for recovery
+1 LOCK ^%ZTSCH("LINK")
SET ^%ZTSCH("LINK")=""
+2 SET ZTDVOL=""
L0 FOR ZT=0:0
SET ZTDVOL=$ORDER(^%ZTSCH("LINK",ZTDVOL))
if ZTDVOL=""
QUIT
DO TEST
+1 IF $DATA(^%ZTSCH("LINK"))#2
IF $ORDER(^%ZTSCH("LINK",""))=""
KILL ^%ZTSCH("LINK")
+2 LOCK
KILL %ZTX,ZT,ZTDVOL,ZTD,ZTDTH,ZTH,ZTI,ZTM,ZTN,ZTR,ZTS,ZTSK,ZTT
+3 QUIT
+4 ;
TEST ;LINK--test dropped link and send tasks if restored
+1 SET ZTI=$ORDER(^%ZIS(14.5,"B",ZTDVOL,""))
+2 SET ZTS=^%ZIS(14.5,ZTI,0)
+3 IF $PIECE(ZTS,U,3)="N"
DO REJECT
QUIT
+4 IF $PIECE(ZTS,U,4)="Y"
QUIT
+5 SET ZTM=$PIECE(ZTS,U,6)
+6 SET ZTN=$PIECE(ZTS,U,7)
+7 IF ZTN
SET ZTNS=^%ZIS(14.5,ZTN,0)
SET ZTN=$PIECE(ZTNS,U)
+8 IF ZTN=""
SET ZTN=ZTDVOL
+9 IF '$TEST
SET ZTS=ZTNS
T1 ;
+1 SET X="ERTEST^%ZTM3"
SET @^%ZOSF("TRAP")
+2 SET X=$DATA(^[ZTM,ZTN]%ZTSK)
+3 SET X=""
SET @^%ZOSF("TRAP")
+4 IF $PIECE(ZTS,U,10)="C"
KILL ^%ZTSCH("LINK",ZTDVOL)
QUIT
+5 DO XCPU
IF $ORDER(^%ZTSCH("LINK",ZTDVOL,""))=""
KILL ^%ZTSCH("LINK",ZTDVOL)
+6 QUIT
+7 ;
REJECT ;TEST--reject waiting tasks whose volume set's link access is removed
+1 SET ZTDTH=""
R3 SET ZTDTH=$ORDER(^%ZTSCH("LINK",ZTDVOL,ZTDTH))
IF ZTDTH=""
KILL ^%ZTSCH("LINK",ZTDVOL)
QUIT
+1 SET ZTSK=""
R4 SET ZTSK=$ORDER(^%ZTSCH("LINK",ZTDVOL,ZTDTH,ZTSK))
IF ZTSK=""
GOTO R3
+1 KILL ^%ZTSCH("LINK",ZTDVOL,ZTDTH,ZTSK)
+2 IF '$DATA(^%ZTSK(ZTSK))
GOTO R4
+3 DO TSKSTAT^%ZTM1("B","NO LINK ACCESS TO VOLUME SET")
+4 GOTO R4
+5 ;
ERTEST ;TEST--trap if dropped link is still down
+1 SET X=""
SET @^%ZOSF("TRAP")
+2 SET ^%ZTSCH("LINK")=$HOROLOG
+3 QUIT
+4 ;
XCPU ;TEST--send saved tasks across reestablished link
+1 SET X="ERXCPU^%ZTM3"
SET @^%ZOSF("TRAP")
+2 IF '$DATA(^[ZTM,ZTN]%ZTSCH("RUN"))
SET ZTT=$HOROLOG
GOTO X1
+3 SET ZTR=^[ZTM
SET ZTN]%ZTSCH("RUN")
SET ZTH=$HOROLOG
+4 SET ZTD=$PIECE(ZTDTH,",",2)+(ZTR-ZTH*86400)+$PIECE(ZTR,",",2)-$PIECE(ZTH,",",2)
+5 SET ZTT=ZTDTH+ZTR-ZTH+(ZTD\86400)-(ZTD<0)_","_$SELECT(ZTD<0:0,1:ZTD#86400)
+6 ;
X1 SET ZTDTH=""
X3 SET ZTDTH=$ORDER(^%ZTSCH("LINK",ZTDVOL,ZTDTH))
IF ZTDTH=""
QUIT
+1 SET ZTSK=""
X4 SET ZTSK=$ORDER(^%ZTSCH("LINK",ZTDVOL,ZTDTH,""))
IF ZTSK=""
GOTO X3
+1 KILL ^%ZTSCH("LINK",ZTDVOL,ZTDTH,ZTSK)
+2 IF $DATA(^%ZTSK(ZTSK,0))[0
GOTO X4
+3 IF $LENGTH($PIECE($GET(^%ZTSK(ZTSK,.1)),U,10))
DO TSKSTAT^%ZTM1("D","Stopped while waiting for Link")
GOTO X4
+4 ;
+5 LOCK ^[ZTM,ZTN]%ZTSK(-1)
+6 SET ZTS=^[ZTM
SET ZTN]%ZTSK(-1)+1
+7 FOR ZTI=0:0
if '$DATA(^[ZTM,ZTN]%ZTSK(ZTS))
QUIT
SET ZTS=ZTS+1
+8 SET ^[ZTM
SET ZTN]%ZTSK(-1)=ZTS
+9 ;
+10 LOCK (^%ZTSK(ZTSK),^[ZTM,ZTN]%ZTSK(ZTS))
+11 DO TSKSTAT^%ZTM1(1,"Link")
+12 SET %X="^%ZTSK(ZTSK,"
SET %Y="^[ZTM,ZTN]%ZTSK(ZTS,"
DO %XY^%RCR
+13 SET $PIECE(^[ZTM,ZTN]%ZTSK(ZTS,0),U,6)=ZTT
+14 SET ^[ZTM
SET ZTN]%ZTSCH(ZTT,ZTS)=""
+15 ;
+16 KILL ^%ZTSK(ZTSK)
+17 LOCK ^%ZTSCH("LINK")
+18 GOTO X4
+19 ;
ERXCPU ;XCPU--trap if link drops again while a task is being sent
+1 SET X=""
SET @^%ZOSF("TRAP")
+2 IF ^%ZTSCH("LINK")=""
SET ^("LINK")=$HOROLOG
+3 IF ZTSK]""
IF $DATA(^%ZTSK(ZTSK,0))#2
DO TSKSTAT^%ZTM1("G","Link Error")
+4 LOCK ^%ZTSCH("LINK")
+5 QUIT
+6 ;
