211 lines
8.7 KiB
Mathematica
211 lines
8.7 KiB
Mathematica
DMSQU ;SFISC/JHM-SQLI UTILITIES ;5/13/98 12:03
|
|
;;22.0;VA FileMan;;Mar 30, 1999
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
SOC(T,B) ;TRANSLATE BASE CODE B TO EXTERNAL FORM FROM TEXT T
|
|
Q $P($P(T,";"_B_":",2),";")
|
|
NEW() ;Extrinsic function returns comma-list of variables to NEW
|
|
Q "DI,DIQUIET,DIFM"
|
|
ENV Q:$G(DUZ(0))'["@"
|
|
K ERR I $G(DIFM),$G(U)="^",$G(DT),$D(DUZ) D CLEAN^DIEFU Q
|
|
S DIQUIET=1,DIFM=1 D INIZE^DIEFU
|
|
Q
|
|
EXT(F,FI,FLG,INT,MSG) ;SQLI ENTRY TO EXTERNAL^DILFD
|
|
D ENV Q $$EXTERNAL^DILFD(F,FI,FLG,INT,$G(MSG))
|
|
GET(F,IEN,FI,FLG,BUF,MSG) ;SQLI ENTRY TO GET1^DIQ
|
|
D ENV Q $$GET1^DIQ(F,IEN,FI,$G(FLG),$G(BUF),$G(MSG))
|
|
CLF(S) D ENV N X
|
|
S X=$P($G(^DMSQ(S,0)),"^",1,2)_"^" I X'="^" K ^DMSQ(S) S ^DMSQ(S,0)=X
|
|
Q
|
|
CLN D CLF("DT"),CLF("DM") Q
|
|
VIEN(TI) ;RETURN VIRTUAL IENS FOR TI
|
|
N I,S S S=""
|
|
F I=$L(^DMSQ("T",TI,1),"{K}")-1:-1:1 S S=S_"{K"_I_"},"
|
|
Q S
|
|
ET(T) ;REPORT ELAPSED TIME SINCE T ($H FORMAT)
|
|
W ?30,"Time elapsed: ",$$TM($$TD(T,$H))," (HH:MM:SS)"
|
|
Q
|
|
TD(T,N) ;RETURNS TIME DIFERENCE OF N(OW)-T(HEN) $H FORMATS
|
|
Q N-T*86400+$P(N,",",2)-$P(T,",",2)
|
|
TM(S) ;RETURN TEXT VALUE OF TIME S SECONDS AS HH:MM:SS
|
|
Q $E(S\3600+100,2,3)_":"_$E(S\60#60+100,2,3)_":"_$E(S#60+100,2,3)
|
|
PAR(TI,NP,G,P,E) ;GET PARENT, GBL FRAGMENT, AND PIECE OR EXTRACT
|
|
;CALLED: S PAR=$$PAR^DMSQU(TABLE_ID,NODE;PIECE,.GBL_FRAG,.PC,.EX)
|
|
N PEI,PI,SQ,CI,E1,E2 D ENV
|
|
S PEI=$O(^DMSQ("E","F",TI,"P","")) Q:'PEI ""
|
|
S SQ=$O(^DMSQ("P","C",PEI,""),-1) Q:'SQ ""
|
|
S PI=$O(^DMSQ("P","C",PEI,SQ,"")),CI=$P(^DMSQ("P",PI,0),U,2)
|
|
S G=","_$$SS($P(NP,";"))_")",E=""
|
|
S P=$P(NP,";",2) I P'["E" S:P]"" P=+P
|
|
E S E=+$P(P,"E",2)_","_(+$P(NP,",",2)),P=""
|
|
Q CI
|
|
ERR(F,FI,T) ;ERROR LOGGER
|
|
N TI,EI,FE S FE=$G(ERR("DIERR",1)) D ENV
|
|
I T?1NN,$D(^DMSQ("ET",T)) S TI=T
|
|
E S TI=$O(^DMSQ("ET","B",T,"")) I 'TI D
|
|
. F TI=$P($G(^DMSQ("ET",0)),U,4)+1:1 Q:'$D(^(TI))
|
|
. S $P(^DMSQ("ET",0),U,3,4)=TI_U_TI,^(TI,0)=T,^DMSQ("ET","B",T,TI)=""
|
|
S EI=$P($G(^DMSQ("EX",0)),U,4)+1,$P(^(0),U,3,4)=EI_U_EI
|
|
S ^DMSQ("EX",EI,0)=F_U_FI_U_TI_U_DT_U_FE,^DMSQ("EX","B",F,EI)=""
|
|
S ^DMSQ("EX","C",TI,EI)="",^DMSQ("EX","D",DT,EI)=""
|
|
I FE S ^DMSQ("EX","E",FE,EI)=""
|
|
Q
|
|
ATTR ;;TYPE;FIELD LENGTH;DECIMAL DEFAULT;INPUT TRANSFORM;GLOBAL SUBSCRIPT LOCATION;POINTER;TITLE;SPECIFIER;DESCRIPTION;MULTIPLE-VALUED;LABEL
|
|
DOM(F,FI,DEF,ERR) ;GET FIELD ATTRIBUTES - DEF AND ERR ARE OPTIONAL
|
|
;RETURNS DOMAIN:WIDTH:SCALE ALLWAYS, ARRAYS DEF AND ERR OPTIONALLY
|
|
N T,W,S,X K DEF D ENV
|
|
I '$D(^DD(F,FI,0))#10 Q ""
|
|
D FIELD^DID(F,FI,"",$P($T(ATTR),";;",2),"DEF","ERR")
|
|
I $D(ERR)!$D(DIERR) D Q T
|
|
. S T=$$DM(F,FI,.DEF) I T]"" D ENV,ERR(F,FI,"FIELD: CALL TO RETRIEVE ATTRIBUTES FAILED")
|
|
S T=DEF("TYPE"),W=DEF("FIELD LENGTH"),S=DEF("DECIMAL DEFAULT")
|
|
S:W W=+W S:S?1N.E S=+S
|
|
S I=DEF("INPUT TRANSFORM"),W=$S(I["$L(X)>":+$P(I,"$L(X)>",2),1:W)
|
|
I T["MUMPS" S W=245,T="FM_MUMPS"
|
|
E I T["SET" S T="SET_OF_CODES"
|
|
E I T["DATE/TIME" D
|
|
. S X=$P($P(DEF("INPUT TRANSFORM"),"%DT=""",2),"""")
|
|
. S T=$S(X["R":"FM_DATE_TIME",X["T":"FM_MOMENT",1:"FM_DATE")
|
|
E I T["NUMERIC",'S S T="INTEGER",S=""
|
|
E I T["FREE TEXT" S T="CHARACTER"
|
|
E I T["COMPUTED" S T=$S(S:"NUMERIC",S=0:"INTEGER",1:"CHARACTER")
|
|
E I T["BOOLEAN" S T="FM_FLAG"
|
|
E I T["VARIABLE-POINTER" S T="VARIABLE_POINTER"
|
|
E I T["POINTER" S T="POINTER"
|
|
E I T["WORD-PROCESSING" S T="WORD_PROCESSING",W=80
|
|
S F=$G(DEF("DESCRIPTION",1)) K DEF("DESCRIPTION")
|
|
S DEF("DESCRIPTION")=$P(F,".")
|
|
Q T_U_W_U_S
|
|
DM(F,FI,DEF) ;BUILD META-DATA FOR ONE FIELD (USE WHEN FIELD^DID FAILS!!)
|
|
D ENV N CK,H,IT,SP,P,D,EX,LD,DP,TYP,DM,X
|
|
K DEF S H=$G(^DD(F,FI,0)) Q:H="" ""
|
|
S DEF("LABEL")=$P(H,U),(PE,DEF("GLOBAL SUBSCRIPT LOCATION"))=$P(H,U,4)
|
|
S (IT,DEF("INPUT TRANSFORM"))=$P(H,U,5),(SP,DEF("SPECIFIER"))=$P(H,U,2)
|
|
S DEF("DESCRIPTION")=$P($G(^DD(F,FI,21,1,0)),".")
|
|
S (P,DEF("POINTER"))=$P(H,U,3),DEF("MULTIPLE-VALUED")=SP["M"!SP
|
|
S D=$TR(SP,"aeAIMOn'X*","") ;IGNORE CHILD DESCRIPTORS
|
|
S EX=$P($P(PE,";",2),"E",2)
|
|
I EX F I=1:1 I $E(EX,I)?.A S EX=$E(EX,1,I-1) Q
|
|
S LD=$P(D,"J",2),DP=+$P(LD,",",2) I LD,'DP S LD=+LD
|
|
I LD="" S CK=$P(IT,"$L(X)>",2) I CK S LD=+CK
|
|
I LD="",$P(EX,",",2) S LD=$P(EX,",",2)-EX+1
|
|
S:DP LD=(+LD)_U_DP,DEF("DECIMAL DEFAULT")=DP
|
|
I LD S DEF("FIELD LENGTH")=+LD,LD=U_LD
|
|
S TYP=$S(DP:"N",D["N":"I",D["D":"D",D["P":"P",D["V":"V",D["B":"B",D["K":"K",D["S":"S",D["W":"W",1:"F")
|
|
I TYP="N" S DM="NUMERIC"_LD,DEF("TYPE")="NUMERIC"
|
|
E I TYP="W" D
|
|
. S DM="WORD_PROCESSING",LD="^80",DEF("TYPE")="WORD-PROCESSING"
|
|
E I TYP="P" S DM="POINTER",LD="^10",DEF("TYPE")="POINTER"
|
|
E I TYP="S" D S DM="SET_OF_CODES"_LD,DEF("TYPE")="SET"
|
|
. N I,X,W S W=1
|
|
. F I=1:1:$L(P,":") S X=$L($P($P(";"_P,":",I),";",2)) S:X>W W=X
|
|
. S LD=U_W
|
|
E I TYP="I" S DM="INTEGER"_LD,DEF("TYPE")="NUMERIC"
|
|
E I TYP="V" S DM="VARIABLE_POINTER",DEF("TYPE")="VARIABLE-POINTER"
|
|
E I TYP="B" S DM="FM_FLAG",DEF("TYPE")="BOOLEAN"
|
|
E I TYP="D" S X=$P($P($P(H,"^",5),"%DT=",2),"""",2) D
|
|
. I X'["T",X'["R" S DM="FM_DATE"
|
|
. E I X["R" S DM="FM_DATE_TIME"
|
|
. E S DM="FM_MOMENT"
|
|
. S DEF("TYPE")="DATE"
|
|
E I TYP="K" S DM="FM_MUMPS^245",DEF("TYPE")="MUMPS"
|
|
E S DM="CHARACTER"_$S(LD]"":LD,1:"(80)"),DEF("TYPE")="FREE TEXT"
|
|
Q DM
|
|
KL(TI) ;RETURN IEN LIST OF TABLE
|
|
N KL,P S KL=TI
|
|
F S P=$G(^DD(TI,0,"UP")) Q:P="" S KL=P_","_KL,TI=P
|
|
Q KL
|
|
PUT(I,A,E) ;FILE OR UPDATE
|
|
;GIVEN I=IEN AND A=FDA ARRAY RETURN IEN AND ERR
|
|
K @E D ENV
|
|
I I?1N.E D
|
|
. D FILE^DIE("",A,E)
|
|
E D
|
|
. N O D UPDATE^DIE("",A,"O",E) S I=$G(O(1))
|
|
Q $S($D(@E):0,1:+I)
|
|
KWC(N) ;RETURN N AS A NON-KEYWORD
|
|
I N]"",$D(^DMSQ("K","B",N)) N X,I S X=$$SQLI(N,25),N=X_1 D
|
|
. F I=2:1 Q:'$D(^DMSQ("K","B",N)) S N=X_I ; AVOID KEYWORDS
|
|
Q N
|
|
FNB(F,TI) ;BUILD SQL FILE NAME
|
|
;EXTRINSIC FUNCTION, ALL PARAMETERS REQUIRED & PASSED BY VALUE
|
|
;INPUT: F=FILEMAN FILE NUMBER, TI=SQLI IEN
|
|
;OUTPUT: STANDARD SQLI TABLE LABEL, UNIQUE BY SCHEMA, AND NOT
|
|
; A KEY WORD
|
|
N NM,F1,SP,P,I,X,J
|
|
S NM="",F1=F,SP="" F D Q:'P
|
|
. S P=$G(^DD(F1,0,"UP"))
|
|
. I P S NM=$O(^DD(F1,0,"NM",""))_SP_NM,SP="_",F1=P
|
|
S NM=$P($G(^DIC(F1,0)),"^")_SP_NM
|
|
I NM=""!(NM["__")!($E(NM,$L(NM))="_")!(NM?1"_".E) Q ""
|
|
F I=1:1:$L(NM,"_")-1 D
|
|
. S X=$P(NM,"_",I)
|
|
. F J=I+1:1:$L(NM,"_") S:$P(NM,"_",J)=X $P(NM,"_",J)=""
|
|
S NM=$$SQLI(NM,26)
|
|
F I=1:1 Q:'$D(^DMSQ("T","B",NM))!($O(^(NM,""))=TI) S NM=NM_I
|
|
Q $$KWC(NM)
|
|
CN(T,C,N) ;BUILD COLUMN NAME N UNIQUE BY TABLE T, COLUMN ELEMENT C
|
|
;EXTRINSIC FUNCTION, ALL PARAMETERS REQUIRED & PASSED BY VALUE
|
|
;INPUT: T=SQLI_TABLE EIN, C=SQLI_COLUMN EIN, N=FIELD NAME
|
|
;FIELD NAME ARE GENERATED FOR PRIMARY AND FOREIGN KEY COLUMNS
|
|
;OUTPUT: STANDARD SQLI COLUMN LABELS, UNIQUE BY TABLE, NOT KEYWORDS
|
|
N I,X,% I N]"" D
|
|
. S N=$$KWC($$SQLI(N,26)),%="",X=N
|
|
. F I=1:1 S %=$O(^DMSQ("E","G",T,N,"")) Q:%=C!'% S N=X_I
|
|
Q N
|
|
SQLK(T,L) ;RETURN SQL IDENTIFIER NOT A KEYWORD
|
|
;EXTRINSIC FUNCTION, ALL PARAMETERS REQUIRED & PASSED BY VALUE
|
|
;SEE $$SQLI FOR DESCRIPTION OF INPUT/OUTPUT
|
|
Q $$KWC($$SQLI(T,L))
|
|
SQLI(T,L) ;RETURN VALID SQL IDENTIFIER OF LENGTH L OR LESS BASED ON T
|
|
;EXTRINSIC FUNCTION, ALL PARAMETERS REQUIRED & PASSED BY VALUE
|
|
;INPUT: T=FREE TEXT, L=MAXIMUM OUTPUT LENGTH
|
|
;OUTPUT: AN SQLI STANDARD SQL IDENTIFIER
|
|
N I,PL,T1
|
|
I $TR(T,"_")?.UN,$L(T)'>L G SQLIX ;SKIP PROCESSING FOR SIMPLE CASE
|
|
;CONVERT LOWER TO UPPER CASE, MOST PUNCTUATION TO UNDERLINES
|
|
S T=$TR(T," -abcdefghijklmnopqrstuvwxyz!@#$%^&*()_-+=|\}]{[:;""'?/>.<,~`","__ABCDEFGHIJKLMNOPQRSTUVWXYZ_________________________________")
|
|
;REMOVE DOUBLE UNDERLINES
|
|
F Q:T'["__" S T=$P(T,"__")_"_"_$P(T,"__",2,99)
|
|
I T?1"_".E S T=$E(T,2,999) ;REMOVE INITIAL UNDERLINE
|
|
I $E(T,$L(T))="_" S T=$E(T,1,$L(T)-1) ;REMOVE TRAILING UNDERLINE
|
|
;COMPRESSION
|
|
I $L(T)>L D
|
|
. S PL=$L(T,"_") ;1) REDUCE SIZE OF _ PIECES
|
|
. F I=PL-1:-1:2,PL,1 S $P(T,"_",I)=$$SQZ($P(T,"_",I)) Q:$L(T)'>L
|
|
;2) CONVERT _ PIECES TO INITIAL LETTERS
|
|
I $L(T)>L F I=PL-1:-1:2,PL,1 S $P(T,"_",I)=$E($P(T,"_",I)) Q:$L(T)'>L
|
|
;3) COMPRESS OVERHANG INTO ONE ALPHA-NUMBERIC CHARACTER
|
|
I $L(T)>L S T=$E(T,1,L-1)_$TR($E(T,L,999),"_")
|
|
SQLIX F Q:$E(T,$L(T))'="_" S $E(T,$L(T))="" ;REMOVE TRAILING _S
|
|
F Q:$E(T)'="_" S $E(T)="" ;REMOVE LEADING _S
|
|
I T?1N.E S T="N"_T ;AVOID INITIAL DIGIT
|
|
I $L(T)>L S T=$E(T,1,$S($E(T,L)="_":L-1,1:L)) ;4) JUST TRUNCATE IT
|
|
Q T
|
|
SQZ(T) ;RETURN MNEMONIC VALUE OF T
|
|
I $L(T)>5 S T=$E(T,1,4) S:"AEIOU"[$E(T,4) T=$E(T,1,3)
|
|
Q T
|
|
ROOT(F) ;GET GLOBAL NAME SYNTAX FOR A SUBFILE (F)
|
|
N G,P,FI
|
|
S G="{K})" F D Q:G["^"
|
|
. S P=$G(^DD(F,0,"UP"))
|
|
. I P D
|
|
. . S FI=$O(^DD(P,"SB",F,""))
|
|
. . I FI S F=P,G="{K},"_$$SS($P($P(^DD(F,FI,0),"^",4),";"))_","_G
|
|
. . E S G="^"
|
|
. E I $D(^DIC(F,0,"GL")) S G=^("GL")_G
|
|
. E S G="^"
|
|
Q G
|
|
SS(T) ;CONVERT T TO A VALID SUBSCRIPT (QUOTES)
|
|
I T?1N.N
|
|
E I T?.N1"."1N.N
|
|
E S T=$C(34)_T_$C(34)
|
|
Q T
|
|
FIL(SF) ;EXTRINSIC FUNCTION RETURNS FILE CONTAINING FILE OR SUBFILE SF
|
|
N F F S F=SF,SF=$G(^DD(SF,0,"UP")) Q:SF=""
|
|
Q $S($D(^DIC(F,0)):F,1:"")
|
|
TBL(TI) ;EXTRINSIC FUNCTION RETURNS TABLE CONTAINING TABLE OR SUBTABLE TI
|
|
N F S F=$P($G(^DMSQ("T",TI,0)),U,7)
|
|
I F S F=$$FIL(F) I F S F=$O(^DMSQ("T","C",F,""))
|
|
Q F
|