1 | DDSU ;SFISC/MLH-PROCESS HELP ;10:48 AM 6 Sep 2006
|
---|
2 | ;;22.0;VA FileMan;**4,3,54,151**;Mar 30, 1999;Build 10
|
---|
3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
---|
4 | LIST ;
|
---|
5 | D FM:'$D(DDS),SC:$D(DDS)
|
---|
6 | Q
|
---|
7 | ;
|
---|
8 | SC ;Screen Help
|
---|
9 | N A0,A1,A2,A3,A4,A5,A6,DDSB1,X,Y
|
---|
10 | K DTOUT,DUOUT
|
---|
11 | ;
|
---|
12 | W $P(DDGLVID,DDGLDEL,9) S X=$G(IOM,80)-1 X ^%ZOSF("RM")
|
---|
13 | I $D(DDQ)#2,DDQ<(IOSL-1),DDQ>DDSHBX!$P(DDQ,U,2)!$D(DDIOL) S DY=$P(DDQ,U),DX=$P(DDQ,U,2)
|
---|
14 | E D CLRMSG^DDS S DY=DDSHBX
|
---|
15 | X DDXY
|
---|
16 | ;
|
---|
17 | S:$G(DDD,5)=5 DDD=1
|
---|
18 | S:$D(DDO) DDSB1=DDO
|
---|
19 | S DDM=1,DDO=.5
|
---|
20 | S (A0,DIY,X)="",A1=0,A5=$S(DDD=2:$O(DS(0)),1:$O(DDH(A0)))
|
---|
21 | K A2,DDSQ
|
---|
22 | ;
|
---|
23 | F D SC1 Q:DDO'<1!(X=U)!'A0!DIY!$D(DTOUT)!$D(DUOUT)
|
---|
24 | ;
|
---|
25 | I $D(DDSB1) S:DDO<1 DDO=DDSB1
|
---|
26 | E K DDO
|
---|
27 | ;
|
---|
28 | S %=0
|
---|
29 | S DDQ=$S(DY>(IOSL-1):IOSL-1,1:DY)_U_DX
|
---|
30 | S:DDQ>DDSHBX DDM=1
|
---|
31 | I $D(A2) K DDD,DDH,DDQ S %=A2 S:%'=1 DDSQ=1 D CLRMSG^DDS G QQ
|
---|
32 | I $D(DDC),DDC'<0 D SV
|
---|
33 | E K DDD,DDH S DDSQ=1
|
---|
34 | ;
|
---|
35 | QQ S A0=$X S X=0 X ^%ZOSF("RM") W $P(DDGLVID,DDGLDEL,8) S $X=A0
|
---|
36 | Q
|
---|
37 | ;
|
---|
38 | SC1 S A6=A0,A0=$O(DDH(A0)) S:A6="" A6=A0-1
|
---|
39 | I 'A0,DDD Q:DDD=1 Q:DD<DS
|
---|
40 | ;
|
---|
41 | S A4=$O(DDH(+A0,""))
|
---|
42 | I A4'="X"!(DY'>DDSHBX) S DY=DY+1 X DDXY
|
---|
43 | I A4="E" D SC2 Q
|
---|
44 | ;
|
---|
45 | I $D(DDSCTRL) S:+DDSCTRL'=DDSCTRL!(DDSCTRL>3)!(DDSCTRL<1)!(DDSCTRL?.E1"."1N.N) DDSCTRL=2 ;DI*151
|
---|
46 | I $Y'<(IOSL-($G(DDSCTRL,2)))!'A0 D SC2 Q:DDO'<1!(X=U)!'A0!DIY!$D(DTOUT)!$D(DUOUT) S DY=DDSHBX+1,DX=0 X DDXY ;DI*151
|
---|
47 | Q:A4=""
|
---|
48 | ;
|
---|
49 | D WR
|
---|
50 | ;
|
---|
51 | I $Y'<(IOSL-1),'$D(DTOUT),'$D(DUOUT) D Q
|
---|
52 | . W ! D SC2
|
---|
53 | . W $P(DDGLVID,DDGLDEL,8) S X=0 X ^%ZOSF("RM") D REFRESH^DDSUTL
|
---|
54 | . W $P(DDGLVID,DDGLDEL,9) S X=$G(IOM,80)-1 X ^%ZOSF("RM")
|
---|
55 | . S DX=0,DY=DDSHBX X DDXY
|
---|
56 | ;
|
---|
57 | S DY=$Y,DX=0
|
---|
58 | Q
|
---|
59 | ;
|
---|
60 | SC2 S DX=0,DY=IOSL-1 X DDXY
|
---|
61 | W $S(DDD=1:$$EZBLD^DIALOG(8053),1:$$EZBLD^DIALOG(8081,A5_"-"_A6))_$P(DDGLCLR,DDGLDEL)
|
---|
62 | ;
|
---|
63 | R X:DTIME E S DTOUT=1 K DDC G Q2
|
---|
64 | I X?1."^" S DUOUT=1,X=U K DDC G Q2
|
---|
65 | ;
|
---|
66 | I X]"",X<A5!(X>A6) W $C(7) G SC2
|
---|
67 | E I X S:DDD["J" DDO=$O(DDH(X,"")) K DDC
|
---|
68 | D CLRMSG^DDS
|
---|
69 | S DDM=1
|
---|
70 | ;
|
---|
71 | Q2 S DIY=X,DY=DDSHBX
|
---|
72 | Q
|
---|
73 | ;
|
---|
74 | ASK W $P(A4,U,2)_$S(%'>2:"? ",1:"")_$S(%>0&(%<3):$P($$EZBLD^DIALOG(7001),U,%)_"// ",1:"")_$P(DDGLCLR,DDGLDEL)
|
---|
75 | S A2=0
|
---|
76 | R X:$G(DTIME,300) E S DTOUT=1,A2=-1 Q
|
---|
77 | ;
|
---|
78 | I %>2 S A2=X Q
|
---|
79 | ;
|
---|
80 | N %1 S %1=$$PRS^DIALOGU(7001,X) S:%1>0 X=$E($P(%1,U,2))
|
---|
81 | K %1
|
---|
82 | ;
|
---|
83 | I "YyNn^"'[X W $C(7) X DDXY G ASK
|
---|
84 | I X]"","^Nn"[X S A2=2 K DDC Q
|
---|
85 | S:"Yy"[X A2=1
|
---|
86 | S:X=""&(%]"") A2=+%
|
---|
87 | S DDD=1
|
---|
88 | Q
|
---|
89 | ;
|
---|
90 | SV ;Kill DDH array, but save the "ID" nodes and DDH itself
|
---|
91 | K A1,A2
|
---|
92 | S:$D(DDH("ID")) A1=DDH("ID")
|
---|
93 | S:$D(DDH("ID",1)) A2=DDH("ID",1)
|
---|
94 | K DDH S DDH=0
|
---|
95 | S:$D(A1) DDH("ID")=A1
|
---|
96 | S:$D(A2) DDH("ID",1)=A2
|
---|
97 | Q
|
---|
98 | ;
|
---|
99 | FM ;FileMan help - Non screen
|
---|
100 | N A0,A1,A2,A3,A4,DDSDIW,DDSDIY,Y
|
---|
101 | S A0=""
|
---|
102 | F S A0=$O(DDH(A0)) Q:'A0 S DDSDIW=$X,DDSDIY=$Y D W I $G(DDD)>2,DDSDIW-$X!(DDSDIY-$Y) D STP Q:$D(DTOUT)
|
---|
103 | I $G(DIPGM)="DICQ1",$G(DP),$G(DIC("?N",DP)) D
|
---|
104 | . N DIZ S DIZ=0 D T Q
|
---|
105 | ;
|
---|
106 | Q I '$D(DTOUT) D SV S DDH=0 Q
|
---|
107 | K DDH D:'DTOUT Q
|
---|
108 | . K DTOUT N % S %=$G(DIPGM) I %'="DICQ1",%'="DIEQ" Q
|
---|
109 | . S DUOUT=1 Q
|
---|
110 | Q
|
---|
111 | ;
|
---|
112 | STP Q:$D(DD)[0!($D(DIY)[0) I DD+DIY'>79 W ?DD S DD=DD+DIY Q
|
---|
113 | ;
|
---|
114 | T W !?3 S DD=DIY+3
|
---|
115 | I $Y>DIZ!'$Y D
|
---|
116 | . R "'^' TO STOP: ",%Y:$G(DTIME,300)
|
---|
117 | . E S DTOUT=1 K DDD
|
---|
118 | . W $C(13),$J("",15),$C(13) Q:$D(DTOUT)
|
---|
119 | . I %Y[U S DTOUT=0 K DDD
|
---|
120 | . D Y W ?3
|
---|
121 | Q
|
---|
122 | ;
|
---|
123 | W S A4=$O(DDH(A0,"")) Q:A4="" Q:DDH(A0,A4)=""
|
---|
124 | W:'$D(DDD) !
|
---|
125 | I $G(DDD)=3,A4["T" K DDD
|
---|
126 | ;
|
---|
127 | WR I A4["X" D Q
|
---|
128 | . N DDD,DIY,DDSXEC
|
---|
129 | . S DDSXEC=DDH(A0,A4)
|
---|
130 | . N DDH
|
---|
131 | . I $D(DDS) N DDSID S DDSID=1 S DDQ=$S(DY>(IOSL-1):IOSL-1,1:DY)_U_DX
|
---|
132 | . X DDSXEC
|
---|
133 | ;
|
---|
134 | I A4["Q" D Q
|
---|
135 | . S A4=DDH(A0,A4),%=$P(A4,U,1)
|
---|
136 | . I $D(DDS) D ASK Q
|
---|
137 | . W $P(A4,U,2)
|
---|
138 | . D YN^DICN
|
---|
139 | ;
|
---|
140 | I A4["T" D Q
|
---|
141 | . I DDH(A0,A4)[$C(0) D
|
---|
142 | .. S DX=$L(DDH(A0,A4),$C(0))-1
|
---|
143 | .. X DDXY
|
---|
144 | .. S DDH(A0,A4)=$TR(DDH(A0,A4),$C(0),"")
|
---|
145 | . W DDH(A0,A4)
|
---|
146 | ;
|
---|
147 | I '$D(DDS),$G(DDD)'["J",A4'=+A4 Q
|
---|
148 | I $D(DDS),$G(DDD)=2!($G(DDD)["J") W A0,?7
|
---|
149 | ;
|
---|
150 | W DDH(A0,A4)
|
---|
151 | I $D(DDH("ID")) D S:$D(DUOUT) DIY=U
|
---|
152 | . N DDD,DIY,DDSID
|
---|
153 | . S DDSID=DDH("ID")
|
---|
154 | . S:$D(DDH("ID",1))#2 DDSID(1)=DDH("ID",1)
|
---|
155 | . N DDH
|
---|
156 | . S:$D(DDSID(1))#2 DDH("ID",1)=DDSID(1) K DDSID(1)
|
---|
157 | . S Y=A4
|
---|
158 | . S:$D(DDS) DDQ=$S(DY>(IOSL-1):IOSL-1,1:DY)_U_$X
|
---|
159 | . X DDSID
|
---|
160 | Q
|
---|
161 | ;
|
---|
162 | Y D:'$D(DISYS) OS^DII
|
---|
163 | S $X=0,$Y=0
|
---|
164 | S DIZ=$S($D(DILN)&'$D(DIR0):DILN,1:21)
|
---|
165 | Q
|
---|
166 | ;
|
---|
167 | Z D Y,T
|
---|
168 | Q
|
---|
169 | ;
|
---|
170 | H S:'$D(A1) A1="T"
|
---|
171 | S DDH=$G(DDH)+1,DDH(DDH,A1)=DST
|
---|
172 | K A1,DST
|
---|
173 | D SC
|
---|
174 | Q
|
---|
175 | ;#8053 Press 'RETURN' to continue...
|
---|
176 | ;#8081 Choose |from-to| or '^'...
|
---|
177 | ;#7001 Yes^No
|
---|