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

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