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

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

initial load of FOIAVistA 6/30/08 version

File size: 6.4 KB
Line 
1XQ1 ; SEA/MJM - DRIVER FOR MENUMAN (PART 2) ;10/29/2003 11:27
2 ;;8.0;KERNEL;**1,15,59,67,46,151,170,242**;Jul 10, 1995
3 S DIC=19,DIC(0)="AEQM" D ^DIC Q:Y<0 S (XQDIC,XQY)=+Y K DIC,XQUR,Y,^VA(200,DUZ,202.1)
4 D INIT^XQ12
5 G M^XQ
6 ;
7KILL K D,D0,D1,DA,DIC,DIE,DIR,DIS,DR,XQI,XQV,XQW,XQZ
8 D CLEAN^DILF
9 ;
10OUT ;Exit point for all option types
11 S U="^"
12 I $D(XQXFLG("ZEBRA")) L ^XWB("SESSION",XQXFLG("ZEBRA")) ;Clear by setting new lock
13 E L ;Clear the lock table
14 ;
15 I $D(ZTQUEUED),'$D(XQUIT) D
16 .N XQF
17 .S XQF=$S('$D(^DIC(19,XQY,15)):0,'$L(^(15)):0,1:1)
18 .X:XQF ^(15)
19 .Q
20 Q:$D(ZTQUEUED) ;Quit here if it's a Taskman job
21 ;
22 I '$D(DT)!('$D(DTIME))!('$D(DUZ))!('$D(DUZ(0)))!('$D(DUZ("AG")))!('$D(DUZ("AUTO"))) D DVARS^XQ12
23 I $D(DUZ("AUTO")),DUZ("AUTO"),$D(XQY),$D(^DIC(19,+XQY,0))#2,$P(^(0),"^",11)["y" W !!,*7,"Press RETURN to continue..." R %:DTIME
24 I $D(^XUTL("XQ",$J,"RBX")) G RBX^XQ73
25 I $D(^XUTL("XQ",$J,"T")) I ^("T")<0 S ^("T")=$S($D(^XUTL("XQ",$J,1)):1,1:0)
26 I $D(^XUTL("XQ",$J,"T")) S XQY=+^(^("T")),XQT="" S:$D(^DIC(19,+XQY,0)) XQT=$P(^(0),U,4) I '$D(XQUIT),("LOQX"'[XQT),$D(^DIC(19,XQY,15)),$L(^(15)) X ^(15) ;W " ==> OUT^XQ1"
27 Q:'$D(^XUTL("XQ",$J,"T"))
28 I $D(^XUTL("XQ",$J,"T")) S XQTT=$S($D(XQUIT):^XUTL("XQ",$J,"T"),1:^XUTL("XQ",$J,"T")-1) K XQUIT
29 I XQTT'<1 S ^XUTL("XQ",$J,"T")=XQTT,XQY=^(XQTT),XQY0=$P(XQY,U,2,999),XQPSM=$P(XQY,U,1),XQY=+XQPSM,XQPSM=$P(XQPSM,XQY,2,99),XQABOLD=1
30 I XQTT=0 S XQY=-1
31 I $P(XQY0,U,4)="M" S XQAA=$P(XQY0,U,2) I $P(XQY0,U,17),$D(^DIC(19,+XQY,26)),$L(^(26)) X ^(26) ;W " ==> OUT^XQ1"
32 K %,X,XQDICNEW,XQF,XQCO,XQEA,XQFLG,XQI,XQJ,XQJS,XQK,XQLOK,XQNOPE,XQOK,XQTT,XQX,XQZ,Y,Z
33 G M1^XQ
34 ;
35A ;ACTION type option entry point
36 X:$D(^DIC(19,+XQY,20)) ^(20) ;W " ==> A^XQ1"
37 I $D(XQUIT) S XQUIT=1 D ^XQUIT I $D(XQUIT) K XQUIT G OUT
38 I $P(XQY0,U,17),$D(^DIC(19,XQY,26)),$L(^(26)) X ^(26) ;W " ==> A^XQ1"
39 G OUT
40 ;
41C ;ScreenMan type options
42 D DIC G:DA=-1 KILL S XQZ="DR,DDSFILE,DDSFILE(1)",XQW=39 D SET
43 S DDSPAGE=$P($G(^DIC(19,+XQY,43)),U) K:DDSPAGE="" DDSPAGE
44 S DDSPARM=$P($G(^DIC(19,+XQY,43)),U,2) K:DDSPARM="" DDSPARM
45 I DDSFILE["(",DDSFILE'[U S DDSFILE=U_DDSFILE
46 I $D(DDSFILE(1)),DDSFILE(1)["(",DDSFILE(1)'[U S DDSFILE(1)=U_DDSFILE(1)
47 D ^DDS K DDSFILE G C
48 ;
49P ;PRINT type option
50 S XQZ="DIC,PG,L,FLDS,BY,FR,TO,DHD,DCOPIES,DIS(0),IOP,DHIT,DIOBEG,DIOEND",XQW=59 D SET
51 I $D(DIS(0))#2 F XQI=1:1:3 Q:'$D(^DIC(19,+XQY,69+(XQI/10))) Q:^(69+(XQI/10))="" S DIS(XQI)=^(69+(XQI/10))
52 S:$D(XQIOP) IOP=XQIOP
53 S XQI=$G(^DIC(19,XQY,79)) S:XQI>0 DIASKHD="" S:$P(XQI,U,2) DISUPNO=1 S:$P(XQI,U,3) DIPCRIT=1
54 D D1,EN1^DIP K IOP,DIOBEG,DIS,DP G OUT
55 ;
56I ;INQUIRE type option
57I1 D DIC G KILL:DA=-1 S DI=DIC,XQZ="DIC,DR,DIQ(0)",XQW=79 D SET,D1 S:$D(DIC)[0 DIC=DI
58 I $D(^DIC(19,+XQY,63)),$L(^(63)) S FLDS=^(63)
59 E S FLDS="[CAPTIONED]"
60 I $G(^DIC(19,+XQY,83))["Y" S IOP="HOME"
61I2 ;
62 W ! S XQZ="DHD",XQW=66 D SET K ^UTILITY($J),^(U,$J) S ^($J,1,DA)="",@("L=+$P("_DI_"0),U,2)"),DPP(1)=L_"^^^@",L=0,C=",",Q="""",DPP=1,DPP(1,"IX")="^UTILITY(U,$J,"_DI_"^2" D N^DIP1 S Y=XQY G I1
63 ;
64E ;EDIT type option entry point
65E1 D DIC G KILL:DA=-1 K DIE,DIC S XQZ="DIE,DR",XQW=49 D SET S XQZ="DIE(""W"")",XQW=53 D SET
66 I $D(^DIC(19,XQY,53)),$L(^(53)) S %=^(53),DIE("NO^")=$S(%="N":"",1:%)
67 ;S:DIE["(" DIE=U_DIE
68 ;
69 ;DIE does not lock so we do it here
70 ;
71 S XQLOK="",XQNOPE=0
72 I DIE["(" D
73 .S DIE=U_DIE
74 .S XQLOK=DIE_DA_")" L +@XQLOK:2
75 .I '$T S XQNOPE=1 W !,"Someone else is editing this data. Try later."
76 .Q
77 ;
78 I DIE=+DIE D
79 .N %
80 .S %=$$ROOT^DILFD(DIE)
81 .I %'="" S XQLOK=%_DA_")" L +@XQLOK:2
82 .I '$T S XQNOPE=1 W !,"Someone else is editing this data. Try later."
83 .Q
84 ;
85 G:XQNOPE E1 ;Node is being edited right now, skip DIE
86 D ^DIE S Y=XQY
87 I XQLOK'="" L -@XQLOK
88 G E1
89 ;
90 ;
91DIC ;Get FileMan parameters from Option File and do look up
92 W ! K DIC S XQZ="DIC,DIC(0),DIC(""A""),DIC(""B""),DIC(""S""),DIC(""W""),D",XQW=29 D SET,D1
93 I '$D(D) D ^DIC
94 I $D(D) S:D="" D="B" D IX^DIC
95 I $D(Y),Y>0,$P(Y,U,3) S XQDICNEW=Y
96 S DA=+Y,Y=XQY
97 Q
98 ;
99D1 S:DIC["(" DIC=U_DIC Q
100 ;
101SET F XQI=1:1 S XQV=$P(XQZ,",",XQI) Q:XQV="" K @XQV I $D(^DIC(19,+XQY,XQW+XQI)),^(XQW+XQI)]"" S @XQV=^(XQW+XQI)
102 I $D(DIC("A")),DIC("A")]"" S DIC("A")=DIC("A")_" "
103 K XQI,J
104 Q
105 ;
106R ;RUN ROUTINE type option entry point
107 G:'$D(^DIC(19,XQY,25)) OUT:$D(ZTQUEUED),M1^XQ S XQZ=^(25) G:'$L(XQZ) M1^XQ S:XQZ'[U XQZ=U_XQZ I XQZ["[" D DO^%XUCI G OUT
108 D @XQZ G OUT
109 ;
110W ;Window type option entry point
111 S XQOK=1
112 I $D(^DIC(19,XQY,25)),$L(^(25)) D G OUT ;Routine type
113 .S XQZ=^DIC(19,XQY,25)
114 .S:XQZ'[U XQZ=U_XQZ
115 .I XQZ["[" D DO^%XUCI Q
116 .D @XQZ
117 .Q
118 ;
119 ;I $D(^DIC(19,XQY,24)),$L(^(24)) D G:XQOK OUT ;Pointer type
120 ;.S XQZ=^DIC(19,XQY,24)
121 ;.S XQZ=$P($G(^XTV(8995,XQZ,0)),U) I XQZ="" S XQOK=0 Q
122 ;.D PREP^XG
123 ;.S XQWIN=$$NEXTNM^XGCLOAD("XQWIN")
124 ;.D GET^XGCLOAD(XQZ,XQWIN,"^TMP($J)")
125 ;.D GET^XGCLOAD(XQZ,$NA(^TMP($J,XQWIN)))
126 ;.D M^XG(XQWIN,$NA(^TMP($J,XQWIN)))
127 ;.D ESTA^XG() ;Send it off to window land
128 ;.;
129 ;.D K^XG(XQWIN) ;Return here after the ESTOP
130 ;.;I $D(^%ZOSF("OS")),^%ZOSF("OS")["MSM" ZSTOP
131 ;.Q
132 ;
133 G M1^XQ ;Window failed
134 ;
135Z ;Window suite option
136 G EN^XQSUITE
137 ;
138S ;Server-type option pseudo entry-point can't be invoked from Meun System
139 G OUT
140 ;
141B ;Client/Server option can't be run from menu system
142 G OUT
143 ;
144L ;OE/RR Limited option
145O ;OE/RR Protocol (orderables) type option entry point
146X ;OE/RR Extended Action type option (Subset of Protocol type)
147Q ;OE/RR Protocol Menu type option entry point
148 S XQOR=+XQY,XQOR(1)=XQT D XQ^XQOR K XQOR G OUT
149 ;
150ZTSK ;Task Manager entry point
151 S U="^" G:$G(XQSCH)'>0 ZTSK2 ;No reschedule
152 S %=$$S^%ZTLOAD("Reschedule Task")
153 S XQ=$G(^DIC(19.2,XQSCH,0)),XQY=+XQ Q:XQY'>0
154 K ZTQPARAM ;Build params from schedule in case we delete it.
155 I $D(^DIC(19.2,XQSCH,3)),$L(^(3)) S ZTQPARAM=^(3)
156 I $D(^DIC(19.2,XQSCH,2)) D ;Build other symbols
157 . S X2=XQSCH N XQSCH,XQY,XQ
158 . F X1=0:0 S X1=$O(^DIC(19.2,X2,2,X1)) Q:X1'>0 S X=^(X1,0),@($P(X,U)_"="_$P(X,U,2))
159 . Q
160REQ S X1=$P(XQ,U,2),X2=$P(XQ,U,6) ;Get params for new schedule
161 S DA=XQSCH,DIE="^DIC(19.2,",DR=$S((X2="")&($P(XQ,U,9)=""):".01///@",X2="":"2///@",1:"2////"_$$SCH^XLFDT(X2,+X1,1))
162 L +^%ZTSK(ZTSK,0) D ^DIE L -^%ZTSK(ZTSK,0) ;File new schedule
163 K DA,DIE,DR,X1,X2,XQ
164 S X=$P($G(^DIC(19.2,XQSCH,1.1)),U) I X>0 D DUZ^XUP(X) ;User to run job
165ZTSK2 S ZTREQ="@" Q:'$D(XQY)
166 D UI^XQ12
167 Q:'$D(^DIC(19,XQY,0)) S XQY0=^(0),XQT=$P(XQY0,U,4) Q:XQT'="A"&(XQT'="P")&(XQT'="R")
168 ;Kernel no longer supports reseting priority
169 ;S X=$P(XQY0,U,8) I X>0,X<11 X ^%ZOSF("PRIORITY")
170 I $P(XQY0,U,3)]""!($D(XQUIT)) S XQT="KILL"
171 ;
172 S XQ=$$S^%ZTLOAD("Run Task")
173RUN S:XQT="P"&$L(IO) XQIOP=ION_";"_IOST_";"_IOM_";"_IOSL G @XQT
174 Q
Note: See TracBrowser for help on using the repository browser.