source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DMSQD.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 6.0 KB
RevLine 
[613]1DMSQD ;SFISC/JHM-SETUP FOR DATATYPE AND DOMAIN ;5/7/98 14:53
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5LCKF ;BUILD KEY FORMAT FOR LONG CHARACTER FIELDS
6 N KFI,DTI,KIE,KIX
7 S KFI=$O(^DMSQ("KF","B","LONG_CHARACTER",""))
8 S DTI=$O(^DMSQ("DT","B","CHARACTER",""))
9 I 'DTI D F(2) S DTI=$O(^DMSQ("DT","B","CHARACTER","")) I 'DTI Q
10 S KIE="$E({I},1,30)",KIX="S {K}="_KIE
11 S IEN=$S(KFI:KFI,1:"+1")_",",TT=1.5213
12 S FDA(TT,IEN,.01)="LONG_CHARACTER" ;NAME
13 S FDA(TT,IEN,1)=DTI ;DATA TYPE
14 S FDA(TT,IEN,2)="Truncate long free text fields to 30 characters" ;COMM
15 S FDA(TT,IEN,3)=KIE ;EXPRESSION FORMAT
16 S FDA(TT,IEN,4)=KIX ;EXECUTE FORMAT
17 S KFI=$$PUT^DMSQU(IEN,"FDA","ERR")
18 I $D(ERR)!'KFI D ERR^DMSQU(TT,"","KEY FORMAT: LONG_CHARACTER INSERT FAILED")
19 Q
20VPTOF(F,FI) ;BUILD OUTPUT FORMAT FOR VARIABLE POINTER FILE F, FIELD FI
21 N TI,ON,OI,TT,IEN,BE,FDA,ERR S TI=$O(^DMSQ("T","C",F,"")) Q:'TI ""
22 S T=^DMSQ("T",TI,0),ON=$$SQLK^DMSQU($P(T,U)_"_VPOF",30)
23 S OI=$O(^DMSQ("OF","B",ON,"")),TT=1.5214,IEN=$S(OI:OI,1:"+1")_","
24 S BE="$$EXT^DMSQU("_F_","_FI_","""",{B})"
25 S FDA(TT,IEN,.01)=ON ;OF NAME
26 S FDA(TT,IEN,1)=2 ; BASE DATA TYPE IS CHARACTER
27 S FDA(TT,IEN,2)="Variable pointer output format" ; COMMENT
28 S FDA(TT,IEN,3)=BE ; OUTPUT TRANSFORM
29 S OI=$$PUT^DMSQU(IEN,"FDA","ERR")
30 I $D(ERR)!'OI D ERR^DMSQU(TI,FI,"OUTPUT FORMAT: INSERT OF VARIABLE POINTER OUTPUT FORMAT FAILED")
31 Q OI
32PTROF(F) ;BUILD OUTPUT FORMAT FOR POINTER TO TABLE FI
33 N TI,ON,OI,TT,IEN,BE,FDA,ERR S TI=$O(^DMSQ("T","C",F,"")) Q:'TI ""
34 S T=^DMSQ("T",TI,0),ON=$$SQLK^DMSQU($P(T,U)_"_PTOF",30)
35 S OI=$O(^DMSQ("OF","B",ON,"")),TT=1.5214,IEN=$S(OI:OI,1:"+1")_","
36 S BE="$S('{B}:"""",1:$$GET^DMSQU("_F_",{B}_"","",.01))"
37 S FDA(TT,IEN,.01)=ON ;OF NAME
38 S FDA(TT,IEN,1)=3 ; BASE DATA TYPE IS INTEGER
39 S FDA(TT,IEN,2)="Output format for pointer to "_$P(T,U) ; COMMENT
40 S FDA(TT,IEN,3)=BE ; OUTPUT TRANSFORM
41 S OI=$$PUT^DMSQU(IEN,"FDA","ERR")
42 I $D(ERR)!'OI D ERR^DMSQU(TI,FI,"OUTPUT FORMAT: INSERT OF POINTER OUTPUT FORMAT FAILED")
43 Q OI
44BE ;;$P($P("{S}",";"_{B}_":",2),";")
45SETOF(SD) ;BUILD PUTPUT FORMAT FOR SET DEFINITION SD
46 N ON,OI,FDA,ERR,BE,TT,IEN,SL
47 I SD?1P.E S $E(SD,1)="Z" ;" " IS USED FOR DEFAULT CODE
48 S ON=$$SQLK^DMSQU(SD,30),OI=$O(^DMSQ("OF","B",ON,""))
49 S:$E(SD)'=";" SD=";"_SD S:$E(SD,$L(SD))'=";" SD=SD_";"
50 S BE=$P($T(BE),";;",2,99),BE=$P(BE,"{S}")_SD_$P(BE,"{S}",2)
51 ;BUILD OUTPUT FORMAT
52 S TT=1.5214,IEN=$S(OI:OI,1:"+1")_","
53 S FDA(TT,IEN,.01)=ON ;OUTPUT FORMAT NAME
54 S FDA(TT,IEN,1)=2 ;CHARACTER DATA TYPE
55 S FDA(TT,IEN,2)="Set output format" ;COMMENT
56 S FDA(TT,IEN,3)=BE ;OUTPUT TRANSFORM EXPRESSION
57 S OI=$$PUT^DMSQU(IEN,"FDA","ERR")
58 I $D(ERR)!'OI D ERR^DMSQU($G(F),$G(FI),"OUTPUT FORMAT: INSERT OF SET-OF-CODES OUTPUT FORMAT FAILED")
59 Q OI
60 ;KW SOURCE ARRAY MUST HAVE THE FORM:
61 ; SRC(I)=KW : FOR EVERY I THERE MUST BE A KEYWORD
62 ;SRC MAY BE LOCAL OR GLOBAL, BUT MUST WORK IN THE SYNTAX @SRC@(I)
63 ;CALL: D KW("^SRC",.ERR)
64KW(SRC,ERR) ;LOAD KEYWORD GLOBAL FROM ARRAY SRC
65 ;RETURN ERRORS IN ERR: D KW^DMSQD("^SRC(,1,",.ERROR)
66 Q:$G(SRC)="" I $G(DUZ(0))'["@" S ERR="ACCESS DENIED" Q
67 N E,DIERR,I,TT,KW,IEN,FDA,@$$NEW^DMSQU K ERR D ENV^DMSQU
68 S TT=1.52101,I=""
69 I $O(@SRC@(""))="" S ERR="INVALID OR MISSING KEYWORD ARRAY" Q
70 F S I=$O(@SRC@(I)) Q:I=""!$D(ERR) D
71 . S KW=$G(@SRC@(I)) Q:KW=""
72 . S IEN=$O(^DMSQ("K","B",KW,""))
73 . S IEN=$S(IEN:IEN,1:"+1")_","
74 . D VAL^DIE(TT,IEN,.01,"F",.KW,"","FDA","E")
75 . I $D(DIERR) S ERR=E("DIERR",1,"TEXT",1) Q
76 . S IEN=$$PUT^DMSQU(IEN,"FDA","ERR")
77 . I $D(ERR)!'IEN S ERR="KEYWORD-$$PUT FAILED"
78 Q
79DMDT F I=1:1 Q:$T(@I)="" D F(I)
80 S $P(^DMSQ("DM",0),U,3)=99
81 Q
82F(DI) N I,FDA,FDB,ERR,IEN,TT,EO
83 S TT=1.5212,IEN=$S($D(^DMSQ("DM",DI)):DI,1:"+1")_","
84 F I=0:1 S T=$T(@DI+I) Q:T>DI D
85 . S FDA(TT,IEN,$P(T,";",3))=$P(T,";",4,99)
86 I FDA(TT,IEN,1)=DI D Q:$D(ERR)
87 . N DIEN S DIEN=$S($D(^DMSQ("DT",DI)):DI,1:"+1")_","
88 . S FDB(1.5211,DIEN,.01)=FDA(TT,IEN,.01)
89 . S FDB(1.5211,DIEN,1)=FDA(TT,IEN,2)
90 . S EO=$$PUT^DMSQU(DIEN,"FDB","ERR")
91 . I $D(ERR) D ERR^DMSQU(1.5211,"","DATA TYPE: INSERT OF DATA TYPE RECORD FAILED")
92 S EO=$$PUT^DMSQU(IEN,"FDA","ERR")
93 I $D(ERR) D ERR^DMSQU(1.5212,"","DOMAIN: INSERT OF DOMAIN RECORD FAILED")
94 Q
951 ;;.01;PRIMARY_KEY
96 ;;1;1
97 ;;2;Table domain, used for primary and foreign keys
982 ;;.01;CHARACTER
99 ;;1;2
100 ;;2;Free Text less than 256 characters
101 ;;4;30
1023 ;;.01;INTEGER
103 ;;1;3
104 ;;2;Up to 15 numeric characters without leading zeroes
105 ;;4;10
1064 ;;.01;NUMERIC
107 ;;1;4
108 ;;2;Up to 15 numeric characters with at most one decimal point
109 ;;4;10
110 ;;5;2
1115 ;;.01;DATE
112 ;;1;5
113 ;;2;Base date is M $H format, ODBC = YYYY-MM-DD
114 ;;4;8
1156 ;;.01;TIME
116 ;;1;6
117 ;;2;Base is M $H format, ODBC = HH:MM:SS[.S...]
118 ;;4;8
1197 ;;.01;MOMENT
120 ;;1;7
121 ;;2;Base is M $H format
122 ;;4;17
1238 ;;.01;BOOLEAN
124 ;;1;8
125 ;;2;YES or NO, internally 1 or 0
126 ;;4;3
1279 ;;.01;MEMO
128 ;;1;9
129 ;;2;Huge character string up to 32KB long
130 ;;4;70
13110 ;;.01;FM_DATE
132 ;;1;5
133 ;;2;Handle base-internal translation of FileMan internal date w/o time
134 ;;4;8
135 ;;8;S %H={B} D YMD^%DTC S {I}=X
136 ;;10;S X={I} D H^%DTC S {B}=%H
137 ;;11;D
13811 ;;.01;FM_MOMENT
139 ;;1;7
140 ;;2;Base-internal of FileMan internal date with optional time
141 ;;4;17
142 ;;8;S %H={B} D YMD^%DTC S {I}=X_$S($G(%):%,1:"")
143 ;;10;S X={I} D H^%DTC S:$G(%T)=86400 %T=0,%H=%H+1 S {B}=%H_$S($G(%T)]"":","_%T,1:"")
144 ;;11;DT
14512 ;;.01;FM_BOOLEAN
146 ;;1;2
147 ;;2;Translate FileMan logical to ODBC
148 ;;7;$S({B}="":0,1:{B})
149 ;;9;$S({I}:{I},1:"")
150 ;;11;B
15113 ;;.01;POINTER
152 ;;1;3
153 ;;2;Pointer to FileMan files in FILE - no subfiles
154 ;;4;10
155 ;;11;P
15614 ;;.01;WORD_PROCESSING
157 ;;1;9
158 ;;2;FileMan WORD-PROCESSING data type
159 ;;4;70
160 ;;11;W
16115 ;;.01;SET_OF_CODES
162 ;;1;2
163 ;;2;FileMan SET-OF-CODES data type
164 ;;4;13
165 ;;11;S
16616 ;;.01;VARIABLE_POINTER
167 ;;1;2
168 ;;2;FileMan VARIABLE POINTER data type
169 ;;4;13
170 ;;11;V
17117 ;;.01;FM_MUMPS
172 ;;1;2
173 ;;2;FileMan MUMPS data type
174 ;;4;245
175 ;;11;K
17618 ;;.01;FM_DATE_TIME
177 ;;1;7
178 ;;2;Base-internal of FileMan internal date with required time
179 ;;4;17
180 ;;8;S %H={B} S:'$P(%H,",",2) %H=%H-1_",86400" D YMD^%DTC S {I}=X_$S($G(%):%,1:"")
181 ;;10;S X={I} D H^%DTC S:$G(%T)=86400 %T=0,%H=%H+1 S {B}=%H_","_(+$G(%T))
182 ;;11;DTR
18399 ;;END FLAG
Note: See TracBrowser for help on using the repository browser.