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

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

initial load of WorldVistAEHR
File size: 6.9 KB
RevLine 
[613]1DIKKUTL ;SFISC/MKO-UTILITY OPTION TO DEFINE A KEY ;8:13 AM 7 Jun 2001
2 ;;22.0;VA FileMan;**68**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4MOD ;Create/Modify/Edit a Key
5 ;In:
6 ; DI = selected top level file#
7 ; DIU = global root of file DI
8 N DIKKCNT,DIKKFILE,DIKKEY,DIKKQUIT,DIKKROOT,DIKKTOP
9 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
10 ;
11 ;Get subfile
12 S DIKKROOT=DIU,DIKKTOP=DI,DIKKFILE=$$SUB^DIKCU(DI)
13 S:'$G(DIKKFILE) DIKKFILE=DIKKTOP
14 ;
15REMOD ;Get and list keys on file DIKKFILE
16 I $G(DIKKQUIT) W ! Q
17 D GET^DIKKUTL2(DIKKFILE,.DIKKCNT)
18 W ! D LIST^DIKKUTL2(.DIKKCNT)
19 ;
20 ;Prompt for action
21 I 'DIKKCNT S Y="C"
22 E S Y=$$RD Q:Y=""
23 ;
24 ;Delete
25 I Y="D" D G REMOD
26 . S DIKKEY=$$CHOOSE^DIKKUTL2(.DIKKCNT,"delete") Q:'DIKKEY
27 . D DELETE(DIKKEY,DIKKTOP,DIKKFILE)
28 ;
29 ;Edit
30 I Y="E" D G REMOD
31 . S DIKKEY=$$CHOOSE^DIKKUTL2(.DIKKCNT,"edit") Q:'DIKKEY
32 . D EDIT(DIKKEY,DIKKTOP,DIKKFILE)
33 ;
34 ;Create
35 I Y="C" D G REMOD
36 . S DIR(0)="Y",DIR("B")="No"
37 . S DIR("A")="Want to create a new Key for this file"
38 . D ^DIR K DIR I $D(DIRUT)!'Y S:'DIKKCNT DIKKQUIT=1 Q
39 . D CREATE^DIKKUTL1(DIKKTOP,DIKKFILE)
40 ;
41 ;Verify
42 I Y="V" D G REMOD
43 . S DIKKEY=$$CHOOSE^DIKKUTL2(.DIKKCNT,"verify") Q:'DIKKEY
44 . D VERIFY^DIKKUTL3(DIKKEY,DIKKTOP,DIKKFILE)
45 Q
46 ;
47DELETE(DIKKEY,DIKKTOP,DIKKFILE) ;Delete a Key
48 N DIKKID,DIKKUI,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
49 ;
50 ;Confirm deletion
51 S DIR(0)="Y"
52 S DIR("A")="Are you sure you want to delete the Key"
53 S DIR("B")="No"
54 D ^DIR K DIR Q:$D(DIRUT)!'Y
55 ;
56 ;Delete
57 S DIKKUI=$P($G(^DD("KEY",DIKKEY,0)),U,4)
58 S DIKKID=$$KEYID(DIKKEY,DIKKTOP,DIKKFILE)
59 D DELKEY(DIKKEY,DIKKID)
60 ;
61 ;Ask/Delete Uniqueness Index
62 I DIKKUI,'$D(^DD("KEY","AU",DIKKUI)) D
63 . D DELUI(DIKKUI,DIKKTOP,DIKKFILE,DIKKID)
64 Q
65 ;
66EDIT(DIKKEY,DIKKTOP,DIKKFILE) ;Edit a Key
67 N DIKKCH,DIKKFLD,DIKKID,DIKKNO,DIKKOLD,DIKKUI0,DIKKUI1,DIKKUFLD
68 N DA,DDSFILE,DR
69 ;
70REEDIT ;Come back here, if user chooses to re-edit the key
71 S DIKKID=$$KEYID(DIKKEY,DIKKTOP,DIKKFILE)
72 ;
73 ;Save original UI, and set and kill logic of original UI
74 ;Invoke form to edit key
75 ;Set new UI
76 S DIKKUI0=$P($G(^DD("KEY",DIKKEY,0)),U,4)
77 K DIKKOLD
78 D:DIKKUI0 LOADXREF^DIKC1(DIKKFILE,"","K",DIKKUI0,"","DIKKOLD")
79 S DDSFILE=.31,DA=DIKKEY,DR="[DIKK EDIT]"
80 D ^DDS K DDSFILE,DA,DR
81 S DIKKUI1=$P($G(^DD("KEY",DIKKEY,0)),U,4)
82 ;
83 ;If UI was edited, rebuild it
84 I DIKKUI0,DIKKUI0=DIKKUI1 D
85 . N DIKKNEW,DIKKFLIS
86 . Q:$G(DIKKOLD(DIKKFILE,DIKKUI0,"K"))=$G(^DD("IX",DIKKUI1,2))
87 . W !,$C(7)_"The definition of the Uniqueness Index was modified."
88 . D LOADXREF^DIKC1(DIKKFILE,"","S",DIKKUI0,"","DIKKNEW")
89 . D GETFLIST^DIKCUTL(DIKKUI0,.DIKKFLIS)
90 . D KSC^DIKCUTL3(DIKKTOP,.DIKKOLD,.DIKKNEW,.DIKKFLIS)
91 K DIKKOLD
92 ;
93 ;If there was an old UI, and it's '= to new UI, ask/delete old UI
94 I DIKKUI0,DIKKUI0'=DIKKUI1 D
95 . D DELUI(DIKKUI0,DIKKTOP,DIKKFILE,DIKKID,DIKKEY)
96 ;
97 ;Quit if key was deleted.
98 Q:$D(^DD("KEY",DIKKEY,0))[0
99 ;
100 ;Get fields in key and new UI
101 D GETFLD^DIKKUTL2(DIKKEY,DIKKUI1,.DIKKFLD,.DIKKUFLD)
102 ;
103 ;If key has no fields and no UI, ask reedit/delete key
104 I 'DIKKFLD,'DIKKUI1 D G:DIKKCH<2 REEDIT Q
105 . S DIKKCH=$$EORD^DIKKUTL4(DIKKID) Q:DIKKCH'=2
106 . D DELKEY(DIKKEY,DIKKID)
107 ;
108 ;If key has fields but no UI, create one.
109 I DIKKFLD,'DIKKUI1 D G:DIKKCH=1 REEDIT Q:DIKKCH=2 G EDITEND
110 . F D Q:DIKKCH'=3
111 .. S DIKKCH=0
112 .. D UICREATE^DIKKUTL1(DIKKEY,DIKKTOP,DIKKFILE,.DIKKNO)
113 .. Q:'$G(DIKKNO)
114 .. ;
115 .. ;User aborted Uniqueness Index creation;
116 .. ;Ask edit key/delete key/create UI
117 .. W ! S DIKKCH=$$EDORC^DIKKUTL4 Q:DIKKCH'=2
118 .. D DELKEY(DIKKEY,DIKKID)
119 ;
120 ;If neither key nor UI has fields, ask reedit/delete key
121 I 'DIKKFLD,'DIKKUFLD D G:DIKKCH<2 REEDIT Q
122 . S DIKKCH=$$EORD^DIKKUTL4(DIKKID,1) Q:DIKKCH'=2
123 . D DELKEY(DIKKEY,DIKKID)
124 ;
125 ;Compare fields in Key with fields in Uniqueness Index; quit if same
126 G:$$GCMP^DIKCU2("DIKKFLD","DIKKUFLD") EDITEND
127 ;
128 ;Key has a UI but no fields; or fields and UI don't match.
129 ;Prompt re-edit/make key fields match UI/or make UI match key fields
130 S DIKKCH=$$RORM^DIKKUTL4(DIKKUFLD,DIKKFLD)
131 ;
132 ;Re-edit
133 I DIKKCH=1 G REEDIT
134 ;
135 ;Make key fields match UI
136 E I DIKKCH=2 D
137 . ;Delete all fields in Key
138 . W !!," Modifying fields in Key ..."
139 . N DA,DIK
140 . S DIK="^DD(""KEY"","_DIKKEY_",2,",DA(1)=DIKKEY
141 . S DA=0 F S DA=$O(^DD("KEY",DIKKEY,2,DA)) Q:'DA D ^DIK
142 . K DA,DIK
143 . ;
144 . ;Add fields to Key
145 . N DIKKFDA,DIKKIENS,DIKKSEQ
146 . S DIKKSEQ=0 F S DIKKSEQ=$O(DIKKUFLD(DIKKSEQ)) Q:'DIKKSEQ D
147 .. S DIKKIENS="+"_DIKKSEQ_","_DIKKEY_","
148 .. S DIKKFDA(.312,DIKKIENS,.01)=$P(DIKKUFLD(DIKKSEQ),U,2)
149 .. S DIKKFDA(.312,DIKKIENS,.02)=$P(DIKKUFLD(DIKKSEQ),U)
150 .. S DIKKFDA(.312,DIKKIENS,1)=DIKKSEQ
151 . D UPDATE^DIE("","DIKKFDA")
152 . I '$D(DIERR) W " DONE!"
153 . E D MSG^DIALOG(),EOP
154 ;
155 ;Make UI match key fields
156 E I DIKKCH=3 D UIMOD^DIKKUTL1(DIKKUI1,DIKKEY,DIKKTOP,DIKKFILE)
157 ;
158EDITEND ;
159 S DIKKCH=$$CHECK Q:'DIKKCH
160 ;
161 W !!,"Checking key integrity ..."
162 I $$INTEG^DIKK(DIKKTOP,"","",DIKKEY) W " NO PROBLEMS" D EOP Q
163 ;
164 S DIKKCH=$$EDORI^DIKKUTL4
165 I DIKKCH=2 G REEDIT
166 I DIKKCH=1 D DELETE(DIKKEY,DIKKTOP,DIKKFILE)
167 Q
168 ;
169DELUI(DIKKUI,DIKKTOP,DIKKFILE,DIKKID,DIKKEY) ;Delete the Uniqueness Index
170 N I,MSG
171 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
172 ;
173 ;If DIKKEY is passed in, quit if any key other than DIKKEY uses
174 ;this index as a Uniqueness Index. (Index can't be deleted.)
175 I $G(DIKKEY) D Q:I
176 . S I=0 F S I=$O(^DD("KEY","AU",DIKKUI,I)) Q:'I Q:I'=DIKKEY
177 ;
178 S MSG(0)="Do you want to delete the "_$$UIID(DIKKUI,DIKKTOP,DIKKFILE)_" previously used by "_$S($G(DIKKID)]"":DIKKID,1:"the Key")
179 D WRAP^DIKCU2(.MSG)
180 S DIR(0)="Y"
181 F I=0:1 Q:'$D(MSG(I+1)) S DIR("A",I+1)=MSG(I)
182 S DIR("A")=MSG(I)
183 W ! D ^DIR K DIR S:$D(DTOUT) Y=1 Q:$D(DUOUT)!'Y
184 D DELETE^DIKCUTL(DIKKUI,DIKKTOP,DIKKFILE)
185 Q
186 ;
187DELKEY(DA,DIKKID) ;Call DIK to delete the key
188 N DIK
189 S DIK="^DD(""KEY""," D ^DIK
190 W !!?2,$G(DIKKID)_" deleted."
191 Q
192 ;
193UIID(UI,TOP,FILE) ;Return text that identifies uniqueness index
194 Q:$D(^DD("IX",UI,0))[0 ""
195 Q "'"_$P(^DD("IX",UI,0),U,2)_"' Uniqueness Index (#"_UI_") on "_$S(TOP'=FILE:"Subf",1:"F")_"ile #"_$P(^(0),U)
196 ;
197KEYID(KEY,TOP,FILE) ;Return string of text that identifies the key
198 Q "Key '"_$P(^DD("KEY",KEY,0),U,2)_"' of "_$S(TOP'=FILE:"Subf",1:"F")_"ile #"_$P(^(0),U)
199 ;
200RD() ;Prompt for action
201 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
202 S DIR(0)="SAO^V:VERIFY;E:EDIT;D:DELETE;C:CREATE"
203 S DIR("A")="Choose V (Verify)/E (Edit)/D (Delete)/C (Create): "
204 S DIR("?",1)="Enter 'V' to verify the integrity of a Key."
205 S DIR("?",2)=" 'E' to edit an existing Key"
206 S DIR("?",3)=" 'D' to delete an existing Key"
207 S DIR("?",4)=" 'C' to create a new Key."
208 W ! D ^DIR S:$D(DIRUT) Y=""
209 Q Y
210 ;
211EOP ;Issue Press Return to continue prompt
212 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
213 S DIR(0)="E",DIR("A")="Press RETURN to continue"
214 S DIR("?")="Press the RETURN or ENTER key."
215 W ! D ^DIR
216 Q
217 ;
218CHECK() ;Prompt whether to check key integrity
219 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
220 S DIR("A")="Do want to check the integrity of this key now"
221 S DIR("?")="Enter 'Y' to run the key integrity checker."
222 S DIR(0)="Y"
223 W ! D ^DIR
224 Q $S($D(DIRUT):0,1:Y)
Note: See TracBrowser for help on using the repository browser.