205 lines
6.4 KiB
Mathematica
205 lines
6.4 KiB
Mathematica
DIKKUTL1 ;SFISC/MKO-KEY CREATION ;10:08 AM 12 Jan 2001
|
|
;;22.0;VA FileMan;**68**;Mar 30, 1999
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
CREATE(DIKKTOP,DIKKFILE) ;Create a new key
|
|
N DIKKEY,DIKKFDA,DIKKNAME,DIKKIEN
|
|
;
|
|
;Prompt for name
|
|
S DIKKNAME=$$NAME(DIKKFILE) Q:DIKKNAME=-1
|
|
;
|
|
;Add new entry to Key file
|
|
W !," Creating new Key '"_DIKKNAME_"' ..."
|
|
S DIKKFDA(.31,"+1,",.01)=DIKKFILE
|
|
S DIKKFDA(.31,"+1,",.02)=DIKKNAME
|
|
S DIKKFDA(.31,"+1,",1)=$S($D(^DD("KEY","AP",DIKKFILE,"P")):"S",1:"P")
|
|
D UPDATE^DIE("","DIKKFDA","DIKKIEN") I $D(DIERR) D MSG^DIALOG() Q
|
|
;
|
|
S DIKKEY=DIKKIEN(1) K DIKKIEN
|
|
D EDIT^DIKKUTL(DIKKEY,DIKKTOP,DIKKFILE)
|
|
Q
|
|
;
|
|
UIMOD(DIXR,DIKKEY,DIKKTOP,DIKKFILE) ;Modify the UI to match the Key
|
|
N DIKKERR,DIKKFLD,DIKKFLIS,DIKKID,DIKKMSG,DIKKNEW,DIKKOLD
|
|
S DIKKID=$$KEYID(DIKKEY,DIKKTOP,DIKKFILE)
|
|
;
|
|
;Write message
|
|
W !!," Modifying Uniqueness Index ..."
|
|
;
|
|
;Get list of fields and original kill logic
|
|
D GETFLIST^DIKCUTL(DIXR,.DIKKFLIS)
|
|
D LOADXREF^DIKC1(DIKKFILE,"","K",DIXR,"","DIKKOLD")
|
|
;
|
|
;Get list of fields in key
|
|
D GETFLD(DIKKEY,.DIKKFLD)
|
|
;
|
|
;Stuff values into Uniqueness Index and fields into CRV multiple
|
|
D STUFF(DIXR,$P(^DD("IX",DIXR,0),U),DIKKFILE,$P(^(0),U,2),.DIKKFLD,DIKKID)
|
|
D DELCRV(DIXR)
|
|
D ADDCRV(DIXR,.DIKKFLD)
|
|
W " DONE!"
|
|
;
|
|
;Get list of fields and new set logic.
|
|
;Kill old and set new index, and recompile input templates and xrefs.
|
|
D GETFLIST^DIKCUTL(DIXR,.DIKKFLIS)
|
|
D LOADXREF^DIKC1(DIKKFILE,"","S",DIXR,"","DIKKNEW")
|
|
D KSC^DIKCUTL3(DIKKTOP,.DIKKOLD,.DIKKNEW,.DIKKFLIS)
|
|
Q
|
|
;
|
|
UICREATE(DIKKEY,DIKKTOP,DIKKFILE,DIKKNO) ;Create a new UI for key
|
|
;Returns DIKKNO=1 if the Index could not be created.
|
|
N DIERR,DIKKERR,DIKKFDA,DIKKFLIS,DIKKID,DIKKMSG,DIKKNAM,DIKKNEW,DIXR,I
|
|
;
|
|
K DIKKNO
|
|
S DIKKID=$$KEYID(DIKKEY,DIKKTOP,DIKKFILE)
|
|
;
|
|
;Write message
|
|
K DIKKMSG
|
|
S DIKKMSG(0)="I'm going to create a new Uniqueness Index to support "_DIKKID_"."
|
|
D WRAP^DIKCU2(.DIKKMSG)
|
|
W ! F I=0:1 Q:'$D(DIKKMSG(I)) W !,DIKKMSG(I)
|
|
K I,DIKKMSG
|
|
;
|
|
;Get Index Name and list of fields
|
|
S DIKKNAM=$$NAME^DIKCUTL1(DIKKFILE,"LS") I DIKKNAM=-1 S DIKKNO=1 Q
|
|
D GETFLD(DIKKEY,.DIKKFLD)
|
|
;
|
|
;Add uniqueness index to Index file, and fields into CRV multiple
|
|
D ADDUI(DIKKFILE,DIKKNAM,.DIXR) I DIXR=-1 S DIKKNO=1 Q
|
|
D STUFF(DIXR,DIKKFILE,DIKKFILE,DIKKNAM,.DIKKFLD,DIKKID)
|
|
D ADDCRV(DIXR,.DIKKFLD,.DIKKERR) I $G(DIKKERR) S DIKKNO=1 Q
|
|
;
|
|
;Set Uniqueness Index pointer in Key file
|
|
S DIKKFDA(.31,DIKKEY_",",3)=DIXR
|
|
D FILE^DIE("","DIKKFDA") I $D(DIERR) D MSG^DIALOG() S DIKKNO=1 Q
|
|
K DIKKFDA
|
|
;
|
|
;Get new field list and set logic.
|
|
;Set new index and recompile input templates and xrefs.
|
|
D GETFLIST^DIKCUTL(DIXR,.DIKKFLIS)
|
|
D LOADXREF^DIKC1(DIKKFILE,"","S",DIXR,"","DIKKNEW")
|
|
D KSC^DIKCUTL3(DIKKTOP,"",.DIKKNEW,.DIKKFLIS)
|
|
Q
|
|
;
|
|
ADDUI(DIKKFILE,DIKKNAM,DIXR) ;Add new entry to Index file
|
|
N DIKKFDA,DIKKIEN
|
|
W !!," One moment please ..."
|
|
S DIKKFDA(.11,"+1,",.01)=DIKKFILE
|
|
S DIKKFDA(.11,"+1,",.02)=DIKKNAM
|
|
D UPDATE^DIE("","DIKKFDA","DIKKIEN") I $D(DIERR) D MSG^DIALOG() Q
|
|
S DIXR=DIKKIEN(1)
|
|
Q
|
|
;
|
|
STUFF(DIXR,DIKKF01,DIKKFILE,DIKKNAM,DIKKFLD,DIKKID) ;Stuff other values into
|
|
;index
|
|
N DIERR,DIKKFDA,DIKKILL,DIKKSET,DIKKWKIL
|
|
;
|
|
;Build logic
|
|
D BLDLOG(DIKKF01,DIKKFILE,DIKKNAM,.DIKKFLD,.DIKKSET,.DIKKILL,.DIKKWKIL)
|
|
;
|
|
;Stuff values into other fields in Index file entry
|
|
S DIKKFDA(.11,DIXR_",",.11)="Uniqueness Index for "_DIKKID
|
|
S DIKKFDA(.11,DIXR_",",.2)="R"
|
|
S DIKKFDA(.11,DIXR_",",.4)=$S(DIKKFLD>1:"R",1:"F")
|
|
S DIKKFDA(.11,DIXR_",",.41)="IR"
|
|
S DIKKFDA(.11,DIXR_",",.42)="LS"
|
|
S DIKKFDA(.11,DIXR_",",.5)=$S(DIKKF01=DIKKFILE:"I",1:"W")
|
|
S DIKKFDA(.11,DIXR_",",.51)=DIKKFILE
|
|
S DIKKFDA(.11,DIXR_",",1.1)=DIKKSET
|
|
S DIKKFDA(.11,DIXR_",",2.1)=DIKKILL
|
|
S DIKKFDA(.11,DIXR_",",2.5)=DIKKWKIL
|
|
D FILE^DIE("","DIKKFDA")
|
|
I $D(DIERR) D MSG^DIALOG()
|
|
Q
|
|
;
|
|
ADDCRV(DIXR,DIKKFLD,DIKKERR) ;Add fields to Cross-Reference Values multiple
|
|
N DA,DD,DIC,DIERR,DIKKFDA,DIKKSS,DINUM,DO,X,Y
|
|
;
|
|
S DIC("P")=$P(^DD(.11,11.1,0),U,2)
|
|
F DIKKSS=1:1 Q:$D(DIKKFLD(DIKKSS))[0 D Q:$G(DIKKERR)
|
|
. ;Add subentry
|
|
. S DIC="^DD(""IX"","_DIXR_",11.1,",DIC(0)="QL",DA(1)=DIXR
|
|
. S (X,DINUM)=DIKKSS
|
|
. K DD,DO D FILE^DICN K DA,DIC,DINUM
|
|
. I Y=-1 S DIKKERR=1 Q
|
|
. ;
|
|
. ;Stuff other values
|
|
. S DIKKFDA(.114,DIKKSS_","_DIXR_",",.5)=DIKKSS
|
|
. S DIKKFDA(.114,DIKKSS_","_DIXR_",",1)="F"
|
|
. S DIKKFDA(.114,DIKKSS_","_DIXR_",",2)=$P(DIKKFLD(DIKKSS),U,2)
|
|
. S DIKKFDA(.114,DIKKSS_","_DIXR_",",3)=$P(DIKKFLD(DIKKSS),U)
|
|
. D FILE^DIE("","DIKKFDA")
|
|
. I $D(DIERR) D MSG^DIALOG() S DIKKERR=1
|
|
Q
|
|
;
|
|
DELCRV(DIXR) ;Delete all entries in CRV multiple
|
|
N DA,DIK
|
|
S DIK="^DD(""IX"","_DIXR_",11.1,",DA(1)=DIXR
|
|
S DA=0 F S DA=$O(^DD("IX",DIXR,11.1,DA)) Q:'DA D ^DIK
|
|
Q
|
|
;
|
|
GETFLD(KEY,FLD) ;Get list fields in key
|
|
;In:
|
|
; KEY = key #
|
|
;Out:
|
|
; FLD = # subscripts
|
|
; FLD(subscript#) = field^file
|
|
;
|
|
N DA,FD,FI,SQ
|
|
K FLD S (FLD,SQ)=0
|
|
F S SQ=$O(^DD("KEY",KEY,2,"S",SQ)) Q:'SQ D
|
|
. S FD=$O(^DD("KEY",KEY,2,"S",SQ,0)) Q:'FD
|
|
. S FI=$O(^DD("KEY",KEY,2,"S",SQ,FD,0)) Q:'FI
|
|
. S DA=$O(^DD("KEY",KEY,2,"S",SQ,FD,FI,0)) Q:'DA
|
|
. Q:$D(^DD("KEY",KEY,2,DA,0))[0
|
|
. S FLD=FLD+1,FLD(FLD)=FD_U_FI
|
|
Q
|
|
;
|
|
BLDLOG(DIKKF01,DIKKFILE,DIKKNAM,DIKKFLD,DIKKSET,DIKKILL,DIKKWKIL) ;
|
|
;Build the logic of the xref
|
|
N DIKKLDIF,DIKKROOT,DIKKSS,L
|
|
I 'DIKKFLD S (DIKKSET,DIKKILL)="Q",DIKKWKIL="" Q
|
|
;
|
|
;Build index root and entire kill logic
|
|
I DIKKF01'=DIKKFILE S DIKKLDIF=$$FLEVDIFF^DIKCU(DIKKF01,DIKKFILE)
|
|
E S DIKKLDIF=0
|
|
S DIKKROOT=$$FROOTDA^DIKCU(DIKKF01,DIKKLDIF_"O")_""""_DIKKNAM_""""
|
|
S DIKKWKIL="K "_DIKKROOT_")"
|
|
;
|
|
;Build root for set/kill logic
|
|
F DIKKSS=1:1 Q:$D(DIKKFLD(DIKKSS))[0 D
|
|
. S DIKKROOT=DIKKROOT_","_$S($G(DIKKFLD)=1:"X",1:"X("_DIKKSS_")")
|
|
;
|
|
;Append DA(n) to root
|
|
F L=DIKKLDIF:-1:1 S DIKKROOT=DIKKROOT_",DA("_L_")"
|
|
S DIKKROOT=DIKKROOT_",DA)"
|
|
;
|
|
;Build set/kill logic
|
|
S DIKKSET="S "_DIKKROOT_"=""""",DIKKILL="K "_DIKKROOT
|
|
Q
|
|
;
|
|
NAME(DIKKFILE) ;Get next available Key name
|
|
N DIKKNAME
|
|
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
|
;
|
|
S DIKKNAME=$O(^DD("KEY","BB",DIKKFILE,""),-1)
|
|
S DIKKNAME=$S(DIKKNAME="":"A",1:$C($A(DIKKNAME)+1))
|
|
;
|
|
S DIR(0)=".31,.02"
|
|
S DIR("A")="Enter a Name for the new Key"
|
|
S DIR("B")=DIKKNAME
|
|
W ! F D Q:$D(X)!$D(DIRUT)
|
|
. D ^DIR Q:$D(DIRUT)
|
|
. Q:'$D(^DD("KEY","BB",DIKKFILE,X))
|
|
. D NAMERR("A key already exists with this name.")
|
|
Q $S($D(DIRUT):-1,1:X)
|
|
;
|
|
NAMERR(MSG) ;Invalid Index Name error
|
|
W !!,$C(7)_$G(MSG),!
|
|
K X
|
|
Q
|
|
;
|
|
KEYID(KEY,TOP,FILE) ;Return string of text that identifies the key
|
|
Q "Key '"_$P(^DD("KEY",KEY,0),U,2)_"' of "_$S(TOP'=FILE:"Subf",1:"F")_"ile #"_$P(^(0),U)
|
|
;
|