source: FOIAVistA/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/_ZTM2.m@ 1401

Last change on this file since 1401 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.4 KB
Line 
1%ZTM2 ;SEA/RDS-TaskMan: Manager, Part 4 (Link Handling 1) ;22 May 2003 10:17 am
2 ;;8.0;KERNEL;**23,118,275**;JUL 10, 1995
3 ;
4XLINK ;SEND^%ZTM--determine routing of XCPU task
5 S ZTJOBIT=0
6 S ZTI=$O(^%ZIS(14.5,"B",ZTDVOL,""))
7 S ZTS=^%ZIS(14.5,ZTI,0)
8 I $P(ZTS,U,4)="Y" G DOWN
9 S ZTM=$P(ZTS,U,6)
10 S ZTN=$P(ZTS,U,7) I ZTN S ZTN=$P(^%ZIS(14.5,ZTN,0),U)
11 I ZTN="" S ZTN=ZTDVOL
12 I ZTN=%ZTVOL S ZTJOBIT=1 Q
13 I $D(^%ZTSCH("LINK",ZTDVOL)) G DOWN
14 I ZTYPE="C" S ZTJOBIT=1 Q
15 ;
16OCPU ;XLINK--send task to manager on another volume set
17 ;First check how many jumps to other volume sets we have done.
18 I $P(^%ZTSK(ZTSK,.02),"^",3)>2 D REJCT^%ZTM1("Too many hops") Q
19 S $P(^%ZTSK(ZTSK,.02),"^",3)=$P($G(^%ZTSK(ZTSK,.02)),"^",3)+1
20 S X="EROCPU^%ZTM2",@^%ZOSF("TRAP")
21 I '$D(^[ZTM,ZTN]%ZTSCH("RUN")) S ZTT=$H G O1
22 S ZTT=^[ZTM,ZTN]%ZTSCH("RUN")
23 ;
24O1 L +^[ZTM,ZTN]%ZTSK(-1):5
25 S ZTS=^[ZTM,ZTN]%ZTSK(-1)+1
26 F ZT=0:0 Q:'$D(^[ZTM,ZTN]%ZTSK(ZTS)) S ZTS=ZTS+1
27 S ^[ZTM,ZTN]%ZTSK(-1)=ZTS
28 ;
29 L -^[ZTM,ZTN]%ZTSK(-1),+^[ZTM,ZTN]%ZTSK(ZTS)
30 D TSKSTAT^%ZTM1(1,"Ready to Move") ;S $P(^%ZTSK(ZTSK,.1),U,1,3)=1_U_ZTT_U
31 S %X="^%ZTSK(ZTSK,",%Y="^[ZTM,ZTN]%ZTSK(ZTS," D %XY^%RCR
32 ;Now schedule task.
33 S $P(^[ZTM,ZTN]%ZTSK(ZTS,0),U,6)=ZTT,^[ZTM,ZTN]%ZTSCH($$H3^%ZTM(ZTT),ZTS)=""
34 L -^[ZTM,ZTN]%ZTSK(ZTS)
35 ;
36 S X="",@^%ZOSF("TRAP")
37 K ^%ZTSK(ZTSK,.3)
38 D TSKSTAT^%ZTM1(6,"^Moved to "_ZTM_","_ZTN_" as task number "_ZTS)
39 K ZT,ZT1,ZTD,ZTI,ZTM,ZTN,ZTR,ZTS,ZTT,ZTREP Q
40 ;
41EROCPU ;OCPU--trap dropped link and reroute task
42 S X="",@^%ZOSF("TRAP")
43 I $D(^%ZTSCH("LINK"))[0 S ^("LINK")=$H
44 S ^%ZTSCH("LINK",ZTDVOL)=1
45 ;
46DOWN ;XLINK/EROCPU--reroute XCPU task whose link is down
47 D REQRD I $D(ZTREQUIR) G ORIGNL
48 I ZTIO]"",$D(IOCPU)#2,IOCPU]"" G LIST
49 S ZTREP(ZTDVOL)=""
50 S ZTREP=$P(^%ZIS(14.5,ZTI,0),U,8)
51 I ZTREP S ZTREP=$P(^%ZIS(14.5,ZTREP,0),U)
52 I ZTREP="" G ORIGNL
53 I $D(ZTREP(ZTREP))#2 G ORIGNL
54D1 ;
55 I $D(^%ZTSK(ZTSK,.01))[0 S ^%ZTSK(ZTSK,.01)=ZTUCI_U_ZTDVOL
56 S Y=$O(^%ZIS(14.6,"AT",ZTUCI,ZTDVOL,ZTREP,""))
57 I Y="" S Y=ZTUCI
58 S ZTUCI=Y,ZTDVOL=ZTREP
59 I ZTDVOL=%ZTVOL S X=ZTUCI_","_ZTDVOL X ^%ZOSF("UCICHECK") S:0'[Y ZTUCI=Y I 0[Y S %ZTREJCT=1
60 S $P(^%ZTSK(ZTSK,.02),U)=ZTUCI
61 I ZTDVOL'=%ZTVOL S $P(^%ZTSK(ZTSK,.02),U,2)=ZTDVOL
62 E S $P(^%ZTSK(ZTSK,.02),U,2)=""
63 I %ZTREJCT D TSKSTAT^%ZTM1("B","BAD DESTINATION UCI") Q
64 I ZTDVOL=%ZTVOL G SEND^%ZTM
65 G XLINK
66 ;
67REQRD ;DOWN--is dropped link required?
68 S ZTI=$O(^%ZIS(14.5,"B",ZTDVOL,""))
69 I ZTI="" Q
70 I $D(^%ZIS(14.5,ZTI,0))#2 S ZTS=^(0)
71 E Q
72 I $P(ZTS,U,5)="Y" S ZTREQUIR=ZTDVOL
73 Q
74 ;
75ORIGNL ;DOWN--give up trying to reroute; make it wait for original destination
76 I $D(^%ZTSK(ZTSK,.01))[0 G LIST
77 S ZTORIGNL=^%ZTSK(ZTSK,.01)
78 S ZTUCI=$P(ZTORIGNL,U)
79 S ZTDVOL=$P(ZTORIGNL,U,2)
80 S $P(^%ZTSK(ZTSK,.02),U)=ZTUCI
81 I ZTDVOL'=%ZTVOL S $P(^%ZTSK(ZTSK,.02),U,2)=ZTDVOL
82 E S $P(^%ZTSK(ZTSK,.02),U,2)=""
83 ;
84LIST ;DOWN/ORIGNL--place task on waiting list for down volume
85 I $D(^%ZTSCH("LINK"))[0 S ^("LINK")=$H
86 I ZTYPE'="C" S ^%ZTSCH("LINK",ZTDVOL,ZTDTH,ZTSK)=""
87 E D
88 .S ^%ZTSCH("LINK",ZTDVOL)=1
89 .L +^%ZTSCH("C",ZTDVOL):5
90 .S ^%ZTSCH("C",ZTDVOL,ZTDTH,ZTSK)=""
91 .L -^%ZTSCH("C",ZTDVOL)
92 .Q
93 D TSKSTAT^%ZTM1("G","Link Wait")
94 L K ZT,ZT1,ZTD,ZTI,ZTM,ZTN,ZTORIGNL,ZTR,ZTS,ZTT,ZTREP Q
95 ;
96ERCL ;I2^%ZTM - error in C list
97 Q:$$OOS^%ZTM(ZTVOL) N %
98 S %=$O(^%ZIS(14.7,"B",ZTVOL,0))
99 I %>0 S $P(^%ZIS(14.7,%,0),U,11)=1
100 Q
101LKUP(VS) ;Lookup a VS and place in ZTVS
102 N %,%1
103 S %=$O(^%ZIS(14.5,"B",VS,0)),%1=$G(^%ZIS(14.5,+%,0))
104 S %ZTVS(VS)=%1,%ZTVS(VS,"IFN")=% Q
Note: See TracBrowser for help on using the repository browser.