Annotation of freem_fileman/DDSZ.m, revision 1.1.1.1
1.1 snw 1: DDSZ ;SFISC/MKO-FORM COMPILER ;11:26 AM 16 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: ;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: ;
19: ALL ;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: ;
34: EN(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: ;
50: PG(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: ;
69: END K DDSB,DDSBO,DDSMUL,DDSNAV,DDSORD
70: K DDSP,DDSPX,DDSPY,DDSREP,DDSRNAV,DDSSCR
71: Q
72: ;
73: BLK(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: ;
104: DELALL ;Delete compile global for all forms
105: N DDSFRM,DDSFNUM,DDSREFS
106: W:'$D(DDSQUIET) !,"Deleting compiled form data ...",!
107: ;
108: S DDSFNUM=0
109: F S DDSFNUM=$O(^DIST(.403,DDSFNUM)) Q:'DDSFNUM D
110: . Q:$D(^DIST(.403,DDSFNUM,0))[0
111: . S DDSFRM=DDSFNUM_U_$P(^DIST(.403,DDSFNUM,0),U)
112: . S DDSREFS=$$REF^DDS0(DDSFRM)
113: . W:'$D(DDSQUIET) !?3,$P(DDSFRM,U,2),?35,"(#"_+DDSFRM_")"
114: . D DEL(DDSFRM)
115: Q
116: ;
117: DEL(DDSFRM) ;Delete compiled global
118: N DDSREFS
119: S DDSREFS=$$REF^DDS0(DDSFRM) K @DDSREFS
120: S $P(^DIST(.403,+DDSFRM,0),U,11)=""
121: Q
122: ;
123: ERR(DDSFRM,DDSREFS) ;Print error, kill compiled global
124: Q:'$G(DIERR)
125: N DDSNAM
126: S DDSNAM=$P(DDSFRM,U,2)
127: S:DDSNAM="" DDSNAM=$P($G(^DIST(.403,+DDSFRM,0)),U)
128: D BLD^DIALOG(3002,DDSNAM)
129: S $P(^DIST(.403,+DDSFRM,0),U,11)=""
130: K @DDSREFS
131: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDSZ.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman