DMSQD ;SFISC/JHM-SETUP FOR DATATYPE AND DOMAIN ;5/7/98 14:53
;;22.0;VA FileMan;;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
LCKF ;BUILD KEY FORMAT FOR LONG CHARACTER FIELDS
N KFI,DTI,KIE,KIX
S KFI=$O(^DMSQ("KF","B","LONG_CHARACTER",""))
S DTI=$O(^DMSQ("DT","B","CHARACTER",""))
I 'DTI D F(2) S DTI=$O(^DMSQ("DT","B","CHARACTER","")) I 'DTI Q
S KIE="$E({I},1,30)",KIX="S {K}="_KIE
S IEN=$S(KFI:KFI,1:"+1")_",",TT=1.5213
S FDA(TT,IEN,.01)="LONG_CHARACTER" ;NAME
S FDA(TT,IEN,1)=DTI ;DATA TYPE
S FDA(TT,IEN,2)="Truncate long free text fields to 30 characters" ;COMM
S FDA(TT,IEN,3)=KIE ;EXPRESSION FORMAT
S FDA(TT,IEN,4)=KIX ;EXECUTE FORMAT
S KFI=$$PUT^DMSQU(IEN,"FDA","ERR")
I $D(ERR)!'KFI D ERR^DMSQU(TT,"","KEY FORMAT: LONG_CHARACTER INSERT FAILED")
Q
VPTOF(F,FI) ;BUILD OUTPUT FORMAT FOR VARIABLE POINTER FILE F, FIELD FI
N TI,ON,OI,TT,IEN,BE,FDA,ERR S TI=$O(^DMSQ("T","C",F,"")) Q:'TI ""
S T=^DMSQ("T",TI,0),ON=$$SQLK^DMSQU($P(T,U)_"_VPOF",30)
S OI=$O(^DMSQ("OF","B",ON,"")),TT=1.5214,IEN=$S(OI:OI,1:"+1")_","
S BE="$$EXT^DMSQU("_F_","_FI_","""",{B})"
S FDA(TT,IEN,.01)=ON ;OF NAME
S FDA(TT,IEN,1)=2 ; BASE DATA TYPE IS CHARACTER
S FDA(TT,IEN,2)="Variable pointer output format" ; COMMENT
S FDA(TT,IEN,3)=BE ; OUTPUT TRANSFORM
S OI=$$PUT^DMSQU(IEN,"FDA","ERR")
I $D(ERR)!'OI D ERR^DMSQU(TI,FI,"OUTPUT FORMAT: INSERT OF VARIABLE POINTER OUTPUT FORMAT FAILED")
Q OI
PTROF(F) ;BUILD OUTPUT FORMAT FOR POINTER TO TABLE FI
N TI,ON,OI,TT,IEN,BE,FDA,ERR S TI=$O(^DMSQ("T","C",F,"")) Q:'TI ""
S T=^DMSQ("T",TI,0),ON=$$SQLK^DMSQU($P(T,U)_"_PTOF",30)
S OI=$O(^DMSQ("OF","B",ON,"")),TT=1.5214,IEN=$S(OI:OI,1:"+1")_","
S BE="$S('{B}:"""",1:$$GET^DMSQU("_F_",{B}_"","",.01))"
S FDA(TT,IEN,.01)=ON ;OF NAME
S FDA(TT,IEN,1)=3 ; BASE DATA TYPE IS INTEGER
S FDA(TT,IEN,2)="Output format for pointer to "_$P(T,U) ; COMMENT
S FDA(TT,IEN,3)=BE ; OUTPUT TRANSFORM
S OI=$$PUT^DMSQU(IEN,"FDA","ERR")
I $D(ERR)!'OI D ERR^DMSQU(TI,FI,"OUTPUT FORMAT: INSERT OF POINTER OUTPUT FORMAT FAILED")
Q OI
BE ;;$P($P("{S}",";"_{B}_":",2),";")
SETOF(SD) ;BUILD PUTPUT FORMAT FOR SET DEFINITION SD
N ON,OI,FDA,ERR,BE,TT,IEN,SL
I SD?1P.E S $E(SD,1)="Z" ;" " IS USED FOR DEFAULT CODE
S ON=$$SQLK^DMSQU(SD,30),OI=$O(^DMSQ("OF","B",ON,""))
S:$E(SD)'=";" SD=";"_SD S:$E(SD,$L(SD))'=";" SD=SD_";"
S BE=$P($T(BE),";;",2,99),BE=$P(BE,"{S}")_SD_$P(BE,"{S}",2)
;BUILD OUTPUT FORMAT
S TT=1.5214,IEN=$S(OI:OI,1:"+1")_","
S FDA(TT,IEN,.01)=ON ;OUTPUT FORMAT NAME
S FDA(TT,IEN,1)=2 ;CHARACTER DATA TYPE
S FDA(TT,IEN,2)="Set output format" ;COMMENT
S FDA(TT,IEN,3)=BE ;OUTPUT TRANSFORM EXPRESSION
S OI=$$PUT^DMSQU(IEN,"FDA","ERR")
I $D(ERR)!'OI D ERR^DMSQU($G(F),$G(FI),"OUTPUT FORMAT: INSERT OF SET-OF-CODES OUTPUT FORMAT FAILED")
Q OI
;KW SOURCE ARRAY MUST HAVE THE FORM:
; SRC(I)=KW : FOR EVERY I THERE MUST BE A KEYWORD
;SRC MAY BE LOCAL OR GLOBAL, BUT MUST WORK IN THE SYNTAX @SRC@(I)
;CALL: D KW("^SRC",.ERR)
KW(SRC,ERR) ;LOAD KEYWORD GLOBAL FROM ARRAY SRC
;RETURN ERRORS IN ERR: D KW^DMSQD("^SRC(,1,",.ERROR)
Q:$G(SRC)="" I $G(DUZ(0))'["@" S ERR="ACCESS DENIED" Q
N E,DIERR,I,TT,KW,IEN,FDA,@$$NEW^DMSQU K ERR D ENV^DMSQU
S TT=1.52101,I=""
I $O(@SRC@(""))="" S ERR="INVALID OR MISSING KEYWORD ARRAY" Q
F S I=$O(@SRC@(I)) Q:I=""!$D(ERR) D
. S KW=$G(@SRC@(I)) Q:KW=""
. S IEN=$O(^DMSQ("K","B",KW,""))
. S IEN=$S(IEN:IEN,1:"+1")_","
. D VAL^DIE(TT,IEN,.01,"F",.KW,"","FDA","E")
. I $D(DIERR) S ERR=E("DIERR",1,"TEXT",1) Q
. S IEN=$$PUT^DMSQU(IEN,"FDA","ERR")
. I $D(ERR)!'IEN S ERR="KEYWORD-$$PUT FAILED"
Q
DMDT F I=1:1 Q:$T(@I)="" D F(I)
S $P(^DMSQ("DM",0),U,3)=99
Q
F(DI) N I,FDA,FDB,ERR,IEN,TT,EO
S TT=1.5212,IEN=$S($D(^DMSQ("DM",DI)):DI,1:"+1")_","
F I=0:1 S T=$T(@DI+I) Q:T>DI D
. S FDA(TT,IEN,$P(T,";",3))=$P(T,";",4,99)
I FDA(TT,IEN,1)=DI D Q:$D(ERR)
. N DIEN S DIEN=$S($D(^DMSQ("DT",DI)):DI,1:"+1")_","
. S FDB(1.5211,DIEN,.01)=FDA(TT,IEN,.01)
. S FDB(1.5211,DIEN,1)=FDA(TT,IEN,2)
. S EO=$$PUT^DMSQU(DIEN,"FDB","ERR")
. I $D(ERR) D ERR^DMSQU(1.5211,"","DATA TYPE: INSERT OF DATA TYPE RECORD FAILED")
S EO=$$PUT^DMSQU(IEN,"FDA","ERR")
I $D(ERR) D ERR^DMSQU(1.5212,"","DOMAIN: INSERT OF DOMAIN RECORD FAILED")
Q
1 ;;.01;PRIMARY_KEY
;;1;1
;;2;Table domain, used for primary and foreign keys
2 ;;.01;CHARACTER
;;1;2
;;2;Free Text less than 256 characters
;;4;30
3 ;;.01;INTEGER
;;1;3
;;2;Up to 15 numeric characters without leading zeroes
;;4;10
4 ;;.01;NUMERIC
;;1;4
;;2;Up to 15 numeric characters with at most one decimal point
;;4;10
;;5;2
5 ;;.01;DATE
;;1;5
;;2;Base date is M $H format, ODBC = YYYY-MM-DD
;;4;8
6 ;;.01;TIME
;;1;6
;;2;Base is M $H format, ODBC = HH:MM:SS[.S...]
;;4;8
7 ;;.01;MOMENT
;;1;7
;;2;Base is M $H format
;;4;17
8 ;;.01;BOOLEAN
;;1;8
;;2;YES or NO, internally 1 or 0
;;4;3
9 ;;.01;MEMO
;;1;9
;;2;Huge character string up to 32KB long
;;4;70
10 ;;.01;FM_DATE
;;1;5
;;2;Handle base-internal translation of FileMan internal date w/o time
;;4;8
;;8;S %H={B} D YMD^%DTC S {I}=X
;;10;S X={I} D H^%DTC S {B}=%H
;;11;D
11 ;;.01;FM_MOMENT
;;1;7
;;2;Base-internal of FileMan internal date with optional time
;;4;17
;;8;S %H={B} D YMD^%DTC S {I}=X_$S($G(%):%,1:"")
;;10;S X={I} D H^%DTC S:$G(%T)=86400 %T=0,%H=%H+1 S {B}=%H_$S($G(%T)]"":","_%T,1:"")
;;11;DT
12 ;;.01;FM_BOOLEAN
;;1;2
;;2;Translate FileMan logical to ODBC
;;7;$S({B}="":0,1:{B})
;;9;$S({I}:{I},1:"")
;;11;B
13 ;;.01;POINTER
;;1;3
;;2;Pointer to FileMan files in FILE - no subfiles
;;4;10
;;11;P
14 ;;.01;WORD_PROCESSING
;;1;9
;;2;FileMan WORD-PROCESSING data type
;;4;70
;;11;W
15 ;;.01;SET_OF_CODES
;;1;2
;;2;FileMan SET-OF-CODES data type
;;4;13
;;11;S
16 ;;.01;VARIABLE_POINTER
;;1;2
;;2;FileMan VARIABLE POINTER data type
;;4;13
;;11;V
17 ;;.01;FM_MUMPS
;;1;2
;;2;FileMan MUMPS data type
;;4;245
;;11;K
18 ;;.01;FM_DATE_TIME
;;1;7
;;2;Base-internal of FileMan internal date with required time
;;4;17
;;8;S %H={B} S:'$P(%H,",",2) %H=%H-1_",86400" D YMD^%DTC S {I}=X_$S($G(%):%,1:"")
;;10;S X={I} D H^%DTC S:$G(%T)=86400 %T=0,%H=%H+1 S {B}=%H_","_(+$G(%T))
;;11;DTR
99 ;;END FLAG
DMSQD ;SFISC/JHM-SETUP FOR DATATYPE AND DOMAIN ;5/7/98 14:53
+1 ;;22.0;VA FileMan;;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
LCKF ;BUILD KEY FORMAT FOR LONG CHARACTER FIELDS
+1 NEW KFI,DTI,KIE,KIX
+2 SET KFI=$ORDER(^DMSQ("KF","B","LONG_CHARACTER",""))
+3 SET DTI=$ORDER(^DMSQ("DT","B","CHARACTER",""))
+4 IF 'DTI
DO F(2)
SET DTI=$ORDER(^DMSQ("DT","B","CHARACTER",""))
IF 'DTI
QUIT
+5 SET KIE="$E({I},1,30)"
SET KIX="S {K}="_KIE
+6 SET IEN=$SELECT(KFI:KFI,1:"+1")_","
SET TT=1.5213
+7 ;NAME
SET FDA(TT,IEN,.01)="LONG_CHARACTER"
+8 ;DATA TYPE
SET FDA(TT,IEN,1)=DTI
+9 ;COMM
SET FDA(TT,IEN,2)="Truncate long free text fields to 30 characters"
+10 ;EXPRESSION FORMAT
SET FDA(TT,IEN,3)=KIE
+11 ;EXECUTE FORMAT
SET FDA(TT,IEN,4)=KIX
+12 SET KFI=$$PUT^DMSQU(IEN,"FDA","ERR")
+13 IF $DATA(ERR)!'KFI
DO ERR^DMSQU(TT,"","KEY FORMAT: LONG_CHARACTER INSERT FAILED")
+14 QUIT
VPTOF(F,FI) ;BUILD OUTPUT FORMAT FOR VARIABLE POINTER FILE F, FIELD FI
+1 NEW TI,ON,OI,TT,IEN,BE,FDA,ERR
SET TI=$ORDER(^DMSQ("T","C",F,""))
IF 'TI
QUIT ""
+2 SET T=^DMSQ("T",TI,0)
SET ON=$$SQLK^DMSQU($PIECE(T,U)_"_VPOF",30)
+3 SET OI=$ORDER(^DMSQ("OF","B",ON,""))
SET TT=1.5214
SET IEN=$SELECT(OI:OI,1:"+1")_","
+4 SET BE="$$EXT^DMSQU("_F_","_FI_","""",{B})"
+5 ;OF NAME
SET FDA(TT,IEN,.01)=ON
+6 ; BASE DATA TYPE IS CHARACTER
SET FDA(TT,IEN,1)=2
+7 ; COMMENT
SET FDA(TT,IEN,2)="Variable pointer output format"
+8 ; OUTPUT TRANSFORM
SET FDA(TT,IEN,3)=BE
+9 SET OI=$$PUT^DMSQU(IEN,"FDA","ERR")
+10 IF $DATA(ERR)!'OI
DO ERR^DMSQU(TI,FI,"OUTPUT FORMAT: INSERT OF VARIABLE POINTER OUTPUT FORMAT FAILED")
+11 QUIT OI
PTROF(F) ;BUILD OUTPUT FORMAT FOR POINTER TO TABLE FI
+1 NEW TI,ON,OI,TT,IEN,BE,FDA,ERR
SET TI=$ORDER(^DMSQ("T","C",F,""))
IF 'TI
QUIT ""
+2 SET T=^DMSQ("T",TI,0)
SET ON=$$SQLK^DMSQU($PIECE(T,U)_"_PTOF",30)
+3 SET OI=$ORDER(^DMSQ("OF","B",ON,""))
SET TT=1.5214
SET IEN=$SELECT(OI:OI,1:"+1")_","
+4 SET BE="$S('{B}:"""",1:$$GET^DMSQU("_F_",{B}_"","",.01))"
+5 ;OF NAME
SET FDA(TT,IEN,.01)=ON
+6 ; BASE DATA TYPE IS INTEGER
SET FDA(TT,IEN,1)=3
+7 ; COMMENT
SET FDA(TT,IEN,2)="Output format for pointer to "_$PIECE(T,U)
+8 ; OUTPUT TRANSFORM
SET FDA(TT,IEN,3)=BE
+9 SET OI=$$PUT^DMSQU(IEN,"FDA","ERR")
+10 IF $DATA(ERR)!'OI
DO ERR^DMSQU(TI,FI,"OUTPUT FORMAT: INSERT OF POINTER OUTPUT FORMAT FAILED")
+11 QUIT OI
BE ;;$P($P("{S}",";"_{B}_":",2),";")
SETOF(SD) ;BUILD PUTPUT FORMAT FOR SET DEFINITION SD
+1 NEW ON,OI,FDA,ERR,BE,TT,IEN,SL
+2 ;" " IS USED FOR DEFAULT CODE
IF SD?1P.E
SET $EXTRACT(SD,1)="Z"
+3 SET ON=$$SQLK^DMSQU(SD,30)
SET OI=$ORDER(^DMSQ("OF","B",ON,""))
+4 IF $EXTRACT(SD)'=";"
SET SD=";"_SD
IF $EXTRACT(SD,$LENGTH(SD))'=";"
SET SD=SD_";"
+5 SET BE=$PIECE($TEXT(BE),";;",2,99)
SET BE=$PIECE(BE,"{S}")_SD_$PIECE(BE,"{S}",2)
+6 ;BUILD OUTPUT FORMAT
+7 SET TT=1.5214
SET IEN=$SELECT(OI:OI,1:"+1")_","
+8 ;OUTPUT FORMAT NAME
SET FDA(TT,IEN,.01)=ON
+9 ;CHARACTER DATA TYPE
SET FDA(TT,IEN,1)=2
+10 ;COMMENT
SET FDA(TT,IEN,2)="Set output format"
+11 ;OUTPUT TRANSFORM EXPRESSION
SET FDA(TT,IEN,3)=BE
+12 SET OI=$$PUT^DMSQU(IEN,"FDA","ERR")
+13 IF $DATA(ERR)!'OI
DO ERR^DMSQU($GET(F),$GET(FI),"OUTPUT FORMAT: INSERT OF SET-OF-CODES OUTPUT FORMAT FAILED")
+14 QUIT OI
+15 ;KW SOURCE ARRAY MUST HAVE THE FORM:
+16 ; SRC(I)=KW : FOR EVERY I THERE MUST BE A KEYWORD
+17 ;SRC MAY BE LOCAL OR GLOBAL, BUT MUST WORK IN THE SYNTAX @SRC@(I)
+18 ;CALL: D KW("^SRC",.ERR)
KW(SRC,ERR) ;LOAD KEYWORD GLOBAL FROM ARRAY SRC
+1 ;RETURN ERRORS IN ERR: D KW^DMSQD("^SRC(,1,",.ERROR)
+2 IF $GET(SRC)=""
QUIT
IF $GET(DUZ(0))'["@"
SET ERR="ACCESS DENIED"
QUIT
+3 NEW E,DIERR,I,TT,KW,IEN,FDA,@$$NEW^DMSQU
KILL ERR
DO ENV^DMSQU
+4 SET TT=1.52101
SET I=""
+5 IF $ORDER(@SRC@(""))=""
SET ERR="INVALID OR MISSING KEYWORD ARRAY"
QUIT
+6 FOR
SET I=$ORDER(@SRC@(I))
IF I=""!$DATA(ERR)
QUIT
Begin DoDot:1
+7 SET KW=$GET(@SRC@(I))
IF KW=""
QUIT
+8 SET IEN=$ORDER(^DMSQ("K","B",KW,""))
+9 SET IEN=$SELECT(IEN:IEN,1:"+1")_","
+10 DO VAL^DIE(TT,IEN,.01,"F",.KW,"","FDA","E")
+11 IF $DATA(DIERR)
SET ERR=E("DIERR",1,"TEXT",1)
QUIT
+12 SET IEN=$$PUT^DMSQU(IEN,"FDA","ERR")
+13 IF $DATA(ERR)!'IEN
SET ERR="KEYWORD-$$PUT FAILED"
End DoDot:1
+14 QUIT
DMDT FOR I=1:1
IF $TEXT(@I)=""
QUIT
DO F(I)
+1 SET $PIECE(^DMSQ("DM",0),U,3)=99
+2 QUIT
F(DI) NEW I,FDA,FDB,ERR,IEN,TT,EO
+1 SET TT=1.5212
SET IEN=$SELECT($DATA(^DMSQ("DM",DI)):DI,1:"+1")_","
+2 FOR I=0:1
SET T=$TEXT(@DI+I)
IF T>DI
QUIT
Begin DoDot:1
+3 SET FDA(TT,IEN,$PIECE(T,";",3))=$PIECE(T,";",4,99)
End DoDot:1
+4 IF FDA(TT,IEN,1)=DI
Begin DoDot:1
+5 NEW DIEN
SET DIEN=$SELECT($DATA(^DMSQ("DT",DI)):DI,1:"+1")_","
+6 SET FDB(1.5211,DIEN,.01)=FDA(TT,IEN,.01)
+7 SET FDB(1.5211,DIEN,1)=FDA(TT,IEN,2)
+8 SET EO=$$PUT^DMSQU(DIEN,"FDB","ERR")
+9 IF $DATA(ERR)
DO ERR^DMSQU(1.5211,"","DATA TYPE: INSERT OF DATA TYPE RECORD FAILED")
End DoDot:1
IF $DATA(ERR)
QUIT
+10 SET EO=$$PUT^DMSQU(IEN,"FDA","ERR")
+11 IF $DATA(ERR)
DO ERR^DMSQU(1.5212,"","DOMAIN: INSERT OF DOMAIN RECORD FAILED")
+12 QUIT
1 ;;.01;PRIMARY_KEY
+1 ;;1;1
+2 ;;2;Table domain, used for primary and foreign keys
2 ;;.01;CHARACTER
+1 ;;1;2
+2 ;;2;Free Text less than 256 characters
+3 ;;4;30
3 ;;.01;INTEGER
+1 ;;1;3
+2 ;;2;Up to 15 numeric characters without leading zeroes
+3 ;;4;10
4 ;;.01;NUMERIC
+1 ;;1;4
+2 ;;2;Up to 15 numeric characters with at most one decimal point
+3 ;;4;10
+4 ;;5;2
5 ;;.01;DATE
+1 ;;1;5
+2 ;;2;Base date is M $H format, ODBC = YYYY-MM-DD
+3 ;;4;8
6 ;;.01;TIME
+1 ;;1;6
+2 ;;2;Base is M $H format, ODBC = HH:MM:SS[.S...]
+3 ;;4;8
7 ;;.01;MOMENT
+1 ;;1;7
+2 ;;2;Base is M $H format
+3 ;;4;17
8 ;;.01;BOOLEAN
+1 ;;1;8
+2 ;;2;YES or NO, internally 1 or 0
+3 ;;4;3
9 ;;.01;MEMO
+1 ;;1;9
+2 ;;2;Huge character string up to 32KB long
+3 ;;4;70
10 ;;.01;FM_DATE
+1 ;;1;5
+2 ;;2;Handle base-internal translation of FileMan internal date w/o time
+3 ;;4;8
+4 ;;8;S %H={B} D YMD^%DTC S {I}=X
+5 ;;10;S X={I} D H^%DTC S {B}=%H
+6 ;;11;D
11 ;;.01;FM_MOMENT
+1 ;;1;7
+2 ;;2;Base-internal of FileMan internal date with optional time
+3 ;;4;17
+4 ;;8;S %H={B} D YMD^%DTC S {I}=X_$S($G(%):%,1:"")
+5 ;;10;S X={I} D H^%DTC S:$G(%T)=86400 %T=0,%H=%H+1 S {B}=%H_$S($G(%T)]"":","_%T,1:"")
+6 ;;11;DT
12 ;;.01;FM_BOOLEAN
+1 ;;1;2
+2 ;;2;Translate FileMan logical to ODBC
+3 ;;7;$S({B}="":0,1:{B})
+4 ;;9;$S({I}:{I},1:"")
+5 ;;11;B
13 ;;.01;POINTER
+1 ;;1;3
+2 ;;2;Pointer to FileMan files in FILE - no subfiles
+3 ;;4;10
+4 ;;11;P
14 ;;.01;WORD_PROCESSING
+1 ;;1;9
+2 ;;2;FileMan WORD-PROCESSING data type
+3 ;;4;70
+4 ;;11;W
15 ;;.01;SET_OF_CODES
+1 ;;1;2
+2 ;;2;FileMan SET-OF-CODES data type
+3 ;;4;13
+4 ;;11;S
16 ;;.01;VARIABLE_POINTER
+1 ;;1;2
+2 ;;2;FileMan VARIABLE POINTER data type
+3 ;;4;13
+4 ;;11;V
17 ;;.01;FM_MUMPS
+1 ;;1;2
+2 ;;2;FileMan MUMPS data type
+3 ;;4;245
+4 ;;11;K
18 ;;.01;FM_DATE_TIME
+1 ;;1;7
+2 ;;2;Base-internal of FileMan internal date with required time
+3 ;;4;17
+4 ;;8;S %H={B} S:'$P(%H,",",2) %H=%H-1_",86400" D YMD^%DTC S {I}=X_$S($G(%):%,1:"")
+5 ;;10;S X={I} D H^%DTC S:$G(%T)=86400 %T=0,%H=%H+1 S {B}=%H_","_(+$G(%T))
+6 ;;11;DTR
99 ;;END FLAG
