DMSQF1 ;SFISC/JHM-INITIALIZE SQLI_FILE (CONT) ;5/7/98 14:53
;;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
PK(TI) ;GENERATE PRIMARY KEY ELEMENTS AND COLUMNS FOR TABLE IDENTIFIER TI
I '$G(DIFM) D ENV^DMSQU
N X,N,G,PAR,PEI,TIEN,T,DIERR S T=1.5215,TIEN=TI_","
K DIERR D GETS^DIQ(T,TIEN,".01;6;8","I","X")
I $D(DIERR) D ERR^DMSQU(999999999,"","PRIMARY KEY: CAN'T GET TABLE DATA") Q ""
S N=X(T,TIEN,.01,"I"),G=X(T,TIEN,8,"I"),F=X(T,TIEN,6,"I")
K FDA S TT=1.5212,DI=$O(^DMSQ("DM","C",TI,"")) ;BUILD DOMAIN
S IEN=$S(DI:DI,1:"+1")_"," ;TABLE DOMAIN
S FDA(TT,IEN,.01)=N_"_ID" ;DOMAIN NAME
S FDA(TT,IEN,1)=1 ;DATA TYPE = PRIMARY KEY
S FDA(TT,IEN,2)="Domain of table "_N ;COMMENT
S FDA(TT,IEN,3)=TI ;TABLE ID
S DI=$$PUT^DMSQU(IEN,"FDA","ERR")
I 'DI D ERR^DMSQU(F,"","PRIMARY KEY: DOMAIN INSERT FAILED") Q ""
; BUILD PRIMARY KEY TABLE ELEMENT
S PEI=$O(^DMSQ("E","F",TI,"P","")),IEN=$S(PEI:PEI,1:"+1")_",",TT=1.5216
S FDA(TT,IEN,.01)=N_"_PK" ;TABLE ELEMENT NAME
S FDA(TT,IEN,1)=DI ;TE DOMAIN SAME AS TABLE
S FDA(TT,IEN,2)=TI ;TABLE ID
S FDA(TT,IEN,3)="P" ;TYPE = PRIMARY KEY
S FDA(TT,IEN,4)="Primary key header for table "_N ;COMMENT
S PEI=$$PUT^DMSQU(IEN,"FDA","ERR")
I 'PEI D ERR^DMSQU(F,"","PRIMARY KEY: TABLE ELEMENT INSERT FAILED") Q ""
;BUILD TABLE PRIMARY KEYS
S F=$$GET^DMSQU(1.5215,TI_",",6,"I","","ERR"),KL=$$KL^DMSQU(F),PAR=""
I $D(ERR)!'F D ERR^DMSQU(F,"","PRIMARY KEY: CAN'T GET TABLE'S FILE #") Q ""
F I=1:1:$L(G,"{K}")-1 D PKI(PEI,I,$P(KL,",",I),$P(G,"{K}",I),.PAR)
Q CEI
PKI(PEI,SEQ,F,GF,PAR) ;BUILD COLUMN ELEMENT, COLUMN AND PRIMARY KEY DEFS
N TN,KI,KN,PI,CI,DM,W,S,TT,I,DI,ERR
S TN=$$GET^DMSQU(1.5216,PEI_",",2,"","","ERR")
I TN="" D ERR^DMSQU(F,SEQ,"INDEX PRIMARY KEY: CAN'T GET DATA FOR MASTER TABLE") Q ""
S KI=$O(^DMSQ("T","C",F,""))
I 'KI D ERR^DMSQU(F,SEQ,"INDEX PRIMARY KEY: MISSING TABLE RECORD") Q ""
S KN=$$GET^DMSQU(1.5215,KI_",",.01),(CI,CEI)=""
S PI=$O(^DMSQ("P","C",PEI,SEQ,""))
I PI K ERR,DIERR D Q:'CI!'CEI
. S CI=$$GET^DMSQU(1.5218,PI_",",1,"I","","ERR")
. I $D(ERR) D ERR^DMSQU(F,SEQ,"INDEX PRIMARY KEY: TABLE MISSING COLUMN POINTER") Q
. I CI S CEI=$$GET^DMSQU(1.5217,CI_",",.01,"I","","ERR")
. I $D(ERR) D ERR^DMSQU(F,SEQ,"INDEX PRIMARY KEY: CAN'T GET COLUMN'S TABLE ELEMENT") Q
. I 'CI!('CEI) D ERR^DMSQU(F,SEQ,"INDEX PRIMARY KEY: MISSING COLUMN POINTER") Q
;DEFINE COLUMN ELEMENT
S IEN=$S(CEI:CEI,1:"+1")_",",TT=1.5216
S DM=$$DOM^DMSQU(F,.001),W=$P(DM,U,2),S=$P(DM,U,3),DM=$P(DM,U)
I DM=""!("FM_DATE_TIME;FM_MOMENT;FM_DATE;INTEGER;NUMERIC"'[DM) S DM="INTEGER",W=10
S DI=$O(^DMSQ("DM","B",DM,""))
S FDA(TT,IEN,.01)=$$KWC^DMSQU(KN_"_ID") ;COLUMN NAME = TABLE_NAME_ID
S FDA(TT,IEN,1)=DI ;DOMAIN
S FDA(TT,IEN,2)=TI ;TABLE ID
S FDA(TT,IEN,3)="C" ; TYPE = COLUMN
S FDA(TT,IEN,4)="Primary key #"_SEQ_" of table "_TN ; COMMENT
S CEI=$$PUT^DMSQU(IEN,"FDA","ERR")
I $D(ERR) D ERR^DMSQU(F,SEQ,"INDEX PRIMARY KEY: COLUMN ELEMENT INSERT FAILED") Q
;DEFINE COLUMN
S TT=1.5217,CI=$O(^DMSQ("C","B",CEI,"")),IEN=$S(CI:CI,1:"+1")_","
S FDA(TT,IEN,.01)=CEI ;COL ELEMENT ID
S FDA(TT,IEN,2)=W ;WIDTH
S:S FDA(TT,IEN,3)=S ;SCALE
S FDA(TT,IEN,5)=1 ;REQUIRED
S FDA(TT,IEN,7)=0 ;BASE COLUMN
S FDA(TT,IEN,9)=GF ;GLOBAL FRAGMENT
S FDA(TT,IEN,8)=PAR ;PARENT
S CI=$$PUT^DMSQU(IEN,"FDA","ERR")
I $D(ERR) D ERR^DMSQU(F,SEQ,"INDEX PRIMARY KEY: COLUMN INSERT FAILED") Q
S PAR=CI
;DEFINE PRIMARY KEY
S TT=1.5218,PI=$O(^DMSQ("P","C",PEI,SEQ,"")),IEN=$S(PI:PI,1:"+1")_","
S FDA(TT,IEN,.01)=PEI ; TABLE ELEMENT
S FDA(TT,IEN,1)=CI ; COLUMN
S FDA(TT,IEN,2)=SEQ ; SEQUENCE NUMBER
S FDA(TT,IEN,3)=0 ; ALWAYS START AT 0
S FDA(TT,IEN,4)="'{K}" ; STOP AT EXPRESSION
S CI=$$PUT^DMSQU(IEN,"FDA","ERR")
I $D(ERR) D ERR^DMSQU(F,SEQ,"INDEX PRIMARY KEY: TABLE ELEMENT INSERT FAILED")
Q
FK(CI) ;DEFINE FOREIGN KEY FOR POINTER COLUMN CI
N C,CEI,CE,CN,F,FI,TI,SP,FF,FIEN,FTI,FTN,FPEI,FPE,FPI,FNM,TT,IEN,FDA
S C=^DMSQ("C",CI,0)
S CEI=$P(C,U),CE=^DMSQ("E",CEI,0),CN=$P(CE,U) Q:$P(CE,U,2)'=13 ""
S F=$P(C,U,5),FI=$P(C,U,6) I 'F!'FI Q ""
S TI=$P(CE,U,3),SP=$P(^DD(F,FI,0),U,2)
S FF=+$P(SP,"P",2)
I 'FF D ERR^DMSQU(F,FI,"FOREIGN KEY: NO POINTED-TO FILE IN SPECIFIER") Q ""
S FTI=$O(^DMSQ("T","C",FF,""))
I 'FTI D ERR^DMSQU(F,FI,"FOREIGN KEY: NO TABLE FOR POINTED-TO FILE") Q ""
S FTN=$P(^DMSQ("T",FTI,0),U)
S FPEI=$O(^DMSQ("E","F",FTI,"P",""))
I 'FPEI D ERR^DMSQU(F,FI,"FOREIGN KEY: NO PRIMARY KEY TABLE ELEMENT") Q ""
S FPE=^DMSQ("E",FPEI,0),FDI=$P(FPE,U,2)
S FPI=$O(^DMSQ("P","B",FPEI,""))
I 'FPI D ERR^DMSQU(F,FI,"FOREIGN KEY: NO ASSOCIATED PRIMARY KEY") Q ""
S FCI=$P(^DMSQ("P",FPI,0),U,2)
S FNM=CN_"_FK",IEN=$O(^DMSQ("E","G",TI,FNM,""))
;BUILD FOREIGN KEY TABLE ELEMENT
S TT=1.5216,IEN=$S(IEN:IEN,1:"+1")_","
S FDA(TT,IEN,.01)=FNM ;FOREIGN KEY NAME
S FDA(TT,IEN,1)=FDI ;DOMAIN = FOREIGN KEY TABLE DOMAIN
S FDA(TT,IEN,2)=TI ;TABLE ID
S FDA(TT,IEN,3)="F" ;TYPE F = FOREIGN KEY
S FDA(TT,IEN,4)="Foreign key to "_FTN ;COMMENT
S FIEN=$$PUT^DMSQU(IEN,"FDA","ERR")
I $D(ERR) D ERR^DMSQU(F,FI,"FOREIGN KEY: TABLE ELEMENT INSERT FAILED") Q ""
;BUILD FOREIGN KEY COLUMN ELEMENT
S TT=1.5219,IEN=$O(^DMSQ("F","B",FIEN,"")),IEN=$S(IEN:IEN,1:"+1")_","
S FDA(TT,IEN,.01)=FIEN ;FK TABLE ELEMENT ID
S FDA(TT,IEN,1)=FPI ;FOREIGN TABLE PRIMARY KEY ELEMENT ID
S FDA(TT,IEN,2)=CI ;COLUMN ID IN LOCAL TABLE
S FIEN=$$PUT^DMSQU(IEN,"FDA","ERR")
I $D(ERR) D ERR^DMSQU(F,FI,"FOREIGN KEY: COLUMN ELEMENT INSERT FAILED")
Q FIEN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDMSQF1 5763 printed Apr 09, 2024@21:54:41 Page 2
DMSQF1 ;SFISC/JHM-INITIALIZE SQLI_FILE (CONT) ;5/7/98 14:53
+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
PK(TI) ;GENERATE PRIMARY KEY ELEMENTS AND COLUMNS FOR TABLE IDENTIFIER TI
+1 IF '$GET(DIFM)
DO ENV^DMSQU
+2 NEW X,N,G,PAR,PEI,TIEN,T,DIERR
SET T=1.5215
SET TIEN=TI_","
+3 KILL DIERR
DO GETS^DIQ(T,TIEN,".01;6;8","I","X")
+4 IF $DATA(DIERR)
DO ERR^DMSQU(999999999,"","PRIMARY KEY: CAN'T GET TABLE DATA")
QUIT ""
+5 SET N=X(T,TIEN,.01,"I")
SET G=X(T,TIEN,8,"I")
SET F=X(T,TIEN,6,"I")
+6 ;BUILD DOMAIN
KILL FDA
SET TT=1.5212
SET DI=$ORDER(^DMSQ("DM","C",TI,""))
+7 ;TABLE DOMAIN
SET IEN=$SELECT(DI:DI,1:"+1")_","
+8 ;DOMAIN NAME
SET FDA(TT,IEN,.01)=N_"_ID"
+9 ;DATA TYPE = PRIMARY KEY
SET FDA(TT,IEN,1)=1
+10 ;COMMENT
SET FDA(TT,IEN,2)="Domain of table "_N
+11 ;TABLE ID
SET FDA(TT,IEN,3)=TI
+12 SET DI=$$PUT^DMSQU(IEN,"FDA","ERR")
+13 IF 'DI
DO ERR^DMSQU(F,"","PRIMARY KEY: DOMAIN INSERT FAILED")
QUIT ""
+14 ; BUILD PRIMARY KEY TABLE ELEMENT
+15 SET PEI=$ORDER(^DMSQ("E","F",TI,"P",""))
SET IEN=$SELECT(PEI:PEI,1:"+1")_","
SET TT=1.5216
+16 ;TABLE ELEMENT NAME
SET FDA(TT,IEN,.01)=N_"_PK"
+17 ;TE DOMAIN SAME AS TABLE
SET FDA(TT,IEN,1)=DI
+18 ;TABLE ID
SET FDA(TT,IEN,2)=TI
+19 ;TYPE = PRIMARY KEY
SET FDA(TT,IEN,3)="P"
+20 ;COMMENT
SET FDA(TT,IEN,4)="Primary key header for table "_N
+21 SET PEI=$$PUT^DMSQU(IEN,"FDA","ERR")
+22 IF 'PEI
DO ERR^DMSQU(F,"","PRIMARY KEY: TABLE ELEMENT INSERT FAILED")
QUIT ""
+23 ;BUILD TABLE PRIMARY KEYS
+24 SET F=$$GET^DMSQU(1.5215,TI_",",6,"I","","ERR")
SET KL=$$KL^DMSQU(F)
SET PAR=""
+25 IF $DATA(ERR)!'F
DO ERR^DMSQU(F,"","PRIMARY KEY: CAN'T GET TABLE'S FILE #")
QUIT ""
+26 FOR I=1:1:$LENGTH(G,"{K}")-1
DO PKI(PEI,I,$PIECE(KL,",",I),$PIECE(G,"{K}",I),.PAR)
+27 QUIT CEI
PKI(PEI,SEQ,F,GF,PAR) ;BUILD COLUMN ELEMENT, COLUMN AND PRIMARY KEY DEFS
+1 NEW TN,KI,KN,PI,CI,DM,W,S,TT,I,DI,ERR
+2 SET TN=$$GET^DMSQU(1.5216,PEI_",",2,"","","ERR")
+3 IF TN=""
DO ERR^DMSQU(F,SEQ,"INDEX PRIMARY KEY: CAN'T GET DATA FOR MASTER TABLE")
QUIT ""
+4 SET KI=$ORDER(^DMSQ("T","C",F,""))
+5 IF 'KI
DO ERR^DMSQU(F,SEQ,"INDEX PRIMARY KEY: MISSING TABLE RECORD")
QUIT ""
+6 SET KN=$$GET^DMSQU(1.5215,KI_",",.01)
SET (CI,CEI)=""
+7 SET PI=$ORDER(^DMSQ("P","C",PEI,SEQ,""))
+8 IF PI
KILL ERR,DIERR
Begin DoDot:1
+9 SET CI=$$GET^DMSQU(1.5218,PI_",",1,"I","","ERR")
+10 IF $DATA(ERR)
DO ERR^DMSQU(F,SEQ,"INDEX PRIMARY KEY: TABLE MISSING COLUMN POINTER")
QUIT
+11 IF CI
SET CEI=$$GET^DMSQU(1.5217,CI_",",.01,"I","","ERR")
+12 IF $DATA(ERR)
DO ERR^DMSQU(F,SEQ,"INDEX PRIMARY KEY: CAN'T GET COLUMN'S TABLE ELEMENT")
QUIT
+13 IF 'CI!('CEI)
DO ERR^DMSQU(F,SEQ,"INDEX PRIMARY KEY: MISSING COLUMN POINTER")
QUIT
End DoDot:1
if 'CI!'CEI
QUIT
+14 ;DEFINE COLUMN ELEMENT
+15 SET IEN=$SELECT(CEI:CEI,1:"+1")_","
SET TT=1.5216
+16 SET DM=$$DOM^DMSQU(F,.001)
SET W=$PIECE(DM,U,2)
SET S=$PIECE(DM,U,3)
SET DM=$PIECE(DM,U)
+17 IF DM=""!("FM_DATE_TIME;FM_MOMENT;FM_DATE;INTEGER;NUMERIC"'[DM)
SET DM="INTEGER"
SET W=10
+18 SET DI=$ORDER(^DMSQ("DM","B",DM,""))
+19 ;COLUMN NAME = TABLE_NAME_ID
SET FDA(TT,IEN,.01)=$$KWC^DMSQU(KN_"_ID")
+20 ;DOMAIN
SET FDA(TT,IEN,1)=DI
+21 ;TABLE ID
SET FDA(TT,IEN,2)=TI
+22 ; TYPE = COLUMN
SET FDA(TT,IEN,3)="C"
+23 ; COMMENT
SET FDA(TT,IEN,4)="Primary key #"_SEQ_" of table "_TN
+24 SET CEI=$$PUT^DMSQU(IEN,"FDA","ERR")
+25 IF $DATA(ERR)
DO ERR^DMSQU(F,SEQ,"INDEX PRIMARY KEY: COLUMN ELEMENT INSERT FAILED")
QUIT
+26 ;DEFINE COLUMN
+27 SET TT=1.5217
SET CI=$ORDER(^DMSQ("C","B",CEI,""))
SET IEN=$SELECT(CI:CI,1:"+1")_","
+28 ;COL ELEMENT ID
SET FDA(TT,IEN,.01)=CEI
+29 ;WIDTH
SET FDA(TT,IEN,2)=W
+30 ;SCALE
if S
SET FDA(TT,IEN,3)=S
+31 ;REQUIRED
SET FDA(TT,IEN,5)=1
+32 ;BASE COLUMN
SET FDA(TT,IEN,7)=0
+33 ;GLOBAL FRAGMENT
SET FDA(TT,IEN,9)=GF
+34 ;PARENT
SET FDA(TT,IEN,8)=PAR
+35 SET CI=$$PUT^DMSQU(IEN,"FDA","ERR")
+36 IF $DATA(ERR)
DO ERR^DMSQU(F,SEQ,"INDEX PRIMARY KEY: COLUMN INSERT FAILED")
QUIT
+37 SET PAR=CI
+38 ;DEFINE PRIMARY KEY
+39 SET TT=1.5218
SET PI=$ORDER(^DMSQ("P","C",PEI,SEQ,""))
SET IEN=$SELECT(PI:PI,1:"+1")_","
+40 ; TABLE ELEMENT
SET FDA(TT,IEN,.01)=PEI
+41 ; COLUMN
SET FDA(TT,IEN,1)=CI
+42 ; SEQUENCE NUMBER
SET FDA(TT,IEN,2)=SEQ
+43 ; ALWAYS START AT 0
SET FDA(TT,IEN,3)=0
+44 ; STOP AT EXPRESSION
SET FDA(TT,IEN,4)="'{K}"
+45 SET CI=$$PUT^DMSQU(IEN,"FDA","ERR")
+46 IF $DATA(ERR)
DO ERR^DMSQU(F,SEQ,"INDEX PRIMARY KEY: TABLE ELEMENT INSERT FAILED")
+47 QUIT
FK(CI) ;DEFINE FOREIGN KEY FOR POINTER COLUMN CI
+1 NEW C,CEI,CE,CN,F,FI,TI,SP,FF,FIEN,FTI,FTN,FPEI,FPE,FPI,FNM,TT,IEN,FDA
+2 SET C=^DMSQ("C",CI,0)
+3 SET CEI=$PIECE(C,U)
SET CE=^DMSQ("E",CEI,0)
SET CN=$PIECE(CE,U)
if $PIECE(CE,U,2)'=13
QUIT ""
+4 SET F=$PIECE(C,U,5)
SET FI=$PIECE(C,U,6)
IF 'F!'FI
QUIT ""
+5 SET TI=$PIECE(CE,U,3)
SET SP=$PIECE(^DD(F,FI,0),U,2)
+6 SET FF=+$PIECE(SP,"P",2)
+7 IF 'FF
DO ERR^DMSQU(F,FI,"FOREIGN KEY: NO POINTED-TO FILE IN SPECIFIER")
QUIT ""
+8 SET FTI=$ORDER(^DMSQ("T","C",FF,""))
+9 IF 'FTI
DO ERR^DMSQU(F,FI,"FOREIGN KEY: NO TABLE FOR POINTED-TO FILE")
QUIT ""
+10 SET FTN=$PIECE(^DMSQ("T",FTI,0),U)
+11 SET FPEI=$ORDER(^DMSQ("E","F",FTI,"P",""))
+12 IF 'FPEI
DO ERR^DMSQU(F,FI,"FOREIGN KEY: NO PRIMARY KEY TABLE ELEMENT")
QUIT ""
+13 SET FPE=^DMSQ("E",FPEI,0)
SET FDI=$PIECE(FPE,U,2)
+14 SET FPI=$ORDER(^DMSQ("P","B",FPEI,""))
+15 IF 'FPI
DO ERR^DMSQU(F,FI,"FOREIGN KEY: NO ASSOCIATED PRIMARY KEY")
QUIT ""
+16 SET FCI=$PIECE(^DMSQ("P",FPI,0),U,2)
+17 SET FNM=CN_"_FK"
SET IEN=$ORDER(^DMSQ("E","G",TI,FNM,""))
+18 ;BUILD FOREIGN KEY TABLE ELEMENT
+19 SET TT=1.5216
SET IEN=$SELECT(IEN:IEN,1:"+1")_","
+20 ;FOREIGN KEY NAME
SET FDA(TT,IEN,.01)=FNM
+21 ;DOMAIN = FOREIGN KEY TABLE DOMAIN
SET FDA(TT,IEN,1)=FDI
+22 ;TABLE ID
SET FDA(TT,IEN,2)=TI
+23 ;TYPE F = FOREIGN KEY
SET FDA(TT,IEN,3)="F"
+24 ;COMMENT
SET FDA(TT,IEN,4)="Foreign key to "_FTN
+25 SET FIEN=$$PUT^DMSQU(IEN,"FDA","ERR")
+26 IF $DATA(ERR)
DO ERR^DMSQU(F,FI,"FOREIGN KEY: TABLE ELEMENT INSERT FAILED")
QUIT ""
+27 ;BUILD FOREIGN KEY COLUMN ELEMENT
+28 SET TT=1.5219
SET IEN=$ORDER(^DMSQ("F","B",FIEN,""))
SET IEN=$SELECT(IEN:IEN,1:"+1")_","
+29 ;FK TABLE ELEMENT ID
SET FDA(TT,IEN,.01)=FIEN
+30 ;FOREIGN TABLE PRIMARY KEY ELEMENT ID
SET FDA(TT,IEN,1)=FPI
+31 ;COLUMN ID IN LOCAL TABLE
SET FDA(TT,IEN,2)=CI
+32 SET FIEN=$$PUT^DMSQU(IEN,"FDA","ERR")
+33 IF $DATA(ERR)
DO ERR^DMSQU(F,FI,"FOREIGN KEY: COLUMN ELEMENT INSERT FAILED")
+34 QUIT FIEN
