Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DMSQF

DMSQF.m

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