Annotation of freem_fileman/DDGFPG.m, revision 1.1.1.1
1.1 snw 1: DDGFPG ;SFISC/MKO-ADD A NEW PAGE ;01:48 PM 22 Nov 1994
2: ;;21.0;VA FileMan;;Dec 28, 1994
3: ;Per VHA Directive 10-93-142, this routine should not be modified.
4: ;
5: ADD ;Invoke forms to add a new page
6: S DDGFDY=DY,DDGFDX=DX K DDGFPNUM
7: ;
8: ;Ask for new page number
9: S DDSFILE=.403,DDSFILE(1)=.4031
10: S DA(1)=+DDGFFM,DA="",DR="[DDGF PAGE ADD]",DDSPARM="KTW"
11: D ^DDS K DDSFILE,DA,DR,DDSPARM
12: ;
13: G:$D(DDGFPNUM)[0 ADDQ
14: ;
15: ;Ask 'are you sure' page should be added
16: K DDGFANS
17: S DDSFILE=.403,DDSFILE(1)=.4031
18: S DR="[DDGF PAGE ADD]",DA(1)=+DDGFFM,DA="",DDSPARM="KTW",DDSPAGE=11
19: D ^DDS K DDSFILE,DA,DR,DDSPARM,DDSPAGE
20: ;
21: I '$G(DDGFANS) K DDGFANS G ADDQ
22: K DDGFANS
23: ;
24: ;Add page to form
25: S DIC="^DIST(.403,+DDGFFM,40,",DIC(0)="L",DA(1)=+DDGFFM
26: S DIC("P")=$P(^DD(.403,40,0),U,2),X=DDGFPNUM
27: D FILE^DICN K DIC,DA,X G:Y=-1 ADDQ
28: S DDGFPG=+Y
29: ;
30: ;Stuff in values for coordinates and name
31: S DIE="^DIST(.403,"_+DDGFFM_",40,",DA(1)=+DDGFFM,DA=DDGFPG
32: S DR="2////1,1;7////Page "_DDGFPNUM
33: D ^DIE K DIE,DA,DR
34: ;
35: K DDGFPNUM
36: D LOADPG
37: S DDGFNEW=1
38: G EDIT
39: ;
40: ADDQ D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
41: K DDGFPNUM,DDGFDY,DDGFDX
42: Q
43: ;
44: EDIT ;Invoke form to edit a page
45: ;Input: DDGFNEW (optional)
46: ; Set by ADD to indicate this is a brand new page.
47: ;
48: S DDGFDY=DY,DDGFDX=DX
49: S DDGFND=@DDGFREF@("F",DDGFPG)
50: S (DDGFTLC,DDGFTLC0)=$P(DDGFND,U)+1_","_($P(DDGFND,U,2)+1)
51: S (DDGFLRC,DDGFLRC0)=$S($P(DDGFND,U,3)]"":$P(DDGFND,U,3)+1_","_($P(DDGFND,U,4)+1),1:"")
52: S (DDGFPNM,DDGFPNM0)=$P(DDGFND,U,5)
53: S DDGFPAR=$P($G(^DIST(.403,+DDGFFM,40,DDGFPG,1)),U,2)
54: ;
55: S DDSFILE=.403,DDSFILE(1)=.4031,DDSPARM="KTW"
56: S DA(1)=+DDGFFM,DA=DDGFPG,DR="[DDGF PAGE EDIT]"
57: D ^DDS K DDSFILE,DA,DR,DDSPARM
58: ;
59: S DDGFND=$G(^DIST(.403,+DDGFFM,40,DDGFPG,0))
60: ;
61: ;If page was deleted, destroy windows and set new page
62: I DDGFND="" D Q:DDGFE
63: . I $D(DDGFWID)#2,$$EXIST^DDGLIBW(DDGFWID) D DESTROY^DDGLIBW(DDGFWID)
64: . I $D(DDGFWIDB)#2,$$EXIST^DDGLIBW(DDGFWIDB) D DESTROY^DDGLIBW(DDGFWIDB)
65: . K @DDGFREF@("F",DDGFPG),@DDGFREF@("RC",DDGFWID),@DDGFREF@("BKRC",DDGFWIDB)
66: . I $D(@DDGFREF@("ASUB","B",DDGFPG)) D DEL^DDGFASUB(DDGFPG)
67: . S DDGFPG=$O(^DIST(.403,+DDGFFM,40,"B",""))
68: . S:DDGFPG]"" DDGFPG=$O(^DIST(.403,+DDGFFM,40,"B",DDGFPG,""))
69: . D LOADPG,REFRESH^DDGF,RC(DDGFDY,DDGFDX)
70: ;
71: E D
72: . S:DDGFPNM'=DDGFPNM0 $P(@DDGFREF@("F",DDGFPG),U,5)=DDGFPNM,$P(^(DDGFPG),U,7)=1,DDGFCHG=1
73: . D:DDGFPAR'=$P($G(^DIST(.403,+DDGFFM,40,DDGFPG,1)),U,2) EDIT^DDGFASUB(DDGFPG)
74: . I DDGFTLC'=DDGFTLC0!(DDGFLRC'=DDGFLRC0) D
75: .. D PAGE^DDGFUPDP($P(DDGFTLC,",")-1,$P(DDGFTLC,",",2)-1,$S(DDGFLRC]"":$P(DDGFLRC,",")-1,1:""),$S(DDGFLRC]"":$P(DDGFLRC,",",2)-1,1:""),$S(DDGFTLC=DDGFTLC0:"PBRC",1:"PTOP"))
76: .. D STATUS^DDGF,RC($P(DDGFLIM,U),$P(DDGFLIM,U,2))
77: . E D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
78: ;
79: K DDGFDX,DDGFDY,DDGFND,DDGFNEW
80: K DDGFLRC,DDGFLRC0,DDGFPOP,DDGFPOP0,DDGFTLC,DDGFTLC0
81: K DDGFPAR,DDGFPNM,DDGFPNM0
82: Q
83: ;
84: PGSEL ;Select a new page
85: S DDGFDY=DY,DDGFDX=DX,DDGFPAGE=DDGFPG
86: ;
87: S DDSFILE=.403,DDSFILE(1)=.4031
88: S DR="[DDGF PAGE SELECT]",DDSPARM="KTW"
89: D ^DDS
90: K DDSFILE,DA,DR,DDSPAGE,DDSPARM
91: ;
92: I DDGFPAGE]"",DDGFPAGE'=DDGFPG S DDGFPG=DDGFPAGE D LOADPG
93: ;
94: D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
95: K DDGFPAGE,DDGFDY,DDGFDX
96: Q
97: ;
98: NXTPRV(F) ;Go to page
99: ;F=1:next page; -1:previous page
100: S DDGFPAGE=$P($G(^DIST(.403,+DDGFFM,40,DDGFPG,0)),U,$S($G(F)=-1:5,1:4))
101: G:DDGFPAGE="" NXTPRVQ
102: S DDGFPAGE=$O(^DIST(.403,+DDGFFM,40,"B",DDGFPAGE,""))
103: G:$D(^DIST(.403,+DDGFFM,40,+DDGFPAGE,0))[0!(DDGFPAGE=DDGFPG) NXTPRVQ
104: ;
105: S DDGFPG=DDGFPAGE
106: D LOADPG,REFRESH^DDGF,RC(DDGFDY,DDGFDX)
107: NXTPRVQ K DDGFPAGE,DDGFDY,DDGFDX
108: Q
109: ;
110: CLSPG ;Close page
111: Q:$G(DDGLSCR)'>1
112: D CLOSE^DDGLIBW(DDGFWID)
113: S DDGFPG=$E(DDGLSCR(DDGLSCR),2,999)
114: D PG^DDGFLOAD(+DDGFFM,DDGFPG,1)
115: D STATUS^DDGF,RC($P(DDGFLIM,U),$P(DDGFLIM,U,2))
116: Q
117: ;
118: SUBPG ;Go into subpage
119: I $D(@DDGFREF@("ASUB",DDGFPG,B,F))#2 S DDGFSUBP=^(F)
120: E D
121: . S DDGFSUBP=+$P($G(^DIST(.404,B,40,F,7)),U,2)
122: . S DDGFSUBP=+$O(^DIST(.403,+DDGFFM,40,"B",DDGFSUBP,""))
123: ;
124: I $D(^DIST(.403,+DDGFFM,40,DDGFSUBP,0))[0 W $C(7) K DDGFSUBP Q
125: I DDGFSUBP=DDGFPG K DDGFSUBP Q
126: S DDGFE=1
127: Q
128: ;
129: SUBPG1 S DDGFPG=DDGFSUBP K DDGFSUBP
130: D PG^DDGFLOAD(+DDGFFM,DDGFPG)
131: D STATUS^DDGF,RC($P(DDGFLIM,U),$P(DDGFLIM,U,2))
132: Q
133: ;
134: LOADPG ;Load new page
135: D PG^DDGFLOAD(+DDGFFM,DDGFPG,1)
136: S DDGFDY=$P(DDGFLIM,U),DDGFDX=$P(DDGFLIM,U,2)
137: Q
138: ;
139: RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
140: N S
141: I DDGFR D
142: . S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
143: . X IOXY W S_$J("",7-$L(S))
144: S DY=DDGFY,DX=DDGFX X IOXY
145: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDGFPG.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman