- DMSQF ;SFISC/JHM-INITIALIZE SQLI_FILE ;11/17/97 13:28
- ;;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
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDMSQF 7206 printed Feb 19, 2025@00:21:21 Page 2
- DMSQF ;SFISC/JHM-INITIALIZE SQLI_FILE ;11/17/97 13:28
- +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
- INI ;INITIALIZE ^DMSQ - CLEAR ALL TABLES
- +1 NEW I
- FOR I="S","KF","T","E","C","P","F","EX","ET","DT","DM","OF"
- DO CLF^DMSQU(I)
- +2 ;INSTALL DOMAINS, DATA TYPES AND KEY FORMATS
- DO DMDT^DMSQD
- DO LCKF^DMSQD
- +3 ;BUILD STANDARD SQLI SCHEMA
- DO SCHEMA^DMSQS
- +4 QUIT
- ET(T) DO ET^DMSQU(T)
- +1 QUIT
- ALLF(I) ;INITIALIZE IF I. COMPILE ALL FILES, TABLE ELEMENTS AND INDICIES
- +1 IF $GET(DUZ(0))'["@"
- QUIT
- +2 NEW @$$NEW^DMSQU
- +3 NEW GF,PE,%H,F,IEN,IENL,FCI,FDI,T,TI,TT,KFI,KIE,KIX,KL,LK,FI,CEI,CI,FKI
- +4 NEW ET,TCT
- SET ET=$HOROLOG
- if I
- DO INI
- DO ENV^DMSQU
- +5 SET (TCT,F)=0
- FOR
- SET F=$ORDER(^DIC(F))
- if 'F
- QUIT
- DO STORE(F)
- if TI
- DO SF(F,"")
- +6 WRITE !
- DO ET(ET)
- WRITE !
- SET (TCT,TI)=0
- +7 FOR
- SET TI=$ORDER(^DMSQ("T",TI))
- if 'TI
- QUIT
- Begin DoDot:1
- +8 DO E(TI)
- IF $DATA(ZTQUEUED)!$DATA(DMDOT)
- SET TCT=TCT+1
- if $Y>29
- WRITE !
- if TCT#20=1
- WRITE "."
- +9 IF '$TEST
- WRITE $CHAR(13),"Columns of ",TI
- End DoDot:1
- +10 WRITE !
- DO ET(ET)
- WRITE !
- +11 SET CEI=""
- SET TCT=0
- FOR
- SET CEI=$ORDER(^DMSQ("E","C",13,CEI))
- if CEI=""
- QUIT
- Begin DoDot:1
- +12 SET CI=$ORDER(^DMSQ("C","B",CEI,""))
- +13 IF CI
- SET FKI=$$FK^DMSQF1(CI)
- IF FKI
- Begin DoDot:2
- +14 IF $DATA(ZTQUEUED)!$DATA(DMDOT)
- SET TCT=TCT+1
- if $Y>29
- WRITE !
- if TCT#20=1
- WRITE "."
- +15 IF '$TEST
- WRITE $CHAR(13),"Foreign key ",FKI
- End DoDot:2
- End DoDot:1
- +16 WRITE !
- DO ET(ET)
- WRITE !
- +17 SET (TCT,TI)=0
- FOR
- SET TI=$ORDER(^DMSQ("T",TI))
- if 'TI
- QUIT
- Begin DoDot:1
- +18 if $PIECE(^DMSQ("T",TI,0),U,4)
- QUIT
- DO INDEX^DMSQF2(TI)
- +19 IF $DATA(ZTQUEUED)!$DATA(DMDOT)
- SET TCT=TCT+1
- if $Y>29
- WRITE !
- if TCT#20=1
- WRITE "."
- +20 IF '$TEST
- WRITE $CHAR(13),"Index ",TI
- +21 DO PFK^DMSQF2(TI)
- End DoDot:1
- +22 WRITE !
- DO ET(ET)
- +23 QUIT
- ONEF(F) ;COMPILE FILE F, COLUMNS AND INDICIES
- +1 IF $GET(DUZ(0))'="@"
- QUIT
- +2 IF '$$FIL^DMSQU(F)
- DO ERR^DMSQU(F,"","ONEF: NO PARENT STRUCTURE")
- QUIT
- +3 NEW @$$NEW^DMSQU,TI,CEI,CI,FKI
- DO ENV^DMSQU
- +4 SET TI=$$FILE(F)
- IF 'TI
- QUIT
- +5 DO E(TI)
- SET CEI=""
- FOR
- SET CEI=$ORDER(^DMSQ("E","D",TI,CEI))
- if 'CEI
- QUIT
- Begin DoDot:1
- +6 SET E=^DMSQ("E",CEI,0)
- if $PIECE(E,U,2)'=13
- QUIT
- +7 SET CI=$ORDER(^DMSQ("C","B",CEI,""))
- if 'CI
- QUIT
- +8 SET FKI=$$FK^DMSQF1(CI)
- End DoDot:1
- +9 DO PFK^DMSQF2(TI)
- +10 IF '$PIECE(^DMSQ("T",TI,0),U,4)
- DO INDEX^DMSQF2(TI)
- +11 QUIT
- SF(P,F) ;RECURSIVELY PARSE AND COMPILE SUBFILES (F) OF PARENT FILE (P)
- +1 FOR
- SET F=$ORDER(^DD(P,"SB",F))
- if 'F
- QUIT
- Begin DoDot:1
- +2 IF $GET(^DD(F,0,"UP"))'=P
- DO ERR^DMSQU(F,P,"SUBFILE: BAD UP-LINK TO PARENT")
- QUIT
- +3 DO STORE(F)
- if TI
- DO SF(F,"")
- End DoDot:1
- +4 QUIT
- STORE(F) SET TI=$$FILE(F)
- +1 IF $DATA(ZTQUEUED)!$DATA(DMDOT)
- SET TCT=TCT+1
- if $Y>29
- WRITE !
- if TCT#20=1
- WRITE "."
- +2 IF '$TEST
- if TI
- WRITE $CHAR(13),"Table ",TI
- +3 QUIT
- E(TI) ;BUILD COLUMNS
- +1 NEW LK,F,FI,CI
- +2 SET F=$PIECE(^DMSQ("T",TI,0),U,7)
- SET FI=.001
- +3 FOR
- SET FI=$ORDER(^DD(F,FI))
- if 'FI
- QUIT
- SET CI=$$C(F,FI)
- +4 QUIT
- FILE(F) ;COMPILE SQLI FOR FILE #F
- +1 NEW TI,DS,P,X,TF,IEN,FIL,NM,FDA
- +2 SET TI=$ORDER(^DMSQ("T","C",F,""))
- +3 IF F=.6!(F=1.1)
- DO ERR^DMSQU(F,"","FILE: NOT FILEMAN COMPATIBLE")
- QUIT ""
- +4 IF $DATA(^DIC(F))
- Begin DoDot:1
- +5 KILL ERR,DIERR
- DO FILE^DID(F,"","NAME;DESCRIPTION","FIL","ERR")
- +6 IF $DATA(ERR)
- DO ERR^DMSQU(F,"","FILE: NO DESCRIPTION")
- QUIT
- +7 IF '$DATA(FIL("DESCRIPTION"))
- DO ERR^DMSQU(F,"","FILE: NULL DESCRIPTION")
- QUIT
- +8 SET DS=$EXTRACT($GET(FIL("DESCRIPTION",1)),1,60)
- +9 FOR
- if DS'[U
- QUIT
- SET DS=$PIECE(DS,U)_"<94>"_$PIECE(DS,U,2,99)
- End DoDot:1
- if $DATA(ERR)
- QUIT ""
- +10 IF '$TEST
- Begin DoDot:1
- +11 SET FIL("NAME")=$ORDER(^DD(F,0,"NM",""))
- SET P=$GET(^DD(F,0,"UP"))
- +12 IF P
- SET DS="Subfile of "_$ORDER(^DD(P,0,"NM",""))
- End DoDot:1
- IF 'P
- DO ERR^DMSQU(F,"","FILE: SUBFILE WITHOUT PARENT")
- QUIT ""
- +13 IF $GET(FIL("NAME"))=""
- DO ERR^DMSQU(F,"","FILE: NO NAME")
- QUIT ""
- +14 IF FIL("NAME")?1"*".E
- DO ERR^DMSQU(F,"","FILE: OBSOLETE")
- QUIT ""
- +15 SET X=$$ROOT^DMSQU(F)
- +16 IF X="^"
- DO ERR^DMSQU(F,"","FILE: NO GLOBAL ROOT")
- QUIT ""
- +17 SET FIL("GLOBAL NAME")=X
- +18 SET NM=$$FNB^DMSQU(F,TI)
- IF NM=""
- DO ERR^DMSQU(F,"","FILE: CAN'T BUILD SQL NAME")
- QUIT ""
- +19 SET TF=1.5215
- SET IEN=$SELECT(TI:TI,1:"+1")_","
- +20 KILL FDA
- +21 ;LABEL
- SET FDA(TF,IEN,.01)=NM
- +22 ;SCHEMA SQLI
- SET FDA(TF,IEN,1)=1
- +23 ;DESCRIPTION
- SET FDA(TF,IEN,2)=DS
- +24 ;VERSION NUMBER
- SET FDA(TF,IEN,4)=1
- +25 ;SOURCE FILE
- SET FDA(TF,IEN,6)=F
- +26 ;UPDATE DATE
- SET FDA(TF,IEN,7)=DT
- +27 ;FULL GLOBAL REFERENCE
- SET FDA(TF,IEN,8)=FIL("GLOBAL NAME")
- +28 SET TI=$$PUT^DMSQU(IEN,"FDA","ERR")
- +29 IF $DATA(ERR)
- DO ERR^DMSQU(F,"","FILE: INSERT OF TABLE FAILED")
- +30 IF TI
- SET X=$$PK^DMSQF1(TI)
- +31 QUIT TI
- GETEXEC ;S {V}=$$GET1^DIQ({F},{IENS},{FI})
- C(F,FI) ;GENERATE NON-KEY ELEMENT/COLUMNS FOR FILE F, FIELD FI
- +1 IF '$GET(DIFM)
- DO ENV^DMSQU
- +2 NEW RQ,OF,P,WP,FDA,CI,CEI,TI,TN,DM,DEF,CM,CN,TP,W,S,TT,IEN,X,CX,FX,XX
- +3 NEW G,PC,E
- +4 SET CI=$ORDER(^DMSQ("C","D",F,FI,""))
- SET CEI=$SELECT(CI:$PIECE(^DMSQ("C",CI,0),U),1:"")
- +5 IF CI
- IF 'CEI
- DO ERR^DMSQU(F,FI,"COLUMN: NO CORRESPONDING TABLE ELEMENT")
- QUIT ""
- +6 SET TI=$ORDER(^DMSQ("T","C",F,""))
- +7 IF 'TI
- DO ERR^DMSQU(F,FI,"COLUMN: NO ASSOCIATED TABLE")
- QUIT ""
- +8 ;SKIP INDEX TABLES
- IF $PIECE(^DMSQ("T",TI,0),U,4)
- QUIT ""
- +9 SET TN=$PIECE(^DMSQ("T",TI,0),U)
- +10 SET DM=$$DOM^DMSQU(F,FI,.DEF)
- +11 IF $DATA(ERR)!$DATA(DIERR)
- DO ERR^DMSQU(F,FI,"COLUMN: CAN'T GET FIELD ELEMENTS")
- QUIT ""
- +12 IF DM=""
- DO ERR^DMSQU(F,FI,"COLUMN: NULL FIELD TYPE (DOMAIN)")
- QUIT ""
- +13 IF DEF("LABEL")?1"*".E
- QUIT ""
- +14 IF DEF("LABEL")?.P
- DO ERR^DMSQU(F,FI,"COLUMN: INVALID FIELD LABEL")
- QUIT ""
- +15 SET CN=$$CN^DMSQU(TI,CEI,DEF("LABEL"))
- SET TP=DEF("TYPE")
- +16 SET WP=TP="WORD-PROCESSING"
- SET CM=DEF("DESCRIPTION")
- +17 FOR
- if CM'[U
- QUIT
- SET CM=$PIECE(CM,U)_"<94>"_$PIECE(CM,U,2,99)
- +18 IF CM=""
- SET CM="Column header for "_TN_"."_CN
- +19 IF DEF("MULTIPLE-VALUED")
- IF 'WP
- QUIT ""
- +20 IF WP
- IF FI=.01
- SET $PIECE(DM,U)="CHARACTER"
- +21 SET OF=""
- IF TP="SET"
- SET X=DEF("POINTER")
- SET OF=$$SETOF^DMSQD(.X)
- +22 SET (CX,FX,XX)=""
- IF "COMPUTED,POINTER,VARIABLE-POINTER"[TP
- Begin DoDot:1
- +23 NEW IEN
- SET IEN=""""_$$VIEN^DMSQU(TI)_""""
- +24 SET XX=1
- SET FX="S {V}=$$GET^DMSQU("_F_","_IEN_","_FI_")"
- +25 IF TP="COMPUTED"
- SET CX=DEF("INPUT TRANSFORM")
- End DoDot:1
- +26 IF TP="POINTER"
- SET OF=$$PTROF^DMSQD(+$PIECE(DEF("SPECIFIER"),"P",2))
- +27 IF '$TEST
- IF TP="VARIABLE-POINTER"
- SET OF=$$VPTOF^DMSQD(F,FI)
- +28 SET W=$PIECE(DM,U,2)
- SET S=$PIECE(DM,U,3)
- +29 IF S<0
- DO ERR^DMSQU(F,FI,"COLUMN: DECIMAL DEFAULT IS NEGATIVE")
- QUIT ""
- +30 SET RQ=$SELECT(WP:0,FI=.01:1,DEF("SPECIFIER")["R"&$DATA(^DD(F,0,"ID",FI)):1,1:0)
- +31 SET DM=$PIECE(DM,U)
- SET DI=$ORDER(^DMSQ("DM","B",DM,""))
- +32 IF 'DI
- DO ERR^DMSQU(F,FI,"COLUMN: FIELD TYPE NOT KNOWN TO SQLI")
- QUIT ""
- +33 ;DEFINE COLUMN ELEMENT
- +34 SET TT=1.5216
- SET IEN=$SELECT(CEI:CEI,1:"+1")_","
- +35 ;COLUMN NAME
- SET FDA(TT,IEN,.01)=CN
- +36 ;DOMAIN
- SET FDA(TT,IEN,1)=DI
- +37 ;COLUMN TABLE
- SET FDA(TT,IEN,2)=TI
- +38 ;TYPE C = COLUMN
- SET FDA(TT,IEN,3)="C"
- +39 ;DESCRIPTION
- SET FDA(TT,IEN,4)=CM
- +40 SET CEI=$$PUT^DMSQU(IEN,"FDA","ERR")
- +41 IF $DATA(ERR)
- DO ERR^DMSQU(F,FI,"COLUMN: INSERT OF COLUMN ELEMENT FAILED")
- QUIT ""
- +42 ;DEFINE COLUMN
- +43 SET TT=1.5217
- SET IEN=$SELECT(CI:CI,1:"+1")_","
- +44 ;COLUMN TABLE ELEMENT
- SET FDA(TT,IEN,.01)=CEI
- +45 ;FILEMAN FILE NUMBER
- SET FDA(TT,IEN,1)=F
- +46 ;FIELD LENGTH
- SET FDA(TT,IEN,2)=W
- +47 ;DECIMAL POINTS
- SET FDA(TT,IEN,3)=S
- +48 ;FILEMAN FIELD NUMBER
- SET FDA(TT,IEN,4)=FI
- +49 ;REQUIRED FLAG
- SET FDA(TT,IEN,5)=RQ
- +50 IF XX
- Begin DoDot:1
- +51 SET FDA(TT,IEN,7)=1
- +52 ; DIRECT COMPUTATION EXECUTE
- if CX]""
- SET FDA(TT,IEN,13)=CX
- +53 ; FILEMAN $$GET1^DIQ EXECUTE
- if FX]""
- SET FDA(TT,IEN,14)=FX
- End DoDot:1
- if TP="COMPUTED"
- GOTO CPUT
- +54 ;SECURITY FLAG - NEED LOGIC TO SET THIS RIGHT
- SET FDA(TT,IEN,6)=0
- +55 ;NOT CALCULATED
- SET FDA(TT,IEN,7)=0
- +56 SET P=$$PAR^DMSQU(TI,DEF("GLOBAL SUBSCRIPT LOCATION"),.G,.PC,.E)
- +57 IF DEF("TYPE")="MUMPS"
- SET PC=""
- +58 ;PARENT COLUMN (LAST PRIMARY KEY)
- SET FDA(TT,IEN,8)=P
- +59 ;GLOBAL FRAGMENT
- SET FDA(TT,IEN,9)=G
- +60 ;PIECE (WP .01 FIELDS ARE REALLY TYPE K!)
- IF PC
- IF 'WP
- SET FDA(TT,IEN,10)=PC
- +61 IF '$TEST
- if E
- Begin DoDot:1
- +62 ;EXTRACT FROM TO
- SET FDA(TT,IEN,11)=+E
- SET FDA(TT,IEN,12)=$PIECE(E,",",2)
- End DoDot:1
- +63 ; POINTER OR SET
- IF DEF("POINTER")]""
- SET FDA(TT,IEN,15)=DEF("POINTER")
- +64 ; OUTPUT FORMAT IF ANY
- IF OF
- SET FDA(TT,IEN,16)=OF
- CPUT SET CI=$$PUT^DMSQU(IEN,"FDA","ERR")
- +1 IF $DATA(ERR)
- Begin DoDot:1
- +2 DO ERR^DMSQU(F,FI,"COLUMN: INSERT OF COLUMN RECORD FAILED")
- End DoDot:1
- CQ QUIT CI