XQT2 ;SEA/Luke - Define a path template ;06/07/99 11:23 [ 04/02/2003 8:29 AM ]
;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
;;8.0;KERNEL;**37**;Jul 10, 1995
S U="^",XQTSV=XQY_U_XQDIC_U_XQY0
EN ;Entry point for Create a Template Option.
N %,XQTBK1,XQCOM,XQMNTMP,XQI,XQOPN,XQVN,XQSL,XQTF,XQTF1,XQTT,XQTREE,XQTREN
S U="^",(XQI,XQOPN,XQMNTMP,XQVN,XQTREN,XQTF,XQTF1)=0,XQTT="",(XQDIC,XQY)=+^XUTL("XQ",$J,"XQM"),XQY0=^DIC(19,XQDIC,0),XQUR=""
S XQCOM=$O(^DIC(19,"B","XUCOMMAND",0))
S XQLIST(XQOPN)=XQDIC_U_XQY_U_XQY0,XQOPN=XQOPN+1,XQVN=XQVN+1
S XQTREN=1,XQTREE(XQTREN)=XQDIC
S XQAA="Choose one of the "_$P(XQY0,U,2)_" Options: "
;
I '$D(IOF),'$D(IOSL) D HOME^%ZIS
;
D SET
;
INF W @IOF,"Do you want some brief instructions? [Y/N] N// " R XQUR:DTIME S:'$T XQUR=U G:XQUR=U OUT S:XQUR="" XQUR="N" I XQUR["?" W !?3,"Answer 'Y' if you want some instructions, 'N' if you don't." G INF
I "Yy"[XQUR S XQH="XQTCREATE" D EN^XQH
;
ASK ;Show user the choices and get the next option, if any
W @IOF,?18,"CREATING A MENU TEMPLATE",!!?5,"Choose an option, type RETURN to back up one level,",!?5,"'+' to store the completed template, or '^' to quit.",! D LIST^XQ2
;
RD1 W !!,?5,XQAA R XQUR:DTIME S:'$T XQUR=U G:XQUR=U OUT G:XQUR="+" STORE
I XQUR["^" W *7,!?3,"Sorry, no jumping." G RD1
I XQUR="?" W !?3,"Enter an option, '+' to store the template,",!?3,"'??' for more help, or '^' to forget the whole thing." G RD1
I XQUR["??" S XQUR="??" S XQTSAV=XQDIC D EN^XQ2 S XQDIC=XQTSAV G RD1
I XQUR="" D BACK S XQDIC=+XQY G ASK
S XQSAVE=XQDIC
D DIC^XQ71
;
;
I XQY<0 S XQTSV=XQDIC,XQDIC="U"_DUZ D DIC^XQ71 ;Search secondaries
I XQY<0 S XQDIC=XQCOM D DIC^XQ71 ;Search XUCOMMAND
I XQY<0 S XQDIC=XQTSV W " ??",*7 H 2 G ASK
;
;Disallow servers or broker-type options
I XQY>0,"SB"[$P(XQY0,U,4) D
.W " ??",*7
.S XQY=+XQLIST(XQOPN-1),XQY0=$P(XQLIST(XQOPN-1),U,3,99),XQDIC=XQY
.S XQTSB=""
.H 2
.Q
I $D(XQTSB) K XQTSB G ASK
;
CHK W !!,$P(XQY0,U,2)," ","(",$P(XQY0,U,1),") This one? [Y/N] Y// " R %:DTIME S:%="" %="Y" W:(%["?")!("YyNn"'[%) *7,!!,"Please answer 'Y' or 'N'" G:(%["?")!("yYnN"'[%) CHK G:"Yy"'[% ASK
S XQLIST(XQOPN)=XQY_U_XQDIC_U_XQY0,XQLIST(XQOPN,0)="Entry Action",XQOPN=XQOPN+1,XQVN=XQOPN
S XQTT=XQTT_$S(XQTF:";",1:"")_XQY,XQTF=1
;
I "MQ"'[$P(XQY0,U,4) D K XQTBK1 G ASK
.S XQTBK1=""
.S XQLIST(XQOPN-1,1)="Exit Action"
.D BACK
.S XQDIC=+XQY
.D SET
.Q
;
I "MQ"[$P(XQY0,U,4) D G ASK
.S XQDIC=+XQY
.D SET
.S XQAA="Choose one of the "_$P(XQY0,U,2)_" Options: "
.Q
Q
;
STORE ;Continued in the program ^XQT3
I XQOPN=1 W !!,"A menu template that contains only your log-on menu? Sorry, that's not",!?5,*7,"allowed. Use '^^' to return to your log-on menu instead." G OUT
G ^XQT3
;
OUT ;Clean up and quit
I $D(XQTSV) S XQY=+XQTSV,XQDIC=$P(XQTSV,U,2),XQY0=$P(XQTSV,U,3,99)
I '$D(XQTSV) S XQY=^(^XUTL("XQ",$J,"T")),XQDIC=$P($P(XQY,U),+XQY,2),XQY0=$P(XQY,U,2,99),XQY=+XQY
K XQTSV
;
;Come here on a restart
O1 K D0,DA,DI,DIC,DQ,DR,XQA,XQAA,XQDR,XQH,XQH1,XQH2,XQI,XQJ,XQK,XQOPN,XQLIST,XQLK,XQN,XQNM,XQOO,XQRD,XQRL,XQSAV,XQSN,XQTSV,XQTF,XQTF1,XQTM,XQTRPT,XQTT,XQTXT,XQUR
K XQT,XQT1,XQTSAV,XQSAVE,XQFLAG,XQL,XQLN
Q
;
BACK ;Back up to last menu-type option and put it on the stack
N %,XQFLG
S XQFLG=0
S:"MQ"[$P(XQY0,U,4) XQFLAG=1
;
I XQOPN<2!(+XQLIST(0)=+XQLIST(XQOPN-1)) D
.S XQY=+XQLIST(0),XQDIC=$P(XQLIST(0),U,2)
.S XQFLG=1
.W !!,*7,"You can't back up any further!",!!,"Press return to continue...." R %:30
.Q
Q:XQFLG
;
S XQT1=$P(XQLIST(XQOPN-1),U,2)
F XQJ=0:1:XQOPN-1 Q:XQT1=+XQLIST(XQJ)
;
I XQJ=(XQOPN-1) D
.S XQT1=+XQLIST(XQOPN-1)
.F XQJ=1:1:$L(XQTT,";") S %=$P(XQTT,";",XQJ) Q:%=XQT1
.S XQJ=XQJ-1
.Q
;
F XQI=XQJ:-1:0 Q:'XQI Q:"MQ"[$P(XQLIST(XQI),U,6)
I XQI<1 S XQLIST(XQOPN-1,1)="Exit Action",XQLIST(XQOPN)=XQLIST(0),(XQDIC,XQY)=+XQLIST(0),XQY0=$P(XQLIST(0),U,3,99),XQOPN=XQOPN+1,XQAA="Choose one of the "_$P(XQY0,U,2)_" Options: " Q
S XQLIST(XQOPN-1,1)="Exit Action"
S %=XQLIST(XQI),XQY=+%,XQDIC=$P(%,U,2),XQY0=$P(%,U,3,99)
S XQLIST(XQOPN)=XQY_U_XQDIC_U_XQY0,XQOPN=XQOPN+1,XQVN=XQVN-1
;
;Drop down one more menu
S XQJ=XQI
F XQI=XQJ:-1:0 Q:'XQI Q:"MQ"[$P(XQLIST(XQI),U,6)
I XQI<1 S XQLIST(XQOPN-1,1)="Exit Action",XQLIST(XQOPN)=XQLIST(0),(XQDIC,XQY)=+XQLIST(0),XQY0=$P(XQLIST(0),U,3,99),XQOPN=XQOPN+1,XQAA="Choose one of the "_$P(XQY0,U,2)_" Options: "
S %=XQLIST(XQI),XQY=+%,XQDIC=$P(%,U,2),XQY0=$P(%,U,3,99)
;S XQDIC=XQY
I "MQ"[$P(XQY0,U,4) S XQAA="Choose one of the "_$P(XQY0,U,2)_" Options: "
Q
;
SET ;Rebuild display nodes if neccissary
L +^XUTL("XQO",XQDIC):5 D:$S('$D(^XUTL("XQO",XQDIC,0)):1,'$D(^DIC(19,XQDIC,99)):1,1:^DIC(19,XQDIC,99)'=$P(^XUTL("XQO",XQDIC,0),U,2)) ^XQSET L -^XUTL("XQO",XQDIC)
Q
XQT2 ;SEA/Luke - Define a path template ;06/07/99 11:23 [ 04/02/2003 8:29 AM ]
+1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
+2 ;;8.0;KERNEL;**37**;Jul 10, 1995
+3 SET U="^"
SET XQTSV=XQY_U_XQDIC_U_XQY0
EN ;Entry point for Create a Template Option.
+1 NEW %,XQTBK1,XQCOM,XQMNTMP,XQI,XQOPN,XQVN,XQSL,XQTF,XQTF1,XQTT,XQTREE,XQTREN
+2 SET U="^"
SET (XQI,XQOPN,XQMNTMP,XQVN,XQTREN,XQTF,XQTF1)=0
SET XQTT=""
SET (XQDIC,XQY)=+^XUTL("XQ",$JOB,"XQM")
SET XQY0=^DIC(19,XQDIC,0)
SET XQUR=""
+3 SET XQCOM=$ORDER(^DIC(19,"B","XUCOMMAND",0))
+4 SET XQLIST(XQOPN)=XQDIC_U_XQY_U_XQY0
SET XQOPN=XQOPN+1
SET XQVN=XQVN+1
+5 SET XQTREN=1
SET XQTREE(XQTREN)=XQDIC
+6 SET XQAA="Choose one of the "_$PIECE(XQY0,U,2)_" Options: "
+7 ;
+8 IF '$DATA(IOF)
IF '$DATA(IOSL)
DO HOME^%ZIS
+9 ;
+10 DO SET
+11 ;
INF WRITE @IOF,"Do you want some brief instructions? [Y/N] N// "
READ XQUR:DTIME
IF '$TEST
SET XQUR=U
IF XQUR=U
GOTO OUT
IF XQUR=""
SET XQUR="N"
IF XQUR["?"
WRITE !?3,"Answer 'Y' if you want some instructions, 'N' if you don't."
GOTO INF
+1 IF "Yy"[XQUR
SET XQH="XQTCREATE"
DO EN^XQH
+2 ;
ASK ;Show user the choices and get the next option, if any
+1 WRITE @IOF,?18,"CREATING A MENU TEMPLATE",!!?5,"Choose an option, type RETURN to back up one level,",!?5,"'+' to store the completed template, or '^' to quit.",!
DO LIST^XQ2
+2 ;
RD1 WRITE !!,?5,XQAA
READ XQUR:DTIME
IF '$TEST
SET XQUR=U
IF XQUR=U
GOTO OUT
IF XQUR="+"
GOTO STORE
+1 IF XQUR["^"
WRITE *7,!?3,"Sorry, no jumping."
GOTO RD1
+2 IF XQUR="?"
WRITE !?3,"Enter an option, '+' to store the template,",!?3,"'??' for more help, or '^' to forget the whole thing."
GOTO RD1
+3 IF XQUR["??"
SET XQUR="??"
SET XQTSAV=XQDIC
DO EN^XQ2
SET XQDIC=XQTSAV
GOTO RD1
+4 IF XQUR=""
DO BACK
SET XQDIC=+XQY
GOTO ASK
+5 SET XQSAVE=XQDIC
+6 DO DIC^XQ71
+7 ;
+8 ;
+9 ;Search secondaries
IF XQY<0
SET XQTSV=XQDIC
SET XQDIC="U"_DUZ
DO DIC^XQ71
+10 ;Search XUCOMMAND
IF XQY<0
SET XQDIC=XQCOM
DO DIC^XQ71
+11 IF XQY<0
SET XQDIC=XQTSV
WRITE " ??",*7
HANG 2
GOTO ASK
+12 ;
+13 ;Disallow servers or broker-type options
+14 IF XQY>0
IF "SB"[$PIECE(XQY0,U,4)
Begin DoDot:1
+15 WRITE " ??",*7
+16 SET XQY=+XQLIST(XQOPN-1)
SET XQY0=$PIECE(XQLIST(XQOPN-1),U,3,99)
SET XQDIC=XQY
+17 SET XQTSB=""
+18 HANG 2
+19 QUIT
End DoDot:1
+20 IF $DATA(XQTSB)
KILL XQTSB
GOTO ASK
+21 ;
CHK WRITE !!,$PIECE(XQY0,U,2)," ","(",$PIECE(XQY0,U,1),") This one? [Y/N] Y// "
READ %:DTIME
IF %=""
SET %="Y"
IF (%["?")!("YyNn"'[%)
WRITE *7,!!,"Please answer 'Y' or 'N'"
IF (%["?")!("yYnN"'[%)
GOTO CHK
IF "Yy"'[%
GOTO ASK
+1 SET XQLIST(XQOPN)=XQY_U_XQDIC_U_XQY0
SET XQLIST(XQOPN,0)="Entry Action"
SET XQOPN=XQOPN+1
SET XQVN=XQOPN
+2 SET XQTT=XQTT_$SELECT(XQTF:";",1:"")_XQY
SET XQTF=1
+3 ;
+4 IF "MQ"'[$PIECE(XQY0,U,4)
Begin DoDot:1
+5 SET XQTBK1=""
+6 SET XQLIST(XQOPN-1,1)="Exit Action"
+7 DO BACK
+8 SET XQDIC=+XQY
+9 DO SET
+10 QUIT
End DoDot:1
KILL XQTBK1
GOTO ASK
+11 ;
+12 IF "MQ"[$PIECE(XQY0,U,4)
Begin DoDot:1
+13 SET XQDIC=+XQY
+14 DO SET
+15 SET XQAA="Choose one of the "_$PIECE(XQY0,U,2)_" Options: "
+16 QUIT
End DoDot:1
GOTO ASK
+17 QUIT
+18 ;
STORE ;Continued in the program ^XQT3
+1 IF XQOPN=1
WRITE !!,"A menu template that contains only your log-on menu? Sorry, that's not",!?5,*7,"allowed. Use '^^' to return to your log-on menu instead."
GOTO OUT
+2 GOTO ^XQT3
+3 ;
OUT ;Clean up and quit
+1 IF $DATA(XQTSV)
SET XQY=+XQTSV
SET XQDIC=$PIECE(XQTSV,U,2)
SET XQY0=$PIECE(XQTSV,U,3,99)
+2 IF '$DATA(XQTSV)
SET XQY=^(^XUTL("XQ",$JOB,"T"))
SET XQDIC=$PIECE($PIECE(XQY,U),+XQY,2)
SET XQY0=$PIECE(XQY,U,2,99)
SET XQY=+XQY
+3 KILL XQTSV
+4 ;
+5 ;Come here on a restart
O1 KILL D0,DA,DI,DIC,DQ,DR,XQA,XQAA,XQDR,XQH,XQH1,XQH2,XQI,XQJ,XQK,XQOPN,XQLIST,XQLK,XQN,XQNM,XQOO,XQRD,XQRL,XQSAV,XQSN,XQTSV,XQTF,XQTF1,XQTM,XQTRPT,XQTT,XQTXT,XQUR
+1 KILL XQT,XQT1,XQTSAV,XQSAVE,XQFLAG,XQL,XQLN
+2 QUIT
+3 ;
BACK ;Back up to last menu-type option and put it on the stack
+1 NEW %,XQFLG
+2 SET XQFLG=0
+3 IF "MQ"[$PIECE(XQY0,U,4)
SET XQFLAG=1
+4 ;
+5 IF XQOPN<2!(+XQLIST(0)=+XQLIST(XQOPN-1))
Begin DoDot:1
+6 SET XQY=+XQLIST(0)
SET XQDIC=$PIECE(XQLIST(0),U,2)
+7 SET XQFLG=1
+8 WRITE !!,*7,"You can't back up any further!",!!,"Press return to continue...."
READ %:30
+9 QUIT
End DoDot:1
+10 IF XQFLG
QUIT
+11 ;
+12 SET XQT1=$PIECE(XQLIST(XQOPN-1),U,2)
+13 FOR XQJ=0:1:XQOPN-1
IF XQT1=+XQLIST(XQJ)
QUIT
+14 ;
+15 IF XQJ=(XQOPN-1)
Begin DoDot:1
+16 SET XQT1=+XQLIST(XQOPN-1)
+17 FOR XQJ=1:1:$LENGTH(XQTT,";")
SET %=$PIECE(XQTT,";",XQJ)
IF %=XQT1
QUIT
+18 SET XQJ=XQJ-1
+19 QUIT
End DoDot:1
+20 ;
+21 FOR XQI=XQJ:-1:0
IF 'XQI
QUIT
IF "MQ"[$PIECE(XQLIST(XQI),U,6)
QUIT
+22 IF XQI<1
SET XQLIST(XQOPN-1,1)="Exit Action"
SET XQLIST(XQOPN)=XQLIST(0)
SET (XQDIC,XQY)=+XQLIST(0)
SET XQY0=$PIECE(XQLIST(0),U,3,99)
SET XQOPN=XQOPN+1
SET XQAA="Choose one of the "_$PIECE(XQY0,U,2)_" Options: "
QUIT
+23 SET XQLIST(XQOPN-1,1)="Exit Action"
+24 SET %=XQLIST(XQI)
SET XQY=+%
SET XQDIC=$PIECE(%,U,2)
SET XQY0=$PIECE(%,U,3,99)
+25 SET XQLIST(XQOPN)=XQY_U_XQDIC_U_XQY0
SET XQOPN=XQOPN+1
SET XQVN=XQVN-1
+26 ;
+27 ;Drop down one more menu
+28 SET XQJ=XQI
+29 FOR XQI=XQJ:-1:0
IF 'XQI
QUIT
IF "MQ"[$PIECE(XQLIST(XQI),U,6)
QUIT
+30 IF XQI<1
SET XQLIST(XQOPN-1,1)="Exit Action"
SET XQLIST(XQOPN)=XQLIST(0)
SET (XQDIC,XQY)=+XQLIST(0)
SET XQY0=$PIECE(XQLIST(0),U,3,99)
SET XQOPN=XQOPN+1
SET XQAA="Choose one of the "_$PIECE(XQY0,U,2)_" Options: "
+31 SET %=XQLIST(XQI)
SET XQY=+%
SET XQDIC=$PIECE(%,U,2)
SET XQY0=$PIECE(%,U,3,99)
+32 ;S XQDIC=XQY
+33 IF "MQ"[$PIECE(XQY0,U,4)
SET XQAA="Choose one of the "_$PIECE(XQY0,U,2)_" Options: "
+34 QUIT
+35 ;
SET ;Rebuild display nodes if neccissary
+1 LOCK +^XUTL("XQO",XQDIC):5
IF $SELECT('$DATA(^XUTL("XQO",XQDIC,0))
DO ^XQSET
LOCK -^XUTL("XQO",XQDIC)
+2 QUIT
