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

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

initial load of WorldVistAEHR
File size: 4.3 KB
RevLine 
[613]1DDGFPG ;SFISC/MKO-ADD A NEW PAGE ;2:26 PM 13 Sep 1995
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5ADD ;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 K DD,DO 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 ;
40ADDQ D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
41 K DDGFPNUM,DDGFDY,DDGFDX
42 Q
43 ;
44EDIT ;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 ;
84PGSEL ;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 ;
98NXTPRV(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)
107NXTPRVQ K DDGFPAGE,DDGFDY,DDGFDX
108 Q
109 ;
110CLSPG ;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 ;
118SUBPG ;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 ;
129SUBPG1 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 ;
134LOADPG ;Load new page
135 D PG^DDGFLOAD(+DDGFFM,DDGFPG,1)
136 S DDGFDY=$P(DDGFLIM,U),DDGFDX=$P(DDGFLIM,U,2)
137 Q
138 ;
139RC(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
Note: See TracBrowser for help on using the repository browser.