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

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1DDWG ;SFISC/MKO-GOTO ;3:40 PM 5 Jul 1996
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4GOTO ;Go to a specific location
5 N DDWANS,DDWI,DDWHLP
6 S DDWHLP(1)="Examples, to go to a screen: S21, 21, S+3, +3, -3"
7 S DDWHLP(2)=" to go to a line: L53, L+4, L-5"
8 S DDWHLP(3)=" to go to a column: C40, C+10, C-20"
9 D ASK(4,"Go to: ",17,"","D VALGTO",.DDWHLP,.DDWANS)
10 I U[DDWANS
11 E I "Ss"[$E(DDWANS)!(DDWANS'?1A.E) D
12 . D GOTOS
13 E I "Ll"[$E(DDWANS) D
14 . D GOTOL
15 E I "Cc"[$E(DDWANS) D
16 . D GOTOC
17 Q
18 ;
19GOTOS ;Go to a page
20 N DDWS
21 S DDWS=DDWANS
22 S:DDWS?1A.E DDWS=$E(DDWS,2,999)
23 S:DDWS?1P.E DDWS=$E(DDWS,2,999)
24 I DDWANS["+" S DDWS=$$SCREEN+DDWS
25 E I DDWANS["-" S DDWS=$$SCREEN-DDWS
26 I DDWS<1 S DDWS=1
27 E I DDWS>$$LTOSC(DDWCNT) S DDWS=$$LTOSC(DDWCNT)
28 D LINE(DDWS-1*DDWMR+1)
29 Q
30 ;
31GOTOL ;Go to a line
32 N DDWLN
33 S DDWLN=DDWANS
34 S:DDWLN?1A.E DDWLN=$E(DDWLN,2,999)
35 S:DDWLN?1P.E DDWLN=$E(DDWLN,2,999)
36 I DDWANS["+" S DDWLN=DDWA+DDWRW+DDWLN
37 E I DDWANS["-" S DDWLN=DDWA+DDWRW-DDWLN
38 I DDWLN<1 S DDWLN=1
39 E I DDWLN>DDWCNT S DDWLN=DDWCNT
40 D LINE(DDWLN)
41 Q
42 ;
43GOTOC ;Go to a column
44 N DDWCOL
45 S DDWCOL=DDWANS
46 S:DDWCOL?1A.E DDWCOL=$E(DDWCOL,2,999)
47 S:DDWCOL?1P.E DDWCOL=$E(DDWCOL,2,999)
48 I DDWANS["+" S DDWCOL=DDWC+DDWCOL
49 E I DDWANS["-" S DDWCOL=DDWC-DDWCOL
50 I DDWCOL<1 S DDWCOL=1
51 E I DDWCOL>246 S DDWCOL=246
52 D POS(DDWRW,DDWCOL,"R")
53 Q
54 ;
55LINE(DDWLN,DDWCOL) ;Adjust arrays and position cursor on line DDWLN
56 I $G(DDWCOL)'="E",'$G(DDWCOL) S DDWCOL=1
57 S:DDWLN>DDWCNT DDWLN=DDWCNT
58 I DDWLN>DDWA,DDWLN'>(DDWA+DDWMR-1) D
59 . D POS(DDWLN-DDWA,DDWCOL,"RN")
60 E I DDWLN>DDWA D
61 . D SHFTDN^DDW3(DDWLN,DDWCOL),POS(DDWLN-DDWA,DDWCOL,"RN")
62 E D
63 . D SHFTUP^DDW3(DDWLN),POS(1,DDWCOL,"RN")
64 Q
65 ;
66ASK(DDWLC,DDWS,DDWLEN,DDWDEF,DDWVAL,DDWHLP,DDWANS,DDWCOD) ;Prompt user
67 N DDWI
68 D CUP(DDWMR-DDWLC,1)
69 W $P(DDGLGRA,DDGLDEL)_$TR($J("",IOM)," ",$P(DDGLGRA,DDGLDEL,3))_$P(DDGLGRA,DDGLDEL,2)
70 F DDWI=DDWMR-DDWLC+1:1:DDWMR D CUP(DDWI,1) W $P(DDGLCLR,DDGLDEL)
71 K DDWANS F D PROMPT Q:$D(DDWANS)
72 ;
73 F DDWI=DDWMR-DDWLC:1:DDWMR D
74 . D CUP(DDWI,1)
75 . W $P(DDGLCLR,DDGLDEL)_$E(DDWL(DDWI),1+DDWOFS,IOM+DDWOFS)
76 D POS(DDWRW,DDWC,"RN")
77 Q
78 ;
79PROMPT ;Issue read
80 N DDWERR,DDWX
81 D CUP(DDWMR-DDWLC+1,1) W DDWS_$P(DDGLCLR,DDGLDEL)
82 D EN^DIR0(IOTM+DDWMR-DDWLC-1,$L(DDWS),DDWLEN,1,$G(DDWDEF),245,"","","AKTW",.DDWX,.DDWCOD)
83 ;
84 I DDWX?1."?",$D(DDWHLP)>9!($G(DDWHLP)]"") D HELP(.DDWHLP) Q
85 I $G(DDWVAL)]"" X DDWVAL I $D(DDWERR) W $C(7) D HELP(.DDWERR) Q
86 S DDWANS=DDWX
87 Q
88 ;
89VALGTO ;Validate DDWX
90 N DDWCH
91 Q:U[DDWX
92 S DDWERR="Invalid format. Enter ? for examples."
93 Q:DDWX'?.1A.1P1.15N
94 I DDWX?1A.E S DDWCH=$E(DDWX) Q:"SsLlCc"'[DDWCH
95 I DDWX?.E1P.E I DDWX'["+",DDWX'["-" Q
96 K DDWERR
97 Q
98 ;
99HELP(DDWMSG) ;Print message
100 N DDWI,DDWEC
101 S:$D(DDWMSG)<9 DDWMSG(1)=DDWMSG
102 S DDWEC=$O(DDWMSG(""),-1)
103 F DDWI=2:1:DDWLC D
104 . D CUP(DDWMR-DDWLC+DDWI,1)
105 . W $P(DDGLCLR,DDGLDEL)_$G(DDWMSG(DDWI-DDWLC+DDWEC))
106 Q
107 ;
108SCREEN() ;Return current screen
109 Q DDWA+DDWRW-1\DDWMR+1
110 ;
111LTOSC(L) ;Convert line number to page number
112 Q L-1\DDWMR+1
113 ;
114CUP(Y,X) ;Pos cursor
115 S DY=IOTM+Y-2,DX=X-1 X IOXY
116 Q
117 ;
118POS(R,C,F) ;Pos cursor based on char pos C
119 N DDWX
120 S:$G(C)="E" C=$L($G(DDWL(R)))+1
121 S:$G(F)["N" DDWN=$G(DDWL(R))
122 S:$G(F)["R" DDWRW=R,DDWC=C
123 ;
124 S DDWX=C-DDWOFS
125 I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
126 S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
127 Q
Note: See TracBrowser for help on using the repository browser.