source: ccr/trunk/p/C0CFM3.m@ 797

Last change on this file since 797 was 415, checked in by George Lilly, 16 years ago

Renamed CCRDPT to C0CDPT

File size: 10.6 KB
Line 
1C0CFM3 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
2 ;;0.1;CCDCCR;nopatch;noreleasedate
3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU
4 ;General Public License See attached copy of the License.
5 ;
6 ;This program is free software; you can redistribute it and/or modify
7 ;it under the terms of the GNU General Public License as published by
8 ;the Free Software Foundation; either version 2 of the License, or
9 ;(at your option) any later version.
10 ;
11 ;This program is distributed in the hope that it will be useful,
12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;GNU General Public License for more details.
15 ;
16 ;You should have received a copy of the GNU General Public License along
17 ;with this program; if not, write to the Free Software Foundation, Inc.,
18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 ;
20 W "This is the CCR FILEMAN Utility Library ",!
21 ; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF
22 ; CCR ELEMENTS (^C0C(179.201,
23 ; E2 IS A SIMPLIFICATION OF CCR ELEMENTS WHERE SUB-ELEMENTS ARE
24 ; AT THE TOP LEVEL. OCCURANCE, THE 4TH PART OF THE KEY IS NOW FREE TEXT
25 ; AND HAS THE FORM X;Y FOR SUB-ELEMENTS
26 ; ALL SUB-VARIABLES HAVE BEEN REMOVED
27 W !
28 Q
29 ;
30RIMTBL(ZWHICH) ; PUT ALL PATIENT IN RIMTBL ZWHICH INTO THE CCR ELEMENTS FILE
31 ; '
32 I '$D(RIMBASE) D ASETUP^GPLRIMA ; FOR COMMAND LINE CALLS
33 N ZI,ZJ,ZC,ZPATBASE
34 S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",ZWHICH))
35 S ZI=""
36 F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END
37 . S ZI=$O(@ZPATBASE@(ZI))
38 . D PUTRIM(ZI) ; EXPORT THE PATIENT TO A FILE
39 Q
40 ;
41PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
42 ;
43 S C0CGLB=$NA(^TMP("C0CRIM","VARS",DFN))
44 I '$D(ZWHICH) S ZWHICH="ALL"
45 I ZWHICH'="ALL" D ; SINGLE SECTION REQUESTED
46 . S C0CVARS=$NA(@C0CGLB@(ZWHICH))
47 . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
48 E D ; MULTIPLE SECTIONS
49 . S C0CVARS=$NA(@C0CGLB)
50 . S C0CI=""
51 . F S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI="" D ;FOR EACH SECTION
52 . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
53 . . D PUTRIM1(DFN,C0CI,C0CVARSN)
54 Q
55 ;
56PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS
57 ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
58 S C0CX=0
59 F S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX="" D ; FOR EACH OCCURANCE
60 . W "ZOCC=",C0CX,!
61 . K C0CMDO ; MULTIPLE SUBELEMENTS FOR THIS OCCURANCE PASSED BY NAME
62 . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
63 . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
64 . I $D(C0CMDO) D ; MULTIPLES TO HANDLE (THIS IS INSTEAD OF RECURSION :()
65 . . N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
66 . . S ZZCNT=0
67 . . S ZZC0CI=0
68 . . S ZZVALS=$NA(@C0CMDO@("M")) ; LOCATION OF THIS MULTILPE
69 . . S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
70 . . S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
71 . . W "MULTIPLE:",ZZVALS,!
72 . . ;B
73 . . F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE
74 . . . S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
75 . . . W "COUNT:",ZZCNT,!
76 . . . S ZV=$NA(@ZZVALS@(ZZC0CI))
77 . . . D PUTELS(DFN,ZT,C0CX_";"_ZZCNT,ZV)
78 Q
79 ;
80PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
81 ; 171.601, ^C0CE DFN IS THE PATIENT IEN PASSED BY VALUE
82 ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
83 ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
84 ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
85 ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
86 ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
87 ;
88 N ZSRC,PATN,ZTYPN,XD0,ZTYP
89 S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
90 ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
91 N C0CF S C0CF=171.601 ; FILE AT ELEMENT LEVEL
92 N C0CFV S C0CFV=171.6011 ; FILE AT VARIABLE LVL
93 N C0CFDA
94 N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
95 W "ZTYPE: ",ZTYPE," ",ZTYPN,!
96 N ZVARN ; IEN OF VARIABLE BEING PROCESSED
97 ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
98 S C0CFDA(C0CF,"+1,",.01)=ZTYPN
99 S C0CFDA(C0CF,"+1,",.02)=DFN
100 S C0CFDA(C0CF,"+1,",.03)=ZSRC
101 S C0CFDA(C0CF,"+1,",.04)=" "_ZOCC ;CREATE OCCURANCE with leading space
102 D UPDIE ; CREATE THE RECORD
103 S C0CIEN=$O(^C0CE4("C",DFN,ZSRC,ZTYPN," "_ZOCC,""))
104 N ZCNT,ZC0CI,ZVARN,C0CZ1
105 S ZCNT=0
106 S ZC0CI="" ;
107 F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;
108 . I ZC0CI'="M" D ; NOT A SUBVARIABLE
109 . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
110 . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
111 . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
112 . . S C0CFDA(C0CFV,"+"_ZCNT_","_C0CIEN_",",.01)=ZVARN
113 . . S C0CFDA(C0CFV,"+"_ZCNT_","_C0CIEN_",",1)=@ZVALS@(ZC0CI)
114 . E D ; THIS IS A SUBELEMENT
115 . . ;PUT THE FOLLOWING BACK TO USE RECURSION
116 . . ;N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
117 . . ;S ZZCNT=0
118 . . ;S ZZC0CI=0
119 . . ;S ZZVALS=$NA(@ZVALS@("M")) ; LOCATION OF THIS MULTILPE
120 . . ;S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
121 . . ;S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
122 . . ;W "MULTIPLE:",ZZVALS,!
123 . . ;B
124 . . ;F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE
125 . . ;. S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
126 . . ;. W "COUNT:",ZZCNT,!
127 . . ;. S ZV=$NA(@ZZVALS@(ZZC0CI))
128 . . ;. D PUTELS(DFN,ZT,ZOCC_";"_ZZCNT,ZV) ; PUT THIS BACK TO DEBUG RECURSION
129 . . S C0CMDO=ZVALS ; FLAG TO HANDLE MULTIPLES (INSTEAD OF RECURSION)
130 D UPDIE ; UPDATE
131 Q
132 ;
133UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
134 K ZERR
135 D CLEAN^DILF
136 D UPDATE^DIE("","C0CFDA","","ZERR")
137 I $D(ZERR) D ;
138 . W "ERROR",!
139 . ZWR ZERR
140 . B
141 K C0CFDA
142 Q
143 ;
144PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
145 ; 171.101, ^C0CE DFN IS THE PATIENT IEN PASSED BY VALUE
146 ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
147 ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
148 ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
149 ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
150 ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
151 ;
152 S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
153 ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
154 N ZF,ZFV S ZF=171.101 S ZFV=171.1011
155 ;S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
156 ;N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
157 N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
158 W "ZTYPE: ",ZTYPE," ",ZTYPN,!
159 N ZVARN ; IEN OF VARIABLE BEING PROCESSED
160 ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
161 K C0CFDA
162 S C0CFDA(ZF,"?+1,",.01)=DFN
163 S C0CFDA(ZF,"?+1,",.02)=ZSRC
164 S C0CFDA(ZF,"?+1,",.03)=ZTYPN
165 S C0CFDA(ZF,"?+1,",.04)=" "_ZOCC ;CREATE OCCURANCE
166 K ZERR
167 ;B
168 D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
169 I $D(ZERR) B ;OOPS
170 K C0CFDA
171 S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
172 W "RECORD NUMBER: ",ZD0,!
173 ;B
174 S ZCNT=0
175 S ZC0CI="" ;
176 F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;
177 . I ZC0CI'="M" D ; NOT A SUBVARIABLE
178 . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
179 . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
180 . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
181 . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
182 . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
183 . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
184 . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
185 ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
186 ;S GT1(170,"?+1,",12)="DIR"
187 ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
188 ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
189 D CLEAN^DILF
190 D UPDATE^DIE("","C0CFDA","","ZERR")
191 I $D(ZERR) D ;
192 . W "ERROR",!
193 . ZWR ZERR
194 . B
195 K C0CFDA
196 Q
197 ;
198VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
199 ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
200 ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
201 ;
202 N ZCCRD,ZVARN,C0CFDA2
203 S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
204 S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
205 I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
206 . I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE
207 . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
208 . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
209 . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
210 . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
211 . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
212 . I $D(ZERR) D ; LAYGO ERROR
213 . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
214 . E D ;
215 . . D CLEAN^DILF ; CLEAN UP
216 . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
217 . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
218 Q ZVARN
219 ;
220BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
221 ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
222 ;
223 N C0CDIC,C0CNODE ;
224 S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY
225 S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE
226 Q
227 ;
228FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED
229 ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
230 ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
231 ; CONVERSION
232 ;N C0CC,C0CI,C0CJ,C0CN,C0CZX
233 D FIELDS^C0CRNF("C0CC",170)
234 S C0CI=""
235 F S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI="" D ; EACH SECTION
236 . S C0CZX=""
237 . F S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX="" D ; EACH VARIABLE
238 . . W "SECTION ",C0CI," VAR ",C0CZX
239 . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
240 . . W " TYPE: ",C0CV,!
241 . . D SETFDA("SECTION",C0CV)
242 . . ;ZWR C0CFDA
243 Q
244 ;
245SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
246 ; TO SET TO VALUE C0CSV.
247 ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
248 ; C0CSN,C0CSV ARE PASSED BY VALUE
249 ;
250 N C0CSI,C0CSJ
251 S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
252 S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
253 S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
254 Q
255ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
256 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
257 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
258 I '$D(ZTAB) S ZTAB="C0CA"
259 N ZR
260 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
261 E S ZR=""
262 Q ZR
263ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
264 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
265 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
266 I '$D(ZTAB) S ZTAB="C0CA"
267 N ZR
268 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
269 E S ZR=""
270 Q ZR
271 ;
272ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
273 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
274 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
275 I '$D(ZTAB) S ZTAB="C0CA"
276 N ZR
277 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
278 E S ZR=""
279 Q ZR
280 ;
281SHOWE4(DFN) ;
282 ;
283 N ZG
284 S ZG=""
285 F S ZG=$O(^C0CE4("P",DFN,ZG)) Q:ZG="" D ZWR ^C0CE4(ZG,*)
286 Q
287 ;
Note: See TracBrowser for help on using the repository browser.