XQ1 ; SEA/MJM - DRIVER FOR MENUMAN (PART 2) ;08/28/08 13:20
;;8.0;KERNEL;**1,15,59,67,46,151,170,242,446,672,737**;Jul 10, 1995;Build 3
;Per VHA Directive 2004-038, this routine should not be modified.
;
S DIC=19,DIC(0)="AEQM" D ^DIC Q:Y<0 S (XQDIC,XQY)=+Y K DIC,XQUR,Y,^VA(200,DUZ,202.1)
D INIT^XQ12
G M^XQ
;
KILL K D,D0,D1,DA,DI,DIC,DIE,DIR,DIS,DIASKHD,DIPCRIT,DISUPNO,DPP,DR,FLDS,Q,XQI,XQV,XQW,XQZ
D CLEAN^DILF
;
OUT ;Exit point for all option types
S U="^"
I $D(XQXFLG("ZEBRA")) L ^XWB("SESSION",XQXFLG("ZEBRA")):15 ;Clear by setting new lock
E L ;Clear the lock table
;
I $D(ZTQUEUED),'$D(XQUIT) D
.N XQF
.S XQF=$S('$D(^DIC(19,XQY,15)):0,'$L(^(15)):0,1:1) X:XQF ^(15)
.Q
Q:$D(ZTQUEUED) ;Quit here if it's a Taskman job
;
I '$D(DT)!('$D(DTIME))!('$D(DUZ))!('$D(DUZ(0)))!('$D(DUZ("AG")))!('$D(DUZ("AUTO"))) D DVARS^XQ12
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
I $D(^XUTL("XQ",$J,"RBX")) G RBX^XQ73
I $D(^XUTL("XQ",$J,"T")) I ^("T")<0 S ^("T")=$S($D(^XUTL("XQ",$J,1)):1,1:0)
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"
Q:'$D(^XUTL("XQ",$J,"T"))
I $D(^XUTL("XQ",$J,"T")) S XQTT=$S($D(XQUIT):^XUTL("XQ",$J,"T"),1:^XUTL("XQ",$J,"T")-1) K XQUIT
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
I XQTT=0 S XQY=-1
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"
K %,X,XQDICNEW,XQF,XQCO,XQEA,XQFLG,XQI,XQJ,XQJS,XQK,XQLOK,XQNOPE,XQOK,XQTT,XQX,XQZ,Y,Z
G M1^XQ
;
A ;ACTION type option entry point
X:$D(^DIC(19,+XQY,20)) ^(20) ;W " ==> A^XQ1"
I $D(XQUIT) S XQUIT=1 D ^XQUIT I $D(XQUIT) K XQUIT G OUT
I $P(XQY0,U,17),$D(^DIC(19,XQY,26)),$L(^(26)) X ^(26) ;W " ==> A^XQ1"
G OUT
;
C ;ScreenMan type options
D DIC G:DA=-1 KILL S XQZ="DR,DDSFILE,DDSFILE(1)",XQW=39 D SET
S DDSPAGE=$P($G(^DIC(19,+XQY,43)),U) K:DDSPAGE="" DDSPAGE
S DDSPARM=$P($G(^DIC(19,+XQY,43)),U,2) K:DDSPARM="" DDSPARM
I DDSFILE["(",DDSFILE'[U S DDSFILE=U_DDSFILE
I $D(DDSFILE(1)),DDSFILE(1)["(",DDSFILE(1)'[U S DDSFILE(1)=U_DDSFILE(1)
D ^DDS K DDSFILE G C
;
P ;PRINT type option
S XQZ="DIC,PG,L,FLDS,BY,FR,TO,DHD,DCOPIES,DIS(0),IOP,DHIT,DIOBEG,DIOEND",XQW=59 D SET
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))
S:$D(XQIOP) IOP=XQIOP
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
D D1,EN1^DIP K IOP,DIOBEG,DIS,DP G OUT
;
I ;INQUIRE type option
I1 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
I $D(^DIC(19,+XQY,63)),$L(^(63)) S FLDS=^(63)
E S FLDS="[CAPTIONED]"
S:$G(DIQ(0))="B" DIQ(0)="CR" ;p672
I $G(^DIC(19,+XQY,83))["Y" S IOP="HOME"
I2 ;
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
;
E ;EDIT type option entry point
E1 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
I $D(^DIC(19,XQY,53)),$L(^(53)) S %=^(53),DIE("NO^")=$S(%="N":"",1:%)
;S:DIE["(" DIE=U_DIE
;
;DIE does not lock so we do it here
;
S XQLOK="",XQNOPE=0
I DIE["(" D
.S DIE=U_DIE
.S XQLOK=DIE_DA_")" L +@XQLOK:2
.I '$T S XQNOPE=1 W !,"Someone else is editing this data. Try later."
.Q
;
I DIE=+DIE D
.N %
.S %=$$ROOT^DILFD(DIE)
.I %'="" S XQLOK=%_DA_")" L +@XQLOK:2
.I '$T S XQNOPE=1 W !,"Someone else is editing this data. Try later."
.Q
;
G:XQNOPE E1 ;Node is being edited right now, skip DIE
D ^DIE S Y=XQY
I XQLOK'="" L -@XQLOK
G E1
;
;
DIC ;Get FileMan parameters from Option File and do look up
W ! K DIC S XQZ="DIC,DIC(0),DIC(""A""),DIC(""B""),DIC(""S""),DIC(""W""),D",XQW=29 D SET,D1
I '$D(D) D ^DIC
I $D(D) S:D="" D="B" D IX^DIC
I $D(Y),Y>0,$P(Y,U,3) S XQDICNEW=Y
S DA=+Y,Y=XQY
Q
;
D1 ;S:DIC["(" DIC=U_DIC Q
S:$G(DIC)["(" DIC=U_DIC Q ;p737
;
SET 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)
I $D(DIC("A")),DIC("A")]"" S DIC("A")=DIC("A")_" "
K XQI,J
Q
;
R ;RUN ROUTINE type option entry point
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
D @XQZ G OUT
;
W ;Window type option entry point
S XQOK=1
I $D(^DIC(19,XQY,25)),$L(^(25)) D G OUT ;Routine type
.S XQZ=^DIC(19,XQY,25)
.S:XQZ'[U XQZ=U_XQZ
.I XQZ["[" D DO^%XUCI Q
.D @XQZ
.Q
;
;I $D(^DIC(19,XQY,24)),$L(^(24)) D G:XQOK OUT ;Pointer type
;.S XQZ=^DIC(19,XQY,24)
;.S XQZ=$P($G(^XTV(8995,XQZ,0)),U) I XQZ="" S XQOK=0 Q
;.D PREP^XG
;.S XQWIN=$$NEXTNM^XGCLOAD("XQWIN")
;.D GET^XGCLOAD(XQZ,XQWIN,"^TMP($J)")
;.D GET^XGCLOAD(XQZ,$NA(^TMP($J,XQWIN)))
;.D M^XG(XQWIN,$NA(^TMP($J,XQWIN)))
;.D ESTA^XG() ;Send it off to window land
;.;
;.D K^XG(XQWIN) ;Return here after the ESTOP
;.;I $D(^%ZOSF("OS")),^%ZOSF("OS")["MSM" ZSTOP
;.Q
;
G M1^XQ ;Window failed
;
Z ;Window suite option
G EN^XQSUITE
;
S ;Server-type option pseudo entry-point can't be invoked from Meun System
G OUT
;
B ;Client/Server option can't be run from menu system
G OUT
;
L ;OE/RR Limited option
O ;OE/RR Protocol (orderables) type option entry point
X ;OE/RR Extended Action type option (Subset of Protocol type)
Q ;OE/RR Protocol Menu type option entry point
S XQOR=+XQY,XQOR(1)=XQT D XQ^XQOR K XQOR G OUT
;
ZTSK ;Task Manager entry point
S U="^" G:$G(XQSCH)'>0 ZTSK2 ;No reschedule
S %=$$S^%ZTLOAD("Reschedule Task")
S XQ=$G(^DIC(19.2,XQSCH,0)),XQY=+XQ Q:XQY'>0
K ZTQPARAM ;Build params from schedule in case we delete it.
I $D(^DIC(19.2,XQSCH,3)),$L(^(3)) S ZTQPARAM=^(3)
I $D(^DIC(19.2,XQSCH,2)) D ;Build other symbols
. N X1,X2 S X2=XQSCH N XQSCH,XQY,XQ
. 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))
. Q
;
S X=$P($G(^DIC(19.2,XQSCH,1.1)),U) I X>0 D DUZ^XUP(X) ;User to run job ;p446
REQ D ;Set the user and Requeue
. N DA,DIE,DR,X,X1,X2
. S X1=$P(XQ,U,2),X2=$P(XQ,U,6) ;Get params for new schedule
. S DA=XQSCH,DIE="^DIC(19.2,",DR=$S((X2="")&($P(XQ,U,9)=""):".01///@",X2="":"2///@",1:"2////"_$$SCH^XLFDT(X2,+X1,1))
. L +^%ZTSK(ZTSK,0):15 D ^DIE L -^%ZTSK(ZTSK,0) ;File new schedule
. Q
;ZTREQ is set by TM.
ZTSK2 I '$D(XQY) K ZTREQ Q ;Leave task
D UI^XQ12
Q:'$D(^DIC(19,XQY,0)) S XQY0=^(0),XQT=$P(XQY0,U,4) Q:XQT'="A"&(XQT'="P")&(XQT'="R")
;Kernel no longer supports reseting priority
;S X=$P(XQY0,U,8) I X>0,X<11 X ^%ZOSF("PRIORITY")
I $P(XQY0,U,3)]""!($D(XQUIT)) S XQT="KILL"
;
S %=$$S^%ZTLOAD("Run Task")
RUN S:XQT="P"&$L(IO) XQIOP=ION_";"_IOST_";"_IOM_";"_IOSL G @XQT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQ1 7055 printed Oct 16, 2024@18:05:27 Page 2
XQ1 ; SEA/MJM - DRIVER FOR MENUMAN (PART 2) ;08/28/08 13:20
+1 ;;8.0;KERNEL;**1,15,59,67,46,151,170,242,446,672,737**;Jul 10, 1995;Build 3
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 SET DIC=19
SET DIC(0)="AEQM"
DO ^DIC
if Y<0
QUIT
SET (XQDIC,XQY)=+Y
KILL DIC,XQUR,Y,^VA(200,DUZ,202.1)
+5 DO INIT^XQ12
+6 GOTO M^XQ
+7 ;
KILL KILL D,D0,D1,DA,DI,DIC,DIE,DIR,DIS,DIASKHD,DIPCRIT,DISUPNO,DPP,DR,FLDS,Q,XQI,XQV,XQW,XQZ
+1 DO CLEAN^DILF
+2 ;
OUT ;Exit point for all option types
+1 SET U="^"
+2 ;Clear by setting new lock
IF $DATA(XQXFLG("ZEBRA"))
LOCK ^XWB("SESSION",XQXFLG("ZEBRA")):15
+3 ;Clear the lock table
IF '$TEST
LOCK
+4 ;
+5 IF $DATA(ZTQUEUED)
IF '$DATA(XQUIT)
Begin DoDot:1
+6 NEW XQF
+7 SET XQF=$SELECT('$DATA(^DIC(19,XQY,15)):0,'$LENGTH(^(15)):0,1:1)
if XQF
XECUTE ^(15)
+8 QUIT
End DoDot:1
+9 ;Quit here if it's a Taskman job
if $DATA(ZTQUEUED)
QUIT
+10 ;
+11 IF '$DATA(DT)!('$DATA(DTIME))!('$DATA(DUZ))!('$DATA(DUZ(0)))!('$DATA(DUZ("AG")))!('$DATA(DUZ("AUTO")))
DO DVARS^XQ12
+12 IF $DATA(DUZ("AUTO"))
IF DUZ("AUTO")
IF $DATA(XQY)
IF $DATA(^DIC(19,+XQY,0))#2
IF $PIECE(^(0),"^",11)["y"
WRITE !!,*7,"Press RETURN to continue..."
READ %:DTIME
+13 IF $DATA(^XUTL("XQ",$JOB,"RBX"))
GOTO RBX^XQ73
+14 IF $DATA(^XUTL("XQ",$JOB,"T"))
IF ^("T")<0
SET ^("T")=$SELECT($DATA(^XUTL("XQ",$JOB,1)):1,1:0)
+15 ;W " ==> OUT^XQ1"
IF $DATA(^XUTL("XQ",$JOB,"T"))
SET XQY=+^(^("T"))
SET XQT=""
if $DATA(^DIC(19,+XQY,0))
SET XQT=$PIECE(^(0),U,4)
IF '$DATA(XQUIT)
IF ("LOQX"'[XQT)
IF $DATA(^DIC(19,XQY,15))
IF $LENGTH(^(15))
XECUTE ^(15)
+16 if '$DATA(^XUTL("XQ",$JOB,"T"))
QUIT
+17 IF $DATA(^XUTL("XQ",$JOB,"T"))
SET XQTT=$SELECT($DATA(XQUIT):^XUTL("XQ",$JOB,"T"),1:^XUTL("XQ",$JOB,"T")-1)
KILL XQUIT
+18 IF XQTT'<1
SET ^XUTL("XQ",$JOB,"T")=XQTT
SET XQY=^(XQTT)
SET XQY0=$PIECE(XQY,U,2,999)
SET XQPSM=$PIECE(XQY,U,1)
SET XQY=+XQPSM
SET XQPSM=$PIECE(XQPSM,XQY,2,99)
SET XQABOLD=1
+19 IF XQTT=0
SET XQY=-1
+20 ;W " ==> OUT^XQ1"
IF $PIECE(XQY0,U,4)="M"
SET XQAA=$PIECE(XQY0,U,2)
IF $PIECE(XQY0,U,17)
IF $DATA(^DIC(19,+XQY,26))
IF $LENGTH(^(26))
XECUTE ^(26)
+21 KILL %,X,XQDICNEW,XQF,XQCO,XQEA,XQFLG,XQI,XQJ,XQJS,XQK,XQLOK,XQNOPE,XQOK,XQTT,XQX,XQZ,Y,Z
+22 GOTO M1^XQ
+23 ;
A ;ACTION type option entry point
+1 ;W " ==> A^XQ1"
if $DATA(^DIC(19,+XQY,20))
XECUTE ^(20)
+2 IF $DATA(XQUIT)
SET XQUIT=1
DO ^XQUIT
IF $DATA(XQUIT)
KILL XQUIT
GOTO OUT
+3 ;W " ==> A^XQ1"
IF $PIECE(XQY0,U,17)
IF $DATA(^DIC(19,XQY,26))
IF $LENGTH(^(26))
XECUTE ^(26)
+4 GOTO OUT
+5 ;
C ;ScreenMan type options
+1 DO DIC
if DA=-1
GOTO KILL
SET XQZ="DR,DDSFILE,DDSFILE(1)"
SET XQW=39
DO SET
+2 SET DDSPAGE=$PIECE($GET(^DIC(19,+XQY,43)),U)
if DDSPAGE=""
KILL DDSPAGE
+3 SET DDSPARM=$PIECE($GET(^DIC(19,+XQY,43)),U,2)
if DDSPARM=""
KILL DDSPARM
+4 IF DDSFILE["("
IF DDSFILE'[U
SET DDSFILE=U_DDSFILE
+5 IF $DATA(DDSFILE(1))
IF DDSFILE(1)["("
IF DDSFILE(1)'[U
SET DDSFILE(1)=U_DDSFILE(1)
+6 DO ^DDS
KILL DDSFILE
GOTO C
+7 ;
P ;PRINT type option
+1 SET XQZ="DIC,PG,L,FLDS,BY,FR,TO,DHD,DCOPIES,DIS(0),IOP,DHIT,DIOBEG,DIOEND"
SET XQW=59
DO SET
+2 IF $DATA(DIS(0))#2
FOR XQI=1:1:3
if '$DATA(^DIC(19,+XQY,69+(XQI/10)))
QUIT
if ^(69+(XQI/10))=""
QUIT
SET DIS(XQI)=^(69+(XQI/10))
+3 if $DATA(XQIOP)
SET IOP=XQIOP
+4 SET XQI=$GET(^DIC(19,XQY,79))
if XQI>0
SET DIASKHD=""
if $PIECE(XQI,U,2)
SET DISUPNO=1
if $PIECE(XQI,U,3)
SET DIPCRIT=1
+5 DO D1
DO EN1^DIP
KILL IOP,DIOBEG,DIS,DP
GOTO OUT
+6 ;
I ;INQUIRE type option
I1 DO DIC
if DA=-1
GOTO KILL
SET DI=DIC
SET XQZ="DIC,DR,DIQ(0)"
SET XQW=79
DO SET
DO D1
if $DATA(DIC)[0
SET DIC=DI
+1 IF $DATA(^DIC(19,+XQY,63))
IF $LENGTH(^(63))
SET FLDS=^(63)
+2 IF '$TEST
SET FLDS="[CAPTIONED]"
+3 ;p672
if $GET(DIQ(0))="B"
SET DIQ(0)="CR"
+4 IF $GET(^DIC(19,+XQY,83))["Y"
SET IOP="HOME"
I2 ;
+1 WRITE !
SET XQZ="DHD"
SET XQW=66
DO SET
KILL ^UTILITY($JOB),^(U,$JOB)
SET ^($JOB,1,DA)=""
SET @("L=+$P("_DI_"0),U,2)")
SET DPP(1)=L_"^^^@"
SET L=0
SET C=","
SET Q=""""
SET DPP=1
SET DPP(1,"IX")="^UTILITY(U,$J,"_DI_"^2"
DO N^DIP1
SET Y=XQY
GOTO I1
+2 ;
E ;EDIT type option entry point
E1 DO DIC
if DA=-1
GOTO KILL
KILL DIE,DIC
SET XQZ="DIE,DR"
SET XQW=49
DO SET
SET XQZ="DIE(""W"")"
SET XQW=53
DO SET
+1 IF $DATA(^DIC(19,XQY,53))
IF $LENGTH(^(53))
SET %=^(53)
SET DIE("NO^")=$SELECT(%="N":"",1:%)
+2 ;S:DIE["(" DIE=U_DIE
+3 ;
+4 ;DIE does not lock so we do it here
+5 ;
+6 SET XQLOK=""
SET XQNOPE=0
+7 IF DIE["("
Begin DoDot:1
+8 SET DIE=U_DIE
+9 SET XQLOK=DIE_DA_")"
LOCK +@XQLOK:2
+10 IF '$TEST
SET XQNOPE=1
WRITE !,"Someone else is editing this data. Try later."
+11 QUIT
End DoDot:1
+12 ;
+13 IF DIE=+DIE
Begin DoDot:1
+14 NEW %
+15 SET %=$$ROOT^DILFD(DIE)
+16 IF %'=""
SET XQLOK=%_DA_")"
LOCK +@XQLOK:2
+17 IF '$TEST
SET XQNOPE=1
WRITE !,"Someone else is editing this data. Try later."
+18 QUIT
End DoDot:1
+19 ;
+20 ;Node is being edited right now, skip DIE
if XQNOPE
GOTO E1
+21 DO ^DIE
SET Y=XQY
+22 IF XQLOK'=""
LOCK -@XQLOK
+23 GOTO E1
+24 ;
+25 ;
DIC ;Get FileMan parameters from Option File and do look up
+1 WRITE !
KILL DIC
SET XQZ="DIC,DIC(0),DIC(""A""),DIC(""B""),DIC(""S""),DIC(""W""),D"
SET XQW=29
DO SET
DO D1
+2 IF '$DATA(D)
DO ^DIC
+3 IF $DATA(D)
if D=""
SET D="B"
DO IX^DIC
+4 IF $DATA(Y)
IF Y>0
IF $PIECE(Y,U,3)
SET XQDICNEW=Y
+5 SET DA=+Y
SET Y=XQY
+6 QUIT
+7 ;
D1 ;S:DIC["(" DIC=U_DIC Q
+1 ;p737
if $GET(DIC)["("
SET DIC=U_DIC
QUIT
+2 ;
SET FOR XQI=1:1
SET XQV=$PIECE(XQZ,",",XQI)
if XQV=""
QUIT
KILL @XQV
IF $DATA(^DIC(19,+XQY,XQW+XQI))
IF ^(XQW+XQI)]""
SET @XQV=^(XQW+XQI)
+1 IF $DATA(DIC("A"))
IF DIC("A")]""
SET DIC("A")=DIC("A")_" "
+2 KILL XQI,J
+3 QUIT
+4 ;
R ;RUN ROUTINE type option entry point
+1 if '$DATA(^DIC(19,XQY,25))
if $DATA(ZTQUEUED)
GOTO OUT
GOTO M1^XQ
SET XQZ=^(25)
if '$LENGTH(XQZ)
GOTO M1^XQ
if XQZ'[U
SET XQZ=U_XQZ
IF XQZ["["
DO DO^%XUCI
GOTO OUT
+2 DO @XQZ
GOTO OUT
+3 ;
W ;Window type option entry point
+1 SET XQOK=1
+2 ;Routine type
IF $DATA(^DIC(19,XQY,25))
IF $LENGTH(^(25))
Begin DoDot:1
+3 SET XQZ=^DIC(19,XQY,25)
+4 if XQZ'[U
SET XQZ=U_XQZ
+5 IF XQZ["["
DO DO^%XUCI
QUIT
+6 DO @XQZ
+7 QUIT
End DoDot:1
GOTO OUT
+8 ;
+9 ;I $D(^DIC(19,XQY,24)),$L(^(24)) D G:XQOK OUT ;Pointer type
+10 ;.S XQZ=^DIC(19,XQY,24)
+11 ;.S XQZ=$P($G(^XTV(8995,XQZ,0)),U) I XQZ="" S XQOK=0 Q
+12 ;.D PREP^XG
+13 ;.S XQWIN=$$NEXTNM^XGCLOAD("XQWIN")
+14 ;.D GET^XGCLOAD(XQZ,XQWIN,"^TMP($J)")
+15 ;.D GET^XGCLOAD(XQZ,$NA(^TMP($J,XQWIN)))
+16 ;.D M^XG(XQWIN,$NA(^TMP($J,XQWIN)))
+17 ;.D ESTA^XG() ;Send it off to window land
+18 ;.;
+19 ;.D K^XG(XQWIN) ;Return here after the ESTOP
+20 ;.;I $D(^%ZOSF("OS")),^%ZOSF("OS")["MSM" ZSTOP
+21 ;.Q
+22 ;
+23 ;Window failed
GOTO M1^XQ
+24 ;
Z ;Window suite option
+1 GOTO EN^XQSUITE
+2 ;
S ;Server-type option pseudo entry-point can't be invoked from Meun System
+1 GOTO OUT
+2 ;
B ;Client/Server option can't be run from menu system
+1 GOTO OUT
+2 ;
L ;OE/RR Limited option
O ;OE/RR Protocol (orderables) type option entry point
X ;OE/RR Extended Action type option (Subset of Protocol type)
Q ;OE/RR Protocol Menu type option entry point
+1 SET XQOR=+XQY
SET XQOR(1)=XQT
DO XQ^XQOR
KILL XQOR
GOTO OUT
+2 ;
ZTSK ;Task Manager entry point
+1 ;No reschedule
SET U="^"
if $GET(XQSCH)'>0
GOTO ZTSK2
+2 SET %=$$S^%ZTLOAD("Reschedule Task")
+3 SET XQ=$GET(^DIC(19.2,XQSCH,0))
SET XQY=+XQ
if XQY'>0
QUIT
+4 ;Build params from schedule in case we delete it.
KILL ZTQPARAM
+5 IF $DATA(^DIC(19.2,XQSCH,3))
IF $LENGTH(^(3))
SET ZTQPARAM=^(3)
+6 ;Build other symbols
IF $DATA(^DIC(19.2,XQSCH,2))
Begin DoDot:1
+7 NEW X1,X2
SET X2=XQSCH
NEW XQSCH,XQY,XQ
+8 FOR X1=0:0
SET X1=$ORDER(^DIC(19.2,X2,2,X1))
if X1'>0
QUIT
SET X=^(X1,0)
SET @($PIECE(X,U)_"="_$PIECE(X,U,2))
+9 QUIT
End DoDot:1
+10 ;
+11 ;User to run job ;p446
SET X=$PIECE($GET(^DIC(19.2,XQSCH,1.1)),U)
IF X>0
DO DUZ^XUP(X)
REQ ;Set the user and Requeue
Begin DoDot:1
+1 NEW DA,DIE,DR,X,X1,X2
+2 ;Get params for new schedule
SET X1=$PIECE(XQ,U,2)
SET X2=$PIECE(XQ,U,6)
+3 SET DA=XQSCH
SET DIE="^DIC(19.2,"
SET DR=$SELECT((X2="")&($PIECE(XQ,U,9)=""):".01///@",X2="":"2///@",1:"2////"_$$SCH^XLFDT(X2,+X1,1))
+4 ;File new schedule
LOCK +^%ZTSK(ZTSK,0):15
DO ^DIE
LOCK -^%ZTSK(ZTSK,0)
+5 QUIT
End DoDot:1
+6 ;ZTREQ is set by TM.
ZTSK2 ;Leave task
IF '$DATA(XQY)
KILL ZTREQ
QUIT
+1 DO UI^XQ12
+2 if '$DATA(^DIC(19,XQY,0))
QUIT
SET XQY0=^(0)
SET XQT=$PIECE(XQY0,U,4)
if XQT'="A"&(XQT'="P")&(XQT'="R")
QUIT
+3 ;Kernel no longer supports reseting priority
+4 ;S X=$P(XQY0,U,8) I X>0,X<11 X ^%ZOSF("PRIORITY")
+5 IF $PIECE(XQY0,U,3)]""!($DATA(XQUIT))
SET XQT="KILL"
+6 ;
+7 SET %=$$S^%ZTLOAD("Run Task")
RUN if XQT="P"&$LENGTH(IO)
SET XQIOP=ION_";"_IOST_";"_IOM_";"_IOSL
GOTO @XQT
+1 QUIT
