source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DMSQF.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1DMSQF ;SFISC/JHM-INITIALIZE SQLI_FILE ;11/17/97 13:28
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5INI ;INITIALIZE ^DMSQ - CLEAR ALL TABLES
6 N I F I="S","KF","T","E","C","P","F","EX","ET","DT","DM","OF" D CLF^DMSQU(I)
7 D DMDT^DMSQD,LCKF^DMSQD ;INSTALL DOMAINS, DATA TYPES AND KEY FORMATS
8 D SCHEMA^DMSQS ;BUILD STANDARD SQLI SCHEMA
9 Q
10ET(T) D ET^DMSQU(T)
11 Q
12ALLF(I) ;INITIALIZE IF I. COMPILE ALL FILES, TABLE ELEMENTS AND INDICIES
13 I $G(DUZ(0))'["@" Q
14 N @$$NEW^DMSQU
15 N GF,PE,%H,F,IEN,IENL,FCI,FDI,T,TI,TT,KFI,KIE,KIX,KL,LK,FI,CEI,CI,FKI
16 N ET,TCT S ET=$H D INI:I,ENV^DMSQU
17 S (TCT,F)=0 F S F=$O(^DIC(F)) Q:'F D STORE(F),SF(F,""):TI
18 W ! D ET(ET) W ! S (TCT,TI)=0
19 F S TI=$O(^DMSQ("T",TI)) Q:'TI D
20 . D E(TI) I $D(ZTQUEUED)!$D(DMDOT) S TCT=TCT+1 W:$Y>29 ! W:TCT#20=1 "."
21 . E W $C(13),"Columns of ",TI
22 W ! D ET(ET) W !
23 S CEI="",TCT=0 F S CEI=$O(^DMSQ("E","C",13,CEI)) Q:CEI="" D
24 . S CI=$O(^DMSQ("C","B",CEI,""))
25 . I CI S FKI=$$FK^DMSQF1(CI) I FKI D
26 . . I $D(ZTQUEUED)!$D(DMDOT) S TCT=TCT+1 W:$Y>29 ! W:TCT#20=1 "."
27 . . E W $C(13),"Foreign key ",FKI
28 W ! D ET(ET) W !
29 S (TCT,TI)=0 F S TI=$O(^DMSQ("T",TI)) Q:'TI D
30 . Q:$P(^DMSQ("T",TI,0),U,4) D INDEX^DMSQF2(TI)
31 . I $D(ZTQUEUED)!$D(DMDOT) S TCT=TCT+1 W:$Y>29 ! W:TCT#20=1 "."
32 . E W $C(13),"Index ",TI
33 . D PFK^DMSQF2(TI)
34 W ! D ET(ET)
35 Q
36ONEF(F) ;COMPILE FILE F, COLUMNS AND INDICIES
37 I $G(DUZ(0))'="@" Q
38 I '$$FIL^DMSQU(F) D ERR^DMSQU(F,"","ONEF: NO PARENT STRUCTURE") Q
39 N @$$NEW^DMSQU,TI,CEI,CI,FKI D ENV^DMSQU
40 S TI=$$FILE(F) I 'TI Q
41 D E(TI) S CEI="" F S CEI=$O(^DMSQ("E","D",TI,CEI)) Q:'CEI D
42 . S E=^DMSQ("E",CEI,0) Q:$P(E,U,2)'=13
43 . S CI=$O(^DMSQ("C","B",CEI,"")) Q:'CI
44 . S FKI=$$FK^DMSQF1(CI)
45 D PFK^DMSQF2(TI)
46 I '$P(^DMSQ("T",TI,0),U,4) D INDEX^DMSQF2(TI)
47 Q
48SF(P,F) ;RECURSIVELY PARSE AND COMPILE SUBFILES (F) OF PARENT FILE (P)
49 F S F=$O(^DD(P,"SB",F)) Q:'F D
50 . I $G(^DD(F,0,"UP"))'=P D ERR^DMSQU(F,P,"SUBFILE: BAD UP-LINK TO PARENT") Q
51 . D STORE(F),SF(F,""):TI
52 Q
53STORE(F) S TI=$$FILE(F)
54 I $D(ZTQUEUED)!$D(DMDOT) S TCT=TCT+1 W:$Y>29 ! W:TCT#20=1 "."
55 E W:TI $C(13),"Table ",TI
56 Q
57E(TI) ;BUILD COLUMNS
58 N LK,F,FI,CI
59 S F=$P(^DMSQ("T",TI,0),U,7),FI=.001
60 F S FI=$O(^DD(F,FI)) Q:'FI S CI=$$C(F,FI)
61 Q
62FILE(F) ;COMPILE SQLI FOR FILE #F
63 N TI,DS,P,X,TF,IEN,FIL,NM,FDA
64 S TI=$O(^DMSQ("T","C",F,""))
65 I F=.6!(F=1.1) D ERR^DMSQU(F,"","FILE: NOT FILEMAN COMPATIBLE") Q ""
66 I $D(^DIC(F)) D Q:$D(ERR) ""
67 . K ERR,DIERR D FILE^DID(F,"","NAME;DESCRIPTION","FIL","ERR")
68 . I $D(ERR) D ERR^DMSQU(F,"","FILE: NO DESCRIPTION") Q
69 . I '$D(FIL("DESCRIPTION")) D ERR^DMSQU(F,"","FILE: NULL DESCRIPTION") Q
70 . S DS=$E($G(FIL("DESCRIPTION",1)),1,60)
71 . F Q:DS'[U S DS=$P(DS,U)_"<94>"_$P(DS,U,2,99)
72 E D I 'P D ERR^DMSQU(F,"","FILE: SUBFILE WITHOUT PARENT") Q ""
73 . S FIL("NAME")=$O(^DD(F,0,"NM","")),P=$G(^DD(F,0,"UP"))
74 . I P S DS="Subfile of "_$O(^DD(P,0,"NM",""))
75 I $G(FIL("NAME"))="" D ERR^DMSQU(F,"","FILE: NO NAME") Q ""
76 I FIL("NAME")?1"*".E D ERR^DMSQU(F,"","FILE: OBSOLETE") Q ""
77 S X=$$ROOT^DMSQU(F)
78 I X="^" D ERR^DMSQU(F,"","FILE: NO GLOBAL ROOT") Q ""
79 S FIL("GLOBAL NAME")=X
80 S NM=$$FNB^DMSQU(F,TI) I NM="" D ERR^DMSQU(F,"","FILE: CAN'T BUILD SQL NAME") Q ""
81 S TF=1.5215,IEN=$S(TI:TI,1:"+1")_","
82 K FDA
83 S FDA(TF,IEN,.01)=NM ;LABEL
84 S FDA(TF,IEN,1)=1 ;SCHEMA SQLI
85 S FDA(TF,IEN,2)=DS ;DESCRIPTION
86 S FDA(TF,IEN,4)=1 ;VERSION NUMBER
87 S FDA(TF,IEN,6)=F ;SOURCE FILE
88 S FDA(TF,IEN,7)=DT ;UPDATE DATE
89 S FDA(TF,IEN,8)=FIL("GLOBAL NAME") ;FULL GLOBAL REFERENCE
90 S TI=$$PUT^DMSQU(IEN,"FDA","ERR")
91 I $D(ERR) D ERR^DMSQU(F,"","FILE: INSERT OF TABLE FAILED")
92 I TI S X=$$PK^DMSQF1(TI)
93 Q TI
94GETEXEC ;S {V}=$$GET1^DIQ({F},{IENS},{FI})
95C(F,FI) ;GENERATE NON-KEY ELEMENT/COLUMNS FOR FILE F, FIELD FI
96 I '$G(DIFM) D ENV^DMSQU
97 N RQ,OF,P,WP,FDA,CI,CEI,TI,TN,DM,DEF,CM,CN,TP,W,S,TT,IEN,X,CX,FX,XX
98 N G,PC,E
99 S CI=$O(^DMSQ("C","D",F,FI,"")),CEI=$S(CI:$P(^DMSQ("C",CI,0),U),1:"")
100 I CI,'CEI D ERR^DMSQU(F,FI,"COLUMN: NO CORRESPONDING TABLE ELEMENT") Q ""
101 S TI=$O(^DMSQ("T","C",F,""))
102 I 'TI D ERR^DMSQU(F,FI,"COLUMN: NO ASSOCIATED TABLE") Q ""
103 I $P(^DMSQ("T",TI,0),U,4) Q "" ;SKIP INDEX TABLES
104 S TN=$P(^DMSQ("T",TI,0),U)
105 S DM=$$DOM^DMSQU(F,FI,.DEF)
106 I $D(ERR)!$D(DIERR) D ERR^DMSQU(F,FI,"COLUMN: CAN'T GET FIELD ELEMENTS") Q ""
107 I DM="" D ERR^DMSQU(F,FI,"COLUMN: NULL FIELD TYPE (DOMAIN)") Q ""
108 I DEF("LABEL")?1"*".E Q ""
109 I DEF("LABEL")?.P D ERR^DMSQU(F,FI,"COLUMN: INVALID FIELD LABEL") Q ""
110 S CN=$$CN^DMSQU(TI,CEI,DEF("LABEL")),TP=DEF("TYPE")
111 S WP=TP="WORD-PROCESSING",CM=DEF("DESCRIPTION")
112 F Q:CM'[U S CM=$P(CM,U)_"<94>"_$P(CM,U,2,99)
113 I CM="" S CM="Column header for "_TN_"."_CN
114 I DEF("MULTIPLE-VALUED"),'WP Q ""
115 I WP,FI=.01 S $P(DM,U)="CHARACTER"
116 S OF="" I TP="SET" S X=DEF("POINTER"),OF=$$SETOF^DMSQD(.X)
117 S (CX,FX,XX)="" I "COMPUTED,POINTER,VARIABLE-POINTER"[TP D
118 . N IEN S IEN=""""_$$VIEN^DMSQU(TI)_""""
119 . S XX=1,FX="S {V}=$$GET^DMSQU("_F_","_IEN_","_FI_")"
120 . I TP="COMPUTED" S CX=DEF("INPUT TRANSFORM")
121 I TP="POINTER" S OF=$$PTROF^DMSQD(+$P(DEF("SPECIFIER"),"P",2))
122 E I TP="VARIABLE-POINTER" S OF=$$VPTOF^DMSQD(F,FI)
123 S W=$P(DM,U,2),S=$P(DM,U,3)
124 I S<0 D ERR^DMSQU(F,FI,"COLUMN: DECIMAL DEFAULT IS NEGATIVE") Q ""
125 S RQ=$S(WP:0,FI=.01:1,DEF("SPECIFIER")["R"&$D(^DD(F,0,"ID",FI)):1,1:0)
126 S DM=$P(DM,U),DI=$O(^DMSQ("DM","B",DM,""))
127 I 'DI D ERR^DMSQU(F,FI,"COLUMN: FIELD TYPE NOT KNOWN TO SQLI") Q ""
128 ;DEFINE COLUMN ELEMENT
129 S TT=1.5216,IEN=$S(CEI:CEI,1:"+1")_","
130 S FDA(TT,IEN,.01)=CN ;COLUMN NAME
131 S FDA(TT,IEN,1)=DI ;DOMAIN
132 S FDA(TT,IEN,2)=TI ;COLUMN TABLE
133 S FDA(TT,IEN,3)="C" ;TYPE C = COLUMN
134 S FDA(TT,IEN,4)=CM ;DESCRIPTION
135 S CEI=$$PUT^DMSQU(IEN,"FDA","ERR")
136 I $D(ERR) D ERR^DMSQU(F,FI,"COLUMN: INSERT OF COLUMN ELEMENT FAILED") Q ""
137 ;DEFINE COLUMN
138 S TT=1.5217,IEN=$S(CI:CI,1:"+1")_","
139 S FDA(TT,IEN,.01)=CEI ;COLUMN TABLE ELEMENT
140 S FDA(TT,IEN,1)=F ;FILEMAN FILE NUMBER
141 S FDA(TT,IEN,2)=W ;FIELD LENGTH
142 S FDA(TT,IEN,3)=S ;DECIMAL POINTS
143 S FDA(TT,IEN,4)=FI ;FILEMAN FIELD NUMBER
144 S FDA(TT,IEN,5)=RQ ;REQUIRED FLAG
145 I XX D G CPUT:TP="COMPUTED"
146 . S FDA(TT,IEN,7)=1
147 . S:CX]"" FDA(TT,IEN,13)=CX ; DIRECT COMPUTATION EXECUTE
148 . S:FX]"" FDA(TT,IEN,14)=FX ; FILEMAN $$GET1^DIQ EXECUTE
149 S FDA(TT,IEN,6)=0 ;SECURITY FLAG - NEED LOGIC TO SET THIS RIGHT
150 S FDA(TT,IEN,7)=0 ;NOT CALCULATED
151 S P=$$PAR^DMSQU(TI,DEF("GLOBAL SUBSCRIPT LOCATION"),.G,.PC,.E)
152 I DEF("TYPE")="MUMPS" S PC=""
153 S FDA(TT,IEN,8)=P ;PARENT COLUMN (LAST PRIMARY KEY)
154 S FDA(TT,IEN,9)=G ;GLOBAL FRAGMENT
155 I PC,'WP S FDA(TT,IEN,10)=PC ;PIECE (WP .01 FIELDS ARE REALLY TYPE K!)
156 E D:E
157 . S FDA(TT,IEN,11)=+E,FDA(TT,IEN,12)=$P(E,",",2) ;EXTRACT FROM TO
158 I DEF("POINTER")]"" S FDA(TT,IEN,15)=DEF("POINTER") ; POINTER OR SET
159 I OF S FDA(TT,IEN,16)=OF ; OUTPUT FORMAT IF ANY
160CPUT S CI=$$PUT^DMSQU(IEN,"FDA","ERR")
161 I $D(ERR) D
162 . D ERR^DMSQU(F,FI,"COLUMN: INSERT OF COLUMN RECORD FAILED")
163CQ Q CI
Note: See TracBrowser for help on using the repository browser.