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/XUTMDEVQ.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 6.0 KB
Line 
1XUTMDEVQ ;ISCSF/RWF - Device call and Queue in one place ;01/18/2006
2 ;;8.0;KERNEL;**20,120,275,389**;Jul 10, 1995;Build 1
3 ; this routine has four entry points: EN, DEV, NODEV, QQ
4 ; usage:
5 ;D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,[.]%ZIS,[FLAG])
6 ;S X=$$DEV^XUTMQUE(ZTRTN,ZTDESC,[.]%VAR,.%VOTH,[.]%ZIS,IOP,%WR)
7 ;S X=$$NODEV^XUTMQUE(ZTRTN,ZTDESC,[.]%VAR,.%VOTH,%WR)
8 ;S X=$$QQ(%RTN,%DESC,[.]%VAR1,.%VOTH1,.%ZIS,IOP,%WR,%RTN2,%DESC2,[.]%VAR2,.%VOTH2)
9 ;EN
10 ;Call with %ZTLOAD parameters and it will call $ZIS and
11 ;run or queue the output.
12 ;
13EN(ZTRTN,ZTDESC,ZTSAVE,%ZIS,%) ;ZTSAVE AND %ZIS pass by reference.
14 Q:$G(ZTRTN)=""
15 N %RET,ZTIO,ZTDTH,ZTSYNC,ZTCPU,ZTUCI N:'$G(%) ZTSK K IO("Q")
16 D ZIS I POP G KILL
17 I '$D(IO("Q")) D RUN G KILL
18 D ZTLOAD
19KILL K ZTDTH,ZTSAVE
20 Q
21ZIS ;
22 S:$G(%ZIS)'["Q" %ZIS=$G(%ZIS)_"Q"
23 D ^%ZIS
24 Q
25ZTLOAD ;
26 K IO("Q"),ZTSK
27 D ^%ZTLOAD,HOME^%ZIS
28 S:$D(ZTSK) %RET=ZTSK
29 Q
30RUN ;
31 U IO
32 D @ZTRTN
33 D ^%ZISC
34 Q
35 ;
36DEV(ZTRTN,ZTDESC,%VAR,%VOTH,%ZIS,IOP,%WR) ; single que ask for device
37 ; ZTRTN - required - [tag]^routine that taskman will run
38 ; ZTDESC - optional - default to name of [tag]~routine
39 ; %VAR - optional - single value or passed by reference
40 ; this will be used to S ZTSAVE()
41 ; can be a string of variable names separated by ';'
42 ; each ;-piece will be used as a subscript in ztsave
43 ; %VOTH - optional - passed by reference
44 ; %voth(sub)="" or explicit value
45 ; sub - this is any other %ZTLOAD variable besides
46 ; ZTRTN,ZTDESC,ZTIO,ZTSAVE
47 ; example: %VOTH("ZTDTH")=$H
48 ; %ZIS - optional - default value "MQ" - passed by reference
49 ; standard %ZIS variable array for calling device handler
50 ; IOP - optional - IOP variable as defined in Kernel device handler
51 ; %WR - optional - if %WR>0 then write text to the screen as to
52 ; whether or not the queueing was successful
53 ;
54 ; return: ZTSK value if successfully queued
55 ; 0 if run ztrtn without queuing
56 ; -1 if unsuccessful device call or failed %ztload call
57 ;
58 N ZTIO,ZTDTH,ZTSYNC,ZTCPU,ZTUCI,ZTSAVE,ZTSK,ZTPRI,ZTKIL,%RET,POP
59 S %RET=-1 I $G(ZTRTN)="" G OUT
60 D SETUP,ZIS I POP G OUT
61 I '$D(IO("Q")) D RUN S %RET=0
62 D ZTLOAD
63OUT I $G(%WR),%RET'=0,'$D(ZTQUEUED) D
64 .W !! I %RET<0 W "Request Aborted",!
65 .E W "Task queued ["_(+%RET)_"]",!
66 .I $P(%RET,U,2) W !,"Second task queued ["_$P(%RET,U,2)_"]",!
67 .Q
68 Q %RET
69 ;
70NODEV(ZTRTN,ZTDESC,%VAR,%VOTH,%WR) ; single que no device needed
71 ; see DEV for parameter descriptions and return values
72 N ZTIO,ZTDTH,ZTSYNC,ZTCPU,ZTUCI,ZTSAVE,ZTSK,ZTKIL,ZTPRI,%RET,POP
73 S %RET=-1 I $G(ZTRTN)]"" S ZTIO="" D SETUP,ZTLOAD
74 G OUT
75 ;
76QQ(%RTN,%DESC,%VAR1,%VOTH1,%ZIS,IOP,%WR,%RTN2,%DESC2,%VAR2,%VOTH2) ;
77 ; double queuing - queue up the second routine to device, but do not
78 ; schedule the task in Taskman
79 ; queue up the first job to ZTIO="" and schedule it
80 ; %RTN - required - [tag]^routine for the 1st job to be run (usually a
81 ; search and build sorted data type process)
82 ; %DESC - optional - ZTDESC value for 1st job (default [tag]~routine)
83 ; %VAR1 - optional - ZTSAVE values for 1st job - see %VAR descript above
84 ;%VOTH1 - optional - 1st job - see %VOTH description above
85 ; %ZIS - optional - see %ZIS description above, except for one diff
86 ; the 2nd job will be tasked to this device call
87 ; exception: IF $D(%ZIS)=0 then default value is "MQ" and call
88 ; device handler
89 ; IF $D(%ZIS)=1,%ZIS="" then queue 2nd job also with
90 ; ZTIO="" i.e., do not do device handler call
91 ; IOP - optional - see above - default value "Q" - if IOP is passed
92 ; and IOP does not start with "Q;" then "Q;" will
93 ; be added
94 ; %WR - optional - see above
95 ; %RTN2 - required - [tag]^routine for the 2nd job to be run (usually a
96 ; print job)
97 ;%DESC2 - optional - ZTDESC value for 2nd job (default [tag]~routine)
98 ; %VAR2 - optional - ZTSAVE values for 2nd job - see %VAR descript above
99 ; if %VAR1 is not passed and $D(%VAR) then also send %VAR
100 ; data to 2nd tasked job. If $D(%VAR1) then do not send %VAR
101 ; data to 2nd tasked job.
102 ;%VOTH2 - optional - 2nd job - see %VOTH description above - usually not
103 ; needed - note: if %VOTH1("ZTDTH") is passed it will be ignored
104 ; as it is necessary to S ZTDTH="@" for the 2nd job - this will
105 ; create the task but not schedule it
106 ;
107 ; return: if successfully queued, return ztsk1^ztsk2 where
108 ; ztsk1 = ZTSK value of 1st job, ztsk2 = ZTSK value of 2nd job
109 ; -1 if unsuccessful device call or failed %ztload call
110 ;
111 N ZTIO,ZTDTH,ZTSYNC,ZTCPU,ZTUCI,ZTSAVE,ZTSK,ZTPRI,ZTKIL,ZTDESC,%RET,POP
112 N %VAR,%VOTH,%TMP S %RET=-1
113 I $G(%RTN)=""!($G(%RTN2)="") G OUT
114 ; setup 2nd job to %ZIS
115 S ZTRTN=%RTN2
116 I $D(%VAR2) M %VAR=%VAR2
117 I '$D(%VAR),$D(%VAR1) M %VAR=%VAR1
118 I $D(%VOTH2) M %VOTH=%VOTH2
119 I $G(%DESC2)]"" S ZTDESC=%DESC2
120 I $D(%ZIS)=1,%ZIS="" S ZTIO=""
121 E D
122 .I $D(IOP),IOP'?1"Q;".E S IOP="Q;"_IOP
123 .I '$D(IOP) S IOP="Q"
124 .Q
125 D SETUP,ZIS:'$D(ZTIO) I $G(POP) G OUT
126 S ZTDTH="@" D ZTLOAD
127 K %VAR,%VOTH,%ZIS,IOP S %TMP=%RET
128 S ZTRTN=%RTN
129 I $D(%VAR1) M %VAR=%VAR1
130 I $D(%VOTH1) M %VOTH=%VOTH1
131 I $G(%DESC)]"" S ZTDESC=%DESC
132 D SETUP S ZTIO="",%RET=-1,ZTSAVE("XUTMQQ")=%TMP D ZTLOAD I %RET>0 S %RET=%RET_U_%TMP
133 G OUT
134 ;
135REQQ(ZTSK,ZTDTH,%VAR) ;Reschedule the second part of a QQ task.
136 ;The task to work on should be in XUTMQQ.
137 N ZTIO,ZTDESC,ZTRTN,ZTSYNC,ZTCPU,ZTUCI,ZTSAVE,ZTPRI,ZTKIL,ZTREQ
138 I $G(ZTSK)=""!($G(ZTDTH)="") Q 0
139 D VAR
140 D REQ^%ZTLOAD
141 Q $G(ZTSK(0),0) ;Return 1 for rescheduled, 0 for fail.
142 ;
143SETUP ; setup %ztload variables
144 K ZTDTH,ZTSYNC,ZTCPU,ZTUCI,ZTSAVE,ZTPRI,ZTKIL,ZTSK,IO("Q") N I,X,Y
145 D VAR
146 I $D(%VOTH) F S X=$O(%VOTH(X)) Q:X="" S:'$D(@X) @X=%VOTH(X)
147 I '$D(ZTDESC) S ZTDESC=$TR($P(ZTRTN,"("),U,"~")
148 Q
149 ;
150VAR ;Setup ZTSAVE
151 I $D(%VAR)#2 F I=1:1:$L(%VAR,";") S X=$P(%VAR,";",I),ZTSAVE(X)=""
152 S X="" F S X=$O(%VAR(X)) Q:X="" S ZTSAVE(X)=%VAR(X)
153 Q
Note: See TracBrowser for help on using the repository browser.