Annotation of freem_fileman/DDGF1.m, revision 1.1.1.1
1.1 snw 1: DDGF1 ;SFISC/MKO-MAIN SCREEN ;02:46 PM 12 Oct 1994
2: ;;21.0;VA FileMan;;Dec 28, 1994
3: ;Per VHA Directive 10-93-142, this routine should not be modified.
4: D RC($P(DDGFLIM,U),$P(DDGFLIM,U,2))
5: S DDGFE=0 F S Y=$$READ W:$T(@Y)="" $C(7) D:$D(DDGFMSG) MSG^DDGF() D:$T(@Y)]"" @Y Q:DDGFE
6: Q
7: ;
8: LNU I DY>$P(DDGFLIM,U) D RC(DY-1,DX)
9: Q
10: LND I DY<$P(DDGFLIM,U,3) D RC(DY+1,DX)
11: Q
12: CHR I DX<$P(DDGFLIM,U,4) D RC(DY,DX+1)
13: Q
14: CHL I DX>$P(DDGFLIM,U,2) D RC(DY,DX-1)
15: Q
16: ;
17: ELR N Y,X
18: S Y=DY,X=DX
19: S X=$O(@DDGFREF@("RC",DDGFWID,Y,X))
20: D:X=""
21: . S Y=$O(@DDGFREF@("RC",DDGFWID,Y))
22: . S:Y="" Y=$O(@DDGFREF@("RC",DDGFWID,""))
23: . S:Y]"" X=$O(@DDGFREF@("RC",DDGFWID,Y,""))
24: D:X]"" RC(Y,X)
25: Q
26: ELL N Y,X
27: S Y=DY,X=DX
28: S X=$O(@DDGFREF@("RC",DDGFWID,Y,X),-1)
29: D:X=""
30: . S Y=$O(@DDGFREF@("RC",DDGFWID,Y),-1)
31: . S:Y="" Y=$O(@DDGFREF@("RC",DDGFWID,""),-1)
32: . S:Y]"" X=$O(@DDGFREF@("RC",DDGFWID,Y,""),-1)
33: D:X]"" RC(Y,X)
34: Q
35: ;
36: TBR I DX<$P(DDGFLIM,U,4) D
37: . D RC(DY,$S(DX+5'<$P(DDGFLIM,U,4):$P(DDGFLIM,U,4),1:DX+5))
38: E I DY<$P(DDGFLIM,U,3) D RC(DY+1,$P(DDGFLIM,U,2))
39: Q
40: TBL I DX>$P(DDGFLIM,U,2) D
41: . D RC(DY,$S(DX-5'>$P(DDGFLIM,U,2):$P(DDGFLIM,U,2),1:DX-5))
42: E I DY>$P(DDGFLIM,U) D RC(DY-1,$P(DDGFLIM,U,4))
43: Q
44: ;
45: SCT I DY>$P(DDGFLIM,U) D RC($P(DDGFLIM,U),DX)
46: Q
47: SCB I DY<$P(DDGFLIM,U,3) D RC($P(DDGFLIM,U,3),DX)
48: Q
49: SCR I DX<$P(DDGFLIM,U,4) D RC(DY,$P(DDGFLIM,U,4))
50: Q
51: SCL I DX>$P(DDGFLIM,U,2) D RC(DY,$P(DDGFLIM,U,2))
52: Q
53: ;
54: SAVE ;Save data from DDGFREF
55: I 'DDGFPG D ERR(110) Q
56: G SAVE^DDGFSV
57: ;
58: SELECT ;Select an item
59: I 'DDGFPG D ERR(110) Q
60: G SELECT^DDGFEL
61: ;
62: EDIT ;Edit a caption or data length
63: I 'DDGFPG D ERR(110) Q
64: G EDIT^DDGFEL
65: ;
66: FLDADD ;Add a new field to the form
67: I 'DDGFPG D ERR(110) Q
68: G ADD^DDGFFLDA
69: ;
70: VIEW ;Go to block viewer
71: I 'DDGFPG D ERR(110) Q
72: I $O(@DDGFREF@("F",DDGFPG,""))="" D ERR(120) Q
73: G ^DDGF3
74: ;
75: BKADD ;Add a new block
76: I 'DDGFPG D ERR(110) Q
77: G ADD^DDGFBK
78: ;
79: HBKADD ;Add a header block
80: I 'DDGFPG D ERR(110) Q
81: G ADD^DDGFHBK
82: ;
83: NXTPG ;Go to next page
84: I 'DDGFPG D ERR(110) Q
85: D NXTPRV^DDGFPG(1) Q
86: ;
87: PRVPG ;Go to previous page
88: I 'DDGFPG D ERR(110) Q
89: D NXTPRV^DDGFPG(-1) Q
90: ;
91: CLSPG ;Close pop-up page
92: G CLSPG^DDGFPG
93: ;
94: PGSEL ;Select a new page
95: I 'DDGFPG D ERR(110) Q
96: G PGSEL^DDGFPG
97: ;
98: PGADD ;Add a new page to the form
99: G ADD^DDGFPG
100: ;
101: PGEDIT ;Edit attributes of a page
102: I 'DDGFPG D ERR(110) Q
103: G EDIT^DDGFPG
104: ;
105: FMSEL ;Select another form
106: G SEL^DDGFFM
107: ;
108: FMADD ;Add a new form
109: G ADD^DDGFFM
110: ;
111: FMEDIT ;Edit the form
112: G EDIT^DDGFFM
113: ;
114: HELP ;Invoke help screens
115: G HLP^DDGFH
116: ;
117: TO ;Time-out
118: W $C(7)
119: G QUIT
120: ;
121: QUIT ;Exit from form designer
122: I DDGLSCR>1 G CLSPG^DDGFPG
123: S DDGFE=1
124: Q
125: EXIT ;Save and exit
126: I DDGLSCR>1 G CLSPG^DDGFPG
127: S DDGFE=1
128: G SAVE^DDGFSV
129: ;
130: RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
131: N DDGFS
132: I DDGFR D
133: . S DY=IOSL-6,DX=IOM-9,DDGFS="R"_(DDGFY+1)_",C"_(DDGFX+1)
134: . X IOXY W DDGFS_$J("",7-$L(DDGFS))
135: S DY=DDGFY,DX=DDGFX X IOXY
136: Q
137: ;
138: READ() N S,Y
139: F R *Y:DTIME D C Q:Y'=-1
140: Q Y
141: ;
142: C I Y<0 S Y="TO" Q
143: S S=""
144: C1 S S=S_$C(Y)
145: I DDGF("IN")'[(U_S) D I Y=-1 W $C(7) Q
146: . I $C(Y)'?1L S Y=-1 Q
147: . S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDGF("IN")'[(U_S_U) Y=-1
148: ;
149: I DDGF("IN")[(U_S_U),S'=$C(27) S Y=$P(DDGF("OUT"),U,$L($P(DDGF("IN"),U_S_U),U)) Q
150: R *Y:5 G:Y'=-1 C1 W $C(7)
151: Q
152: ;
153: ERR(X) ;
154: D MSG^DDGF($C(7)_$P($T(@X),";;",2,999)) H 3
155: D MSG^DDGF()
156: Q
157: 110 ;;There are no pages on this form. Use PF2-P to add a page.
158: 120 ;;There are no blocks on this page. Use PF2-B to add a block.
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>