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/ZTMS3.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 4.7 KB
Line 
1%ZTMS3 ;SEA/RDS-TaskMan: Submanager, Part 5 (Run Task) ;07/20/2005 13:54
2 ;;8.0;KERNEL;**1,18,36,49,64,67,94,118,127,136,175,275,355**;Jul 10, 1995;Build 9
3 ;
4TASK ;SUBMGR--prepare and run task; cleanup after
5 ;
6BEFORE ;prepare task
7 ;submanager's variables
8 S ZTDEF=""
9 S X=$O(^%ZIS(14.7,"B",ZTPAIR,""))
10 I X]"",$D(^%ZIS(14.7,X,0))#2 S ZTDEF=^(0)
11 S DUZ=+$P(ZTREC,U,3)
12 S %ZTTV=ZTUCI_U_IOS_U_U_ZTSK_U_IO_U_IOT_U_ZTCPU_U_ZTNODE_U_DUZ_U_U_IOF_U_IOST_U_ZTPAIR_U_ZTYPE_U
13 S %ZTTV(0)=ZTRTN_U_$P(ZTREC,U,8,9)_U_$P(ZTREC,U,6)_U_ION_U_ZTUCI_U_$P(ZTREC,U,5)_U_$S($L($P(ZTREC,U,10)):$P(ZTREC,U,10),1:$P(ZTREC,U,3))_U_$J_U_ZTSYNCFL_U_ZTPAIR_U
14 ;
15 I +$G(^%ZTSCH("LOGRSRC")) S %ZTTV(1)="!"_$S($P(ZTREC,U,9)="":$P(ZTREC,U,2),1:$P(ZTREC,U,9))
16 ;
17 ;external calls
18 D NOW^%DTC S DT=% ;DT is Date.time at this point.
191 D SETNM^%ZOSV($E("BTask ",(ZTIO]"")+1,6)_(ZTSK#100000000))
20 ;
21 ;priority (Not done in the VA)
22 ;S X=$P(ZTREC,U,15)
23 ;S X=$S(+X'=X:0,X'<1&(X'>10):X\1,1:0)
24 ;S Y=$S(IOS="":0,$D(^%ZIS(1,+IOS,0))[0:0,1:+$P(^(0),U,5))
25 ;S Y=$S(Y'<1&(Y'>10):Y\1,1:0)
26 ;S X=$S(Y:Y,X:X,$P(ZTDEF,U,4):$P(ZTDEF,U,4),1:10)
27 ;X ^%ZOSF("PRIORITY")
28 ;
292 ;restore saved variables
30 S X=$O(^XTV(8989.3,1,4,"B",ZTCPU,0)) S:$P($G(^XTV(8989.3,1,4,+X,0)),U,6)="y" XRTL=ZTUCI
31 K %,%H,%I,%ZTI,%ZTIO,IO("C"),IO("T"),X,Y,ZTCPU,ZTDEF,ZTIOST,ZTIOT,ZTNODE,ZTPAIR,ZTREC,ZTREC2,ZTREC21,ZTREC25,ZTUCI
32 K ^TMP($J),^UTILITY($J),^XUTL("XQ",$J)
33 S DUZ(0)="" D RESTORE^%ZTMS4
34 ;
35 ;force values, DTIME=1 so HFS reads work under Cache
36 S DUZ=+DUZ,DTIME=1,ZTDESC=$G(^%ZTSK(ZTSK,.03)),ZTDTH=$H
37 I DUZ(0)="" S DUZ(0)=$S($D(^VA(200,DUZ,0))#2:$P(^(0),U,4),1:"")
38 I $D(DUZ(2))[0 S DUZ(2)=$S($D(^VA(200,DUZ,2,0)):$O(^(0)),1:0)
39 S ^XUTL("XQ",$J,0)=DT,^("ZTSK")=ZTDESC,^("ZTSKNUM")=ZTSK
40 S X="DUZ" F S X=$Q(@X) Q:X="" I $D(@X) S ^XUTL("XQ",$J,$TR(X,""""))=@X
41 F X="DUZ","IO","IOBS","IOF","IOM","ION","IOS","IOSL","IOST","IOST(0)","IOT","IOXY","XQVOL" I $D(@X) S ^XUTL("XQ",$J,X)=@X
423 ;
43 ;final checks & sets
44 I '$D(^%ZTSK(ZTSK)) S ZTTASK=0 D AFTER Q
45 I $L($P($G(^%ZTSK(ZTSK,.1)),U,10)) D Q
46 . D TSKSTAT("D","Stopped by User")
47 . S ZTTASK=0
48 . D AFTER
49 D TSKSTAT(5,"Started Running",$J)
50 S ZTQUEUED=ZTSK,ZTSTAT="1 General error"
51 S ^%ZTSCH("TASK",ZTSK)=%ZTTV(0)_$H,^(ZTSK,2)=%ZTTV
52 ;
534 ;run task
54 I ^%ZOSF("OS")["MSM" D
55 . I $P($ZV,"Version ",2)]]"4.3.0" D PURGELST^%MSMOPS Q
56 . Q
57 L
58 I ZTPFLG("XUSCNT") D SETLOCK^XUSCNT($NA(^%ZTSCH("TASK",ZTSK)))
59 L +^%ZTSCH("TASK",ZTSK) ;establish a lock on the task to be used to indicate that it is active
60 ;Persistent task get set in ZTSK^XQ1
61 I $P(^%ZIS(14.7,ZTPFLG("ZTPN"),0),U,3)="Y" S %ZTTV("LOG")=1 D LOGIN^%ZTMS4
62 I $D(%ZTTV(1)) D:+$G(^%ZTSCH("LOGRSRC")) LOGRSRC^%ZOSV(%ZTTV(1))
63 S DT=DT\1 S:ZTPFLG("ZTREQ") ZTREQ="@"
64 M %ZTPFLG=ZTPFLG
65 D RUN
66 M ZTPFLG=%ZTPFLG K %ZTPFLG
67 I $D(%ZTTV(1)) D:+$G(^%ZTSCH("LOGRSRC")) LOGRSRC^%ZOSV("$AFTR ZTMS$")
68 I $G(%ZTTV("LOG")) D LOGOUT^%ZTMS4
69 ;
70AFTER ;cleanup after task; reset partition
71 S U="^",ZTSK=$P(%ZTTV,U,4) D PCLEAR^%ZTLOAD(ZTSK) ;Clear persistent flag
72 D TSKSTAT(6,"Finished")
73 I ZTPFLG("XUSCNT") D SETLOCK^XUSCNT()
74 L ;Clear all user locks.
75 L +^%ZTSK(ZTSK)
76 I $D(ZTTASK)[0 K ^%ZTSCH("TASK",ZTSK) S ZTQUEUED=.6,ZTTASK=1
77 ;S X=10 X ^%ZOSF("PRIORITY")
78 D SETNM^%ZOSV("Sub "_$J) ;Change name back
79 S ZTUCI=$P(%ZTTV,U),IOS=$P(%ZTTV,U,2),(IO,IO(0),%ZTIO)=$P(%ZTTV,U,5),IOT=$P(%ZTTV,U,6),ZTCPU=$P(%ZTTV,U,7),ZTNODE=$P(%ZTTV,U,8)
80 S IOF=$P(%ZTTV,U,11),IOST=$P(%ZTTV,U,12),ZTPAIR=$P(%ZTTV,U,13),ZTYPE=$P(%ZTTV,U,14),ZTSYNCFL=$P(%ZTTV(0),U,11)
81 I $G(ZTSYNCFL)]"" S X=$$SYNCFLG^%ZTMS2($S($G(ZTSTAT):"S",1:"D"),ZTSYNCFL,IO,$G(ZTSTAT)) D SCHSYNC^%ZTMS2(ZTSYNCFL,IO):'$G(ZTSTAT)
82 D POST^%ZTMS4:ZTTASK,CLOSE
83 K ^TMP($J),^UTILITY($J),^XUTL("XQ",$J) I $T(XUTL^XUSCLEAN)]"" D XUTL^XUSCLEAN
84 K (%ZTIO,%ZTTV,DT,IO,IOF,ION,IOS,IOST,IOT,U,ZTCPU,ZTNODE,ZTNONEXT,ZTPAIR,ZTPFLG,ZTQUEUED,ZTREQ,ZTSTOP,ZTUCI,ZTYPE)
85 K IO("C"),IO("T"),IO("ERROR"),IO("LASTERR"),IO("DOC"),IO("P"),IO("HFSIO")
86 S DUZ=0,DUZ(0)="@",ZTQUEUED=0
87 L ;Clear all locks, -^%ZTSK(ZTSK)
88 Q
89 ;
90RUN ;
91 N %,%ZTTV,%ZTPFLG,XUALLOC
92 F %=1:1:12 S $P(XUALLOC(%)," ",250)=""
93 D @ZTRTN
94 Q
95 ;
96CLOSE ;RUN--close &/or close execute
97 I %ZTIO="" S ZTNONEXT=1 G CLX
98 N ZTUCI,ZTCPU,ZTNODE,IOCPU,%IO
99 I IOT="HFS"!(IOT="SPL") S ZTNONEXT=1
100 K IO("C") S:IOT'="TRM" IO("C")=1
101 S:$D(IO("CLOSE")) IO("T")=1
102 I IOT="RES" K ZTNONEXT Q ;For a Resource, don't close.
103 ;Here is the Lock and hang to allow IDCU ports to reset. See %ZTMS2.
104 I IOST["MINIOUT" S IO("C")=1,%IO=1 L +^%ZTSCH("NETMAIL",%ZTIO):8
105 I $D(IO(1,IO))#2 D ^%ZISC
106 I $G(%IO) H 6 ;Wait for terminal server to reset.
107 ;Unlock of all locks is done in clean
108 ;See that all devices are closed.
109CLX S %IO="" F S %IO=$O(IO(1,%IO)) Q:%IO="" I %IO'=IO K IO(1,%IO) C %IO
110 Q
111 ;
112TSKSTAT(CODE,MSG,JOB) ; Update task's status
113 S $P(^%ZTSK(ZTSK,.1),U,1,3)=$G(CODE)_U_$H_U_$G(MSG)
114 I $G(JOB)>0 S $P(^%ZTSK(ZTSK,.1),U,4)=JOB
115 Q
116 ;
Note: See TracBrowser for help on using the repository browser.