- DMSQF2 ;SFISC/JHM-BUILD INDEX AND PARENT FOREIGN KEYS ;7/28/97 11:10
- ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- ;;Licensed under the terms of the Apache License, Version 2.0.
- ;
- Q
- PFK(TI) ;BUILD FOREIGN KEYS FOR PARENT TABLES
- N T,GL,FL,PEI,S,TE,TC
- D INIT F I=1:1:$O(TE(""),-1)-1 D BFK(I)
- Q
- BFK(L) ;BUILD A LEVEL L FOREIGN KEY FOR TABLE PRIMARY KEYS
- N I,FF,FTI,FT,FTN,FKN,FPEI,FPE,IEN,TT,FDA,ERR,FIEN,PI
- S FF=$P(FL,",",L),FTI=$O(^DMSQ("T","C",FF,"")) Q:FTI=""
- S FT=^DMSQ("T",FTI,0),FTN=$P(FT,U),FKN=FTN_"_PFK"
- S FPEI=$O(^DMSQ("E","F",FTI,"P","")) Q:FPEI=""
- S FPE=^DMSQ("E",FPEI,0),FDI=$P(FPE,U,2)
- ;BUILD FOREIGN KEY TABLE ELEMENT
- S IEN=$O(^DMSQ("E","G",TI,FKN,"")),TT=1.5216,IEN=$S(IEN:IEN,1:"+1")_","
- S FDA(TT,IEN,.01)=FKN ; FOREIGN KEY NAME
- S FDA(TT,IEN,1)=FDI ; DOMAIN OF FOREIGN TABLE
- S FDA(TT,IEN,2)=TI ; FOREIGN KEY IS IN THIS TABLE
- S FDA(TT,IEN,3)="F" ; TYPE F FOR FOREIGN KEY
- S FDA(TT,IEN,4)="Foreign key to ancestor "_FTN ; COMMENT
- S FIEN=$$PUT^DMSQU(IEN,"FDA","ERR")
- I $D(ERR)!'FIEN D ERR^DMSQU(F,L,"FOREIGN KEY: ANCESTOR FOREIGN KEY INSERT FAILED") Q
- S (IENL,FKI)=""
- F I=1:1:L S FKI=$O(^DMSQ("F","B",FIEN,FKI)) Q:FKI="" D
- . S $P(IENL,U,I)=FKI
- F I=1:1:L D BFKI(I)
- Q
- BFKI(L) ;BUILD FOREIGN KEY COLUMN ELEMENT
- S CEI=$P(TC(L),U),CI=$O(^DMSQ("C","B",CEI,""))
- I 'CI D ERR^DMSQU(F,L,"FOREIGN KEY: NO POINTED-TO COLUMN AT LEVEL") Q
- S PI=$O(^DMSQ("P","C",FPEI,L,""))
- I 'PI D ERR^DMSQU(F,L,"FOREIGN KEY: NO ANCESTOR PRIMARY KEY") Q
- ;BUILD FK COLUMN
- S FI=$P(IENL,U,I),TT=1.5219,IEN=$S(FI:FI,1:"+1")_","
- S FDA(TT,IEN,.01)=FIEN ; FK TABLE ELEMENT ID
- S FDA(TT,IEN,1)=PI ; FOREIGN PRIMARY KEY ID
- S FDA(TT,IEN,2)=CI ; LOCAL PRIMARY KEY COLUMN ID
- S FI=$$PUT^DMSQU(IEN,"FDA","ERR")
- I $D(ERR)!'FI D ERR^DMSQU(F,L,"FOREIGN KEY: ANCESTOR FOREIGN KEY COLUMN INSERT FAILED")
- Q
- INIT ;SET PRIMARY KEY VARIABLES FOR TABLE TI
- N S,P,PI,K,KCI,KC,PEI
- S S=0,T=^DMSQ("T",TI,0),GL=^(1),(F,P,FL)=$P(T,U,7)
- F S P=$G(^DD(P,0,"UP")) Q:P="" S FL=P_","_FL
- S PEI=$O(^DMSQ("E","F",TI,"P","")),PI=""
- F S PI=$O(^DMSQ("P","B",PEI,PI)) Q:PI="" D
- . S K=^DMSQ("P",PI,0),S=$P(K,U,3),KCI=$P(K,U,2),KC=^DMSQ("C",KCI,0)
- . S TE(S)=$P(^DMSQ("E",$P(KC,U),0),U,1,2),TC(S)=KC
- Q
- INDEX(TI) ;BUILD ALL REGULAR INDICIES FOR TABLE TI
- I '$G(DIFM) D ENV^DMSQU
- N T,GL,FL,PI,K,TE,TC,KC,KCI,IN,FI,CI,IC,IE,I,IF,IX,C,CEI,L,TN,CN,INM,IEI,IEN,FDA,ERR,TIEN,PIEN,DIEN,CIEN
- D INIT S FI=0
- FI S FI=$O(^DD(F,FI)) Q:'FI S IN=0
- IN S IN=$O(^DD(F,FI,1,IN)) G FI:'IN D IDX(F,FI,IN,.TC,.TE) G IN
- ;
- IDX(F,FI,IN,TC,TE) ;BUILD INDEX
- N P,S,IGL,IC,IE,I,IF,IX,CI,ITI,CEI,CE,L,TN,GF,INM1,INM2,TN1,TN2
- S I=$G(^DD(F,FI,1,IN,0)) I $P(I,U,3)]"" Q
- I I="" D ERR^DMSQU(F,FI,"INDEX: MISSING DATA DICTIONARY DATA") Q
- S IF=+I,IX=$P(I,U,2) I IX=""!'IF Q
- I $G(^DD(F,FI,1,IN,1))'[",DA)" D Q
- . D ERR^DMSQU(F,FI,"INDEX: IRREGULAR FORMAT")
- S CI=$O(^DMSQ("C","D",F,FI,"")),ITI=$$T(IF)
- I 'CI D ERR^DMSQU(F,FI,"INDEX: NO ASSOCIATED COLUMN RECORD") Q
- F L=$L(FL,","):-1:1 Q:$P(FL,",",L)=IF
- M IC=TC,IE=TE
- S C=^DMSQ("C",CI,0),CEI=$P(C,U),CE=^DMSQ("E",CEI,0)
- S IC(L-.5)=C,IE(L-.5)=CE
- ;S TN=$P(T,U),CN=$P(CE,U),INM=$$SQLI^DMSQU(TN_"_X"_IX_"_"_CN,30)
- S TN=$P(T,U),TN1=$E(TN,1,$L(TN)-1),TN2=$E(TN,$L(TN)),CN=$P(CE,U)
- S INM1=$$SQLI^DMSQU(TN1,18),INM2=$$SQLI^DMSQU("X"_IX_"_"_CN,10)
- S INM=INM1_TN2_"_"_INM2
- S IGL=GL,GF=$P(IGL,"{K}",L)_$C(34)_IX_$C(34)_",{K},"
- S $P(IGL,"{K}",L)=GF F I=L+1:1:$L(GL,"{K}") S $P(IGL,"{K}",I)=","
- S IEI=$O(^DMSQ("T","B",INM,""))
- ;BUILD TABLE
- S TT=1.5215,IEN=$S(IEI:IEI,1:"+1")_","
- S FDA(TT,IEN,.01)=INM ; INDEX TABLE NAME
- S FDA(TT,IEN,1)=1 ; SCHEMA SQLI
- S FDA(TT,IEN,2)="Index of "_TN_" by "_CN ;COMMENT
- S FDA(TT,IEN,3)=TI ; MASTER TABLE ID
- S FDA(TT,IEN,4)=1 ; VERSION NUMBER
- S FDA(TT,IEN,7)=DT ; UPDATE DATE
- S FDA(TT,IEN,8)=IGL ; GLOBAL NAME
- S TIEN=$$PUT^DMSQU(IEN,"FDA","ERR")
- I $D(ERR) D ERR^DMSQU(F,FI,"INDEX: TABLE INSERT FAILED") Q
- S DIEN=$O(^DMSQ("DM","C",TIEN,""))
- ; BUILD TABLE DOMAIN
- S TT=1.5212,IEN=$S(DIEN:DIEN,1:"+1")_","
- S FDA(TT,IEN,.01)=$$SQLI^DMSQU(INM_"_ID",30) ; DOMAIN NAME
- S FDA(TT,IEN,1)=1 ; TYPE = PRIMARY KEY
- S FDA(TT,IEN,2)="Domain of table "_INM ; COMMENT
- S FDA(TT,IEN,3)=TIEN ; TABLE ID
- S DIEN=$$PUT^DMSQU(IEN,"FDA","ERR")
- I $D(ERR) D ERR^DMSQU(F,FI,"INDEX: TABLE DOMAIN INSERT FAILED") Q
- S PIEN=$O(^DMSQ("E","F",TIEN,"P",""))
- ;BUILD PRIMARY KEY HEADER ELEMENT
- S TT=1.5216,IEN=$S(PIEN:PIEN,1:"+1")_","
- S FDA(TT,IEN,.01)=$$SQLI^DMSQU(INM_"_PK",30) ; PRIMARY KEY NAME
- S FDA(TT,IEN,1)=DIEN ; TABLE DOMAIN
- S FDA(TT,IEN,2)=TIEN ; TABLE ID
- S FDA(TT,IEN,3)="P" ; TYPE = P FOR PRIMARY KEY
- S FDA(TT,IEN,4)="Primary key header for "_INM ; COMMENT
- S PIEN=$$PUT^DMSQU(IEN,"FDA","ERR")
- I $D(ERR) D ERR^DMSQU(F,FI,"INDEX: PRIMARY KEY ELEMENT INSERT FAILED") Q
- S S=0,(K,P)="" F S K=$O(IE(K)) Q:K="" D
- . S S=S+1 D PKI(S,PIEN,$P(IGL,"{K}",S),IE(K),IC(K),.P)
- Q
- PKI(S,PEI,G,E,C,P) ;BUILD COLUMN ELEMENT, COLUMN AND PRIMARY KEY ELEMENT
- N ICN,CI,CEI,PI,W,KFI S (CI,CEI,PI,KFI)="",W=$P(C,U,2)
- I W>30 S KFI=$O(^DMSQ("KF","B","LONG_CHARACTER",""))
- S PI=$O(^DMSQ("P","C",PEI,S,""))
- I PI S CI=$P($G(^DMSQ("P",PI,0)),U,2)
- I CI S CEI=$P($G(^DMSQ("C",CI,0)),U)
- S ICN=$P(E,U)
- ;BUILD COLUMN ELEMENT
- S TT=1.5216,IEN=$S(CEI:CEI,1:"+1")_","
- S FDA(TT,IEN,.01)=ICN ; COLUMN NAME
- S FDA(TT,IEN,1)=$P(E,U,2) ; DOMAIN ID
- S FDA(TT,IEN,2)=TIEN ; TABLE ID
- S FDA(TT,IEN,3)="C" ; TYPE = COLUMN
- S FDA(TT,IEN,4)="Index Primary Key #"_S_" for "_INM_"."_ICN
- S CEI=$$PUT^DMSQU(IEN,"FDA","ERR")
- I $D(ERR)!'CEI D ERR^DMSQU(F,FI,"INDEX: COLUMN ELEMENT INSERT FAILED") Q
- ;BUILD COLUMN
- S TT=1.5217,IEN=$S(CI:CI,1:"+1")_","
- S FDA(TT,IEN,.01)=CEI ; COLUMN ELEMENT ID
- I P S FDA(TT,IEN,8)=P ; PARENT POINTER
- S FDA(TT,IEN,9)=G ; GLOBAL FRAGMENT
- S CI=$$PUT^DMSQU(IEN,"FDA","ERR")
- I $D(ERR)!'CI D ERR^DMSQU(F,FI,"INDEX: COLUMN INSERT FAILED")
- ;BUILD PRIMARY KEY
- S TT=1.5218,IEN=$S(PI:PI,1:"+1")_","
- S FDA(TT,IEN,.01)=PEI ; PRIMARY KEY HEADER ID
- S FDA(TT,IEN,1)=CI ; COLUMN ID
- S FDA(TT,IEN,2)=S ; KEY SEQUENCE
- I KFI S FDA(TT,IEN,7)=KFI ; KEY FORMAT
- S PI=$$PUT^DMSQU(IEN,"FDA","ERR")
- I $D(ERR)!'PI D ERR^DMSQU(F,FI,"INDEX: PRIMARY KEY INSERT FAILED")
- S P=CI
- Q
- T(F) Q $O(^DMSQ("T","C",F,""))
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDMSQF2 6460 printed Feb 19, 2025@00:21:23 Page 2
- DMSQF2 ;SFISC/JHM-BUILD INDEX AND PARENT FOREIGN KEYS ;7/28/97 11:10
- +1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- +4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- +5 ;;Licensed under the terms of the Apache License, Version 2.0.
- +6 ;
- +7 QUIT
- PFK(TI) ;BUILD FOREIGN KEYS FOR PARENT TABLES
- +1 NEW T,GL,FL,PEI,S,TE,TC
- +2 DO INIT
- FOR I=1:1:$ORDER(TE(""),-1)-1
- DO BFK(I)
- +3 QUIT
- BFK(L) ;BUILD A LEVEL L FOREIGN KEY FOR TABLE PRIMARY KEYS
- +1 NEW I,FF,FTI,FT,FTN,FKN,FPEI,FPE,IEN,TT,FDA,ERR,FIEN,PI
- +2 SET FF=$PIECE(FL,",",L)
- SET FTI=$ORDER(^DMSQ("T","C",FF,""))
- if FTI=""
- QUIT
- +3 SET FT=^DMSQ("T",FTI,0)
- SET FTN=$PIECE(FT,U)
- SET FKN=FTN_"_PFK"
- +4 SET FPEI=$ORDER(^DMSQ("E","F",FTI,"P",""))
- if FPEI=""
- QUIT
- +5 SET FPE=^DMSQ("E",FPEI,0)
- SET FDI=$PIECE(FPE,U,2)
- +6 ;BUILD FOREIGN KEY TABLE ELEMENT
- +7 SET IEN=$ORDER(^DMSQ("E","G",TI,FKN,""))
- SET TT=1.5216
- SET IEN=$SELECT(IEN:IEN,1:"+1")_","
- +8 ; FOREIGN KEY NAME
- SET FDA(TT,IEN,.01)=FKN
- +9 ; DOMAIN OF FOREIGN TABLE
- SET FDA(TT,IEN,1)=FDI
- +10 ; FOREIGN KEY IS IN THIS TABLE
- SET FDA(TT,IEN,2)=TI
- +11 ; TYPE F FOR FOREIGN KEY
- SET FDA(TT,IEN,3)="F"
- +12 ; COMMENT
- SET FDA(TT,IEN,4)="Foreign key to ancestor "_FTN
- +13 SET FIEN=$$PUT^DMSQU(IEN,"FDA","ERR")
- +14 IF $DATA(ERR)!'FIEN
- DO ERR^DMSQU(F,L,"FOREIGN KEY: ANCESTOR FOREIGN KEY INSERT FAILED")
- QUIT
- +15 SET (IENL,FKI)=""
- +16 FOR I=1:1:L
- SET FKI=$ORDER(^DMSQ("F","B",FIEN,FKI))
- if FKI=""
- QUIT
- Begin DoDot:1
- +17 SET $PIECE(IENL,U,I)=FKI
- End DoDot:1
- +18 FOR I=1:1:L
- DO BFKI(I)
- +19 QUIT
- BFKI(L) ;BUILD FOREIGN KEY COLUMN ELEMENT
- +1 SET CEI=$PIECE(TC(L),U)
- SET CI=$ORDER(^DMSQ("C","B",CEI,""))
- +2 IF 'CI
- DO ERR^DMSQU(F,L,"FOREIGN KEY: NO POINTED-TO COLUMN AT LEVEL")
- QUIT
- +3 SET PI=$ORDER(^DMSQ("P","C",FPEI,L,""))
- +4 IF 'PI
- DO ERR^DMSQU(F,L,"FOREIGN KEY: NO ANCESTOR PRIMARY KEY")
- QUIT
- +5 ;BUILD FK COLUMN
- +6 SET FI=$PIECE(IENL,U,I)
- SET TT=1.5219
- SET IEN=$SELECT(FI:FI,1:"+1")_","
- +7 ; FK TABLE ELEMENT ID
- SET FDA(TT,IEN,.01)=FIEN
- +8 ; FOREIGN PRIMARY KEY ID
- SET FDA(TT,IEN,1)=PI
- +9 ; LOCAL PRIMARY KEY COLUMN ID
- SET FDA(TT,IEN,2)=CI
- +10 SET FI=$$PUT^DMSQU(IEN,"FDA","ERR")
- +11 IF $DATA(ERR)!'FI
- DO ERR^DMSQU(F,L,"FOREIGN KEY: ANCESTOR FOREIGN KEY COLUMN INSERT FAILED")
- +12 QUIT
- INIT ;SET PRIMARY KEY VARIABLES FOR TABLE TI
- +1 NEW S,P,PI,K,KCI,KC,PEI
- +2 SET S=0
- SET T=^DMSQ("T",TI,0)
- SET GL=^(1)
- SET (F,P,FL)=$PIECE(T,U,7)
- +3 FOR
- SET P=$GET(^DD(P,0,"UP"))
- if P=""
- QUIT
- SET FL=P_","_FL
- +4 SET PEI=$ORDER(^DMSQ("E","F",TI,"P",""))
- SET PI=""
- +5 FOR
- SET PI=$ORDER(^DMSQ("P","B",PEI,PI))
- if PI=""
- QUIT
- Begin DoDot:1
- +6 SET K=^DMSQ("P",PI,0)
- SET S=$PIECE(K,U,3)
- SET KCI=$PIECE(K,U,2)
- SET KC=^DMSQ("C",KCI,0)
- +7 SET TE(S)=$PIECE(^DMSQ("E",$PIECE(KC,U),0),U,1,2)
- SET TC(S)=KC
- End DoDot:1
- +8 QUIT
- INDEX(TI) ;BUILD ALL REGULAR INDICIES FOR TABLE TI
- +1 IF '$GET(DIFM)
- DO ENV^DMSQU
- +2 NEW T,GL,FL,PI,K,TE,TC,KC,KCI,IN,FI,CI,IC,IE,I,IF,IX,C,CEI,L,TN,CN,INM,IEI,IEN,FDA,ERR,TIEN,PIEN,DIEN,CIEN
- +3 DO INIT
- SET FI=0
- FI SET FI=$ORDER(^DD(F,FI))
- if 'FI
- QUIT
- SET IN=0
- IN SET IN=$ORDER(^DD(F,FI,1,IN))
- if 'IN
- GOTO FI
- DO IDX(F,FI,IN,.TC,.TE)
- GOTO IN
- +1 ;
- IDX(F,FI,IN,TC,TE) ;BUILD INDEX
- +1 NEW P,S,IGL,IC,IE,I,IF,IX,CI,ITI,CEI,CE,L,TN,GF,INM1,INM2,TN1,TN2
- +2 SET I=$GET(^DD(F,FI,1,IN,0))
- IF $PIECE(I,U,3)]""
- QUIT
- +3 IF I=""
- DO ERR^DMSQU(F,FI,"INDEX: MISSING DATA DICTIONARY DATA")
- QUIT
- +4 SET IF=+I
- SET IX=$PIECE(I,U,2)
- IF IX=""!'IF
- QUIT
- +5 IF $GET(^DD(F,FI,1,IN,1))'[",DA)"
- Begin DoDot:1
- +6 DO ERR^DMSQU(F,FI,"INDEX: IRREGULAR FORMAT")
- End DoDot:1
- QUIT
- +7 SET CI=$ORDER(^DMSQ("C","D",F,FI,""))
- SET ITI=$$T(IF)
- +8 IF 'CI
- DO ERR^DMSQU(F,FI,"INDEX: NO ASSOCIATED COLUMN RECORD")
- QUIT
- +9 FOR L=$LENGTH(FL,","):-1:1
- if $PIECE(FL,",",L)=IF
- QUIT
- +10 MERGE IC=TC,IE=TE
- +11 SET C=^DMSQ("C",CI,0)
- SET CEI=$PIECE(C,U)
- SET CE=^DMSQ("E",CEI,0)
- +12 SET IC(L-.5)=C
- SET IE(L-.5)=CE
- +13 ;S TN=$P(T,U),CN=$P(CE,U),INM=$$SQLI^DMSQU(TN_"_X"_IX_"_"_CN,30)
- +14 SET TN=$PIECE(T,U)
- SET TN1=$EXTRACT(TN,1,$LENGTH(TN)-1)
- SET TN2=$EXTRACT(TN,$LENGTH(TN))
- SET CN=$PIECE(CE,U)
- +15 SET INM1=$$SQLI^DMSQU(TN1,18)
- SET INM2=$$SQLI^DMSQU("X"_IX_"_"_CN,10)
- +16 SET INM=INM1_TN2_"_"_INM2
- +17 SET IGL=GL
- SET GF=$PIECE(IGL,"{K}",L)_$CHAR(34)_IX_$CHAR(34)_",{K},"
- +18 SET $PIECE(IGL,"{K}",L)=GF
- FOR I=L+1:1:$LENGTH(GL,"{K}")
- SET $PIECE(IGL,"{K}",I)=","
- +19 SET IEI=$ORDER(^DMSQ("T","B",INM,""))
- +20 ;BUILD TABLE
- +21 SET TT=1.5215
- SET IEN=$SELECT(IEI:IEI,1:"+1")_","
- +22 ; INDEX TABLE NAME
- SET FDA(TT,IEN,.01)=INM
- +23 ; SCHEMA SQLI
- SET FDA(TT,IEN,1)=1
- +24 ;COMMENT
- SET FDA(TT,IEN,2)="Index of "_TN_" by "_CN
- +25 ; MASTER TABLE ID
- SET FDA(TT,IEN,3)=TI
- +26 ; VERSION NUMBER
- SET FDA(TT,IEN,4)=1
- +27 ; UPDATE DATE
- SET FDA(TT,IEN,7)=DT
- +28 ; GLOBAL NAME
- SET FDA(TT,IEN,8)=IGL
- +29 SET TIEN=$$PUT^DMSQU(IEN,"FDA","ERR")
- +30 IF $DATA(ERR)
- DO ERR^DMSQU(F,FI,"INDEX: TABLE INSERT FAILED")
- QUIT
- +31 SET DIEN=$ORDER(^DMSQ("DM","C",TIEN,""))
- +32 ; BUILD TABLE DOMAIN
- +33 SET TT=1.5212
- SET IEN=$SELECT(DIEN:DIEN,1:"+1")_","
- +34 ; DOMAIN NAME
- SET FDA(TT,IEN,.01)=$$SQLI^DMSQU(INM_"_ID",30)
- +35 ; TYPE = PRIMARY KEY
- SET FDA(TT,IEN,1)=1
- +36 ; COMMENT
- SET FDA(TT,IEN,2)="Domain of table "_INM
- +37 ; TABLE ID
- SET FDA(TT,IEN,3)=TIEN
- +38 SET DIEN=$$PUT^DMSQU(IEN,"FDA","ERR")
- +39 IF $DATA(ERR)
- DO ERR^DMSQU(F,FI,"INDEX: TABLE DOMAIN INSERT FAILED")
- QUIT
- +40 SET PIEN=$ORDER(^DMSQ("E","F",TIEN,"P",""))
- +41 ;BUILD PRIMARY KEY HEADER ELEMENT
- +42 SET TT=1.5216
- SET IEN=$SELECT(PIEN:PIEN,1:"+1")_","
- +43 ; PRIMARY KEY NAME
- SET FDA(TT,IEN,.01)=$$SQLI^DMSQU(INM_"_PK",30)
- +44 ; TABLE DOMAIN
- SET FDA(TT,IEN,1)=DIEN
- +45 ; TABLE ID
- SET FDA(TT,IEN,2)=TIEN
- +46 ; TYPE = P FOR PRIMARY KEY
- SET FDA(TT,IEN,3)="P"
- +47 ; COMMENT
- SET FDA(TT,IEN,4)="Primary key header for "_INM
- +48 SET PIEN=$$PUT^DMSQU(IEN,"FDA","ERR")
- +49 IF $DATA(ERR)
- DO ERR^DMSQU(F,FI,"INDEX: PRIMARY KEY ELEMENT INSERT FAILED")
- QUIT
- +50 SET S=0
- SET (K,P)=""
- FOR
- SET K=$ORDER(IE(K))
- if K=""
- QUIT
- Begin DoDot:1
- +51 SET S=S+1
- DO PKI(S,PIEN,$PIECE(IGL,"{K}",S),IE(K),IC(K),.P)
- End DoDot:1
- +52 QUIT
- PKI(S,PEI,G,E,C,P) ;BUILD COLUMN ELEMENT, COLUMN AND PRIMARY KEY ELEMENT
- +1 NEW ICN,CI,CEI,PI,W,KFI
- SET (CI,CEI,PI,KFI)=""
- SET W=$PIECE(C,U,2)
- +2 IF W>30
- SET KFI=$ORDER(^DMSQ("KF","B","LONG_CHARACTER",""))
- +3 SET PI=$ORDER(^DMSQ("P","C",PEI,S,""))
- +4 IF PI
- SET CI=$PIECE($GET(^DMSQ("P",PI,0)),U,2)
- +5 IF CI
- SET CEI=$PIECE($GET(^DMSQ("C",CI,0)),U)
- +6 SET ICN=$PIECE(E,U)
- +7 ;BUILD COLUMN ELEMENT
- +8 SET TT=1.5216
- SET IEN=$SELECT(CEI:CEI,1:"+1")_","
- +9 ; COLUMN NAME
- SET FDA(TT,IEN,.01)=ICN
- +10 ; DOMAIN ID
- SET FDA(TT,IEN,1)=$PIECE(E,U,2)
- +11 ; TABLE ID
- SET FDA(TT,IEN,2)=TIEN
- +12 ; TYPE = COLUMN
- SET FDA(TT,IEN,3)="C"
- +13 SET FDA(TT,IEN,4)="Index Primary Key #"_S_" for "_INM_"."_ICN
- +14 SET CEI=$$PUT^DMSQU(IEN,"FDA","ERR")
- +15 IF $DATA(ERR)!'CEI
- DO ERR^DMSQU(F,FI,"INDEX: COLUMN ELEMENT INSERT FAILED")
- QUIT
- +16 ;BUILD COLUMN
- +17 SET TT=1.5217
- SET IEN=$SELECT(CI:CI,1:"+1")_","
- +18 ; COLUMN ELEMENT ID
- SET FDA(TT,IEN,.01)=CEI
- +19 ; PARENT POINTER
- IF P
- SET FDA(TT,IEN,8)=P
- +20 ; GLOBAL FRAGMENT
- SET FDA(TT,IEN,9)=G
- +21 SET CI=$$PUT^DMSQU(IEN,"FDA","ERR")
- +22 IF $DATA(ERR)!'CI
- DO ERR^DMSQU(F,FI,"INDEX: COLUMN INSERT FAILED")
- +23 ;BUILD PRIMARY KEY
- +24 SET TT=1.5218
- SET IEN=$SELECT(PI:PI,1:"+1")_","
- +25 ; PRIMARY KEY HEADER ID
- SET FDA(TT,IEN,.01)=PEI
- +26 ; COLUMN ID
- SET FDA(TT,IEN,1)=CI
- +27 ; KEY SEQUENCE
- SET FDA(TT,IEN,2)=S
- +28 ; KEY FORMAT
- IF KFI
- SET FDA(TT,IEN,7)=KFI
- +29 SET PI=$$PUT^DMSQU(IEN,"FDA","ERR")
- +30 IF $DATA(ERR)!'PI
- DO ERR^DMSQU(F,FI,"INDEX: PRIMARY KEY INSERT FAILED")
- +31 SET P=CI
- +32 QUIT
- T(F) QUIT $ORDER(^DMSQ("T","C",F,""))