| 1 | DMSQU ;SFISC/JHM-SQLI UTILITIES ;5/13/98 12:03
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | SOC(T,B) ;TRANSLATE BASE CODE B TO EXTERNAL FORM FROM TEXT T
|
|---|
| 6 | Q $P($P(T,";"_B_":",2),";")
|
|---|
| 7 | NEW() ;Extrinsic function returns comma-list of variables to NEW
|
|---|
| 8 | Q "DI,DIQUIET,DIFM"
|
|---|
| 9 | ENV Q:$G(DUZ(0))'["@"
|
|---|
| 10 | K ERR I $G(DIFM),$G(U)="^",$G(DT),$D(DUZ) D CLEAN^DIEFU Q
|
|---|
| 11 | S DIQUIET=1,DIFM=1 D INIZE^DIEFU
|
|---|
| 12 | Q
|
|---|
| 13 | EXT(F,FI,FLG,INT,MSG) ;SQLI ENTRY TO EXTERNAL^DILFD
|
|---|
| 14 | D ENV Q $$EXTERNAL^DILFD(F,FI,FLG,INT,$G(MSG))
|
|---|
| 15 | GET(F,IEN,FI,FLG,BUF,MSG) ;SQLI ENTRY TO GET1^DIQ
|
|---|
| 16 | D ENV Q $$GET1^DIQ(F,IEN,FI,$G(FLG),$G(BUF),$G(MSG))
|
|---|
| 17 | CLF(S) D ENV N X
|
|---|
| 18 | S X=$P($G(^DMSQ(S,0)),"^",1,2)_"^" I X'="^" K ^DMSQ(S) S ^DMSQ(S,0)=X
|
|---|
| 19 | Q
|
|---|
| 20 | CLN D CLF("DT"),CLF("DM") Q
|
|---|
| 21 | VIEN(TI) ;RETURN VIRTUAL IENS FOR TI
|
|---|
| 22 | N I,S S S=""
|
|---|
| 23 | F I=$L(^DMSQ("T",TI,1),"{K}")-1:-1:1 S S=S_"{K"_I_"},"
|
|---|
| 24 | Q S
|
|---|
| 25 | ET(T) ;REPORT ELAPSED TIME SINCE T ($H FORMAT)
|
|---|
| 26 | W ?30,"Time elapsed: ",$$TM($$TD(T,$H))," (HH:MM:SS)"
|
|---|
| 27 | Q
|
|---|
| 28 | TD(T,N) ;RETURNS TIME DIFERENCE OF N(OW)-T(HEN) $H FORMATS
|
|---|
| 29 | Q N-T*86400+$P(N,",",2)-$P(T,",",2)
|
|---|
| 30 | TM(S) ;RETURN TEXT VALUE OF TIME S SECONDS AS HH:MM:SS
|
|---|
| 31 | Q $E(S\3600+100,2,3)_":"_$E(S\60#60+100,2,3)_":"_$E(S#60+100,2,3)
|
|---|
| 32 | PAR(TI,NP,G,P,E) ;GET PARENT, GBL FRAGMENT, AND PIECE OR EXTRACT
|
|---|
| 33 | ;CALLED: S PAR=$$PAR^DMSQU(TABLE_ID,NODE;PIECE,.GBL_FRAG,.PC,.EX)
|
|---|
| 34 | N PEI,PI,SQ,CI,E1,E2 D ENV
|
|---|
| 35 | S PEI=$O(^DMSQ("E","F",TI,"P","")) Q:'PEI ""
|
|---|
| 36 | S SQ=$O(^DMSQ("P","C",PEI,""),-1) Q:'SQ ""
|
|---|
| 37 | S PI=$O(^DMSQ("P","C",PEI,SQ,"")),CI=$P(^DMSQ("P",PI,0),U,2)
|
|---|
| 38 | S G=","_$$SS($P(NP,";"))_")",E=""
|
|---|
| 39 | S P=$P(NP,";",2) I P'["E" S:P]"" P=+P
|
|---|
| 40 | E S E=+$P(P,"E",2)_","_(+$P(NP,",",2)),P=""
|
|---|
| 41 | Q CI
|
|---|
| 42 | ERR(F,FI,T) ;ERROR LOGGER
|
|---|
| 43 | N TI,EI,FE S FE=$G(ERR("DIERR",1)) D ENV
|
|---|
| 44 | I T?1NN,$D(^DMSQ("ET",T)) S TI=T
|
|---|
| 45 | E S TI=$O(^DMSQ("ET","B",T,"")) I 'TI D
|
|---|
| 46 | . F TI=$P($G(^DMSQ("ET",0)),U,4)+1:1 Q:'$D(^(TI))
|
|---|
| 47 | . S $P(^DMSQ("ET",0),U,3,4)=TI_U_TI,^(TI,0)=T,^DMSQ("ET","B",T,TI)=""
|
|---|
| 48 | S EI=$P($G(^DMSQ("EX",0)),U,4)+1,$P(^(0),U,3,4)=EI_U_EI
|
|---|
| 49 | S ^DMSQ("EX",EI,0)=F_U_FI_U_TI_U_DT_U_FE,^DMSQ("EX","B",F,EI)=""
|
|---|
| 50 | S ^DMSQ("EX","C",TI,EI)="",^DMSQ("EX","D",DT,EI)=""
|
|---|
| 51 | I FE S ^DMSQ("EX","E",FE,EI)=""
|
|---|
| 52 | Q
|
|---|
| 53 | ATTR ;;TYPE;FIELD LENGTH;DECIMAL DEFAULT;INPUT TRANSFORM;GLOBAL SUBSCRIPT LOCATION;POINTER;TITLE;SPECIFIER;DESCRIPTION;MULTIPLE-VALUED;LABEL
|
|---|
| 54 | DOM(F,FI,DEF,ERR) ;GET FIELD ATTRIBUTES - DEF AND ERR ARE OPTIONAL
|
|---|
| 55 | ;RETURNS DOMAIN:WIDTH:SCALE ALLWAYS, ARRAYS DEF AND ERR OPTIONALLY
|
|---|
| 56 | N T,W,S,X K DEF D ENV
|
|---|
| 57 | I '$D(^DD(F,FI,0))#10 Q ""
|
|---|
| 58 | D FIELD^DID(F,FI,"",$P($T(ATTR),";;",2),"DEF","ERR")
|
|---|
| 59 | I $D(ERR)!$D(DIERR) D Q T
|
|---|
| 60 | . S T=$$DM(F,FI,.DEF) I T]"" D ENV,ERR(F,FI,"FIELD: CALL TO RETRIEVE ATTRIBUTES FAILED")
|
|---|
| 61 | S T=DEF("TYPE"),W=DEF("FIELD LENGTH"),S=DEF("DECIMAL DEFAULT")
|
|---|
| 62 | S:W W=+W S:S?1N.E S=+S
|
|---|
| 63 | S I=DEF("INPUT TRANSFORM"),W=$S(I["$L(X)>":+$P(I,"$L(X)>",2),1:W)
|
|---|
| 64 | I T["MUMPS" S W=245,T="FM_MUMPS"
|
|---|
| 65 | E I T["SET" S T="SET_OF_CODES"
|
|---|
| 66 | E I T["DATE/TIME" D
|
|---|
| 67 | . S X=$P($P(DEF("INPUT TRANSFORM"),"%DT=""",2),"""")
|
|---|
| 68 | . S T=$S(X["R":"FM_DATE_TIME",X["T":"FM_MOMENT",1:"FM_DATE")
|
|---|
| 69 | E I T["NUMERIC",'S S T="INTEGER",S=""
|
|---|
| 70 | E I T["FREE TEXT" S T="CHARACTER"
|
|---|
| 71 | E I T["COMPUTED" S T=$S(S:"NUMERIC",S=0:"INTEGER",1:"CHARACTER")
|
|---|
| 72 | E I T["BOOLEAN" S T="FM_FLAG"
|
|---|
| 73 | E I T["VARIABLE-POINTER" S T="VARIABLE_POINTER"
|
|---|
| 74 | E I T["POINTER" S T="POINTER"
|
|---|
| 75 | E I T["WORD-PROCESSING" S T="WORD_PROCESSING",W=80
|
|---|
| 76 | S F=$G(DEF("DESCRIPTION",1)) K DEF("DESCRIPTION")
|
|---|
| 77 | S DEF("DESCRIPTION")=$P(F,".")
|
|---|
| 78 | Q T_U_W_U_S
|
|---|
| 79 | DM(F,FI,DEF) ;BUILD META-DATA FOR ONE FIELD (USE WHEN FIELD^DID FAILS!!)
|
|---|
| 80 | D ENV N CK,H,IT,SP,P,D,EX,LD,DP,TYP,DM,X
|
|---|
| 81 | K DEF S H=$G(^DD(F,FI,0)) Q:H="" ""
|
|---|
| 82 | S DEF("LABEL")=$P(H,U),(PE,DEF("GLOBAL SUBSCRIPT LOCATION"))=$P(H,U,4)
|
|---|
| 83 | S (IT,DEF("INPUT TRANSFORM"))=$P(H,U,5),(SP,DEF("SPECIFIER"))=$P(H,U,2)
|
|---|
| 84 | S DEF("DESCRIPTION")=$P($G(^DD(F,FI,21,1,0)),".")
|
|---|
| 85 | S (P,DEF("POINTER"))=$P(H,U,3),DEF("MULTIPLE-VALUED")=SP["M"!SP
|
|---|
| 86 | S D=$TR(SP,"aeAIMOn'X*","") ;IGNORE CHILD DESCRIPTORS
|
|---|
| 87 | S EX=$P($P(PE,";",2),"E",2)
|
|---|
| 88 | I EX F I=1:1 I $E(EX,I)?.A S EX=$E(EX,1,I-1) Q
|
|---|
| 89 | S LD=$P(D,"J",2),DP=+$P(LD,",",2) I LD,'DP S LD=+LD
|
|---|
| 90 | I LD="" S CK=$P(IT,"$L(X)>",2) I CK S LD=+CK
|
|---|
| 91 | I LD="",$P(EX,",",2) S LD=$P(EX,",",2)-EX+1
|
|---|
| 92 | S:DP LD=(+LD)_U_DP,DEF("DECIMAL DEFAULT")=DP
|
|---|
| 93 | I LD S DEF("FIELD LENGTH")=+LD,LD=U_LD
|
|---|
| 94 | 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")
|
|---|
| 95 | I TYP="N" S DM="NUMERIC"_LD,DEF("TYPE")="NUMERIC"
|
|---|
| 96 | E I TYP="W" D
|
|---|
| 97 | . S DM="WORD_PROCESSING",LD="^80",DEF("TYPE")="WORD-PROCESSING"
|
|---|
| 98 | E I TYP="P" S DM="POINTER",LD="^10",DEF("TYPE")="POINTER"
|
|---|
| 99 | E I TYP="S" D S DM="SET_OF_CODES"_LD,DEF("TYPE")="SET"
|
|---|
| 100 | . N I,X,W S W=1
|
|---|
| 101 | . F I=1:1:$L(P,":") S X=$L($P($P(";"_P,":",I),";",2)) S:X>W W=X
|
|---|
| 102 | . S LD=U_W
|
|---|
| 103 | E I TYP="I" S DM="INTEGER"_LD,DEF("TYPE")="NUMERIC"
|
|---|
| 104 | E I TYP="V" S DM="VARIABLE_POINTER",DEF("TYPE")="VARIABLE-POINTER"
|
|---|
| 105 | E I TYP="B" S DM="FM_FLAG",DEF("TYPE")="BOOLEAN"
|
|---|
| 106 | E I TYP="D" S X=$P($P($P(H,"^",5),"%DT=",2),"""",2) D
|
|---|
| 107 | . I X'["T",X'["R" S DM="FM_DATE"
|
|---|
| 108 | . E I X["R" S DM="FM_DATE_TIME"
|
|---|
| 109 | . E S DM="FM_MOMENT"
|
|---|
| 110 | . S DEF("TYPE")="DATE"
|
|---|
| 111 | E I TYP="K" S DM="FM_MUMPS^245",DEF("TYPE")="MUMPS"
|
|---|
| 112 | E S DM="CHARACTER"_$S(LD]"":LD,1:"(80)"),DEF("TYPE")="FREE TEXT"
|
|---|
| 113 | Q DM
|
|---|
| 114 | KL(TI) ;RETURN IEN LIST OF TABLE
|
|---|
| 115 | N KL,P S KL=TI
|
|---|
| 116 | F S P=$G(^DD(TI,0,"UP")) Q:P="" S KL=P_","_KL,TI=P
|
|---|
| 117 | Q KL
|
|---|
| 118 | PUT(I,A,E) ;FILE OR UPDATE
|
|---|
| 119 | ;GIVEN I=IEN AND A=FDA ARRAY RETURN IEN AND ERR
|
|---|
| 120 | K @E D ENV
|
|---|
| 121 | I I?1N.E D
|
|---|
| 122 | . D FILE^DIE("",A,E)
|
|---|
| 123 | E D
|
|---|
| 124 | . N O D UPDATE^DIE("",A,"O",E) S I=$G(O(1))
|
|---|
| 125 | Q $S($D(@E):0,1:+I)
|
|---|
| 126 | KWC(N) ;RETURN N AS A NON-KEYWORD
|
|---|
| 127 | I N]"",$D(^DMSQ("K","B",N)) N X,I S X=$$SQLI(N,25),N=X_1 D
|
|---|
| 128 | . F I=2:1 Q:'$D(^DMSQ("K","B",N)) S N=X_I ; AVOID KEYWORDS
|
|---|
| 129 | Q N
|
|---|
| 130 | FNB(F,TI) ;BUILD SQL FILE NAME
|
|---|
| 131 | ;EXTRINSIC FUNCTION, ALL PARAMETERS REQUIRED & PASSED BY VALUE
|
|---|
| 132 | ;INPUT: F=FILEMAN FILE NUMBER, TI=SQLI IEN
|
|---|
| 133 | ;OUTPUT: STANDARD SQLI TABLE LABEL, UNIQUE BY SCHEMA, AND NOT
|
|---|
| 134 | ; A KEY WORD
|
|---|
| 135 | N NM,F1,SP,P,I,X,J
|
|---|
| 136 | S NM="",F1=F,SP="" F D Q:'P
|
|---|
| 137 | . S P=$G(^DD(F1,0,"UP"))
|
|---|
| 138 | . I P S NM=$O(^DD(F1,0,"NM",""))_SP_NM,SP="_",F1=P
|
|---|
| 139 | S NM=$P($G(^DIC(F1,0)),"^")_SP_NM
|
|---|
| 140 | I NM=""!(NM["__")!($E(NM,$L(NM))="_")!(NM?1"_".E) Q ""
|
|---|
| 141 | F I=1:1:$L(NM,"_")-1 D
|
|---|
| 142 | . S X=$P(NM,"_",I)
|
|---|
| 143 | . F J=I+1:1:$L(NM,"_") S:$P(NM,"_",J)=X $P(NM,"_",J)=""
|
|---|
| 144 | S NM=$$SQLI(NM,26)
|
|---|
| 145 | F I=1:1 Q:'$D(^DMSQ("T","B",NM))!($O(^(NM,""))=TI) S NM=NM_I
|
|---|
| 146 | Q $$KWC(NM)
|
|---|
| 147 | CN(T,C,N) ;BUILD COLUMN NAME N UNIQUE BY TABLE T, COLUMN ELEMENT C
|
|---|
| 148 | ;EXTRINSIC FUNCTION, ALL PARAMETERS REQUIRED & PASSED BY VALUE
|
|---|
| 149 | ;INPUT: T=SQLI_TABLE EIN, C=SQLI_COLUMN EIN, N=FIELD NAME
|
|---|
| 150 | ;FIELD NAME ARE GENERATED FOR PRIMARY AND FOREIGN KEY COLUMNS
|
|---|
| 151 | ;OUTPUT: STANDARD SQLI COLUMN LABELS, UNIQUE BY TABLE, NOT KEYWORDS
|
|---|
| 152 | N I,X,% I N]"" D
|
|---|
| 153 | . S N=$$KWC($$SQLI(N,26)),%="",X=N
|
|---|
| 154 | . F I=1:1 S %=$O(^DMSQ("E","G",T,N,"")) Q:%=C!'% S N=X_I
|
|---|
| 155 | Q N
|
|---|
| 156 | SQLK(T,L) ;RETURN SQL IDENTIFIER NOT A KEYWORD
|
|---|
| 157 | ;EXTRINSIC FUNCTION, ALL PARAMETERS REQUIRED & PASSED BY VALUE
|
|---|
| 158 | ;SEE $$SQLI FOR DESCRIPTION OF INPUT/OUTPUT
|
|---|
| 159 | Q $$KWC($$SQLI(T,L))
|
|---|
| 160 | SQLI(T,L) ;RETURN VALID SQL IDENTIFIER OF LENGTH L OR LESS BASED ON T
|
|---|
| 161 | ;EXTRINSIC FUNCTION, ALL PARAMETERS REQUIRED & PASSED BY VALUE
|
|---|
| 162 | ;INPUT: T=FREE TEXT, L=MAXIMUM OUTPUT LENGTH
|
|---|
| 163 | ;OUTPUT: AN SQLI STANDARD SQL IDENTIFIER
|
|---|
| 164 | N I,PL,T1
|
|---|
| 165 | I $TR(T,"_")?.UN,$L(T)'>L G SQLIX ;SKIP PROCESSING FOR SIMPLE CASE
|
|---|
| 166 | ;CONVERT LOWER TO UPPER CASE, MOST PUNCTUATION TO UNDERLINES
|
|---|
| 167 | S T=$TR(T," -abcdefghijklmnopqrstuvwxyz!@#$%^&*()_-+=|\}]{[:;""'?/>.<,~`","__ABCDEFGHIJKLMNOPQRSTUVWXYZ_________________________________")
|
|---|
| 168 | ;REMOVE DOUBLE UNDERLINES
|
|---|
| 169 | F Q:T'["__" S T=$P(T,"__")_"_"_$P(T,"__",2,99)
|
|---|
| 170 | I T?1"_".E S T=$E(T,2,999) ;REMOVE INITIAL UNDERLINE
|
|---|
| 171 | I $E(T,$L(T))="_" S T=$E(T,1,$L(T)-1) ;REMOVE TRAILING UNDERLINE
|
|---|
| 172 | ;COMPRESSION
|
|---|
| 173 | I $L(T)>L D
|
|---|
| 174 | . S PL=$L(T,"_") ;1) REDUCE SIZE OF _ PIECES
|
|---|
| 175 | . F I=PL-1:-1:2,PL,1 S $P(T,"_",I)=$$SQZ($P(T,"_",I)) Q:$L(T)'>L
|
|---|
| 176 | ;2) CONVERT _ PIECES TO INITIAL LETTERS
|
|---|
| 177 | I $L(T)>L F I=PL-1:-1:2,PL,1 S $P(T,"_",I)=$E($P(T,"_",I)) Q:$L(T)'>L
|
|---|
| 178 | ;3) COMPRESS OVERHANG INTO ONE ALPHA-NUMBERIC CHARACTER
|
|---|
| 179 | I $L(T)>L S T=$E(T,1,L-1)_$TR($E(T,L,999),"_")
|
|---|
| 180 | SQLIX F Q:$E(T,$L(T))'="_" S $E(T,$L(T))="" ;REMOVE TRAILING _S
|
|---|
| 181 | F Q:$E(T)'="_" S $E(T)="" ;REMOVE LEADING _S
|
|---|
| 182 | I T?1N.E S T="N"_T ;AVOID INITIAL DIGIT
|
|---|
| 183 | I $L(T)>L S T=$E(T,1,$S($E(T,L)="_":L-1,1:L)) ;4) JUST TRUNCATE IT
|
|---|
| 184 | Q T
|
|---|
| 185 | SQZ(T) ;RETURN MNEMONIC VALUE OF T
|
|---|
| 186 | I $L(T)>5 S T=$E(T,1,4) S:"AEIOU"[$E(T,4) T=$E(T,1,3)
|
|---|
| 187 | Q T
|
|---|
| 188 | ROOT(F) ;GET GLOBAL NAME SYNTAX FOR A SUBFILE (F)
|
|---|
| 189 | N G,P,FI
|
|---|
| 190 | S G="{K})" F D Q:G["^"
|
|---|
| 191 | . S P=$G(^DD(F,0,"UP"))
|
|---|
| 192 | . I P D
|
|---|
| 193 | . . S FI=$O(^DD(P,"SB",F,""))
|
|---|
| 194 | . . I FI S F=P,G="{K},"_$$SS($P($P(^DD(F,FI,0),"^",4),";"))_","_G
|
|---|
| 195 | . . E S G="^"
|
|---|
| 196 | . E I $D(^DIC(F,0,"GL")) S G=^("GL")_G
|
|---|
| 197 | . E S G="^"
|
|---|
| 198 | Q G
|
|---|
| 199 | SS(T) ;CONVERT T TO A VALID SUBSCRIPT (QUOTES)
|
|---|
| 200 | I T?1N.N
|
|---|
| 201 | E I T?.N1"."1N.N
|
|---|
| 202 | E S T=$C(34)_T_$C(34)
|
|---|
| 203 | Q T
|
|---|
| 204 | FIL(SF) ;EXTRINSIC FUNCTION RETURNS FILE CONTAINING FILE OR SUBFILE SF
|
|---|
| 205 | N F F S F=SF,SF=$G(^DD(SF,0,"UP")) Q:SF=""
|
|---|
| 206 | Q $S($D(^DIC(F,0)):F,1:"")
|
|---|
| 207 | TBL(TI) ;EXTRINSIC FUNCTION RETURNS TABLE CONTAINING TABLE OR SUBTABLE TI
|
|---|
| 208 | N F S F=$P($G(^DMSQ("T",TI,0)),U,7)
|
|---|
| 209 | I F S F=$$FIL(F) I F S F=$O(^DMSQ("T","C",F,""))
|
|---|
| 210 | Q F
|
|---|
