source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDSU.m@ 1474

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

initial load of WorldVistAEHR
File size: 4.1 KB
RevLine 
[613]1DDSU ;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.
4LIST ;
5 D FM:'$D(DDS),SC:$D(DDS)
6 Q
7 ;
8SC ;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 ;
35QQ S A0=$X S X=0 X ^%ZOSF("RM") W $P(DDGLVID,DDGLDEL,8) S $X=A0
36 Q
37 ;
38SC1 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 ;
60SC2 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 ;
71Q2 S DIY=X,DY=DDSHBX
72 Q
73 ;
74ASK 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 ;
90SV ;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 ;
99FM ;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 ;
106Q 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 ;
112STP Q:$D(DD)[0!($D(DIY)[0) I DD+DIY'>79 W ?DD S DD=DD+DIY Q
113 ;
114T 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 ;
123W 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 ;
127WR 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 ;
162Y 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 ;
167Z D Y,T
168 Q
169 ;
170H 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
Note: See TracBrowser for help on using the repository browser.