source: IHS-VA_UTILITIES-XB/trunk/XBDR.m@ 1319

Last change on this file since 1319 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 2.2 KB
Line 
1XBDR ; IHS/ADC/GTH - BUILDS DIR STRING ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; This routine builds a string which sets variable DIR, and
5 ; it's descendants, for use in a routine. The string is
6 ; stored in the variable "%", and in the "Temp" storage
7 ; area for the screen editor for the current device.
8 ;
9START ;
10 NEW XBDRQUIT,DIR,XBDRMIN,XBDRMAX,XBDRSPEC,X,Y,V,XBDRCODE,XBDRDIR,XBDRDIRA,XBDRDIRB,XBDRRUN,XBDRTYPE,I,Z,DIROUT,DUOUT,DTOUT,DIRUT,XBDRDQ,XBDRDQQ,XBDROUT
11RUN ;
12 F XBDRRUN=1:1:8 D @$P("LOC,NAR,DFLT,^XBDR1,HELP,SET,TEST,SAVE",",",XBDRRUN) I $D(XBDRQUIT) Q
13EXIT ;
14 Q
15 ;
16LOC ;
17 S V="|",U="^"
18 S XBDROUT="I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))"
19 I '$D(DT) S X="T" D ^%DT S DT=Y KILL %DT
20 I '$D(DTIME) S DTIME=9999
21 I $D(IOM),$D(IOF),$D(IOST),$D(IOSL) Q
22 D HOME^%ZIS
23 KILL IOPAR,IOT,IOBS,POP
24 Q
25 ;
26HELP ;
27 W !!,"The current HELP text is: "
28 S X=$E(XBDRTYPE)_1,X=$T(@X^DIR2),X=$P(X,";",4)
29 W """",X,""""
30 S DIR("A")="Additional HELP text",DIR(0)="FO^1:199"
31 D ^DIR
32 KILL DIR
33 X XBDROUT
34 I S XBDRQUIT="" Q
35 S XBDRDQ=X
36 W !
37 I '$D(^DIC(9.2)) Q
38QQ ;
39 S DIC("A")="Enter HELP FRAME name: ",DIC(0)="AEQ",DIC=9.2
40 D ^DIC
41 KILL DIC
42 X XBDROUT
43 I S XBDRQUIT="" Q
44 I Y=-1 Q
45 S XBDRDQQ=$P(Y,U,2)
46 Q
47 ;
48SET ;
49 S XBDRDIR=XBDRTYPE,Y=""
50 F I=1:1:3 S X="XBDR"_$P("MIN,MAX,SPEC",",",I) I $D(@X) S $P(Y,":",I)=@X
51 I Y]"" S XBDRDIR=XBDRDIR_U_Y
52S1 ;
53 S XBDRCODE="S DIR(0)="""_XBDRDIR_""""
54 I $D(XBDRDIRA) S:XBDRTYPE["F"!($E(XBDRTYPE)) XBDRDIRA=XBDRDIRA S XBDRCODE=XBDRCODE_",DIR(""A"")="""_XBDRDIRA_""""
55 I $D(XBDRDIRB) S XBDRCODE=XBDRCODE_",DIR(""B"")="""_XBDRDIRB_""""
56 I $D(XBDRDQ),XBDRDQ]"" S XBDRCODE=XBDRCODE_",DIR(""?"")="""_XBDRDQ_""""
57 I $D(XBDRDQQ),XBDRDQQ]"" S XBDRCODE=XBDRCODE_",DIR(""??"")="""_XBDRDQQ_""""
58 S XBDRCODE=XBDRCODE_" KILL DA D ^DIR KILL DIR"
59 Q
60 ;
61NAR ;
62 S DIR("A")="Enter query narrative",DIR(0)="FO"
63 D ^DIR
64 KILL DIR
65 I X="" Q
66 X XBDROUT
67 I S XBDRQUIT="" Q
68 S XBDRDIRA=X
69 Q
70 ;
71DFLT ;
72 S DIR("A")="Enter default value",DIR(0)="FO"
73 D ^DIR
74 KILL DIR
75 I X="" Q
76 X XBDROUT
77 I S XBDRQUIT="" Q
78 S XBDRDIRB=X
79 Q
80 ;
81TEST ;
82 W !!!!!?30,"***** TEST *****"
83TQ ;
84 X XBDRCODE
85 I X=U Q
86 G TQ
87 ;
88SAVE ;
89 S %=" "_XBDRCODE
90 W !!!,"Saving the following line of code in the '%' variable:",!,%,!!
91 D SV(%)
92 Q
93 ;
94SV(%) ;
95 NEW (%)
96 D SAVE^ZIBDR(%)
97 Q
98 ;
Note: See TracBrowser for help on using the repository browser.