1: DDS ;SFISC/MLH,MKO-MAIN ROUTINE ;02:33 PM 15 Nov 1994
2: ;;21.0;VA FileMan;;Dec 28, 1994
3: ;Per VHA Directive 10-93-142, this routine should not be modified.
4: N DIE,DX,DY,X,Y
5: I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
6: ;
7: D EN^DDS0(.DDSFILE,DR,.DA)
8: I $G(DIERR) D:$G(DDSPARM)'["E" G END^DDS0
9: . W !,$C(7)_$$EZBLD^DIALOG(3000)
10: . D MSG^DIALOG("BW")
11: . S DIMSG=""
12: ;
13: N DR
14: X:$G(^DIST(.403,+DDS,11))'?."^" ^(11)
15: F D PG Q:DDACT="Q"
16: X:$G(^DIST(.403,+DDS,12))'?."^" ^(12)
17: ;
18: D:$G(@DDSREFT@("HLP"))>0 HLP^DDSMSG()
19: G END^DDS0
20: ;
21: PROC ;Main loop
22: F D PG Q:DDACT="Q"
23: Q
24: ;
25: PG ;Get DDSPOP and update DDSSC array
26: ;If we're going to another page
27: S DDACT="N"
28: I '$D(DDSPGUP) D
29: . S DDSLN=^DIST(.403,+DDS,40,DDSPG,0),DDSPOP=$P(DDSLN,U,6)
30: . K:'DDSPOP DDSSC
31: . I '$D(DDSSC("B",DDSPG)) D
32: .. S DDSSC=$G(DDSSC)+1,DDSSC(DDSSC)=DDSPG,DDSSC("B",DDSPG,DDSSC)=""
33: .. S:DDSPOP $P(DDSSC(DDSSC),U,2,3)=$P(DDSLN,U,3)_U_$P(DDSLN,U,7)
34: .. I $G(DDSSTK) S $P(DDSSC(DDSSC),U,4)=1 K DDSSTK
35: .. K DDSPOP
36: . E D
37: .. Q:$P($G(DDSSC(+$G(DDSSC))),U)=DDSPG
38: .. N I,J,S
39: .. S I=$O(DDSSC("B",DDSPG,"")),S=DDSSC(I) K DDSSC("B",DDSPG,I)
40: .. F J=I:1:DDSSC-1 D
41: ... K DDSSC("B",$P(DDSSC(J+1),U),J)
42: ... S DDSSC(J)=DDSSC(J+1),DDSSC("B",$P(DDSSC(J),U),J)=""
43: .. S DDSSC(DDSSC)=S,DDSSC("B",DDSPG,DDSSC)=""
44: ;
45: ;If we've moving up from a pop-up page
46: E K DDSPGUP
47: ;
48: ;Pre-action, save old and get next page
49: S DDSOPB=DDSPG
50: I $G(^DIST(.403,+DDS,40,DDSPG,11))'?."^" D PA(^(11)) Q:DDACT="NP"
51: S DDSNP=$$NP^DDS5(.Y) S:'Y DDSNP=""
52: ;
53: ;Load page
54: D ^DDS1(DDSPG)
55: I $G(DIERR) D Q
56: . N P S P(1)=$P($G(^DIST(.403,+DDS,40,DDSPG,0)),U),P(2)=$P($G(^(1)),U)
57: . S:P(2)="" P(2)="unnamed"
58: . D BLD^DIALOG(3041,.P),ERR^DDSMSG
59: . S DDACT="Q"
60: ;
61: ;Get DDO and DDSBK
62: I $S($D(DDSBR)[0:1,1:$D(@DDSREFS@(DDSPG,$S(DDO:+DDSBK,1:0),DDO,"N"))[0) D
63: . S DDO=+@DDSREFS@(DDSPG,"FIRST"),DDSBK=$P(^("FIRST"),",",2)
64: I 'DDSBK D Q
65: . D BLD^DIALOG(3055,"number "_$P($G(^DIST(.403,+DDS,40,DDSPG,0)),U)_$S($G(^(1))]"":" ("_$P($G(^(1)),U)_")",1:""))
66: . S DDACT="Q"
67: ;
68: ;Paint the page
69: D RP^DDSR(DDSSC(DDSSC),DDSSC=1)
70: ;
71: P1 F D BLK Q:"^Q^NP^"[(U_DDACT_U)
72: ;
73: ;Post action, print any help
74: D:$G(^DIST(.403,+DDS,40,+DDSOPB,12))'?."^" PA(^(12))
75: D:$G(@DDSREFT@("HLP"))>0 HLP^DDSMSG()
76: G:"^NB^N^"[(U_DDACT_U) P1
77: ;
78: I DDACT="Q" D
79: . I '$P(DDSSC(DDSSC),U,4) D
80: .. D:$G(DDSSEL) GDA^DDSRSEL
81: .. D:$G(DDSSC)>1 CLEAR^DDSBOX($P(DDSSC(DDSSC),U,2),$P(DDSSC(DDSSC),U,3))
82: .. S:DDSSC>1 DDSPG=$P(DDSSC(DDSSC-1),U),DDACT="N",DDSPGUP=1
83: . K DDSSC("B",$P(DDSSC(DDSSC),U),DDSSC),DDSSC(DDSSC) S DDSSC=DDSSC-1
84: Q
85: ;
86: BLK S DDACT="N",DDSOSV=0
87: ;
88: I $D(@DDSREFS@(DDSPG,DDSBK))[0 S DDACT="Q" Q
89: S DDSLN=@DDSREFS@(DDSPG,DDSBK)
90: ;
91: S DDSDN=$P(DDSLN,U,4),DDSTP=$P(DDSLN,U,5)
92: S DDSREP=$P(DDSLN,U,7),DDSPTB=$P(DDSLN,U,8)
93: K:'DDSDN DDSDN K:DDSTP="e" DDSTP K:'DDSPTB DDSPTB K:DDSREP'>1 DDSREP
94: ;
95: I $D(DDSPTB)!$D(DDSREP) N DDP,DDSDA,DIE D
96: . S DDP=$P(DDSLN,U,3)
97: . S DDSDA=$P(@DDSREFT@(DDSPG,DDSBK),U) Q:DDSDA=""
98: . S DIE=@DDSREFT@(DDSPG,DDSBK,DDSDA,"GL")
99: ;
100: I $D(DDSPTB) N DA,@$$D0(DDSDL),DDSDL D
101: . S DDSPTB=@DDSREFS@(DDSPG,DDSBK,"PTB")
102: . S DDSDL=$L(DDSDA,",")-2
103: . S (D0,DA)=+DDSDA
104: ;
105: I $D(DDSREP) N DDSDL,DA D
106: . S DDSREP=$P(@DDSREFT@(DDSPG,DDSBK,DDSDA),U,2,999)
107: . S DDSDL=$L(DDSDA,",")-1
108: . S DDSDA=$G(@DDSREFT@(DDSPG,DDSBK,$P(DDSREP,U),$P(DDSREP,U,4)),"0,"_DDSDA)
109: I N @$$D0(DDSDL) D
110: . D BLDDA(DDSDA)
111: . S:'DA DDO=+$P(DDSREP,U,8)
112: ;
113: I $D(DDSPTB),DDSDA="" D Q
114: . S DDSBK=$$NB^DDS5(.Y) Q:Y
115: . I DDSNP]"" S DDSPG=DDSNP,DDACT="NP" Q
116: . S DDSPG=$$PP^DDS5(.Y) I Y S DDACT="NP" Q
117: ;
118: S $P(DDSOPB,U,2)=DDSBK
119: I $G(^DIST(.403,+DDS,40,DDSPG,40,DDSBK,11))'?."^" D PA(^(11)) Q:DDACT="NP"
120: I $G(^DIST(.404,DDSBK,11))'?."^" D PA(^(11)) Q:DDACT="NP"
121: I $S($D(DDSBR)[0:1,1:$D(@DDSREFS@(DDSPG,$S(DDO:+DDSBK,1:0),DDO,"N"))[0) D
122: . S DDO=$P(@DDSREFS@(DDSPG,DDSBK),U,9)
123: K DDSLN
124: ;
125: B1 D ^DDS01
126: ;
127: I $G(^DIST(.403,+DDS,40,DDSPG,40,$P(DDSOPB,U,2),12))'?."^" D PA(^(12)) G:DDACT="N" B1
128: I $G(^DIST(.404,$P(DDSOPB,U,2),12))'?."^" D PA(^(12)) G:DDACT="N" B1
129: Q
130: ;
131: BLDDA(DDSDA) ;
132: N I
133: S (DA,@("D"_DDSDL))=$P(DDSDA,",")
134: F I=1:1:DDSDL S (DA(I),@("D"_(DDSDL-I)))=$P(DDSDA,",",I+1)
135: Q
136: ;
137: D0(DL) ;Given DL, return string D0,D1,...,Dn
138: N I,S
139: S S="" F I=0:1:DL S S=S_"D"_I_","
140: S:S?.E1"," S=$E(S,1,$L(S)-1)
141: Q S
142: ;
143: CLRMSG ;
144: K DDQ S DDSH=1,(DDM,DX)=0,DY=DDSHBX+1 X DDXY W $P(DDGLCLR,DDGLDEL,3)
145: Q
146: ;
147: PA(DDSPA) ;
148: N DDSBRORG S:$D(DDSBR)#2 DDSBRORG=DDSBR
149: K DDSBR X DDSPA
150: I $D(DDSBR)[0 S:$D(DDSBRORG)#2 DDSBR=DDSBRORG Q
151: D BR^DDS2
152: Q
153: RESET ;Programmer entry point to reset terminal and cleanup
154: D INIT^DDGLIB0() D:$G(DIERR) MSG^DIALOG("BW")
155: W $P($G(DDGLVID),DDGLDEL,10)
156: K DDSPARM
157: S DDSREFT="^TMP(""DDS"",$J)"
158: D END^DDS0
159: G RESET^DDGF
160: ;
161: RUN ;Run a form
162: G ^DDSRUN
163: CLONE ;Clone a form
164: G ^DDSCLONE
165: PRINT ;Print a form
166: G ^DDSPRNT
167: DFRM ;Delete a form
168: G ^DDSDFRM
169: DBLK ;Delete unused blocks
170: G ^DDSDBLK
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDS.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman / USER