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/XQT2.m@ 1128

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1XQT2 ;SEA/Luke - Define a path template ;06/07/99 11:23
2 ;;8.0;KERNEL;**37**;Jul 10, 1995
3 S U="^",XQTSV=XQY_U_XQDIC_U_XQY0
4EN ;Entry point for Create a Template Option.
5 N %,XQTBK1,XQCOM,XQMNTMP,XQI,XQOPN,XQVN,XQSL,XQTF,XQTF1,XQTT,XQTREE,XQTREN
6 S U="^",(XQI,XQOPN,XQMNTMP,XQVN,XQTREN,XQTF,XQTF1)=0,XQTT="",(XQDIC,XQY)=+^XUTL("XQ",$J,"XQM"),XQY0=^DIC(19,XQDIC,0),XQUR=""
7 S XQCOM=$O(^DIC(19,"B","XUCOMMAND",0))
8 S XQLIST(XQOPN)=XQDIC_U_XQY_U_XQY0,XQOPN=XQOPN+1,XQVN=XQVN+1
9 S XQTREN=1,XQTREE(XQTREN)=XQDIC
10 S XQAA="Choose one of the "_$P(XQY0,U,2)_" Options: "
11 ;
12 I '$D(IOF),'$D(IOSL) D HOME^%ZIS
13 ;
14 D SET
15 ;
16INF 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
17 I "Yy"[XQUR S XQH="XQTCREATE" D EN^XQH
18 ;
19ASK ;Show user the choices and get the next option, if any
20 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
21 ;
22RD1 W !!,?5,XQAA R XQUR:DTIME S:'$T XQUR=U G:XQUR=U OUT G:XQUR="+" STORE
23 I XQUR["^" W *7,!?3,"Sorry, no jumping." G RD1
24 I XQUR="?" W !?3,"Enter an option, '+' to store the template,",!?3,"'??' for more help, or '^' to forget the whole thing." G RD1
25 I XQUR["??" S XQUR="??" S XQTSAV=XQDIC D EN^XQ2 S XQDIC=XQTSAV G RD1
26 I XQUR="" D BACK S XQDIC=+XQY G ASK
27 S XQSAVE=XQDIC
28 D DIC^XQ71
29 ;
30 ;
31 I XQY<0 S XQTSV=XQDIC,XQDIC="U"_DUZ D DIC^XQ71 ;Search secondaries
32 I XQY<0 S XQDIC=XQCOM D DIC^XQ71 ;Search XUCOMMAND
33 I XQY<0 S XQDIC=XQTSV W " ??",*7 H 2 G ASK
34 ;
35 ;Disallow servers or broker-type options
36 I XQY>0,"SB"[$P(XQY0,U,4) D
37 .W " ??",*7
38 .S XQY=+XQLIST(XQOPN-1),XQY0=$P(XQLIST(XQOPN-1),U,3,99),XQDIC=XQY
39 .S XQTSB=""
40 .H 2
41 .Q
42 I $D(XQTSB) K XQTSB G ASK
43 ;
44CHK 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
45 S XQLIST(XQOPN)=XQY_U_XQDIC_U_XQY0,XQLIST(XQOPN,0)="Entry Action",XQOPN=XQOPN+1,XQVN=XQOPN
46 S XQTT=XQTT_$S(XQTF:";",1:"")_XQY,XQTF=1
47 ;
48 I "MQ"'[$P(XQY0,U,4) D K XQTBK1 G ASK
49 .S XQTBK1=""
50 .S XQLIST(XQOPN-1,1)="Exit Action"
51 .D BACK
52 .S XQDIC=+XQY
53 .D SET
54 .Q
55 ;
56 I "MQ"[$P(XQY0,U,4) D G ASK
57 .S XQDIC=+XQY
58 .D SET
59 .S XQAA="Choose one of the "_$P(XQY0,U,2)_" Options: "
60 .Q
61 Q
62 ;
63STORE ;Continued in the program ^XQT3
64 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
65 G ^XQT3
66 ;
67OUT ;Clean up and quit
68 I $D(XQTSV) S XQY=+XQTSV,XQDIC=$P(XQTSV,U,2),XQY0=$P(XQTSV,U,3,99)
69 I '$D(XQTSV) S XQY=^(^XUTL("XQ",$J,"T")),XQDIC=$P($P(XQY,U),+XQY,2),XQY0=$P(XQY,U,2,99),XQY=+XQY
70 K XQTSV
71 ;
72 ;Come here on a restart
73O1 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
74 K XQT,XQT1,XQTSAV,XQSAVE,XQFLAG,XQL,XQLN
75 Q
76 ;
77BACK ;Back up to last menu-type option and put it on the stack
78 N %,XQFLG
79 S XQFLG=0
80 S:"MQ"[$P(XQY0,U,4) XQFLAG=1
81 ;
82 I XQOPN<2!(+XQLIST(0)=+XQLIST(XQOPN-1)) D
83 .S XQY=+XQLIST(0),XQDIC=$P(XQLIST(0),U,2)
84 .S XQFLG=1
85 .W !!,*7,"You can't back up any further!",!!,"Press return to continue...." R %:30
86 .Q
87 Q:XQFLG
88 ;
89 S XQT1=$P(XQLIST(XQOPN-1),U,2)
90 F XQJ=0:1:XQOPN-1 Q:XQT1=+XQLIST(XQJ)
91 ;
92 I XQJ=(XQOPN-1) D
93 .S XQT1=+XQLIST(XQOPN-1)
94 .F XQJ=1:1:$L(XQTT,";") S %=$P(XQTT,";",XQJ) Q:%=XQT1
95 .S XQJ=XQJ-1
96 .Q
97 ;
98 F XQI=XQJ:-1:0 Q:'XQI Q:"MQ"[$P(XQLIST(XQI),U,6)
99 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
100 S XQLIST(XQOPN-1,1)="Exit Action"
101 S %=XQLIST(XQI),XQY=+%,XQDIC=$P(%,U,2),XQY0=$P(%,U,3,99)
102 S XQLIST(XQOPN)=XQY_U_XQDIC_U_XQY0,XQOPN=XQOPN+1,XQVN=XQVN-1
103 ;
104 ;Drop down one more menu
105 S XQJ=XQI
106 F XQI=XQJ:-1:0 Q:'XQI Q:"MQ"[$P(XQLIST(XQI),U,6)
107 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: "
108 S %=XQLIST(XQI),XQY=+%,XQDIC=$P(%,U,2),XQY0=$P(%,U,3,99)
109 ;S XQDIC=XQY
110 I "MQ"[$P(XQY0,U,4) S XQAA="Choose one of the "_$P(XQY0,U,2)_" Options: "
111 Q
112 ;
113SET ;Rebuild display nodes if neccissary
114 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)
115 Q
Note: See TracBrowser for help on using the repository browser.