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

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1DIKCUTL ;SFISC/MKO-UTILITY OPTION TO MODIFY INDEX ;2:57 PM 25 Apr 2002
2 ;;22.0;VA FileMan;**68,108**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5MOD ;Utility option to modify an index
6 N DIKCCNT,DIKCFILE,DIKCQUIT,DIKCROOT,DIKCTOP,DIXR
7 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
8 ;
9 ;Prompt for file
10 D SELFILE^DIKCU(.DIKCROOT,.DIKCTOP,.DIKCFILE)
11 Q:$G(DIKCROOT)="" Q:'$G(DIKCTOP)
12 S:'$G(DIKCFILE) DIKCFILE=DIKCTOP
13 ;
14REMOD ;Get and list indexes
15 I $G(DIKCQUIT) W ! Q
16 D GETXR^DIKCUTL2(DIKCFILE,.DIKCCNT)
17 W ! D LIST^DIKCUTL2(.DIKCCNT)
18 ;
19 ;Prompt for action
20 I 'DIKCCNT S Y="C"
21 E D RD^DICD I $D(DIRUT) W ! Q
22 ;
23 ;Delete
24 I Y="D" D G REMOD
25 . S DIXR=$$CHOOSE^DIKCUTL2(.DIKCCNT,"delete") Q:'DIXR
26 . I $D(^DD("KEY","AU",DIXR)) W ! D PRTMSG^DIKCUTL2(DIXR) Q
27 . S DIR(0)="Y"
28 . S DIR("A")="Are you sure you want to delete the index definition"
29 . S DIR("B")="NO"
30 . D ^DIR K DIR Q:$D(DIRUT)!'Y
31 . D DELETE(DIXR,DIKCTOP,DIKCFILE)
32 ;
33 ;Edit
34 I Y="E" D G REMOD
35 . S DIXR=$$CHOOSE^DIKCUTL2(.DIKCCNT,"edit") Q:'DIXR
36 . D EDIT(DIXR,DIKCTOP,DIKCFILE)
37 ;
38 ;Create
39 I Y="C" D G REMOD
40 . S DIR(0)="Y",DIR("B")="No"
41 . S DIR("A")="Want to create a new index for this file"
42 . D ^DIR K DIR I $D(DIRUT)!'Y S:'DIKCCNT DIKCQUIT=1 Q
43 . D CREATE^DIKCUTL1(DIKCTOP,DIKCFILE)
44 Q
45 ;
46DELETE(DIXR,DIKCTOP,DIKCFILE) ;Delete an index
47 N DA,DIK,DIKCFLIS,DIKCOLD
48 D GETFLIST(DIXR,.DIKCFLIS)
49 D LOADXREF^DIKC1(DIKCFILE,"","K",DIXR,"","DIKCOLD")
50 ;
51 ;Delete the index
52 S DIK="^DD(""IX"",",DA=DIXR D ^DIK K DIK,DA
53 W !!," Index definition deleted."
54 ;
55 ;Run kill logic, recompile
56 D KSC^DIKCUTL3(DIKCTOP,.DIKCOLD,"",.DIKCFLIS)
57 Q
58 ;
59EDIT(DIXR,DIKCTOP,DIKCFILE) ;Edit an index
60 N DA,DDSCHANG,DDSFILE,DDSPARM,DR
61 N DIKCFLIS,DIKCNEW,DIKCOLD,DIKCREB
62 ;
63 ;Save original fields list and logic
64 D GETFLIST(DIXR,.DIKCFLIS)
65 D LOADXREF^DIKC1(DIKCFILE,"","KS",DIXR,"","DIKCOLD")
66 ;
67 ;Invoke form to edit, quit if there were no changes
68 S DDSFILE=.11,DA=DIXR,DDSPARM="C"
69 S DR="[DIKC EDIT"_$S($D(^DD("KEY","AU",DIXR)):" UI]",1:"]")
70 D ^DDS Q:'$G(DDSCHANG) K DDSFILE,DA,DDSPARM,DR
71 ;
72 ;If index was deleted, run kill logic, recompile and quit
73 I $D(^DD("IX",DIXR,0))[0 D Q
74 . K DIKCOLD(DIKCFILE,DIXR,"S"),DIKCOLD(DIKCFILE,DIXR,"SC")
75 . D KSC^DIKCUTL3(DIKCTOP,.DIKCOLD,"",.DIKCFLIS)
76 ;
77 ;Rebuild the set/kill logic if a crv was deleted,
78 ;but form was not saved.
79 ;Deleting a crv sets DIKCREB; saving the form, kills it.
80 D:$G(DIKCREB) BLDLOG^DIKCUTL2(DIXR)
81 ;
82 ;Load new logic; quit if equal to old logic
83 D LOADXREF^DIKC1(DIKCFILE,"","KS",DIXR,"","DIKCNEW")
84 Q:$$GCMP^DIKCU2("DIKCOLD","DIKCNEW")
85 ;
86 ;Run old kill logic and new set logic.
87 ;Add new fields to list, and recompile input templates and xrefs.
88 D GETFLIST(DIXR,.DIKCFLIS)
89 K DIKCOLD(DIKCFILE,DIXR,"S"),DIKCOLD(DIKCFILE,DIXR,"SC")
90 D KSC^DIKCUTL3(DIKCTOP,.DIKCOLD,.DIKCNEW,.DIKCFLIS)
91 Q
92 ;
93 ;============================
94 ;GETFLIST(index#,.fieldList)
95 ;============================
96 ;Loop through Cross Reference Values multiple and
97 ;build list of fields used in Index XR. (Existing items in fieldList
98 ;array are NOT deleted.)
99 ;In:
100 ; XR = Index ien
101 ;Out:
102 ; FLIST(file#,field#) = ""
103 ;
104GETFLIST(XR,FLIST) ;
105 N FIL,FLD,I
106 S I=0 F S I=$O(^DD("IX",XR,11.1,I)) Q:'I D
107 . Q:$P($G(^DD("IX",XR,11.1,I,0)),U,2)'="F"
108 . S FIL=$P(^DD("IX",XR,11.1,I,0),U,3),FLD=$P(^(0),U,4) Q:'FIL Q:'FLD
109 . S FLIST(FIL,FLD)=""
110 Q
Note: See TracBrowser for help on using the repository browser.