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 Dec 13, 2024@02:55:07 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
