164 lines
6.7 KiB
Mathematica
164 lines
6.7 KiB
Mathematica
DMSQF ;SFISC/JHM-INITIALIZE SQLI_FILE ;11/17/97 13:28
|
|
;;22.0;VA FileMan;;Mar 30, 1999
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
INI ;INITIALIZE ^DMSQ - CLEAR ALL TABLES
|
|
N I F I="S","KF","T","E","C","P","F","EX","ET","DT","DM","OF" D CLF^DMSQU(I)
|
|
D DMDT^DMSQD,LCKF^DMSQD ;INSTALL DOMAINS, DATA TYPES AND KEY FORMATS
|
|
D SCHEMA^DMSQS ;BUILD STANDARD SQLI SCHEMA
|
|
Q
|
|
ET(T) D ET^DMSQU(T)
|
|
Q
|
|
ALLF(I) ;INITIALIZE IF I. COMPILE ALL FILES, TABLE ELEMENTS AND INDICIES
|
|
I $G(DUZ(0))'["@" Q
|
|
N @$$NEW^DMSQU
|
|
N GF,PE,%H,F,IEN,IENL,FCI,FDI,T,TI,TT,KFI,KIE,KIX,KL,LK,FI,CEI,CI,FKI
|
|
N ET,TCT S ET=$H D INI:I,ENV^DMSQU
|
|
S (TCT,F)=0 F S F=$O(^DIC(F)) Q:'F D STORE(F),SF(F,""):TI
|
|
W ! D ET(ET) W ! S (TCT,TI)=0
|
|
F S TI=$O(^DMSQ("T",TI)) Q:'TI D
|
|
. D E(TI) I $D(ZTQUEUED)!$D(DMDOT) S TCT=TCT+1 W:$Y>29 ! W:TCT#20=1 "."
|
|
. E W $C(13),"Columns of ",TI
|
|
W ! D ET(ET) W !
|
|
S CEI="",TCT=0 F S CEI=$O(^DMSQ("E","C",13,CEI)) Q:CEI="" D
|
|
. S CI=$O(^DMSQ("C","B",CEI,""))
|
|
. I CI S FKI=$$FK^DMSQF1(CI) I FKI D
|
|
. . I $D(ZTQUEUED)!$D(DMDOT) S TCT=TCT+1 W:$Y>29 ! W:TCT#20=1 "."
|
|
. . E W $C(13),"Foreign key ",FKI
|
|
W ! D ET(ET) W !
|
|
S (TCT,TI)=0 F S TI=$O(^DMSQ("T",TI)) Q:'TI D
|
|
. Q:$P(^DMSQ("T",TI,0),U,4) D INDEX^DMSQF2(TI)
|
|
. I $D(ZTQUEUED)!$D(DMDOT) S TCT=TCT+1 W:$Y>29 ! W:TCT#20=1 "."
|
|
. E W $C(13),"Index ",TI
|
|
. D PFK^DMSQF2(TI)
|
|
W ! D ET(ET)
|
|
Q
|
|
ONEF(F) ;COMPILE FILE F, COLUMNS AND INDICIES
|
|
I $G(DUZ(0))'="@" Q
|
|
I '$$FIL^DMSQU(F) D ERR^DMSQU(F,"","ONEF: NO PARENT STRUCTURE") Q
|
|
N @$$NEW^DMSQU,TI,CEI,CI,FKI D ENV^DMSQU
|
|
S TI=$$FILE(F) I 'TI Q
|
|
D E(TI) S CEI="" F S CEI=$O(^DMSQ("E","D",TI,CEI)) Q:'CEI D
|
|
. S E=^DMSQ("E",CEI,0) Q:$P(E,U,2)'=13
|
|
. S CI=$O(^DMSQ("C","B",CEI,"")) Q:'CI
|
|
. S FKI=$$FK^DMSQF1(CI)
|
|
D PFK^DMSQF2(TI)
|
|
I '$P(^DMSQ("T",TI,0),U,4) D INDEX^DMSQF2(TI)
|
|
Q
|
|
SF(P,F) ;RECURSIVELY PARSE AND COMPILE SUBFILES (F) OF PARENT FILE (P)
|
|
F S F=$O(^DD(P,"SB",F)) Q:'F D
|
|
. I $G(^DD(F,0,"UP"))'=P D ERR^DMSQU(F,P,"SUBFILE: BAD UP-LINK TO PARENT") Q
|
|
. D STORE(F),SF(F,""):TI
|
|
Q
|
|
STORE(F) S TI=$$FILE(F)
|
|
I $D(ZTQUEUED)!$D(DMDOT) S TCT=TCT+1 W:$Y>29 ! W:TCT#20=1 "."
|
|
E W:TI $C(13),"Table ",TI
|
|
Q
|
|
E(TI) ;BUILD COLUMNS
|
|
N LK,F,FI,CI
|
|
S F=$P(^DMSQ("T",TI,0),U,7),FI=.001
|
|
F S FI=$O(^DD(F,FI)) Q:'FI S CI=$$C(F,FI)
|
|
Q
|
|
FILE(F) ;COMPILE SQLI FOR FILE #F
|
|
N TI,DS,P,X,TF,IEN,FIL,NM,FDA
|
|
S TI=$O(^DMSQ("T","C",F,""))
|
|
I F=.6!(F=1.1) D ERR^DMSQU(F,"","FILE: NOT FILEMAN COMPATIBLE") Q ""
|
|
I $D(^DIC(F)) D Q:$D(ERR) ""
|
|
. K ERR,DIERR D FILE^DID(F,"","NAME;DESCRIPTION","FIL","ERR")
|
|
. I $D(ERR) D ERR^DMSQU(F,"","FILE: NO DESCRIPTION") Q
|
|
. I '$D(FIL("DESCRIPTION")) D ERR^DMSQU(F,"","FILE: NULL DESCRIPTION") Q
|
|
. S DS=$E($G(FIL("DESCRIPTION",1)),1,60)
|
|
. F Q:DS'[U S DS=$P(DS,U)_"<94>"_$P(DS,U,2,99)
|
|
E D I 'P D ERR^DMSQU(F,"","FILE: SUBFILE WITHOUT PARENT") Q ""
|
|
. S FIL("NAME")=$O(^DD(F,0,"NM","")),P=$G(^DD(F,0,"UP"))
|
|
. I P S DS="Subfile of "_$O(^DD(P,0,"NM",""))
|
|
I $G(FIL("NAME"))="" D ERR^DMSQU(F,"","FILE: NO NAME") Q ""
|
|
I FIL("NAME")?1"*".E D ERR^DMSQU(F,"","FILE: OBSOLETE") Q ""
|
|
S X=$$ROOT^DMSQU(F)
|
|
I X="^" D ERR^DMSQU(F,"","FILE: NO GLOBAL ROOT") Q ""
|
|
S FIL("GLOBAL NAME")=X
|
|
S NM=$$FNB^DMSQU(F,TI) I NM="" D ERR^DMSQU(F,"","FILE: CAN'T BUILD SQL NAME") Q ""
|
|
S TF=1.5215,IEN=$S(TI:TI,1:"+1")_","
|
|
K FDA
|
|
S FDA(TF,IEN,.01)=NM ;LABEL
|
|
S FDA(TF,IEN,1)=1 ;SCHEMA SQLI
|
|
S FDA(TF,IEN,2)=DS ;DESCRIPTION
|
|
S FDA(TF,IEN,4)=1 ;VERSION NUMBER
|
|
S FDA(TF,IEN,6)=F ;SOURCE FILE
|
|
S FDA(TF,IEN,7)=DT ;UPDATE DATE
|
|
S FDA(TF,IEN,8)=FIL("GLOBAL NAME") ;FULL GLOBAL REFERENCE
|
|
S TI=$$PUT^DMSQU(IEN,"FDA","ERR")
|
|
I $D(ERR) D ERR^DMSQU(F,"","FILE: INSERT OF TABLE FAILED")
|
|
I TI S X=$$PK^DMSQF1(TI)
|
|
Q TI
|
|
GETEXEC ;S {V}=$$GET1^DIQ({F},{IENS},{FI})
|
|
C(F,FI) ;GENERATE NON-KEY ELEMENT/COLUMNS FOR FILE F, FIELD FI
|
|
I '$G(DIFM) D ENV^DMSQU
|
|
N RQ,OF,P,WP,FDA,CI,CEI,TI,TN,DM,DEF,CM,CN,TP,W,S,TT,IEN,X,CX,FX,XX
|
|
N G,PC,E
|
|
S CI=$O(^DMSQ("C","D",F,FI,"")),CEI=$S(CI:$P(^DMSQ("C",CI,0),U),1:"")
|
|
I CI,'CEI D ERR^DMSQU(F,FI,"COLUMN: NO CORRESPONDING TABLE ELEMENT") Q ""
|
|
S TI=$O(^DMSQ("T","C",F,""))
|
|
I 'TI D ERR^DMSQU(F,FI,"COLUMN: NO ASSOCIATED TABLE") Q ""
|
|
I $P(^DMSQ("T",TI,0),U,4) Q "" ;SKIP INDEX TABLES
|
|
S TN=$P(^DMSQ("T",TI,0),U)
|
|
S DM=$$DOM^DMSQU(F,FI,.DEF)
|
|
I $D(ERR)!$D(DIERR) D ERR^DMSQU(F,FI,"COLUMN: CAN'T GET FIELD ELEMENTS") Q ""
|
|
I DM="" D ERR^DMSQU(F,FI,"COLUMN: NULL FIELD TYPE (DOMAIN)") Q ""
|
|
I DEF("LABEL")?1"*".E Q ""
|
|
I DEF("LABEL")?.P D ERR^DMSQU(F,FI,"COLUMN: INVALID FIELD LABEL") Q ""
|
|
S CN=$$CN^DMSQU(TI,CEI,DEF("LABEL")),TP=DEF("TYPE")
|
|
S WP=TP="WORD-PROCESSING",CM=DEF("DESCRIPTION")
|
|
F Q:CM'[U S CM=$P(CM,U)_"<94>"_$P(CM,U,2,99)
|
|
I CM="" S CM="Column header for "_TN_"."_CN
|
|
I DEF("MULTIPLE-VALUED"),'WP Q ""
|
|
I WP,FI=.01 S $P(DM,U)="CHARACTER"
|
|
S OF="" I TP="SET" S X=DEF("POINTER"),OF=$$SETOF^DMSQD(.X)
|
|
S (CX,FX,XX)="" I "COMPUTED,POINTER,VARIABLE-POINTER"[TP D
|
|
. N IEN S IEN=""""_$$VIEN^DMSQU(TI)_""""
|
|
. S XX=1,FX="S {V}=$$GET^DMSQU("_F_","_IEN_","_FI_")"
|
|
. I TP="COMPUTED" S CX=DEF("INPUT TRANSFORM")
|
|
I TP="POINTER" S OF=$$PTROF^DMSQD(+$P(DEF("SPECIFIER"),"P",2))
|
|
E I TP="VARIABLE-POINTER" S OF=$$VPTOF^DMSQD(F,FI)
|
|
S W=$P(DM,U,2),S=$P(DM,U,3)
|
|
I S<0 D ERR^DMSQU(F,FI,"COLUMN: DECIMAL DEFAULT IS NEGATIVE") Q ""
|
|
S RQ=$S(WP:0,FI=.01:1,DEF("SPECIFIER")["R"&$D(^DD(F,0,"ID",FI)):1,1:0)
|
|
S DM=$P(DM,U),DI=$O(^DMSQ("DM","B",DM,""))
|
|
I 'DI D ERR^DMSQU(F,FI,"COLUMN: FIELD TYPE NOT KNOWN TO SQLI") Q ""
|
|
;DEFINE COLUMN ELEMENT
|
|
S TT=1.5216,IEN=$S(CEI:CEI,1:"+1")_","
|
|
S FDA(TT,IEN,.01)=CN ;COLUMN NAME
|
|
S FDA(TT,IEN,1)=DI ;DOMAIN
|
|
S FDA(TT,IEN,2)=TI ;COLUMN TABLE
|
|
S FDA(TT,IEN,3)="C" ;TYPE C = COLUMN
|
|
S FDA(TT,IEN,4)=CM ;DESCRIPTION
|
|
S CEI=$$PUT^DMSQU(IEN,"FDA","ERR")
|
|
I $D(ERR) D ERR^DMSQU(F,FI,"COLUMN: INSERT OF COLUMN ELEMENT FAILED") Q ""
|
|
;DEFINE COLUMN
|
|
S TT=1.5217,IEN=$S(CI:CI,1:"+1")_","
|
|
S FDA(TT,IEN,.01)=CEI ;COLUMN TABLE ELEMENT
|
|
S FDA(TT,IEN,1)=F ;FILEMAN FILE NUMBER
|
|
S FDA(TT,IEN,2)=W ;FIELD LENGTH
|
|
S FDA(TT,IEN,3)=S ;DECIMAL POINTS
|
|
S FDA(TT,IEN,4)=FI ;FILEMAN FIELD NUMBER
|
|
S FDA(TT,IEN,5)=RQ ;REQUIRED FLAG
|
|
I XX D G CPUT:TP="COMPUTED"
|
|
. S FDA(TT,IEN,7)=1
|
|
. S:CX]"" FDA(TT,IEN,13)=CX ; DIRECT COMPUTATION EXECUTE
|
|
. S:FX]"" FDA(TT,IEN,14)=FX ; FILEMAN $$GET1^DIQ EXECUTE
|
|
S FDA(TT,IEN,6)=0 ;SECURITY FLAG - NEED LOGIC TO SET THIS RIGHT
|
|
S FDA(TT,IEN,7)=0 ;NOT CALCULATED
|
|
S P=$$PAR^DMSQU(TI,DEF("GLOBAL SUBSCRIPT LOCATION"),.G,.PC,.E)
|
|
I DEF("TYPE")="MUMPS" S PC=""
|
|
S FDA(TT,IEN,8)=P ;PARENT COLUMN (LAST PRIMARY KEY)
|
|
S FDA(TT,IEN,9)=G ;GLOBAL FRAGMENT
|
|
I PC,'WP S FDA(TT,IEN,10)=PC ;PIECE (WP .01 FIELDS ARE REALLY TYPE K!)
|
|
E D:E
|
|
. S FDA(TT,IEN,11)=+E,FDA(TT,IEN,12)=$P(E,",",2) ;EXTRACT FROM TO
|
|
I DEF("POINTER")]"" S FDA(TT,IEN,15)=DEF("POINTER") ; POINTER OR SET
|
|
I OF S FDA(TT,IEN,16)=OF ; OUTPUT FORMAT IF ANY
|
|
CPUT S CI=$$PUT^DMSQU(IEN,"FDA","ERR")
|
|
I $D(ERR) D
|
|
. D ERR^DMSQU(F,FI,"COLUMN: INSERT OF COLUMN RECORD FAILED")
|
|
CQ Q CI
|