source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDSZ.m@ 1446

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

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1DDSZ ;SFISC/MKO-FORM COMPILER ;9:41 AM 19 Nov 2001
2 ;;22.0;VA FileMan;**94**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;Prompt, compile
6 N DDSFRM,DDSDDP,DDSREFS
7 N C,DIC,X,Y
8 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
9 ;
10 S DIC="^DIST(.403,",DIC(0)="AEQZ"
11 D ^DIC K DIC Q:Y=-1!'$D(^DIST(.403,+Y,0))
12 S DDSFRM=Y,DDSDDP=$P(Y(0),U,8)
13 ;
14 W !!,"Compiling "_$P(Y,U,2)_" (#"_+Y_") ...",!
15 D EN(DDSFRM,DDSDDP)
16 I $G(DIERR) W $C(7) D MSG^DIALOG("BW")
17 Q
18 ;
19ALL ;Compile all forms
20 N DDSFRM,DDSDDP,DDSFNUM,DDSREFS
21 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
22 W:'$D(DDSQUIET) !,"Compiling all forms ...",!
23 ;
24 S DDSFNUM=0
25 F S DDSFNUM=$O(^DIST(.403,DDSFNUM)) Q:'DDSFNUM D
26 . Q:$D(^DIST(.403,DDSFNUM,0))[0
27 . S DDSFRM=DDSFNUM_U_$P(^DIST(.403,DDSFNUM,0),U),DDSDDP=+$P(^(0),U,8)
28 . S DDSREFS=$$REF^DDS0(DDSFRM)
29 . W:'$D(DDSQUIET) !?3,$P(DDSFRM,U,2),?35,"(#"_+DDSFRM_")"
30 . D EN(DDSFRM,DDSDDP)
31 . I $G(DIERR),'$D(DDSQUIET) W !,$C(7) D MSG^DIALOG("BW") W !
32 Q
33 ;
34EN(DDSFRM,DDSDDP,DDSREFS) ;Compile a form
35 N DDSDO,DDSPG,DDSNDD,DDSPGRP
36 ;
37 S:'$G(DDSDDP) DDSDDP=$P(^DIST(.403,+DDSFRM,0),U,8)
38 S:$G(DDSREFS)="" DDSREFS=$$REF^DDS0(DDSFRM)
39 K @DDSREFS
40 ;
41 ;Find page groups
42 D PGRP^DDSZ3(+DDSFRM,.DDSPGRP)
43 ;
44 S DDSPG=0,(DDSDO,DDSNDD)=1
45 F S DDSPG=$O(^DIST(.403,+DDSFRM,40,DDSPG)) Q:'DDSPG D PG(DDSFRM,DDSPG,DDSDDP,.DDSDO,.DDSNDD) Q:$G(DIERR)
46 I $G(DIERR) D ERR(DDSFRM,DDSREFS) Q
47 S $P(^DIST(.403,+DDSFRM,0),U,9,11)=+$G(DDSDO)_U_+$G(DDSNDD)_U_1
48 Q
49 ;
50PG(DDSFRM,DDSPG,DDSDDP,DDSDO,DDSNDD) ;Compile a page
51 ;
52 Q:$D(^DIST(.403,+DDSFRM,40,DDSPG,0))[0
53 D:$P($G(^DIST(.403,+DDSFRM,40,DDSPG,1)),U,2)]"" ASUB^DDSZ3(DDSPG,DDSFRM)
54 ;
55 ;Get page coordinates
56 S DDSPX=$P(^DIST(.403,+DDSFRM,40,DDSPG,0),U,3)
57 S DDSPY=$P(DDSPX,",")-1,DDSPX=$P(DDSPX,",",2)-1
58 S:DDSPY<0 DDSPY=0 S:DDSPX<0 DDSPX=0
59 ;
60 ;Compile header block
61 S DDSB=$P($G(^DIST(.403,+DDSFRM,40,DDSPG,0)),U,2)
62 I DDSB]"" D BLK(DDSFRM,DDSPG,DDSDDP,DDSPY,DDSPX,DDSB,"",1,"",.DDSNDD,.DDSSCR,.DDSNAV,.DDSORD) G:$G(DIERR) END
63 ;
64 ;Compile all other blocks on page
65 S DDSBO="" F S DDSBO=$O(^DIST(.403,+DDSFRM,40,DDSPG,40,"AC",DDSBO)) Q:DDSBO="" S DDSB=$O(^(DDSBO,0)) Q:'DDSB D BLK(DDSFRM,DDSPG,DDSDDP,DDSPY,DDSPX,DDSB,DDSBO,"",.DDSDO,.DDSNDD,.DDSSCR,.DDSNAV,.DDSORD) G:$G(DIERR) END
66 ;
67 D:$D(DDSSCR)!$D(DDSORD) EN^DDSZ2(.DDSSCR,.DDSNAV,.DDSORD,.DDSRNAV)
68 ;
69END K DDSB,DDSBO,DDSMUL,DDSNAV,DDSORD
70 K DDSP,DDSPX,DDSPY,DDSREP,DDSRNAV,DDSSCR
71 Q
72 ;
73BLK(DDSFRM,DDSPG,DDSDDP,DDSPY,DDSPX,DDSB,DDSBO,DDSH,DDSDO,DDSNDD,DDSSCR,DDSNAV,DDSORD) ;
74 ;Compile block
75 ; DDSH = 1 if header block
76 ; DDSDO = killed if any edit blocks
77 ; DDSNDD = killed if any DD fields
78 ;
79 N DDP
80 I $D(^DIST(.404,DDSB,0))[0 D BLD^DIALOG(3051,"#"_DDSB) Q
81 S DDSDN=$P(^DIST(.404,DDSB,0),U,3),DDP=+$P(^(0),U,2)
82 ;
83 S DDSPTB=""
84 S:'$G(DDSH) DDSPTB=$G(^DIST(.403,+DDSFRM,40,DDSPG,40,DDSB,1))
85 ;
86 ;Get DDSBY,DDSBX,DDSTP
87 I $G(DDSH) S DDSBY=DDSPY,DDSBX=DDSPX,DDSTP="h",DDSREP=1
88 E D
89 . S DDSBX=$P(^DIST(.403,+DDSFRM,40,DDSPG,40,DDSB,0),U,3),DDSTP=$P(^(0),U,4) S DDSREP=$S($G(^(2)):^(2),1:1)
90 . K:DDSTP="e" DDSDO
91 . S DDSBY=$P(DDSBX,",")-1,DDSBX=$P(DDSBX,",",2)-1
92 . S:DDSBY<0 DDSBY=0 S:DDSBX<0 DDSBX=0
93 . S DDSBY=DDSBY+DDSPY,DDSBX=DDSBX+DDSPX
94 ;
95 ;Set @DDSREFS@(DDSPG,DDSB)
96 S @DDSREFS@(DDSPG,DDSB)=DDSBY_U_DDSBX_U_$P($G(^DIST(.404,DDSB,0)),U,2)_U_DDSDN_U_DDSTP_$S(DDSREP>1:U_U_+DDSREP,1:"")
97 ;
98 D:DDSPTB]"" PT^DDSPTR(DDSDDP,DDSPTB,DDSFRM,DDSPG,DDSB)
99 D EN^DDSZ1(DDSPG,DDSB,DDP,DDSBY,DDSBX,DDSBO,DDSTP,DDSREP,.DDSNDD,.DDSPGRP,.DDSSCR,.DDSNAV,.DDSORD,.DDSRNAV)
100 ;
101 K DDSBX,DDSBY,DDSDN,DDSPTB,DDSTP
102 Q
103 ;
104ENGRP(DDSFRM) ;Compile a form and all forms that use any of the blocks
105 ;on that form
106 N DDSLST
107 D FRMLST(DDSFRM,.DDSLST)
108 ;
109 ;Compile all forms in DDSLST
110 S DDSFRM=0 F S DDSFRM=$O(DDSLST(DDSFRM)) Q:'DDSFRM D EN(DDSFRM)
111 Q
112 ;
113DELGRP(DDSFRM) ;Uncompile a form and all forms that use any of the blocks
114 ;on that form
115 N DDSLST
116 D FRMLST(DDSFRM,.DDSLST)
117 ;
118 ;Uncompile all forms in DDSLST
119 S DDSFRM=0 F S DDSFRM=$O(DDSLST(DDSFRM)) Q:'DDSFRM D DEL(DDSFRM)
120 Q
121 ;
122ENLIST(DDSROOT) ;Compile all forms in @DDSROOT
123 N DDSFRM
124 S DDSFRM=0 F S DDSFRM=$O(@DDSROOT@(DDSFRM)) Q:'DDSFRM D EN(DDSFRM)
125 Q
126 ;
127FRMLST(DDSFRM,DDSLST) ;Build list of forms that contain blocks on this form
128 N DDSPG,DDSBK
129 S DDSPG=0 F S DDSPG=$O(^DIST(.403,DDSFRM,40,DDSPG)) Q:'DDSPG D
130 . D BLDLST($P($G(^DIST(.403,DDSFRM,40,DDSPG,0)),U,2),.DDSLST)
131 . S DDSBK=0 F S DDSBK=$O(^DIST(.403,DDSFRM,40,DDSPG,40,DDSBK)) Q:'DDSBK D
132 .. D BLDLST($P($G(^DIST(.403,DDSFRM,40,DDSPG,40,DDSBK,0)),U),.DDSLST)
133 Q
134 ;
135BLDLST(DDSBK,DDSLST) ;Build list of forms that contain a given block
136 N DDSFRM
137 Q:'$G(DDSBK)
138 S DDSFRM=0 F S DDSFRM=$O(^DIST(.403,"AB",DDSBK,DDSFRM)) Q:'DDSFRM S DDSLST(DDSFRM)=""
139 S DDSFRM=0 F S DDSFRM=$O(^DIST(.403,"AC",DDSBK,DDSFRM)) Q:'DDSFRM S DDSLST(DDSFRM)=""
140 Q
141 ;
142DELALL ;Delete compile global for all forms
143 N DDSFRM,DDSFNUM,DDSREFS
144 W:'$D(DDSQUIET) !,"Deleting compiled form data ...",!
145 ;
146 S DDSFNUM=0
147 F S DDSFNUM=$O(^DIST(.403,DDSFNUM)) Q:'DDSFNUM D
148 . Q:$D(^DIST(.403,DDSFNUM,0))[0
149 . S DDSFRM=DDSFNUM_U_$P(^DIST(.403,DDSFNUM,0),U)
150 . W:'$D(DDSQUIET) !?3,$P(DDSFRM,U,2),?35,"(#"_+DDSFRM_")"
151 . D DEL(DDSFRM)
152 Q
153 ;
154DEL(DDSFRM) ;Delete compiled global
155 N DDSREFS
156 S DDSREFS=$$REF^DDS0(DDSFRM) K @DDSREFS
157 S $P(^DIST(.403,+DDSFRM,0),U,11)=""
158 Q
159 ;
160ERR(DDSFRM,DDSREFS) ;Print error, kill compiled global
161 Q:'$G(DIERR)
162 N DDSNAM
163 S DDSNAM=$P(DDSFRM,U,2)
164 S:DDSNAM="" DDSNAM=$P($G(^DIST(.403,+DDSFRM,0)),U)
165 D BLD^DIALOG(3002,DDSNAM)
166 S $P(^DIST(.403,+DDSFRM,0),U,11)=""
167 K @DDSREFS
168 Q
Note: See TracBrowser for help on using the repository browser.