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

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

initial load of WorldVistAEHR
File size: 4.8 KB
RevLine 
[613]1DDGFU ;SFISC/MKO-CALLED FROM THE FORMS ;10:49 AM 27 Jul 1995
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5VAL1 ;Data validation code
6 ;Form: DDS FIELD ADD
7 I $$GET^DDSVALF("BLOCK","DDGF FIELD ADD")]"",$$GET^DDSVALF("FIELD ORDER","DDGF FIELD ADD")]"",$$GET^DDSVALF("FIELD TYPE","DDGF FIELD ADD")]"" Q
8 ;
9 S DDGFT(1)=$C(7)_"Unable to save values."
10 S DDGFT(2)="All values must be filled in order to add a new field."
11 D HLP^DDSUTL(.DDGFT)
12 S DDSERROR=1
13 K DDGFT
14 Q
15 ;
16DDCAP ;Caption, Post action on change
17 ;Form: DDGF FIELD DD
18 N DDGFOPG
19 S DDGFOPG=$$OTHPG
20 D:DDSOLD="!M" PUT^DDSVAL(.4044,.DA,1.1,"")
21 ;
22 D:X="" CAPNULL(DDGFOPG)
23 D:X]"" UPDDC(DDGFOPG)
24 Q
25 ;
26OTHPG() ;Return Other Params page#
27 N FLD,SUB,OPG
28 S FLD=$$GET^DDSVAL(.4044,.DA,4)
29 I FLD D
30 . S OPG=11
31 . S SUB=+$P($G(^DD(DDGFDD,FLD,0)),U,2)
32 . S:SUB OPG=$S(SUB_$P($G(^DD(SUB,.01,0)),U,2)'["W":21,1:31)
33 Q $G(OPG)
34 ;
35FOCAP ;Caption, Post action on change
36 ;Form: DDGF FIELD FORM ONLY
37 D:X'="!M" PUT^DDSVAL(.4044,.DA,1.1,"")
38 ;
39 D:X="" CAPNULL(21)
40 D:X]"" UPDDC(21)
41 Q
42 ;
43COMPCAP ;Caption, Post action on change
44 ;Form: DDGF FIELD COMPUTED
45 D:X'="!M" PUT^DDSVAL(.4044,.DA,1.1,"")
46 ;
47 D:X="" CAPNULL(11)
48 D:X]"" UPDDC(11)
49 Q
50 ;
51CAPNULL(OPG) ;Caption changed to null
52 N DC,SC
53 ;
54 ;Clear suppress colon
55 S SC=$$GET^DDSVALF("SUPPRESS COLON AFTER CAPTION?")
56 D PUT^DDSVALF("SUPPRESS COLON AFTER CAPTION?","","","","I")
57 Q:'$G(OPG)
58 ;
59 ;Clear caption coords
60 D PUT^DDSVALF("CAPTION COORDINATE",1,OPG,"")
61 ;
62 ;Move data to the left
63 S DC=$$GET^DDSVALF("DATA COORDINATE",1,OPG)
64 S $P(DC,",",2)=$P(DC,",",2)-$L(DDSOLD)-1-'SC
65 S:$P(DC,",",2)<1 $P(DC,",",2)=1
66 D PUT^DDSVALF("DATA COORDINATE",1,OPG,DC,"I")
67 Q
68 ;
69UPDDC(OPG) ;Update data coords
70 N DC,COL
71 S DC=$$GET^DDSVALF("DATA COORDINATE",1,OPG)
72 S COL=$P(DC,",",2),COL=COL+$L(X)-$L(DDSOLD)
73 I DDSOLD="" D
74 . D PUT^DDSVALF("CAPTION COORDINATE",1,OPG,DC,"I")
75 . S COL=COL+2
76 S:COL<1 COL=1
77 S $P(DC,",",2)=COL
78 D PUT^DDSVALF("DATA COORDINATE",1,OPG,DC)
79 Q
80 ;
81POSTCH1 ;Field, Post Action On Change
82 ;Form: DDGF FIELD DD
83 ;
84 ;Reset (if caption not !M): caption, caption and data coords,
85 ; data length
86 ;Input:
87 ; DDGFPG = Page #
88 ; DA(1) = Block #
89 ; DA = Field order
90 ; X = Fld #
91 ; DDSOLD = Prev fld #
92 ;
93 Q:X=""
94 N FILE,FLD,DD,C,C0,CC,DC,SC,L,OPG,OPG0,PLRC
95 ;
96 S FLD=X
97 S FILE=+$P(^DIST(.404,DA(1),0),U,2) Q:'FILE
98 S DD=$G(^DD(FILE,FLD,0)) Q:DD?."^"
99 S OPG=$$OTHPG
100 ;
101 S OPG0=11
102 I $G(DDSOLD)]"" D
103 . N SUB
104 . S SUB=+$P($G(^DD(FILE,DDSOLD,0)),U,2)
105 . S:SUB OPG0=$S(SUB_$P($G(^DD(SUB,.01,0)),U,2)'["W":21,1:31)
106 ;
107 S (C,C0)=$$GET^DDSVALF("CAPTION",1,1)
108 S:C]"" CC=$$GET^DDSVALF("CAPTION COORDINATE",1,OPG0)
109 S DC=$$GET^DDSVALF("DATA COORDINATE",1,OPG0)
110 ;
111 I OPG'=OPG0 D
112 . D:C]"" PUT^DDSVALF("CAPTION COORDINATE",1,OPG,CC)
113 . D:DC]"" PUT^DDSVALF("DATA COORDINATE",1,OPG,DC)
114 . D DESTROY^DDSUTL(OPG0)
115 .
116 ;
117 I $D(DDGFREF),$D(DDGFPG) S PLRC=$P($G(@DDGFREF@("F",DDGFPG)),U,4)
118 S PLRC=$S($G(PLRC)]"":PLRC-1,1:IOM-2)-$P($G(@DDGFREF@("F",DDGFPG,DA(1))),U,2)
119 S L=$$LENGTH(FILE,FLD) S:'L L=1
120 ;
121 I C'="!M",$P(DD,U)]"" D
122 . S C=$P(DD,U)
123 . I $P(DD,U,2),$P($G(^DD(+$P(DD,U,2),.01,0)),U,2)'["W" S C="Select "_C
124 . D PUT^DDSVALF("CAPTION",1,1,C)
125 . ;
126 . I C0="" D
127 .. S CC=DC
128 .. S $P(DC,",",2)=$P(DC,",",2)+2
129 .. D PUT^DDSVALF("CAPTION COORDINATE",1,OPG,CC)
130 . E Q:$P(CC,",")'=$P(DC,",")
131 . ;
132 . S $P(DC,",",2)=$P(DC,",",2)+$L(C)-$L(C0)
133 . S:$P(DC,",",2)<1 $P(DC,",",2)=1
134 . D PUT^DDSVALF("DATA COORDINATE",1,OPG,DC)
135 ;
136 I C0'="!M",$P(DC,",",2)-2+L>PLRC S L=PLRC-$P(DC,",",2)+2
137 D PUT^DDSVALF("DATA LENGTH",1,OPG,L)
138 Q
139 ;
140HBVAL ;Validate hdr blk
141 Q:X="" Q:'$O(@(DIE_DA_",40,""B"",X,"""")"))
142 S DDSERROR=1
143 D HLP^DDSUTL($C(7)_DDSEXT_" already exists on this page.")
144 Q
145 ;
146LENGTH(DIFILE,DIFLD) ;Find max field length
147 N DD,DIIT,DILEN,DITYPE
148 S DILEN=""
149 S DD=$G(^DD(DIFILE,DIFLD,0)) Q:DD?."^" DILEN
150 S DITYPE=$P(DD,U,2),DIIT=$P(DD,U,5,999)
151 ;
152 I DIIT["$L(X)>" S DILEN=+$P($P(DIIT,"$L(X)>",2,999),"E")
153 E I DITYPE["N" S DILEN=+$P(DITYPE,"J",2)
154 E I DITYPE["P" S DILEN=$$LENGTH(+$P(DITYPE,"P",2),.01)
155 ;
156 E I DITYPE["S" D
157 . N DICODE,DICODEA,DIPC
158 . S DICODE=$P(DD,U,3)
159 . F DIPC=1:1 S DICODEA=$P(DICODE,";",DIPC) Q:DICODEA="" D
160 .. S DILEN=$$MAX(DILEN,$L($P(DICODEA,":")),$L($P(DICODEA,":",2)))
161 ;
162 E I DITYPE["D" D
163 . N DIDT
164 . S DIDT=$P($P(DIIT,"S %DT=""",2,999),"""")
165 . S DILEN=$S(DIDT["S"&(DIDT["T"):20,DIDT["T":17,1:11)
166 ;
167 E I DITYPE["V" D
168 . N DIL,DIX
169 . S DIX=0 F S DIX=$O(^DD(DIFILE,DIFLD,"V",DIX)) Q:'DIX D
170 .. Q:'$G(^DD(DIFILE,DIFLD,"V",DIX,0))
171 .. S DIL=$G(DIL)+1
172 .. S DIL(DIL)=$$LENGTH(+^DD(DIFILE,DIFLD,"V",DIX,0),.01)
173 . S DILEN=$G(DIL(1))
174 . F DIL=1:1:$G(DIL)-1 S DILEN=$$MAX(DIL(DIL),DIL(DIL+1))
175 ;
176 E I DITYPE D
177 . Q:$D(^DD(+DITYPE,.01,0))[0
178 . S DILEN=$S($P(^DD(+DITYPE,.01,0),U,2)["W":1,1:$$LENGTH(+DITYPE,.01))
179 ;
180 Q DILEN
181 ;
182MAX(X,Y,Z) ;Return max of 2 or 3 numbers
183 N M
184 S M=$S(X>Y:+X,1:+Y),M=$S(M>$G(Z):M,1:+$G(Z))
185 Q M
Note: See TracBrowser for help on using the repository browser.